From fe66a089e3a5423eea4adc63422e966481096e15 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 19 Oct 2008 22:13:33 -0500
Subject: [PATCH] a convert to/from md5 shadow passwords.  just for fun

---
 extra/crypto/passwd-md5/authors.txt           |  1 +
 .../crypto/passwd-md5/passwd-md5-docs.factor  | 34 ++++++++++++++
 .../crypto/passwd-md5/passwd-md5-tests.factor | 16 +++++++
 extra/crypto/passwd-md5/passwd-md5.factor     | 47 +++++++++++++++++++
 4 files changed, 98 insertions(+)
 create mode 100644 extra/crypto/passwd-md5/authors.txt
 create mode 100644 extra/crypto/passwd-md5/passwd-md5-docs.factor
 create mode 100644 extra/crypto/passwd-md5/passwd-md5-tests.factor
 create mode 100644 extra/crypto/passwd-md5/passwd-md5.factor

diff --git a/extra/crypto/passwd-md5/authors.txt b/extra/crypto/passwd-md5/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/extra/crypto/passwd-md5/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/extra/crypto/passwd-md5/passwd-md5-docs.factor b/extra/crypto/passwd-md5/passwd-md5-docs.factor
new file mode 100644
index 0000000000..eb8f3e74a9
--- /dev/null
+++ b/extra/crypto/passwd-md5/passwd-md5-docs.factor
@@ -0,0 +1,34 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string strings ;
+IN: crypto.passwd-md5
+
+HELP: authenticate-password
+{ $values
+     { "shadow" string } { "password" string }
+     { "?" "a boolean" } }
+{ $description "Encodes the provided password and compares it to the encoded password entry from a shadowed password file." } ;
+
+HELP: parse-shadow-password
+{ $values
+     { "string" string }
+     { "magic" string } { "salt" string } { "password" string } }
+{ $description "Splits a shadowed password entry into a magic string, a salt, and an encoded password string." } ;
+
+HELP: passwd-md5
+{ $values
+     { "magic" string } { "salt" string } { "password" string }
+     { "bytes" "an md5-shadowed password entry" } }
+{ $description "Encodes the password with the given magic string and salt to an MD5-shadow password entry." } ;
+
+ARTICLE: "crypto.passwd-md5" "MD5 shadow passwords"
+"The " { $vocab-link "crypto.passwd-md5" } " vocabulary can encode passwords for use in an MD5 shadow password file." $nl
+
+"Encoding a password:"
+{ $subsection passwd-md5 }
+"Parsing a shadowed password entry:"
+{ $subsection parse-shadow-password }
+"Authenticating against a shadowed password:"
+{ $subsection authenticate-password } ;
+
+ABOUT: "crypto.passwd-md5"
diff --git a/extra/crypto/passwd-md5/passwd-md5-tests.factor b/extra/crypto/passwd-md5/passwd-md5-tests.factor
new file mode 100644
index 0000000000..a858d8dab5
--- /dev/null
+++ b/extra/crypto/passwd-md5/passwd-md5-tests.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test crypto.passwd-md5 ;
+IN: crypto.passwd-md5.tests
+
+
+[ "$1$npUpD5oQ$1.X7uXR2QG0FzPifVeZ2o1" ]
+[ "$1$" "npUpD5oQ" "factor" passwd-md5 ] unit-test
+
+[ "$1$Kilak4kR$wlEr5Dv5DcdqPjKjQtt430" ]
+[
+    "$1$"
+    "Kilak4kR"
+    "longpassword12345678901234567890"
+    passwd-md5
+] unit-test
diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor
new file mode 100644
index 0000000000..32a913ef23
--- /dev/null
+++ b/extra/crypto/passwd-md5/passwd-md5.factor
@@ -0,0 +1,47 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel base64 checksums.md5 symbols sequences checksums
+locals prettyprint math math.bitwise grouping io combinators
+fry make combinators.short-circuit math.functions splitting ;
+IN: crypto.passwd-md5
+
+<PRIVATE
+
+: lookup-table ( n -- nth )
+    "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" nth ; inline
+
+: to64 ( v n -- string )
+    [ [ -6 shift ] [ 6 2^ 1- bitand lookup-table ] bi ]
+    replicate nip ; inline
+
+PRIVATE>
+
+:: passwd-md5 ( magic salt password -- bytes )
+    [let* | final! [ password magic salt 3append
+                salt password tuck 3append md5 checksum-bytes
+                password length
+                [ 16 / ceiling swap <repetition> concat ] keep
+                head-slice append
+                password [ length ] [ first ] bi
+                '[ [ CHAR: \0 _ ? , ] each-bit ] "" make append
+                md5 checksum-bytes ] |
+        1000 [
+            "" swap
+            {
+                [ 0 bit? password final ? append ]
+                [ 3 mod 0 > [ salt append ] when ]
+                [ 7 mod 0 > [ password append ] when ]
+                [ 0 bit? final password ? append ]
+            } cleave md5 checksum-bytes final!
+        ] each
+
+        magic salt "$" 3append
+        { 12 0 6 13 1 7 14 2 8 15 3 9 5 4 10 } final nths 3 group
+        [ first3 [ 16 shift ] [ 8 shift ] bi* + + 4 to64 ] map concat
+        11 final nth 2 to64 3append ] ;
+        
+: parse-shadow-password ( string -- magic salt password )
+    "$" split harvest first3 [ "$" tuck 3append ] 2dip ;
+    
+: authenticate-password ( shadow password -- ? )
+    '[ parse-shadow-password drop _ passwd-md5 ] keep = ;