~nilium/chicken-pwhash

93c0d54b71ca60f7b7b6f1fc8a78face680d32ac — Noel Cower 3 years ago
Initial commit
4 files changed, 302 insertions(+), 0 deletions(-)

A .gitignore
A COPYING
A pwhash.egg
A pwhash.scm
A  => .gitignore +8 -0
@@ 1,8 @@
*.build.sh
*.import.scm
*.install.sh
*.o
*.a
*.so
*.link
*.log

A  => COPYING +13 -0
@@ 1,13 @@
Copyright 2021 Noel Cower

Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.

THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

A  => pwhash.egg +8 -0
@@ 1,8 @@
((synopsis "Password hashing via libsodium")
 (version "0.1")
 (author "Noel Cower")
 (category misc)
 (license "BSD-3-Clause")
 (components
   (extension pwhash
              (link-options "-L" "-lsodium"))))

A  => pwhash.scm +273 -0
@@ 1,273 @@
(module pwhash

  ;; Exports
  (pwhash-init
    pwhash!
    pwhash
    pwhash-verify
    pwhash-needs-rehash?
    ;; Algorithm accessors.
    pwhash-alg
    pwhash-bytes-min
    pwhash-bytes-max
    pwhash-passwd-min
    pwhash-passwd-max
    pwhash-opslimit-min
    pwhash-opslimit-max
    pwhash-opslimit-interactive
    pwhash-opslimit-moderate
    pwhash-opslimit-sensitive
    pwhash-memlimit-min
    pwhash-memlimit-max
    pwhash-memlimit-interactive
    pwhash-memlimit-moderate
    pwhash-memlimit-sensitive
    pwhash-saltbytes
    pwhash-strbytes
    pwhash-strprefix
    ;; Parameters.
    pwhash-opslimit
    pwhash-memlimit
    pwhash-algorithm
    ;; Algorithms.
    pwhash-alg:default
    pwhash-alg:argon2i13
    pwhash-alg:argon2id13
    ;; Convenience functions.
    pwhash-random-salt)


  (import scheme
          (chicken base)
          (chicken foreign)
          (only (chicken blob) make-blob blob-size)
          (only (chicken string) substring-index)
          (only (chicken random) random-bytes))

  #>
  #include <sodium.h>
  <#

  (define-record pwhash-alg
    ;; Algorithm.
    alg*
    ;; Byte lengths.
    bytes-min*
    bytes-max*
    ;; Password lengths.
    passwd-min*
    passwd-max*
    ;; Op limits.
    opslimit-min*
    opslimit-max*
    opslimit-interactive*
    opslimit-moderate*
    opslimit-sensitive*
    ;; Mem limits.
    memlimit-min*
    memlimit-max*
    memlimit-interactive*
    memlimit-moderate*
    memlimit-sensitive*
    ;; Byte lengths.
    saltbytes*
    strbytes*
    ;; Hash prefix.
    strprefix*)

  (define pwhash-init
    (foreign-lambda int "sodium_init"))

  (define %pwhash-strbytes
    (foreign-lambda size_t "crypto_pwhash_strbytes"))

  (define pwhash-alg:default*
    (make-pwhash-alg
      (foreign-lambda int "crypto_pwhash_alg_default")
      (foreign-lambda size_t "crypto_pwhash_bytes_min")
      (foreign-lambda size_t "crypto_pwhash_bytes_max")
      (foreign-lambda size_t "crypto_pwhash_passwd_min")
      (foreign-lambda size_t "crypto_pwhash_passwd_max")
      (foreign-lambda size_t "crypto_pwhash_opslimit_min")
      (foreign-lambda size_t "crypto_pwhash_opslimit_max")
      (foreign-lambda size_t "crypto_pwhash_opslimit_interactive")
      (foreign-lambda size_t "crypto_pwhash_opslimit_moderate")
      (foreign-lambda size_t "crypto_pwhash_opslimit_sensitive")
      (foreign-lambda size_t "crypto_pwhash_memlimit_min")
      (foreign-lambda size_t "crypto_pwhash_memlimit_max")
      (foreign-lambda size_t "crypto_pwhash_memlimit_interactive")
      (foreign-lambda size_t "crypto_pwhash_memlimit_moderate")
      (foreign-lambda size_t "crypto_pwhash_memlimit_sensitive")
      (foreign-lambda size_t "crypto_pwhash_saltbytes")
      %pwhash-strbytes
      (foreign-lambda nonnull-c-string "crypto_pwhash_strprefix")))
  (define (pwhash-alg:default) pwhash-alg:default*)

  (define pwhash-alg:argon2i13*
    (make-pwhash-alg
      (foreign-lambda int "crypto_pwhash_alg_argon2i13")
      (foreign-lambda size_t "crypto_pwhash_argon2i_bytes_min")
      (foreign-lambda size_t "crypto_pwhash_argon2i_bytes_max")
      (foreign-lambda size_t "crypto_pwhash_argon2i_passwd_min")
      (foreign-lambda size_t "crypto_pwhash_argon2i_passwd_max")
      (foreign-lambda size_t "crypto_pwhash_argon2i_opslimit_min")
      (foreign-lambda size_t "crypto_pwhash_argon2i_opslimit_max")
      (foreign-lambda size_t "crypto_pwhash_argon2i_opslimit_interactive")
      (foreign-lambda size_t "crypto_pwhash_argon2i_opslimit_moderate")
      (foreign-lambda size_t "crypto_pwhash_argon2i_opslimit_sensitive")
      (foreign-lambda size_t "crypto_pwhash_argon2i_memlimit_min")
      (foreign-lambda size_t "crypto_pwhash_argon2i_memlimit_max")
      (foreign-lambda size_t "crypto_pwhash_argon2i_memlimit_interactive")
      (foreign-lambda size_t "crypto_pwhash_argon2i_memlimit_moderate")
      (foreign-lambda size_t "crypto_pwhash_argon2i_memlimit_sensitive")
      (foreign-lambda size_t "crypto_pwhash_argon2i_saltbytes")
      (foreign-lambda size_t "crypto_pwhash_argon2i_strbytes")
      (foreign-lambda nonnull-c-string "crypto_pwhash_argon2i_strprefix")))
  (define (pwhash-alg:argon2i13) pwhash-alg:argon2i13*)

  (define pwhash-alg:argon2id13*
    (make-pwhash-alg
      (foreign-lambda int "crypto_pwhash_alg_argon2id13")
      (foreign-lambda size_t "crypto_pwhash_argon2id_bytes_min")
      (foreign-lambda size_t "crypto_pwhash_argon2id_bytes_max")
      (foreign-lambda size_t "crypto_pwhash_argon2id_passwd_min")
      (foreign-lambda size_t "crypto_pwhash_argon2id_passwd_max")
      (foreign-lambda size_t "crypto_pwhash_argon2id_opslimit_min")
      (foreign-lambda size_t "crypto_pwhash_argon2id_opslimit_max")
      (foreign-lambda size_t "crypto_pwhash_argon2id_opslimit_interactive")
      (foreign-lambda size_t "crypto_pwhash_argon2id_opslimit_moderate")
      (foreign-lambda size_t "crypto_pwhash_argon2id_opslimit_sensitive")
      (foreign-lambda size_t "crypto_pwhash_argon2id_memlimit_min")
      (foreign-lambda size_t "crypto_pwhash_argon2id_memlimit_max")
      (foreign-lambda size_t "crypto_pwhash_argon2id_memlimit_interactive")
      (foreign-lambda size_t "crypto_pwhash_argon2id_memlimit_moderate")
      (foreign-lambda size_t "crypto_pwhash_argon2id_memlimit_sensitive")
      (foreign-lambda size_t "crypto_pwhash_argon2id_saltbytes")
      (foreign-lambda size_t "crypto_pwhash_argon2id_strbytes")
      (foreign-lambda nonnull-c-string "crypto_pwhash_argon2id_strprefix")))
  (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
    (foreign-lambda int "crypto_pwhash"
      (c-pointer char)                  ; out
      (const size_t)                    ; outlen
      (const (c-pointer char))          ; passwd
      (const size_t)                    ; passwlen
      (const (c-pointer unsigned-char)) ; salt
      size_t                            ; opslimit
      size_t                            ; memlimit
      int))                             ; alg

  (define %pwhash-str-alg
    (foreign-lambda int "crypto_pwhash_str_alg"
      (c-pointer char)                  ; out[N]
      (const (c-pointer char))          ; passwd
      (const size_t)                    ; passwlen
      size_t                            ; opslimit
      size_t                            ; memlimit
      int))                             ; alg

  (define %pwhash-str-verify
    (foreign-lambda int "crypto_pwhash_str_verify"
      (c-pointer char)                  ; hash[N]
      (const (c-pointer char))          ; passwd
      (const size_t)))                  ; passwlen

  (define %pwhash-str-needs-rehash
    (foreign-lambda int "crypto_pwhash_str_needs_rehash"
      (c-pointer char)                  ; hash[N]
      size_t                            ; opslimit
      size_t))                          ; memlimit

  (define pwhash-opslimit (make-parameter pwhash-opslimit-moderate))
  (define pwhash-memlimit (make-parameter pwhash-memlimit-moderate))
  (define pwhash-algorithm (make-parameter (pwhash-alg:default)))

  (define (pwhash-random-salt alg)
    (let ([buf (make-blob (pwhash-saltbytes alg))])
      (random-bytes buf)))

  (define (pad-hash* str)
    (let ([n (string-length str)]
          [need (%pwhash-strbytes)])
      (if (>= n need)
          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 (pwhash! outlen passwd salt #!key (alg (pwhash-algorithm)) opslimit memlimit)
    (let* ([opslimit* (or opslimit ((pwhash-opslimit) alg))]
           [memlimit* (or memlimit ((pwhash-memlimit) alg))]
           [out (make-blob outlen)]
           [rc (%pwhash (location out)
                        (blob-size out)
                        (location passwd)
                        (string-length passwd)
                        (location salt)
                        opslimit*
                        memlimit*
                        (pwhash-alg alg))])
      (if (= rc 0)
          out
          (error 'pwhash-failed))))

  (define (pwhash passwd #!key (alg (pwhash-algorithm)) opslimit memlimit)
    (let* ([outlen (pwhash-strbytes alg)]
           [opslimit* (or opslimit ((pwhash-opslimit) alg))]
           [memlimit* (or memlimit ((pwhash-memlimit) alg))]
           [out (make-string outlen #\x00)]
           [rc (%pwhash-str-alg (location out)
                                (location passwd)
                                (string-length passwd)
                                opslimit*
                                memlimit*
                                (pwhash-alg alg))])
      (if (= rc 0)
          (trim-null-bytes* out)
          (error 'pwhash-str-failed))))

  (define (pwhash-verify hash passwd)
    (let* ([hash (pad-hash* hash)]
           [rc (%pwhash-str-verify (location hash)
                                   (location passwd)
                                   (string-length passwd))])
      (= rc 0)))

  (define (pwhash-needs-rehash? hash #!key (alg (pwhash-algorithm)) opslimit memlimit)
    (let* ([hash (pad-hash* hash)]
           [opslimit* (or opslimit ((pwhash-opslimit) alg))]
           [memlimit* (or memlimit ((pwhash-memlimit) alg))]
           [rc (%pwhash-str-needs-rehash (location hash)
                                         opslimit*
                                         memlimit*)])
      (case rc
        ((0 1) (= rc 1))
        (else  (error 'pwhash-needs-rehash-failed)))))

  (pwhash-init))