;; from Rosetta code, with modifications https://rosettacode.org/wiki/Password_generator#Common_Lisp (defpackage :fwoar.password-gen (:use :cl ) (:export )) (in-package :fwoar.password-gen) (defparameter *lowercase* "abcdefghijklmnopqrstuvwxyz") (defparameter *uppercase* "ABCDEFGHIJKLMNOPQRSTUVWXYZ") (defparameter *numbers* "1234567890") (defparameter *special-characters* '(#\! #\\ #\# #\% #\& #\* #\+ #\, #\- #\. #\: #\< #\= #\> #\? #\^ #\_ #\| #\~)) (defparameter *similar-characters* '(#\I #\l #\1 #\| #\O #\0 #\5 #\S #\2 #\Z)) (defparameter *excluded-characters* '(#\@ #\! #\[ #\] #\{ #\} #\/ #\\ #\' #\" #\& #\< #\> #\`)) (defun make-readable (flag s) (if flag (remove-if (lambda (x) (member x *similar-characters*)) s) s)) (defun shuffle-seq (input-seq) (loop with l = (length input-seq) for i below l do (rotatef (elt input-seq i) (elt input-seq (random l)))) input-seq) (defun sample (seq) (elt seq (random (length seq)))) (defun generate-password (len human-readable exclude-excluded additional-special asp) (let* ((upper (make-readable human-readable *uppercase*)) (lower (make-readable human-readable *lowercase*)) (number (make-readable human-readable *numbers*)) (special-initial (make-readable human-readable *special-characters*)) (special (cond (asp (coerce additional-special 'list)) (exclude-excluded (set-difference special-initial *excluded-characters*)) (t special-initial))) (character-groups (list upper lower number special)) (initial-password (reduce (lambda (acc x) (cons (sample x) acc)) character-groups :initial-value NIL))) (coerce (shuffle-seq (reduce (lambda (acc x) (declare (ignore x)) (let ((group (nth (random (length character-groups)) character-groups))) (cons (sample group) acc))) (make-list (- len 4)) :initial-value initial-password)) 'string))) (defun main (len count &optional human-readable exclude-excluded (additional-special nil asp)) (setf *random-state* (make-random-state t)) (if (< len 4) (print "Length must be at least 4~%") (loop for x from 1 to count do (princ (generate-password len human-readable exclude-excluded additional-special asp)) (terpri)))) (defun parse-bool (str) (case (elt (string-downcase str) 0) ((#\t #\y) t) ((#\f #\n) nil)))