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)))
|