(module pbkdf2 (pbkdf2 make-salt) (import scheme chicken) (use srfi-1) (use srfi-4 srfi-27 entropy-unix) (use sha2 message-digest hmac loops base64 string-utils ) (define dklen 32) (define password "spider") (define salt "salty") (define iterations 10000) (define digest sha256-primitive) (define hlen (string-length (message-digest-string (digest) "x"))) (if (not dklen) (set! dklen hlen) '()) (if (> dklen (* 4294967295 hlen)) (error 'dklen "Overflow, dklen too large") '()) ;ensures dklen < 2^32 (define l (inexact->exact (ceiling (/ dklen hlen)))) ;determines the number of blocks dklen will be broken into (define r (- dklen (* (- l 1) hlen))) ;determines the length of the remainder block (define (hmac-sha256 key message) ((hmac key (sha256-primitive)) message)) ;slower implementation (that actually works) ; (if (> (string-length key) 64) ; (set! key (sha256 key)) ; (set! key (string-pad-right key 64 #\x00)) ; ) ; ; ; (define o-key-pad (string-map (lambda (x) (integer->char (bitwise-xor 92 (char->integer x)))) key)) ; (define i-key-pad (string-map (lambda (x) (integer->char (bitwise-xor 54 (char->integer x)))) key)) ; (sha256 (string-append o-key-pad (sha256 (string-append i-key-pad message)))) ;) (define (sha256 x) (message-digest-string (sha256-primitive) x)) (define (U u xor count) (if (= count iterations) xor (let* ((new-u (hmac-sha256 password u))) (U new-u (string-xor xor new-u) (+ count 1)) ) ) ) (define (F i) (let* ((salt-i (string-append salt (int->4bytestring i))) (u1 (hmac-sha256 password salt-i))) (U u1 u1 1) ) ) (define (T) (let* ((tlist '())) (do-times x l (set! tlist (append tlist (list (F (+ x 1)))))) tlist ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;FOR CONVERTING INTEGERS TO 4 BYTE STRINGS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;supports encoding ints up to 2^32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (int->dhex x) (if (< x 256) (list x) (append (int->dhex (quotient x 256)) (list (modulo x 256))) ) ) (define (pad x) (if (< (length x) 4) (pad (append (list 0) x)) x)) (define (int->padhex x) (pad (int->dhex x))) (define (int->4bytestring x) (let* ((padhex (int->padhex x)) (charlist (map integer->char padhex))) (apply string charlist)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;For XORing strings together;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (char-xor x y) (let* ((num (bitwise-xor (char->integer x) (char->integer y)))) (integer->char num) ) ) (define (string-xor x y) (list->string (map char-xor (string->list x) (string->list y))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (pbkdf2 _password _salt _iterations );_dklen) (set! password _password) (set! salt _salt) (set! iterations _iterations) (let* ((tlist (T)) (listlen (length tlist)) (last-elem (list-ref tlist (- listlen 1))) (almost-list (apply string-append (take tlist (- listlen 1)))) (last-elem-list (string->list last-elem)) (tstring (string-append almost-list (list->string (take last-elem-list r))))) (base64-encode tstring) ) ) ;(do-times _ 10 (pbkdf2 "spider" "salt" 10000)) ;for benchmarking ; Randomness for password algorithms (define (u8vectors->base64 vec) (base64-encode (blob->string (u8vector->blob/shared vec)))) (define (make-secret-generator) (let ((source (make-entropy-source-urandom-device))) (lambda (byte-width) (u8vectors->base64 (entropy-source-u8vector source byte-width))))) (define make-salt (make-secret-generator)) )