From 9d3a42f16604bfe5b977abd854535f1a94ce68fc Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 7 Mar 2013 09:21:49 -0700
Subject: [PATCH] using bcrypt

---
 collects/meta/planet2-index/official/main.rkt | 29 +++++++++++++++----
 1 file changed, 23 insertions(+), 6 deletions(-)

diff --git a/collects/meta/planet2-index/official/main.rkt b/collects/meta/planet2-index/official/main.rkt
index ef5e57a0af..8e712edcba 100644
--- a/collects/meta/planet2-index/official/main.rkt
+++ b/collects/meta/planet2-index/official/main.rkt
@@ -20,7 +20,8 @@
          net/sendmail
          meta/planet2-index/basic/main
          web-server/http/id-cookie
-         file/sha1)
+         file/sha1
+         (prefix-in bcrypt- bcrypt))
 
 (define-syntax-rule (while cond e ...)
   (let loop ()
@@ -43,6 +44,8 @@
    (build-path root "secret.key")))
 (define users-path (build-path root "users"))
 (make-directory* users-path)
+(define users.new-path (build-path root "users.new"))
+(make-directory* users.new-path)
 
 (define (client_id)
   (file->string (build-path root "client_id")))
@@ -271,7 +274,7 @@
                     ,@(formlet-display login-formlet)
                     (input ([type "submit"] [value "Log in"])))
               (p "If you enter an unclaimed email address, then an account will be created.")
-              (p "Passwords are stored in the delicious SHA1 format, but transfered as plain-text over the HTTPS connection.")
+              (p "Passwords are stored in the delicious bcrypt format, but transfered as plain-text over the HTTPS connection.")
               ,@(if last-error
                   `((h1 ([class "error"]) ,last-error))
                   '()))))))
@@ -304,9 +307,22 @@
       `(p "Email addresses must not be empty::"
           (tt ,email)))))
 
-  (define password-path (build-path users-path email))
+  (define password-path (build-path users.new-path email))
+  (define old-password-path (build-path users-path email))
 
   (cond
+    [(and (not (file-exists? password-path))
+          (file-exists? old-password-path))
+     (cond
+       [(not (bytes=? (file->bytes old-password-path)
+                      (string->bytes/utf-8 (salty passwd))))
+        (login req (format "The given password is incorrect for email address ~e"
+                           email))]
+       [else
+        (display-to-file (bcrypt-encode (string->bytes/utf-8 passwd))
+                         password-path)
+        (delete-file old-password-path)     
+        (authenticated!)])]
     [(not (file-exists? password-path))
      (send/suspend
       (λ (k-url)
@@ -329,11 +345,12 @@
              ", please click the link it contains to register and log in."))))
 
      (when (not (file-exists? password-path))
-       (display-to-file (salty passwd) password-path))
+       (display-to-file (bcrypt-encode (string->bytes/utf-8 passwd))
+                        password-path))
 
      (authenticated!)]
-    [(not (bytes=? (string->bytes/utf-8 (salty passwd))
-                   (file->bytes password-path)))
+    [(not (bcrypt-check (file->bytes password-path)
+                        (string->bytes/utf-8 passwd)))
      (login req (format "The given password is incorrect for email address ~e"
                         email))]
     [else