Changeset 38056 in project


Ignore:
Timestamp:
01/05/20 18:20:57 (3 weeks ago)
Author:
sjamaan
Message:

Port crypt egg to C5

Location:
release/5/crypt
Files:
3 added
2 deleted
6 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/5/crypt/trunk/build-crypt.scm

    r38050 r38056  
    11;; -*- Scheme -*-
    22
    3 (use files)
     3(import (chicken base) (chicken file) (chicken process-context)
     4        (chicken process) (chicken platform) (chicken string)
     5        (chicken port) (chicken io) compile-file)
    46
    57(define libcrypt-presence-checker #<<EOF
    68#include <unistd.h>
     9#ifndef _XOPEN_CRYPT
     10#include <crypt.h>
     11#endif
     12
    713int main (void) {
    814  return crypt("foo", "bar") != NULL;
     
    3238  (if uses-libcrypt '(-L -lcrypt) '()))
    3339
     40(define (filter pred lst)               ; Why require srfi-1?
     41  (foldr (lambda (x r) (if (pred x) (cons x r) r)) '() lst))
     42
    3443(cond
    3544 ((get-environment-variable "FORCE_CRYPT_HASHTYPES") =>
    3645  (lambda (f)
    37     (let* ((forced-types (with-input-from-string f read-file))
     46    (let* ((forced-types (with-input-from-string f read-list))
    3847           (supported-features
    3948            (filter (lambda (x) (member x known-hash-types)) forced-types))
    40            (features (map (lambda (h) (string->symbol (conc 'crypt-native- h)))
     49           (features (map (lambda (h) (symbol->string (symbol-append 'crypt-native- h)))
    4150                          supported-features)))
    4251      (print "\n==============================================================")
     
    5867 
    5968 ((try-compile libcrypt-presence-checker
    60                cflags: "-D_XOPEN_SOURCE"
     69               cflags: "-D_XOPEN_SOURCE=700"
    6170               ldflags: (if uses-libcrypt "-lcrypt" ""))
    62   (compile -C -D_XOPEN_SOURCE ,@libcrypt-flags detect-native-crypt-features.scm)
    63   (run (./detect-native-crypt-features))
     71  (compile-file "detect-native-crypt-features.scm" #:options (map ->string `(-C -D_XOPEN_SOURCE ,@libcrypt-flags)))
     72  ;; (system* "./detect-native-crypt-features")
    6473  (let ((features (with-input-from-file "crypt-features" read)))
    6574    ;; Useful for debugging
     
    8594                  '()
    8695                  `(-feature has-native-crypt -feature ,@feature-flags))))
    87   (compile -s -O2 crypt.scm ,@libcrypt-flags -C -D_XOPEN_SOURCE ,@flags -j crypt))
     96  (system* (string-intersperse (map (lambda (s) (qs (->string s)))
     97                                    (append (command-line-arguments)
     98                                            `(,@libcrypt-flags -C -D_XOPEN_SOURCE ,@flags))))))
    8899
    89 (compile -s -O2 crypt.import.scm)
     100(compile-file "crypt.import.scm" #:options `("-s" "-O2"))
    90101
    91 (install-extension
    92   'crypt
    93   '("crypt.so" "crypt.import.so")
    94   `((version 0.5)))
  • release/5/crypt/trunk/crypt.scm

    r25770 r38056  
    2323   crypt-sha512-gensalt crypt-sha512-default-rounds)
    2424
    25 (import chicken scheme foreign)
    26 (use srfi-4 srfi-13 data-structures extras)
     25(import scheme (chicken base) (chicken foreign) (chicken syntax)
     26        (chicken random) (chicken string) (chicken bitwise) (chicken format)
     27        srfi-4)
     28
     29(import-for-syntax (chicken string))
    2730
    2831(foreign-declare "#include \"common.c\"")
     
    4346 (else))
    4447
    45 (define-syntax (fallback-implementation e r c)
    46   (let* ((type (symbol->string (cadr e)))
    47          (file (caddr e))
    48          (feature (string->symbol (conc "crypt-native-" type))))
    49    `(cond-expand ((not ,feature) (include ,file)) (else))))
     48(define-syntax fallback-implementation
     49  (er-macro-transformer
     50   (lambda (e r c)
     51     (let* ((type (symbol->string (cadr e)))
     52            (file (caddr e))
     53            (feature (string->symbol (string-append "crypt-native-" type))))
     54       `(cond-expand ((not ,feature) (include ,file)) (else))))))
    5055
    5156(fallback-implementation blowfish "implementations/blowfish/crypt.scm")
     
    5762
    5863(define (u8vector->saltstring u8vector)
    59   (let* ((salt-length (inexact->exact
    60                        (ceiling (/ (* (u8vector-length u8vector) 8) 6))))
     64  (let* ((salt-length (ceiling (/ (* (u8vector-length u8vector) 8) 6)))
    6165         (salt (make-string salt-length)))
    6266    ((foreign-lambda void "bytes_to_saltstring"
    63                      u8vector unsigned-int scheme-pointer unsigned-int)
     67                     u8vector unsigned-int (scheme-pointer char) unsigned-int)
    6468     u8vector (u8vector-length u8vector) salt salt-length)
    6569    salt))
     
    6973         (input-size (u8vector-length input)))
    7074    (cond
    71      ((fx< input-size minimum-size)
     75     ((< input-size minimum-size)
    7276      (error "Vector with random bytes too short" impl input-size minimum-size))
    73      ((fx> input-size (or maximum-size input-size))
     77     ((> input-size (or maximum-size input-size))
    7478      (error "Vector with random bytes too long" impl input-size maximum-size))
    7579     (else input))))
     
    7781(define (crypt-maximum-random-u8vector minimum-size maximum-size)
    7882  (let ((size (or maximum-size minimum-size)))
    79     (do ((i 0 (fx+ i 1))
     83    (do ((i 0 (add1 i))
    8084         (v (make-u8vector size)))
    81         ((fx= i size) v)
    82       (u8vector-set! v i (random 256)))))
     85        ((= i size) v)
     86      (u8vector-set! v i (pseudo-random-integer 256)))))
    8387
    8488(define crypt-default-random-u8vector
     
    8690
    8791(define crypt-default-implementation (make-parameter 'blowfish))
     92
     93(define (string-prefix? p s) ; We don't need no srfi-13
     94  (substring=? p s 0 0 (string-length p)))
    8895
    8996;; Maybe this should be sped up (by not comparing from the start every time)
     
    117124        (else (error "Unknown crypt prefix type" str))))
    118125
    119 (define-syntax (crypt-cases e r c)
    120   `(case ,(cadr e)
    121      ,@(map
    122         (lambda (type)
    123           (let* ((fallback-procedure (string->symbol (conc "crypt-" type)))
    124                  (feature-name (string->symbol (conc "crypt-native-" type))))
    125             `((,type)
    126               (cond-expand (,feature-name (crypt-native password hash))
    127                            (else (,fallback-procedure password hash))))))
    128         (cddr e))
    129      (else (error "Unkown crypt() type" ,(cadr e)))))
     126(define-syntax crypt-cases
     127  (er-macro-transformer
     128   (lambda (e r c)
     129     `(case ,(cadr e)
     130        ,@(map
     131           (lambda (type)
     132             (let* ((stype (->string type))
     133                    (fallback-procedure (string->symbol (string-append "crypt-" stype)))
     134                    (feature-name (string->symbol (string-append "crypt-native-" stype))))
     135               `((,type)
     136                 (cond-expand (,feature-name (crypt-native password hash))
     137                              (else (,fallback-procedure password hash))))))
     138           (cddr e))
     139        (else (error "Unkown crypt() type" ,(cadr e)))))))
    130140
    131141(define (crypt password #!optional setting)
  • release/5/crypt/trunk/detect-native-crypt-features.scm

    r28669 r38056  
    1 (import foreign)
     1(import (chicken base) (chicken foreign))
    22
    33(include "implementations/native/crypt.scm")
     
    99              "$2a$05$bvIG6Nmid91Mu9RcmmWZfO5HJIMCT8riNW0hEp8f6/FuA2/mHZFpe")
    1010    (sha512 "$6$zWwwXKNj"
    11             ,(conc "$6$zWwwXKNj$gLAOoZCjcr8p/.VgV/"
    12                    "FkGC3NX7BsXys3KHYePfuIGMNjY83dVxugPYlxVg/"
    13                    "evpcVEJLT/rSwZcDMlVVf/bhf.1"))
     11            ,(string-append "$6$zWwwXKNj$gLAOoZCjcr8p/.VgV/"
     12                            "FkGC3NX7BsXys3KHYePfuIGMNjY83dVxugPYlxVg/"
     13                            "evpcVEJLT/rSwZcDMlVVf/bhf.1"))
    1414    (sha256 "$5$MnfsQ4iN"
    1515            "$5$MnfsQ4iN$ZMTppKN16y/tIsUYs/obHlhdP.Os80yXhTurpBMUbA5")
     
    1818    (des "rE" "rEK1ecacw.7.c")))
    1919
    20 (use srfi-1 extras)
    21 
    2220(define native-crypt-supported-types
    23   (fold (lambda (type supported-types)
    24           (let* ((name (car type))
    25                  (feature-name (string->symbol
    26                                 (conc "crypt-native-" (symbol->string name))))
    27                  (salt (cadr type))
    28                  (hash (caddr type)))
    29             (if (equal? hash (crypt-native "password" salt))
    30                 (cons (cons name feature-name) supported-types)
    31                 supported-types)))
    32         '()
    33         types))
     21  (foldl (lambda (supported-types type)
     22           (let* ((name (car type))
     23                  (feature-name (symbol-append 'crypt-native- name))
     24                  (salt (cadr type))
     25                  (hash (caddr type)))
     26             (if (equal? hash (crypt-native "password" salt))
     27                 (cons (cons name feature-name) supported-types)
     28                 supported-types)))
     29         '()
     30         types))
    3431
    3532;; For the setup script
  • release/5/crypt/trunk/implementations/DES/crypt.scm

    r22310 r38056  
    1 (import foreign)
    21(foreign-declare "#include \"implementations/DES/crypt_des.c\"")
    32
  • release/5/crypt/trunk/implementations/MD5/gensalt.scm

    r22324 r38056  
    11(define (crypt-md5-gensalt random)
    2   (conc "$1$"
    3         (u8vector->saltstring
    4          (get-random-u8vector 'crypt-md5-gensalt random 6 6))))
     2  (string-append "$1$"
     3                 (u8vector->saltstring
     4                  (get-random-u8vector 'crypt-md5-gensalt random 6 6))))
  • release/5/crypt/trunk/implementations/native/crypt.scm

    r22342 r38056  
    1 (foreign-declare "#include <unistd.h>")
     1(foreign-declare #<<EOF
     2#include <unistd.h>
     3#ifndef _XOPEN_CRYPT
     4#include <crypt.h>
     5#endif
     6EOF
     7)
    28
    39;; There's no such thing as a native gensalt, by the way.
  • release/5/crypt/trunk/tests/run.scm

    r25770 r38056  
    1 (use test)
    2 (use srfi-1 srfi-13)
    3 
    4 (use crypt)
     1(import crypt test srfi-4)
    52
    63(test-begin "Chicken crypt egg")
     
    8784    (test-crypt "U*U*U"
    8885                "$2a$05$XXXXXXXXXXXXXXXXXXXXXOAcXxm9kjPGEMsLznoKqmqw7tc8WCx4a")
    89     (test-crypt (conc "0123456789abcdefghijklmnopqrstuvwxyz"
    90                       "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
     86    (test-crypt (string-append "0123456789abcdefghijklmnopqrstuvwxyz"
     87                               "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
    9188                "$2a$05$abcdefghijklmnopqrstuu5s2v8.iXieOjg/.AySBTTZIIVFJeBui")
    92     (test-crypt (conc "0123456789abcdefghijklmnopqrstuvwxyz"
    93                       "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    94                       "chars after 72 are ignored")
     89    (test-crypt (string-append "0123456789abcdefghijklmnopqrstuvwxyz"
     90                               "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
     91                               "chars after 72 are ignored")
    9592                "$2a$05$abcdefghijklmnopqrstuu5s2v8.iXieOjg/.AySBTTZIIVFJeBui")
    9693
     
    118115                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.Sa7shbm4.OzKpvFnX1pQLmQW96oUlCq")
    119116    #|
    120     (test-crypt (conc "1\xa3" "345")
     117    (test-crypt (string-append "1\xa3" "345")
    121118                "$2x$05$/OK.fbVrR/bpIqNJ5ianF.o./n25XVfn6oAPaUvHe.Csk4zRfsYPi")
    122     (test-crypt (conc "\xff\xa3" "345")
     119    (test-crypt (string-append "\xff\xa3" "345")
    123120                "$2x$05$/OK.fbVrR/bpIqNJ5ianF.o./n25XVfn6oAPaUvHe.Csk4zRfsYPi")
    124     (test-crypt (conc "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
     121    (test-crypt (string-append "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
    125122                "$2x$05$/OK.fbVrR/bpIqNJ5ianF.o./n25XVfn6oAPaUvHe.Csk4zRfsYPi")
    126123    |#
    127124    ;; From the 2y below. This is where our testsuite differs from openwall's
    128     (test-crypt (conc "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
     125    (test-crypt (string-append "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
    129126                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.o./n25XVfn6oAPaUvHe.Csk4zRfsYPi")
    130127    #|
    131     (test-crypt (conc "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
     128    (test-crypt (string-append "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
    132129                "$2y$05$/OK.fbVrR/bpIqNJ5ianF.o./n25XVfn6oAPaUvHe.Csk4zRfsYPi")
    133     (test-crypt (conc "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
     130    (test-crypt (string-append "\xff\xa3" "34" "\xff\xff\xff\xa3" "345")
    134131                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.ZC1JEJ8Z4gPfpe1JOr/oyPXTWl9EFd.")
    135     (test-crypt (conc "\xff\xa3" "345")
     132    (test-crypt (string-append "\xff\xa3" "345")
    136133                "$2y$05$/OK.fbVrR/bpIqNJ5ianF.nRht2l/HRhr6zmCp9vYUvvsqynflf9e")
    137134    |#
    138     (test-crypt (conc "\xff\xa3" "345")
     135    (test-crypt (string-append "\xff\xa3" "345")
    139136                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.nRht2l/HRhr6zmCp9vYUvvsqynflf9e")
    140     (test-crypt (conc "\xa3" "ab")
     137    (test-crypt (string-append "\xa3" "ab")
    141138                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.6IflQkJytoRVc1yuaNtHfiuq.FRlSIS")
    142139    #|
    143     (test-crypt (conc "\xa3" "ab")
     140    (test-crypt (string-append "\xa3" "ab")
    144141                "$2x$05$/OK.fbVrR/bpIqNJ5ianF.6IflQkJytoRVc1yuaNtHfiuq.FRlSIS")
    145     (test-crypt (conc "\xa3" "ab")
     142    (test-crypt (string-append "\xa3" "ab")
    146143                "$2y$05$/OK.fbVrR/bpIqNJ5ianF.6IflQkJytoRVc1yuaNtHfiuq.FRlSIS")
    147144    (test-crypt "\xd1\x91"
     
    150147                "$2x$05$6bNw2HLQYeqHYyBfLMsv/O9LIGgn8OMzuDoHfof8AQimSGfcSWxnS")
    151148    |#
    152     (test-crypt (conc "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
    153                       "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
    154                       "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
    155                       "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
    156                       "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
    157                       "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
    158                       "chars after 72 are ignored as usual")
     149    (test-crypt (string-append "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
     150                               "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
     151                               "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
     152                               "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
     153                               "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
     154                               "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa"
     155                               "chars after 72 are ignored as usual")
    159156                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.swQOIzjOiJ9GHEPuhEkvqrUyvWhEMx6")
    160     (test-crypt (conc "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
    161                       "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
    162                       "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
    163                       "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
    164                       "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
    165                       "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55")
     157    (test-crypt (string-append "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
     158                               "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
     159                               "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
     160                               "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
     161                               "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55"
     162                               "\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55\xaa\x55")
    166163                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.R9xrDjiycxMbQE2bp.vgqlYpW5wx2yy")
    167     (test-crypt (conc "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
    168                       "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
    169                       "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
    170                       "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
    171                       "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
    172                       "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff")
     164    (test-crypt (string-append "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
     165                               "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
     166                               "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
     167                               "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
     168                               "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff"
     169                               "\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff\x55\xaa\xff")
    173170                "$2a$05$/OK.fbVrR/bpIqNJ5ianF.9tQZzcJfm3uj2NvJ/n5xkhpqLrMpWCe")
    174171    (test-crypt ""
     
    187184      (test-crypt "$5$rounds=10000$saltstringsaltstring"
    188185                  "Hello world!"
    189                   (conc "$5$rounds=10000$saltstringsaltst$"
    190                         "3xv.VbSHBb41AL9AvLeujZkZRBAwqFMz2.opqey6IcA") )
     186                  (string-append "$5$rounds=10000$saltstringsaltst$"
     187                                 "3xv.VbSHBb41AL9AvLeujZkZRBAwqFMz2.opqey6IcA") )
    191188      (test-crypt "$5$rounds=5000$toolongsaltstring"
    192189                  "This is just a test"
    193                   (conc "$5$rounds=5000$toolongsaltstrin$"
    194                         "Un/5jzAHMgOGZ5.mWJpuVolil07guHPvOW8mGRcvxa5"))
     190                  (string-append "$5$rounds=5000$toolongsaltstrin$"
     191                                 "Un/5jzAHMgOGZ5.mWJpuVolil07guHPvOW8mGRcvxa5"))
    195192      (test-crypt "$5$rounds=1400$anotherlongsaltstring"
    196                   (conc "a very much longer text to encrypt.  This one even "
    197                         "stretches over morethan one line.")
    198                   (conc "$5$rounds=1400$anotherlongsalts$"
    199                         "Rx.j8H.h8HjEDGomFU8bDkXm3XIUnzyxf12oP84Bnq1"))
     193                  (string-append "a very much longer text to encrypt.  This one even "
     194                                 "stretches over morethan one line.")
     195                  (string-append "$5$rounds=1400$anotherlongsalts$"
     196                                 "Rx.j8H.h8HjEDGomFU8bDkXm3XIUnzyxf12oP84Bnq1"))
    200197      (test-crypt "$5$rounds=77777$short"
    201198                  "we have a short salt string but not a short password"
    202                   (conc "$5$rounds=77777$short$"
    203                         "JiO1O3ZpDAxGJeaDIuqCoEFysAe1mZNJRs3pw0KQRd/"))
     199                  (string-append "$5$rounds=77777$short$"
     200                                 "JiO1O3ZpDAxGJeaDIuqCoEFysAe1mZNJRs3pw0KQRd/"))
    204201      (test-crypt "$5$rounds=123456$asaltof16chars.."
    205202                  "a short string"
    206                   (conc "$5$rounds=123456$asaltof16chars..$"
    207                         "gP3VQ/6X7UUEW3HkBn2w1/Ptq2jxPyzV/cZKmF/wJvD"))
     203                  (string-append "$5$rounds=123456$asaltof16chars..$"
     204                                 "gP3VQ/6X7UUEW3HkBn2w1/Ptq2jxPyzV/cZKmF/wJvD"))
    208205      (test-crypt "$5$rounds=10$roundstoolow"
    209206                  "the minimum number is still observed"
    210                   (conc "$5$rounds=1000$roundstoolow$"
    211                         "yfvwcWrQ8l/K0DAWyuPMDNHpIVlTQebY9l/gL972bIC"))
     207                  (string-append "$5$rounds=1000$roundstoolow$"
     208                                 "yfvwcWrQ8l/K0DAWyuPMDNHpIVlTQebY9l/gL972bIC"))
    212209      ;; From http://openwall.info/wiki/john/sample-hashes
    213210      (test-crypt "password"
     
    218215      (test-crypt "$6$saltstring"
    219216                  "Hello world!"
    220                   (conc "$6$saltstring$svn8UoSVapNtMuq1ukKS4tPQd8iKwSMHWjl/"
    221                         "O817G3uBnIFNjnQJu"
    222                         "esI68u4OTLiBFdcbYEdFCoEOfaS35inz1"))
     217                  (string-append "$6$saltstring$svn8UoSVapNtMuq1ukKS4tPQd8iKwSMHWjl/"
     218                                 "O817G3uBnIFNjnQJu"
     219                                 "esI68u4OTLiBFdcbYEdFCoEOfaS35inz1"))
    223220      (test-crypt "$6$rounds=10000$saltstringsaltstring"
    224221                  "Hello world!"
    225                   (conc "$6$rounds=10000$saltstringsaltst$"
    226                         "OW1/O6BYHV6BcXZu8QVeXbDWra3Oeqh0sb"
    227                         "HbbMCVNSnCM/UrjmM0Dp8vOuZeHBy/YTBmSK6H9qs/y3RnOaw5v."))
     222                  (string-append "$6$rounds=10000$saltstringsaltst$"
     223                                 "OW1/O6BYHV6BcXZu8QVeXbDWra3Oeqh0sb"
     224                                 "HbbMCVNSnCM/UrjmM0Dp8vOuZeHBy/YTBmSK6H9qs/y3RnOaw5v."))
    228225      (test-crypt "$6$rounds=5000$toolongsaltstring"
    229226                  "This is just a test"
    230                   (conc "$6$rounds=5000$toolongsaltstrin$"
    231                         "lQ8jolhgVRVhY4b5pZKaysCLi0QBxGoNeKQ"
    232                         "zQ3glMhwllF7oGDZxUhx1yxdYcz/e1JSbq3y6JMxxl8audkUEm0"))
     227                  (string-append "$6$rounds=5000$toolongsaltstrin$"
     228                                 "lQ8jolhgVRVhY4b5pZKaysCLi0QBxGoNeKQ"
     229                                 "zQ3glMhwllF7oGDZxUhx1yxdYcz/e1JSbq3y6JMxxl8audkUEm0"))
    233230      (test-crypt "$6$rounds=1400$anotherlongsaltstring"
    234                   (conc "a very much longer text to encrypt.  This one even "
    235                         "stretches over morethan one line.")
    236                   (conc "$6$rounds=1400$anotherlongsalts$"
    237                         "POfYwTEok97VWcjxIiSOjiykti.o/pQs.wP"
    238                         "vMxQ6Fm7I6IoYN3CmLs66x9t0oSwbtEW7o7UmJEiDwGqd8p4ur1"))
     231                  (string-append "a very much longer text to encrypt.  This one even "
     232                                 "stretches over morethan one line.")
     233                  (string-append "$6$rounds=1400$anotherlongsalts$"
     234                                 "POfYwTEok97VWcjxIiSOjiykti.o/pQs.wP"
     235                                 "vMxQ6Fm7I6IoYN3CmLs66x9t0oSwbtEW7o7UmJEiDwGqd8p4ur1"))
    239236      (test-crypt "$6$rounds=77777$short"
    240237                  "we have a short salt string but not a short password"
    241                   (conc "$6$rounds=77777$short$WuQyW2YR.hBNpjjRhpYD/"
    242                         "ifIw05xdfeEyQoMxIXbkvr0g"
    243                         "ge1a1x3yRULJ5CCaUeOxFmtlcGZelFl5CxtgfiAc0"))
     238                  (string-append "$6$rounds=77777$short$WuQyW2YR.hBNpjjRhpYD/"
     239                                 "ifIw05xdfeEyQoMxIXbkvr0g"
     240                                 "ge1a1x3yRULJ5CCaUeOxFmtlcGZelFl5CxtgfiAc0"))
    244241      (test-crypt "$6$rounds=123456$asaltof16chars.."
    245242                  "a short string"
    246                   (conc "$6$rounds=123456$asaltof16chars..$"
    247                         "BtCwjqMJGx5hrJhZywWvt0RLE8uZ4oPwc"
    248                         "elCjmw2kSYu.Ec6ycULevoBK25fs2xXgMNrCzIMVcgEJAstJeonj1"))
     243                  (string-append "$6$rounds=123456$asaltof16chars..$"
     244                                 "BtCwjqMJGx5hrJhZywWvt0RLE8uZ4oPwc"
     245                                 "elCjmw2kSYu.Ec6ycULevoBK25fs2xXgMNrCzIMVcgEJAstJeonj1"))
    249246      (test-crypt "$6$rounds=10$roundstoolow"
    250247                  "the minimum number is still observed"
    251                   (conc "$6$rounds=1000$roundstoolow$kUMsbe306n21p9R."
    252                         "FRkW3IGn.S9NPN0x50YhH1x"
    253                         "hLsPuWGsUSklZt58jaTfF4ZEQpyUNGc0dqbpBYYBaHHrsX."))
     248                  (string-append "$6$rounds=1000$roundstoolow$kUMsbe306n21p9R."
     249                                 "FRkW3IGn.S9NPN0x50YhH1x"
     250                                 "hLsPuWGsUSklZt58jaTfF4ZEQpyUNGc0dqbpBYYBaHHrsX."))
    254251
    255252      ;; From http://openwall.info/wiki/john/sample-hashes
    256253      (test-crypt "password"
    257                   (conc "$6$zWwwXKNj$gLAOoZCjcr8p/.VgV/"
    258                         "FkGC3NX7BsXys3KHYePfuIGMNjY83dVxugPYlxVg/"
    259                         "evpcVEJLT/rSwZcDMlVVf/bhf.1")))))
     254                  (string-append "$6$zWwwXKNj$gLAOoZCjcr8p/.VgV/"
     255                                 "FkGC3NX7BsXys3KHYePfuIGMNjY83dVxugPYlxVg/"
     256                                 "evpcVEJLT/rSwZcDMlVVf/bhf.1")))))
    260257
    261258;; These tests are tightly coupled to the actual implementation of the
Note: See TracChangeset for help on using the changeset viewer.