guile password generator

;; generate passwords like this
;; (generate-password 10 (list numeric alpha-lower) (make-rule alpha-lower #:max 5 #:min 5))
;; This will generate a 10 character password with lowercase alphabetic characters and numeric caracters.
;; it also makes sure that you have a maximum AND minimum of 5 lowercase alphabetic characters.
;; public domain
;; WARNING: there is something wonky about it. I generated a million numeric characters, and the average
;; is always a bit low (around 4.45 instead of 4.5 in all tests run), so it seems my maths skills are off

(use-modules
 (rnrs arithmetic fixnums)
 (srfi srfi-1)
 (ice-9 binary-ports))


(define alpha-lower
  (ucs-range->char-set 97 123))

(define alpha-upper
  (ucs-range->char-set 67 91))

(define numeric
  (ucs-range->char-set 48 58))

;; looking at some different keyboard layouts, these seem to be accessible in most languages
(define special
  (->char-set "!#%&/()=?+.,:;-_[]><"))


(define urandom (open-input-file "/dev/urandom"))

(define (false->empty-charset x)
  (or x char-set:empty))

(define* (%generate-password len char-sets)
  (let* ((char-string (char-set->string (apply char-set-union char-sets)))
         (size (string-length char-string))
         (res (make-string len)))
    (do ((i 0 (1+ i)))
        ((>= i len))
      (let ((byte (remainder (get-u8 urandom) size)))
        (string-set! res i (string-ref char-string byte))))
    res))

(define* (make-rule cs #:key (min 0) (max (greatest-fixnum)))
  (lambda (str)
    (let ((n (string-count str cs)))
      (and (>= n min) (<= n max)))))


(define (generate-password len char-sets .  rules)
  (let loop ((pass (%generate-password len char-sets)))
    (if (every (lambda (proc) (proc pass)) rules)
        pass
        (loop (%generate-password len char-sets)))))