; password generator
(define-syntax when
(syntax-rules ()
((when pred? expr ...)
(if pred? (begin expr ...)))))
(define rand ; knuth random number generator with shuffle box
(let* ((a 69069) (c 1234567) (m 4294967296) (k 32) ; 32-bit
; (a 6364136223846793005) (c 1442695040888963407)
; (m 18446744073709551616) (k 256) ; 64-bit
(seed 19380110) ; Happy Birthday DEK
;(seed (time-second (current-time)))
(next (lambda ()
(set! seed (modulo (+ (* a seed) c) m)) seed))
(init (lambda (seed) (let ((box (make-vector k)))
(do ((j 0 (+ j 1))) ((= j k) box)
(vector-set! box j (next))))))
(box (init seed)))
(lambda args
(when (pair? args)
(set! seed (modulo (car args) m)) (set! box (init seed)))
(let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
(set! seed (next)) (vector-set! box j seed) (/ n m)))))
(define (randint . args)
(let ((lo (if (pair? (cdr args)) (car args) 0))
(hi (if (pair? (cdr args)) (cadr args) (car args))))
(inexact->exact (+ lo (floor (* (rand) (- hi lo)))))))
(define (shuffle x)
(do ((v (list->vector x)) (n (length x) (- n 1)))
((zero? n) (vector->list v))
(let* ((r (randint n)) (t (vector-ref v r)))
(vector-set! v r (vector-ref v (- n 1)))
(vector-set! v (- n 1) t))))
(define (genrand count chars)
(let ((len (string-length chars)))
(do ((k count (- k 1))
(ps (list) (cons (string-ref chars (randint len)) ps)))
((zero? k) ps))))
(define (pgen lower upper digit special)
(let ((lowers (genrand lower "abcdefghijklmnopqrstuvwxyz"))
(uppers (genrand upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(digits (genrand digit "0123456789"))
(specials (genrand special "!@#$%^&*()")))
(list->string (shuffle
(append lowers uppers digits specials)))))
(display (pgen 5 2 3 0)) (newline)