Uses SHA256 instead of sxhash from now on.

Notice that if a user doesn't change his password, we'll keep using
sxhash forever, which I think is quite okay.  The problem with sxhash
is not only that it's not cryptographic, but different systems will
produce different hashes.  For instance, Windows will produce one hash
and FreeBSD will produce another.  We're better off with something
more deterministic such as SHA256.

loop.asd

@@ -3,5 +3,5 @@
   :version "0.1"
   :description "An NNTP server for a circle of friends."
   :depends-on (:lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
-               :filesystem-utils)
+               :filesystem-utils :ironclad/digest/sha256)
   :components ((:file "loop")))

loop.lisp

@@ -2,7 +2,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload 
    '(:lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
-     :filesystem-utils)
+     :filesystem-utils :ironclad/digest/sha256)
    :silent t))
 
 (clsql:enable-sql-reader-syntax)
@@ -1111,11 +1111,20 @@
       (setq *accounts* (read s))))
   *accounts*)
 
+(defun string->array (s)
+  (make-array (length s) 
+              :element-type '(unsigned-byte 8)
+              :initial-contents (map 'vector #'char-code s)))
+
+(defun string->sha256 (s)
+  (let ((d (ironclad:make-digest :sha256)))
+    (ironclad:produce-digest (ironclad:update-digest d (string->array s)))))
+
 (defun new-account! (username invited-by)
   (let* ((u (str:upcase username))
          (p (random-string 6))
          (a (make-account :username u
-                          :pass (sxhash (str:upcase p))
+                          :pass (string->sha256 (str:upcase p))
                           :creation (get-universal-time)))) 
     (if (get-account u)
         (values nil (fmt "account ~a already exists" u))
@@ -1212,14 +1221,19 @@
 
 (defun pass? (username pass)
   (let ((u (get-account username)))
-    (and u
-         (eq (sxhash pass) (account-pass u)))))
+    (and 
+     u
+     (cond ((integerp (account-pass u))
+            (eq (sxhash pass) (account-pass u)))
+           ((arrayp (account-pass u))
+            (equal (string->sha256 pass) (account-pass u)))
+           (t (error "pass? expected to find INTEGERP or ARRAYP but found ~a" (type-of (account-pass u))))))))
 
 (defun change-passwd! (username newpass)
   (let ((u (get-account username)))
     (when (not u)
       (error "I could not find account ~a." username))
-    (setf (account-pass u) (sxhash newpass))
+    (setf (account-pass u) (string->sha256 newpass))
     (write-accounts!)))
 
 (defun notify-group-created (g)

loop.nw

@@ -981,11 +981,20 @@ same check here.
       (setq *accounts* (read s))))
   *accounts*)
 
+(defun string->array (s)
+  (make-array (length s) 
+              :element-type '(unsigned-byte 8)
+              :initial-contents (map 'vector #'char-code s)))
+
+(defun string->sha256 (s)
+  (let ((d (ironclad:make-digest :sha256)))
+    (ironclad:produce-digest (ironclad:update-digest d (string->array s)))))
+
 (defun new-account! (username invited-by)
   (let* ((u (str:upcase username))
          (p (random-string 6))
          (a (make-account :username u
-                          :pass (sxhash (str:upcase p))
+                          :pass (string->sha256 (str:upcase p))
                           :creation (get-universal-time)))) 
     (if (get-account u)
         (values nil (fmt "account ~a already exists" u))
@@ -1121,14 +1130,19 @@ there is a macro emerging here called [[with-upcase-args]]. %% TODO
 
 (defun pass? (username pass)
   (let ((u (get-account username)))
-    (and u
-         (eq (sxhash pass) (account-pass u)))))
+    (and 
+     u
+     (cond ((integerp (account-pass u))
+            (eq (sxhash pass) (account-pass u)))
+           ((arrayp (account-pass u))
+            (equal (string->sha256 pass) (account-pass u)))
+           (t (error "pass? expected to find INTEGERP or ARRAYP but found ~a" (type-of (account-pass u))))))))
 
 (defun change-passwd! (username newpass)
   (let ((u (get-account username)))
     (when (not u)
       (error "I could not find account ~a." username))
-    (setf (account-pass u) (sxhash newpass))
+    (setf (account-pass u) (string->sha256 newpass))
     (write-accounts!)))
 
 @ %def PASSWD pass? change-passwd!
@@ -2660,7 +2674,7 @@ about.
 
 <<List of packages to be loaded>>=
 :lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
-:filesystem-utils
+:filesystem-utils :ironclad/digest/sha256
 @
 
 <<loop.lisp>>=