--- a/lisp/genpass.lisp Thu Jan 10 20:16:53 2019 -0500
+++ b/lisp/genpass.lisp Thu Jan 10 20:37:36 2019 -0500
@@ -1,5 +1,5 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
- (ql:quickload '(:adopt :series :iterate) :silent t))
+ (ql:quickload '(:adopt :series :iterate :str) :silent t))
(defpackage :genpass
(:use :cl :iterate)
@@ -7,6 +7,15 @@
(in-package :genpass)
+;;;; Functionality ------------------------------------------------------------
+(defparameter *passphrase-sep* " ")
+(defparameter *words* nil)
+
+(defmacro -<> (value &body forms)
+ (reduce (lambda (val expression)
+ (subst val '<> expression))
+ forms
+ :initial-value value))
(defun safep (char)
(or (char<= #\a char #\z)
@@ -14,10 +23,13 @@
(char<= #\0 char #\9)))
(defun word-list ()
- (iterate
- (for line :in-file "/usr/share/dict/words" :using #'read-line)
- (when (every #'safep line)
- (collect line :result-type vector))))
+ (unless *words*
+ (setf *words*
+ (iterate
+ (for line :in-file "/usr/share/dict/words" :using #'read-line)
+ (when (every #'safep line)
+ (collect line :result-type vector)))))
+ *words*)
(defun random-unsigned-byte-32 ()
(with-open-file (urandom "/dev/urandom" :element-type '(unsigned-byte 8))
@@ -43,19 +55,13 @@
(collect (random-elt words))))
(defun random-sentence% (words)
- (format nil "~{~:(~A~)~^ ~}" (random-words words)))
+ (str:join *passphrase-sep* (mapcar #'string-capitalize (random-words words))))
(defun random-sentence (words length)
(iterate
(for candidate = (random-sentence% words))
(finding candidate :such-that (<= (length candidate) length))))
-(defmacro -<> (value &body forms)
- (reduce (lambda (val expression)
- (subst val '<> expression))
- forms
- :initial-value value))
-
(defun random-garbage (length)
(with-open-file (urandom "/dev/urandom" :element-type '(unsigned-byte 8))
(-<> urandom
@@ -65,13 +71,22 @@
(series:subseries <> 0 length)
(series:collect 'string <>))))
+(defun random-smart (words length)
+ (check-type words (integer 1))
+ (format nil "~A~A~D"
+ (random-sentence words (- length 1 (length *passphrase-sep*)))
+ *passphrase-sep*
+ (urandom 10)))
-;;;; User Interface -----------------------------------------------------------
-(defun run (length words)
- (write-string
- (if (zerop words)
- (random-garbage length)
- (random-sentence words length))))
+
+;;;; Run ----------------------------------------------------------------------
+(defun run (length words smart smush?)
+ (let ((*passphrase-sep* (if smush? "" " ")))
+ (write-string
+ (cond
+ ((zerop words) (random-garbage length))
+ (smart (random-smart words length))
+ (t (random-sentence words length))))))
;;;; User Interface -----------------------------------------------------------
@@ -79,8 +94,12 @@
"Generate a random password.")
(defparameter *examples*
- '(("Generate a random 24-character password:" .
- "genpass --length 24")))
+ '(("Generate a random passphrase no longer than 24 characters:"
+ . "genpass --length 24")
+ ("Generate a more random, harder to type password:"
+ . "genpass --no-words")
+ ("Generate a six word passphrase with no spaces:"
+ . "genpass --words 6 --smush")))
(adopt:define-interface *ui*
(:name "genpass"
@@ -89,21 +108,20 @@
:documentation *documentation*
:examples *examples*)
((help)
- :documentation "display help and exit"
- :manual "Display help and exit."
+ :documentation "Display help and exit."
:long "help"
:short #\h
:reduce (constantly t))
((length)
- :documentation "ensure password is no longer than N characters (default 32)"
+ :documentation "Ensure password is no longer than N characters (default 40)."
:long "length"
:short #\l
:parameter "N"
- :initial-value 32
+ :initial-value 40
:reduce #'adopt:newest
:key #'parse-integer)
((words)
- :documentation "if non-zero, generate passphrases of N words instead of opaque strings (default 4)"
+ :documentation "If non-zero, generate passphrases of N words instead of opaque strings (default 4)."
:long "words"
:short #\w
:parameter "N"
@@ -111,10 +129,31 @@
:reduce #'adopt:newest
:key #'parse-integer)
((no-words words)
- :documentation "shorthand for --words=0"
+ :documentation "Shorthand for --words=0."
:long "no-words"
:short #\W
- :reduce (constantly 0)))
+ :reduce (constantly 0))
+ ((smart)
+ :documentation "Smart mode (the default). Generate as with --words, but add a number on the end to satisfy the red tape on many sites."
+ :long "smart"
+ :short #\s
+ :initial-value t
+ :reduce (constantly t))
+ ((no-smart smart)
+ :documentation "Turn off smart mode."
+ :long "no-smart"
+ :short #\S
+ :reduce (constantly nil))
+ ((smush)
+ :documentation "Don't include spaces in passphrases."
+ :long "smush"
+ :short #\m
+ :reduce (constantly t))
+ ((no-smush smush)
+ :documentation "Include spaces in passphrases (the default)."
+ :long "no-smush"
+ :short #\M
+ :reduce (constantly nil)))
(defun toplevel ()
(handler-case
@@ -124,5 +163,7 @@
(when arguments
(error "Unrecognized command line arguments: ~S" arguments))
(run (gethash 'length options)
- (gethash 'words options)))
+ (gethash 'words options)
+ (gethash 'smart options)
+ (gethash 'smush options)))
(error (c) (adopt:print-error-and-exit c))))