GopherProxy

	Added code for password modes - pee - Pee a password manager;Pee - because you …
	git clone git://vernunftzentrum.de/pee.git
	Log
	Files
	Refs
	LICENSE
	---
	commit ba5446f2cf49fc4c1c2b9447fdad838c3cada3e3
	parent 68423fd8d0b50e881e715610cbb6b34336586ad5
	Author: Christian Kellermann <[email protected]>
	Date: Tue, 12 Jan 2016 16:47:35 +0100

	Added code for password modes

	Some websites have very specific ideas about how passwords should look
	like. This commit introduces the idea of password modes. Currently a
	charset is substracted from the inital charset to prevent "forbidden
	characters" in passwords.

	Entropy calculation is based on the resulting charset, thus the lenght
	will when switching modes.

	The modes are

	(define password-modes
	'(("all chars" . "")
	("alpha-numeric" . "!@#$%^&*()-=~?/\\|+,:.<>{}[]")
	("easy-to-read" . "l1o0I\|!ji")
	("some-funny-chars" . "\|\\[]{}<>~&")))

	Diffstat:
	README.rst \| 10 ++++++++++
	pee.scm \| 69 ++++++++++++++++++++-----------
	static-compilation.sh \| 2 +-

	3 files changed, 55 insertions(+), 26 deletions(-)
	---
	diff --git a/README.rst b/README.rst
	@@ -55,6 +55,16 @@ For symmertric encryption the tweetnacl library is used.
	If running on OpenBSD, passwords are generated using OpenBSD's `arc4random()`_…
	If running on any other OS /dev/random will be used as a source for random byt…
	Passwords are choosen from this set of characters "abcdefhijklmnopqrstuvwxyzAB…
	+There are currently several password modes available that substract a subset o…
	+
	+The modes are::
	+
	+ '(("all chars" . "")
	+ ("alpha-numeric" . "!@#$%^&*()-=~?/\\|+,:.<>{}[]")
	+ ("easy-to-read" . "l1o0I\|!ji")
	+ ("some-funny-chars" . "\|\\[]{}<>~&")))
	+
	+

	__ http://www.openbsd.org/cgi-bin/man.cgi/OpenBSD-current/man3/arc4random.3

	diff --git a/pee.scm b/pee.scm
	@@ -14,7 +14,7 @@
	;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
	;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

	-(use (srfi 1 4) matchable posix tweetnacl utils crypto-helper getopt-long stty)
	+(use (srfi 1 4 14) matchable posix tweetnacl utils crypto-helper getopt-long s…

	(define-constant program-name "pee")
	(define-constant program-version "0.1")
	@@ -22,27 +22,40 @@

	(define-constant password-chars "abcdefhijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRST…

	-(define entropy-per-char
	+(define password-modes
	+ '(("all chars" . "")
	+ ("alpha-numeric" . "!@#$%^&*()-=~?/\\|+,:.<>{}[]")
	+ ("easy-to-read" . "l1o0I\|!ji")
	+ ("some-funny-chars" . "\|\\[]{}<>~&")))
	+
	+(define (entropy-per-char password-chars)
	(inexact->exact (floor (* (/ (log (string-length password-chars)) (log 2)) 1…

	(define wanted-entropy (* 20 8))

	-(define (generate-new-password wanted-entropy)
	+(define (chars-for-mode chars mode)
	+ (char-set->string
	+ (char-set-difference
	+ (string->char-set chars)
	+ (string->char-set mode))))
	+
	+(define (generate-new-password wanted-entropy mode)
	(define (new-indices count)
	- (let loop ((len count)
	- (idx '()))
	- (clear-line)
	- (printf "~a/~a random bytes recieved.~!" (- count len) count)
	- (cond ((zero? len) (clear-line) idx)
	- (else
	- (let ((new (filter (lambda (n)
	- (< n (string-length password-chars)))
	- (u8vector->list (random-bytes len)))))
	- (loop (- len (length new)) (append new idx)))))))
	+ (let ((password-chars (chars-for-mode password-chars mode)))
	+ (let loop ((len count)
	+ (idx '()))
	+ (clear-line)
	+ (printf "~a/~a random bytes recieved.~!" (- count len) count)
	+ (cond ((zero? len) (clear-line) idx)
	+ (else
	+ (let ((new (filter (lambda (n)
	+ (< n (string-length password-chars)))
	+ (u8vector->list (random-bytes len)))))
	+ (loop (- len (length new)) (append new idx))))))))
	(list->string (map (lambda (i)
	(string-ref password-chars i))
	(new-indices (inexact->exact
	- (round (/ (* 100 wanted-entropy) entropy-pe…
	+ (round (/ (* 100 wanted-entropy) (entropy-p…

	(define (prompt-for msg #!optional default)
	(if default (printf "~a [~a]: " msg default)
	@@ -87,21 +100,27 @@
	(p2 (ask-for-manual-password)))
	(unless (equal? p1 p2) (print "Passwords do not match.") (manual-loo…
	p1)
	- (let password-loop ((e wanted-entropy))
	- (let ((p (generate-new-password e))
	- (entropy-delta (cond ((< e 64) 8)
	- ((< e 128) 16)
	- (else 32))))
	- (printf "Length ~a chars, entropy ~a bits~%" (string-length p) (qu…
	+ (let password-loop ((e wanted-entropy)
	+ (modes password-modes))
	+ (let* ((m (car modes))
	+ (p (generate-new-password e (cdr m)))
	+ (entropy-delta (cond ((< e 64) 8)
	+ ((< e 128) 16)
	+ (else 32))))
	+ (printf "Mode ~a, Length ~a chars, entropy ~a bits~%"
	+ (car m)
	+ (string-length p)
	+ (quotient (* (string-length p) (entropy-per-char (chars-fo…
	(print p)
	(let dialog-loop ()
	- (let ((choice (ask-for-choice "Use this password?" "y" "n" "+" "…
	+ (let ((choice (ask-for-choice "Use this password?" "y" "n" "+" "…
	(case choice
	- ((#\space #\n) (password-loop e))
	- ((#\+) (password-loop (+ e entropy-delta)))
	- ((#\-) (password-loop (max 32 (- e entropy-delta))))
	+ ((#\space #\n) (password-loop e modes))
	+ ((#\+) (password-loop (+ e entropy-delta) modes))
	+ ((#\-) (password-loop (max 32 (- e entropy-delta)) modes))
	+ ((#\m) (password-loop e (append (cdr modes) (list m))))
	((#\?)
	- (printf "y - accept password~%+ - increase password length~…
	+ (printf "y - accept password~%+ - increase password length~…
	(dialog-loop))
	(else p)))))))))

	diff --git a/static-compilation.sh b/static-compilation.sh
	@@ -20,7 +20,7 @@ csc -unit tweetnacl -emit-import-library tweetnacl -c tweetna…
	csc -unit type-checks -uses type-errors -J -c ./check-errors/type-checks.scm -…
	csc -unit type-errors -J -c ./check-errors/type-errors.scm -o type-errors.o
	csc -uses matchable -uses foreigners -c stty/stty.scm -emit-import-library stt…
	-csc -uses srfi-1 -uses srfi-4 -uses utils -uses stty -uses crypto-helper -uses…
	+csc -uses srfi-1,srfi-4,srfi-14,utils,stty,crypto-helper,tweetnacl,getopt-long…
	csc -static *o ./tweetnacl/tweetnacl.impl.o -o pee

	strip ./pee