;;;
;;; Time-stamp: <06/01/12 13:36:47 nhw>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <[email protected]>
;;
;;
;; Commentary:
(module password mzscheme

  (require (planet "macro.ss" ("schematics" "macro.plt" 1))
           (planet "port.ss" ("schematics" "port.plt" 1))
           (lib "etc.ss")
           (lib "string.ss" "srfi" "13")
           "leet.ss"
           "random.ss")

  (provide min-length
           max-length
           string->password
           make-passwords)

  (define min-length 8)
  (define max-length 16)

  ;; read-words : path -> (vector-of string)
  (define (read-words path)
    (list->vector (port->string-list (open-input-file path))))

  ;; choose-word : (vector-of string) -> string
  (define (choose-word words)
    (choose/uniform words))

  ;; make-passwords : int [path] -> (list-of string)
  (define make-passwords
    (case-lambda
      [(number)
       (let ((dict1 (string->path "/usr/share/dict/words"))
             (dict2 (build-path
                     (this-expression-source-directory)
                     "words")))
         (if (file-exists? dict1)
             (make-passwords number dict1)
             (if (file-exists? dict2)
                 (make-passwords number dict2)
                 (error "Cannot find a file containing a list of words"))))]
      [(number path)
       (let ((words (read-words path)))
         (for ((i 0 number) (passwords null))
              (cons (string->password (choose-word words))
                    passwords)))]))

  ;; correct-length : string -> string
  (define (correct-length input)
    (define (pad input offset pad-length)
      (let ((pad-string (make-string pad-length #\0))
            (chooser
             (lambda ()
               (choose/uniform
                #(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))))
        (for! (i 0 pad-length)
              (string-set! pad-string i (chooser)))
        (string-append input pad-string)))
    (let ((len (string-length input)))
      (cond
       ((> len max-length)
        (substring input 0 max-length))
       ((< len min-length)
        (pad input len (- min-length len)))
       (else input))))

  ;; string->password : string -> string
  (define (string->password input)
    (let ((input (correct-length input)))
      (add-noise input)))

  ;; add-noise : string -> string
  ;;
  ;; Increase the space of possible passwords by randomly
  ;; manipulating the input string
  (define (add-noise input)
    (string-map
     (lambda (char)
       ((choose/uniform (vector char-upcase char-downcase char->leet)) char))
     input))
  )