~nilium/chicken-pwhash: Add more useful error data

1 files changed, 76 insertions(+), 24 deletions(-)

M pwhash.scm

M pwhash.scm => pwhash.scm +76 -24

@@ 34,13 34,18 @@
     pwhash-alg:argon2i13
     pwhash-alg:argon2id13
     ;; Convenience functions.
-    pwhash-random-salt)
+    pwhash-random-salt
+    ;; Errors
+    pwhash-error-proc
+    pwhash-error-kind
+    pwhash-error?)
 
 
   (import scheme
           (chicken base)
           (chicken foreign)
-          (only (chicken blob) make-blob blob-size)
+          (only (chicken format) fprintf)
+          (only (chicken blob) make-blob blob-size blob?)
           (only (chicken string) substring-index)
           (only (chicken random) random-bytes))
 


@@ 48,6 53,21 @@
   #include <sodium.h>
   <#
 
+  (define-syntax error*
+    (syntax-rules ()
+      ((_ PROC ARG)
+       (error (make-pwhash-error (quote PROC) (quote ARG))))))
+
+  (define-record pwhash-error
+    proc
+    kind)
+
+  (set-record-printer! pwhash-error
+                       (lambda (e out)
+                         (fprintf out "#,(pwhash-error ~S ~S)"
+                                  (pwhash-error-proc e)
+                                  (pwhash-error-kind e))))
+
   (define-record pwhash-alg
     ;; Algorithm.
     alg*


@@ 148,24 168,42 @@
   (define (pwhash-alg:argon2id13) pwhash-alg:argon2id13*)
 
   ;; Accessors.
-  (define (pwhash-alg #!optional (alg (pwhash-algorithm))) ((pwhash-alg-alg* alg)))
-  (define (pwhash-bytes-min #!optional (alg (pwhash-algorithm))) ((pwhash-alg-bytes-min* alg)))
-  (define (pwhash-bytes-max #!optional (alg (pwhash-algorithm))) ((pwhash-alg-bytes-max* alg)))
-  (define (pwhash-passwd-min #!optional (alg (pwhash-algorithm))) ((pwhash-alg-passwd-min* alg)))
-  (define (pwhash-passwd-max #!optional (alg (pwhash-algorithm))) ((pwhash-alg-passwd-max* alg)))
-  (define (pwhash-opslimit-min #!optional (alg (pwhash-algorithm))) ((pwhash-alg-opslimit-min* alg)))
-  (define (pwhash-opslimit-max #!optional (alg (pwhash-algorithm))) ((pwhash-alg-opslimit-max* alg)))
-  (define (pwhash-opslimit-interactive #!optional (alg (pwhash-algorithm))) ((pwhash-alg-opslimit-interactive* alg)))
-  (define (pwhash-opslimit-moderate #!optional (alg (pwhash-algorithm))) ((pwhash-alg-opslimit-moderate* alg)))
-  (define (pwhash-opslimit-sensitive #!optional (alg (pwhash-algorithm))) ((pwhash-alg-opslimit-sensitive* alg)))
-  (define (pwhash-memlimit-min #!optional (alg (pwhash-algorithm))) ((pwhash-alg-memlimit-min* alg)))
-  (define (pwhash-memlimit-max #!optional (alg (pwhash-algorithm))) ((pwhash-alg-memlimit-max* alg)))
-  (define (pwhash-memlimit-interactive #!optional (alg (pwhash-algorithm))) ((pwhash-alg-memlimit-interactive* alg)))
-  (define (pwhash-memlimit-moderate #!optional (alg (pwhash-algorithm))) ((pwhash-alg-memlimit-moderate* alg)))
-  (define (pwhash-memlimit-sensitive #!optional (alg (pwhash-algorithm))) ((pwhash-alg-memlimit-sensitive* alg)))
-  (define (pwhash-saltbytes #!optional (alg (pwhash-algorithm))) ((pwhash-alg-saltbytes* alg)))
-  (define (pwhash-strbytes #!optional (alg (pwhash-algorithm))) ((pwhash-alg-strbytes* alg)))
-  (define (pwhash-strprefix #!optional (alg (pwhash-algorithm))) ((pwhash-alg-strprefix* alg)))
+  (define (pwhash-alg #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-alg* alg)))
+  (define (pwhash-bytes-min #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-bytes-min* alg)))
+  (define (pwhash-bytes-max #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-bytes-max* alg)))
+  (define (pwhash-passwd-min #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-passwd-min* alg)))
+  (define (pwhash-passwd-max #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-passwd-max* alg)))
+  (define (pwhash-opslimit-min #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-opslimit-min* alg)))
+  (define (pwhash-opslimit-max #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-opslimit-max* alg)))
+  (define (pwhash-opslimit-interactive #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-opslimit-interactive* alg)))
+  (define (pwhash-opslimit-moderate #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-opslimit-moderate* alg)))
+  (define (pwhash-opslimit-sensitive #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-opslimit-sensitive* alg)))
+  (define (pwhash-memlimit-min #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-memlimit-min* alg)))
+  (define (pwhash-memlimit-max #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-memlimit-max* alg)))
+  (define (pwhash-memlimit-interactive #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-memlimit-interactive* alg)))
+  (define (pwhash-memlimit-moderate #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-memlimit-moderate* alg)))
+  (define (pwhash-memlimit-sensitive #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-memlimit-sensitive* alg)))
+  (define (pwhash-saltbytes #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-saltbytes* alg)))
+  (define (pwhash-strbytes #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-strbytes* alg)))
+  (define (pwhash-strprefix #!optional (alg (pwhash-algorithm)))
+    ((pwhash-alg-strprefix* alg)))
 
   (define %pwhash
     (foreign-lambda int "crypto_pwhash"


@@ 214,14 252,22 @@
           str
           (string-append str (make-string (- need n) #\x00)))))
 
-
   (define (trim-null-bytes* str)
     (let ([n (substring-index "\x00" str)])
       (if n
           (substring str 0 n)
           str)))
 
+  (define (length* obj)
+    (cond [(string? obj) (string-length obj)]
+          [(blob? obj) (blob-size obj)]
+          [else -1]))
+
   (define (pwhash! outlen passwd salt #!key (alg (pwhash-algorithm)) opslimit memlimit)
+    (cond [(<= outlen 0) (error* pwhash! invalid-output-length)]
+          [(= 0 (string-length passwd)) (error* pwhash! empty-password)]
+          [(not (= (pwhash-saltbytes alg) (length* salt)))
+           (error* pwhash invalid-salt-length)])
     (let* ([opslimit* (or opslimit ((pwhash-opslimit) alg))]
            [memlimit* (or memlimit ((pwhash-memlimit) alg))]
            [out (make-blob outlen)]


@@ 235,9 281,11 @@
                         (pwhash-alg alg))])
       (if (= rc 0)
           out
-          (error 'pwhash-failed))))
+          (error* pwhash! failed))))
 
   (define (pwhash passwd #!key (alg (pwhash-algorithm)) opslimit memlimit)
+    (when (= 0 (string-length passwd))
+        (error* pwhash empty-password))
     (let* ([outlen (pwhash-strbytes alg)]
            [opslimit* (or opslimit ((pwhash-opslimit) alg))]
            [memlimit* (or memlimit ((pwhash-memlimit) alg))]


@@ 250,9 298,11 @@
                                 (pwhash-alg alg))])
       (if (= rc 0)
           (trim-null-bytes* out)
-          (error 'pwhash-str-failed))))
+          (error* pwhash failed))))
 
   (define (pwhash-verify hash passwd)
+    (cond [(= 0 (string-length hash)) (error* pwhash-verify empty-hash)]
+          [(= 0 (string-length passwd)) (error* pwhash-verify empty-password)])
     (let* ([hash (pad-hash* hash)]
            [rc (%pwhash-str-verify (location hash)
                                    (location passwd)


@@ 260,6 310,8 @@
       (= rc 0)))
 
   (define (pwhash-needs-rehash? hash #!key (alg (pwhash-algorithm)) opslimit memlimit)
+    (when (= 0 (string-length hash))
+      (error* pwhash-needs-rehash? empty-hash))
     (let* ([hash (pad-hash* hash)]
            [opslimit* (or opslimit ((pwhash-opslimit) alg))]
            [memlimit* (or memlimit ((pwhash-memlimit) alg))]


@@ 268,6 320,6 @@
                                          memlimit*)])
       (case rc
         ((0 1) (= rc 1))
-        (else  (error 'pwhash-needs-rehash-failed)))))
+        (else  (error* pwhash-needs-rehash? failed)))))
 
   (pwhash-init))