Permalink
Browse files

add in a password encryption/decryption suite, with associated test c…

…ases (needs ounit for the test cases)
  • Loading branch information...
1 parent 95e25f6 commit b37301501ae2ff90697809162af4107212b2d967 @avsm committed Mar 11, 2009
Showing with 158 additions and 1 deletion.
  1. +1 −0 .gitignore
  2. +1 −1 Makefile
  3. +23 −0 Makefile.passwords
  4. +81 −0 password_tests.ml
  5. +52 −0 passwords.ml
View
@@ -10,3 +10,4 @@
/lifedb_server
/client/python/LifeDB.egg-info
/forktest
+/passtest
View
@@ -19,7 +19,7 @@ SOURCES= custom_unix_stubs.c fork_helper.ml utils.ml lifedb_config.ml sql_access
server.ml
THREADS=yes
RESULT=lifedb_server
-PACKS=netstring netcgi2 unix nethttpd-for-netcgi2 netplex json-static json-wheel uuidm sqlite3 str ANSITerminal
+PACKS=netstring netcgi2 unix nethttpd-for-netcgi2 netplex json-static json-wheel uuidm sqlite3 str ANSITerminal cryptokit
LIBDIRS=/opt/local/lib
PP=./camlp4find $(PACKS)
View
@@ -0,0 +1,23 @@
+OCAMLMAKEFILE = OCamlMakefile
+
+ANNOTATE = yes
+export ANNOTATE
+DEBUG = yes
+export DEBUG
+
+OCAMLRUNPARAM=b
+export OCAMLRUNPARAM
+
+SOURCES=passwords.ml password_tests.ml
+RESULT=passtest
+PACKS=cryptokit ounit
+
+.PHONY: all
+all: dnc
+ @ :
+
+.PHONY: test
+test: all
+ ./$(RESULT) -verbose
+
+include $(OCAMLMAKEFILE)
View
@@ -0,0 +1,81 @@
+(* test suite for the password encryption library *)
+
+open OUnit
+open Passwords
+
+let must = function
+ |None -> assert_failure "must"
+ |Some x -> x
+
+let never = function
+ |Some x -> assert_failure "never"
+ |None -> ()
+
+(* Basic test to make sure an encrypted password is reversed
+ successfully with the same passphrase and salt *)
+let test_encrypt_and_decrypt () =
+ let tod = Int64.of_float (Unix.gettimeofday () ) in
+ let origpass = "verysecret" in
+ let encpass = must (encrypt_password tod "wibble" origpass) in
+ let decpass = must(decrypt_password tod "wibble" encpass) in
+ "password differ" @? (origpass <> encpass);
+ "decpass and encpass differ" @? (decpass <> encpass);
+ assert_equal origpass decpass
+
+(* ensure a bad passphrase causes an incorrect decrypt *)
+let test_fail_decrypt () =
+ let tod = Int64.of_float (Unix.gettimeofday () ) in
+ let origpass = "verysecret" in
+ let encpass = must(encrypt_password tod "wibble" origpass) in
+ never(decrypt_password tod "foobar" encpass)
+
+(* ensure a different time causes incorrect decrypt *)
+let test_fail_decrypt_time () =
+ let tod = Int64.of_float (Unix.gettimeofday () ) in
+ let tod' = Int64.of_float (12345678.0) in
+ let origpass = "verysecret" in
+ let encpass = must(encrypt_password tod "wibble" origpass) in
+ never(decrypt_password tod' "wibble" encpass);
+ never(decrypt_password tod' "foobar" encpass);
+ never(decrypt_password tod "foobar" encpass)
+
+(* ensure different passwords dont have the same encrypted result *)
+let test_successive_encrypt () =
+ let tod = Int64.of_float (Unix.gettimeofday ()) in
+ let passwds = [ "one"; "two"; "three"; "four"; "five" ] in
+ let encpasswds = List.map (encrypt_password tod "wobble") passwds in
+ let h = Hashtbl.create 1 in
+ List.iter (fun enc ->
+ let p = must enc in
+ "password collision" @? (not (Hashtbl.mem h p));
+ Hashtbl.add h p ();
+ ) encpasswds
+
+let suite = "Password encryption test" >:::
+ ["test_encrypt_and_decrypt" >:: test_encrypt_and_decrypt;
+ "test_fail_decrypt" >:: test_fail_decrypt;
+ "test_fail_decrypt_time" >:: test_fail_decrypt_time;
+ "test_successive_encrypt" >:: test_successive_encrypt ]
+
+(* Returns true if the result list contains successes only *)
+let rec was_successful results =
+ match results with
+ [] -> true
+ | RSuccess _::t
+ | RSkip _::t -> was_successful t
+ | RFailure _::_
+ | RError _::_
+ | RTodo _::_ -> false
+
+let _ =
+ let verbose = ref false in
+ let set_verbose _ = verbose := true in
+ Arg.parse
+ [("-verbose", Arg.Unit set_verbose, "Run the tests in verbose mode.");]
+ (fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
+ ("Usage: " ^ Sys.argv.(0) ^ " [-verbose]");
+
+ while true do
+ if not (was_successful (run_test_tt ~verbose:!verbose suite)) then
+ exit 1
+ done
View
@@ -0,0 +1,52 @@
+(* module to manage passwords securely.
+ encryption scheme is:
+ * pass in a 64-bit time (e.g. when the password was entered by the user) with passwd
+ * time is converted to a string and MD5 hashed into a 16-byte string (acts as iv).
+ * passphrase is SHA-256 hashed into a 32-byte string (acts as key).
+ * use AES block encryption with CBC (iv/key from above), padding provided
+ * result is hex encoded as a string
+ *)
+open Cryptokit
+open Printf
+
+let hash_of_string hfn s =
+ let hash = hfn () in
+ hash#add_string s;
+ let r = hash#result in
+ hash#wipe;
+ r
+
+(* the AES key is obtained by taking the SHA1 hash of the input passphrase.
+ the IV for the CBC is obtained from the SHA1 hash of the string representation
+ of the time the password was stored. this is the "salt" *)
+let key_of_passphrase time pass =
+ let passhash = hash_of_string Hash.sha256 pass in
+ let timehash = hash_of_string Hash.md5 (sprintf "%Lu" time) in
+ passhash, timehash
+
+(* encrypt the password using the key and AES *)
+let encrypt_password time passphrase password =
+ try
+ let key, iv = key_of_passphrase time passphrase in
+ let hexenc = Hexa.encode () in
+ let aes = Cipher.aes ~mode:Cipher.CBC ~pad:Padding.length ~iv:iv key Cipher.Encrypt in
+ let t = compose aes hexenc in
+ t#put_string password;
+ t#finish;
+ let r = t#get_string in
+ t#wipe;
+ Some r
+ with Error _ -> None
+
+let decrypt_password time passphrase enc_password =
+ try
+ let key, iv = key_of_passphrase time passphrase in
+ let hexdec = Hexa.decode () in
+ let aes = Cipher.aes ~mode:Cipher.CBC ~pad:Padding.length ~iv:iv key Cipher.Decrypt in
+ let t = compose hexdec aes in
+ t#put_string enc_password;
+ t#finish;
+ let r = t#get_string in
+ t#wipe;
+ Some r
+ with Error _ -> None

0 comments on commit b373015

Please sign in to comment.