(import foreign)

(include "implementations/native/crypt.scm")

;; These all describe what the hash would be of encoding the
;; password "password" with the given salt.
(define types
  `((blowfish "$2a$05$bvIG6Nmid91Mu9RcmmWZfO"
              "$2a$05$bvIG6Nmid91Mu9RcmmWZfO5HJIMCT8riNW0hEp8f6/FuA2/mHZFpe")
    (sha512 "$6$zWwwXKNj"
            ,(conc "$6$zWwwXKNj$gLAOoZCjcr8p/.VgV/"
                   "FkGC3NX7BsXys3KHYePfuIGMNjY83dVxugPYlxVg/"
                   "evpcVEJLT/rSwZcDMlVVf/bhf.1"))
    (sha256 "$5$MnfsQ4iN"
            "$5$MnfsQ4iN$ZMTppKN16y/tIsUYs/obHlhdP.Os80yXhTurpBMUbA5")
    (md5 "$1$O3JMY.Tw" "$1$O3JMY.Tw$AdLnLjQ/5jXF9.MTp3gHv/")
    (des-extended "_J9..K0Ay" "_J9..K0AyUubDrfOgO4s")
    (des "rE" "rEK1ecacw.7.c")))

(use srfi-1 extras)

(define native-crypt-supported-types
  (fold (lambda (type supported-types)
          (let* ((name (car type))
                 (feature-name (string->symbol
                                (conc "crypt-native-" (symbol->string name))))
                 (salt (cadr type))
                 (hash (caddr type)))
            (if (string=? hash (crypt-native "password" salt))
                (cons (cons name feature-name) supported-types)
                supported-types)))
        '()
        types))

;; Useful for debugging
(print "\n================================================================")
(print "Detected support for the following hash types in system crypt():")
(print (map car native-crypt-supported-types))
(print "================================================================\n")

;; For the setup script
(with-output-to-file "crypt-features"
  (lambda () (write (cons 'has-native-crypt
                          (map cdr native-crypt-supported-types)))))