72
author |
Steve Losh <steve@stevelosh.com> |
date |
Sat, 02 Feb 2019 14:12:14 -0500 |
parents |
c3b026046776 |
children |
ef75870a1f30 |
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload '(:adopt :series :iterate :str) :silent t))
(defpackage :genpass
(:use :cl :iterate)
(:export :toplevel :*ui*))
(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)
(char<= #\A char #\Z)
(char<= #\0 char #\9)))
(defun word-list ()
(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))
(logior (ash (read-byte urandom) 0)
(ash (read-byte urandom) 8)
(ash (read-byte urandom) 16)
(ash (read-byte urandom) 24))))
(defun urandom (limit)
(check-type limit (integer 0 (#.(expt 2 32))))
(iterate
(with threshold = (mod (expt 2 32) limit))
(for candidate = (random-unsigned-byte-32))
(finding (mod candidate limit) :such-that (>= candidate threshold))))
(defun random-elt (sequence)
(elt sequence (urandom (length sequence))))
(defun random-words (n)
(iterate
(with words = (word-list))
(repeat n)
(collect (random-elt words))))
(defun random-sentence% (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))))
(defun random-garbage (length)
(with-open-file (urandom "/dev/urandom" :element-type '(unsigned-byte 8))
(-<> urandom
(series:scan-stream <> #'read-byte)
(series:map-fn t #'code-char <>)
(series:choose-if #'safep <>)
(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)))
;;;; 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 -----------------------------------------------------------
(adopt:define-string *documentation*
"Generate a random password.")
(defparameter *examples*
'(("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"
:usage "[OPTIONS]"
:summary "Generate a random password."
:documentation *documentation*
:examples *examples*)
((help)
:documentation "Display help and exit."
:long "help"
:short #\h
:reduce (constantly t))
((length)
:documentation "Ensure password is no longer than N characters (default 40)."
:long "length"
:short #\l
:parameter "N"
: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)."
:long "words"
:short #\w
:parameter "N"
:initial-value 4
:reduce #'adopt:newest
:key #'parse-integer)
((no-words words)
:documentation "Shorthand for --words=0."
:long "no-words"
:short #\W
: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
(multiple-value-bind (arguments options) (adopt:parse-options *ui*)
(when (gethash 'help options)
(adopt:print-usage-and-exit *ui*))
(when arguments
(error "Unrecognized command line arguments: ~S" arguments))
(run (gethash 'length options)
(gethash 'words options)
(gethash 'smart options)
(gethash 'smush options)))
(error (c) (adopt:print-error-and-exit c))))