git.fiddlerwoaroof.com
password-gen.lisp
4d63beae
 ;; 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)
 
78a7363a
 (defparameter *lowercase* "abcdefghijklmnopqrstuvwxyz")
4d63beae
 
78a7363a
 (defparameter *uppercase* "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
4d63beae
 
78a7363a
 (defparameter *numbers* "1234567890")
4d63beae
 
 (defparameter *special-characters*
   '(#\! #\\ #\# #\% #\& #\* #\+ #\, #\- #\. #\: #\< #\= #\>
     #\? #\^ #\_ #\| #\~))
 
 (defparameter *similar-characters*
   '(#\I #\l #\1 #\| #\O #\0 #\5 #\S #\2 #\Z))
 
78a7363a
 (defparameter *excluded-characters*
   '(#\@ #\! #\[ #\] #\{ #\} #\/ #\\ #\' #\" #\& #\< #\> #\`))
4d63beae
 
78a7363a
 (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)
4d63beae
         for i below l
78a7363a
         do (rotatef (elt input-seq i)
                     (elt input-seq
                          (random l))))
   input-seq)
 
 (defun sample (seq)
   (elt seq
        (random (length seq))))
 
c28d8520
 (defun generate-password (len human-readable exclude-excluded additional-special asp)
78a7363a
   (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*))
c28d8520
          (special (cond (asp (coerce additional-special 'list))
                         (exclude-excluded
                          (set-difference special-initial *excluded-characters*))
                         (t special-initial)))
78a7363a
          (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)))
 
c28d8520
 (defun main (len count &optional human-readable exclude-excluded (additional-special nil asp))
84c33506
   (setf *random-state* (make-random-state t))
4d63beae
   (if (< len 4)
       (print "Length must be at least 4~%")
       (loop for x from 1 to count do
c28d8520
         (princ (generate-password len human-readable exclude-excluded additional-special asp))
4d63beae
         (terpri))))
78a7363a
 
 (defun parse-bool (str)
   (case (elt (string-downcase str) 0)
     ((#\t #\y) t)
     ((#\f #\n) nil)))