# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1547170656 18000
# Node ID c3b026046776a21c6fa314b210f351331bb553e7
# Parent  3e8af1c65b8ca4ac5788a9eb2b0c8c80feb59fab
More

diff -r 3e8af1c65b8c -r c3b026046776 lisp/genpass.lisp
--- 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))))