summaryrefslogtreecommitdiffstats
path: root/cl-password.lisp
blob: 6550383ed3e9eab2912bdc82b9344bec679f34d5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
(in-package :cl-password)

(defparameter *prng* (make-prng :fortuna :seed :urandom))

(defun make-random-salt (&optional (size 16))
  (random-data size *prng*))

(defun generate-password-hash-scrypt (password salt hash-length n r p)
  (byte-array-to-hex-string
   (derive-key
    (make-kdf 'scrypt-kdf :n n :r r :p p)
    (ascii-string-to-byte-array password)
    salt
    0 ; ignored for scrypt
    hash-length)))

(define-condition unsupported-hash-error (error)
    ((name :initarg :name :reader name)))

(defun hash-password
    (password type
     &key (hash-length 40)
          (n 2048) (r 1) (p 1)
          (salt (make-random-salt)))
  (when (typep salt 'string) (setf salt (hex-string-to-byte-array salt)))
  (cond ((eq type :scrypt)
         (list :type type
               :salt (byte-array-to-hex-string salt)
               :n n
               :r r
               :p p
               :hash-length hash-length
               :hash (generate-password-hash-scrypt password salt hash-length n r p)))
        (t (error 'unsupported-hash-error :name type))))

(defun check-password (password hashed-password-plist)
  (equalp
   (getf
    (hash-password password
                   (getf hashed-password-plist :type)
                   :hash-length (getf hashed-password-plist :hash-length)
                   :n (getf hashed-password-plist :n)
                   :r (getf hashed-password-plist :r)
                   :p (getf hashed-password-plist :p)
                   :salt (getf hashed-password-plist :salt))
    :hash)
   (getf hashed-password-plist :hash)))