extra/crypto/passwd-md5/passwd-md5.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel base64 checksums.md5 sequences checksums
   4 locals prettyprint math math.bits grouping io combinators
   5 fry make combinators.short-circuit math.functions splitting ;
   6 IN: crypto.passwd-md5
   7
   8 <PRIVATE
   9
  10 : lookup-table ( n -- nth )
  11     "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" nth ; inline
  12
  13 : to64 ( v n -- string )
  14     [ [ -6 shift ] [ 6 2^ 1 - bitand lookup-table ] bi ]
  15     replicate nip ; inline
  16
  17 PRIVATE>
  18
  19 :: passwd-md5 ( magic salt password -- bytes )
  20     [let* | final! [ password magic salt 3append
  21                 salt password tuck 3append md5 checksum-bytes
  22                 password length
  23                 [ 16 / ceiling swap <repetition> concat ] keep
  24                 head-slice append
  25                 password [ length make-bits ] [ first ] bi
  26                 '[ CHAR: \0 _ ? ] "" map-as append
  27                 md5 checksum-bytes ] |
  28         1000 [
  29             "" swap
  30             {
  31                 [ 0 bit? password final ? append ]
  32                 [ 3 mod 0 > [ salt append ] when ]
  33                 [ 7 mod 0 > [ password append ] when ]
  34                 [ 0 bit? final password ? append ]
  35             } cleave md5 checksum-bytes final!
  36         ] each
  37
  38         magic salt "$" 3append
  39         { 12 0 6 13 1 7 14 2 8 15 3 9 5 4 10 } final nths 3 group
  40         [ first3 [ 16 shift ] [ 8 shift ] bi* + + 4 to64 ] map concat
  41         11 final nth 2 to64 3append ] ;
  42
  43 : parse-shadow-password ( string -- magic salt password )
  44     "$" split harvest first3 [ "$" tuck 3append ] 2dip ;
  45
  46 : authenticate-password ( shadow password -- ? )
  47     '[ parse-shadow-password drop _ passwd-md5 ] keep = ;