From 4e9da40b0e1de0cfb956246956591cc5ecc08e42 Mon Sep 17 00:00:00 2001 From: Noel Cower Date: Fri, 9 Apr 2021 01:32:12 -0700 Subject: [PATCH] Add more useful error data Add more useful error data structures, as well as an error* syntax to shortcut some of the boilerplate for errors. --- pwhash.scm | 100 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 76 insertions(+), 24 deletions(-) diff --git a/pwhash.scm b/pwhash.scm index d939010..bc2b93f 100644 --- a/pwhash.scm +++ b/pwhash.scm @@ -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 <# + (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)) -- 2.45.2