Added code for password modes - pee - Pee a password manager;Pee - because you have to...
(HTM) git clone git://vernunftzentrum.de/pee.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) LICENSE
---
(DIR) commit ba5446f2cf49fc4c1c2b9447fdad838c3cada3e3
(DIR) parent 68423fd8d0b50e881e715610cbb6b34336586ad5
(HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
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(-)
---
(DIR) 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()`__ RNG.
If running on any other OS /dev/random will be used as a source for random bytes.
Passwords are choosen from this set of characters "abcdefhijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!@#$%^&*()-=~?/\|+,:.<>{}[]".
+There are currently several password modes available that substract a subset of the above character set.
+
+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
(DIR) 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 stty)
(define-constant program-name "pee")
(define-constant program-version "0.1")
@@ -22,27 +22,40 @@
(define-constant password-chars "abcdefhijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!@#$%^&*()-=~?/\|+,:.<>{}[]")
-(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)) 100))))
(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-per-char)))))))
+ (round (/ (* 100 wanted-entropy) (entropy-per-char (chars-for-mode password-chars mode)))))))))
(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-loop))
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) (quotient (* (string-length p) entropy-per-char) 100))
+ (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-for-mode password-chars (cdr m)))) 100))
(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" "+" "-" " " "m" "?")))
(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~%- - decrease password length~%n/space - new password~%")
+ (printf "y - accept password~%+ - increase password length~%- - decrease password length~%n/space - new password~%m\t - next password mode~%")
(dialog-loop))
(else p)))))))))
(DIR) diff --git a/static-compilation.sh b/static-compilation.sh
@@ -20,7 +20,7 @@ csc -unit tweetnacl -emit-import-library tweetnacl -c tweetnacl/tweetnacl.scm -c
csc -unit type-checks -uses type-errors -J -c ./check-errors/type-checks.scm -o type-checks.o
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 stty -unit stty -o stty.o
-csc -uses srfi-1 -uses srfi-4 -uses utils -uses stty -uses crypto-helper -uses tweetnacl -uses getopt-long -uses matchable -c pee.scm -o pee.o
+csc -uses srfi-1,srfi-4,srfi-14,utils,stty,crypto-helper,tweetnacl,getopt-long,matchable -c pee.scm -o pee.o
csc -static *o ./tweetnacl/tweetnacl.impl.o -o pee
strip ./pee