Merge a few cleanups inspired by bpt's redesign
[hcoop/portal.git] / app / app.sml
index 7345bbf..8a734f2 100644 (file)
@@ -2,7 +2,7 @@ structure App :> APP =
 struct
 
 val baseUrl = "https://join.hcoop.net/join/"
-val portalUrl = "https://members2.hcoop.net/portal/"
+val portalUrl = "https://members.hcoop.net/portal/"
 
 open Sql
 
@@ -14,7 +14,7 @@ val rnd = ref (Random.rand (0, 0))
 
 fun init () = 
     let
-       val c = C.conn "dbname='hcoop_hcoop'"
+       val c = C.conn "dbname='hcoop_hcoop' host='postgres'"
     in
        db := SOME c;
        C.dml c "BEGIN";
@@ -144,14 +144,7 @@ fun apply {name, rname, gname, email, forward, uses, other, paypal, checkout} =
                                        mwrite passwd;
                                        mwrite ("\n")),
                             id) then
-                   let
-                       val outf = TextIO.openOut (OS.Path.joinDirFile {dir = "/var/lib/portal",
-                                                                        file = name})
-                   in
-                       TextIO.output (outf, unix_passwd);
-                       TextIO.closeOut outf;
-                       SOME unix_passwd
-                   end
+                   SOME unix_passwd
                else
                    NONE
            end
@@ -166,10 +159,11 @@ fun validHost s =
 fun validDomain s =
     size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 
-fun validUser s =
-    size s > 0 andalso size s < 50 andalso List.all
-                                              (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
-                                              (String.explode s)
+fun validUsername name =
+    size name <= 12
+    andalso size name > 0
+    andalso Char.isLower (String.sub (name, 0))
+    andalso CharVector.all Char.isAlphaNum name
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50 andalso List.all
@@ -182,7 +176,9 @@ fun validEmail s =
        | _ => false)
 
 fun userExists name =
-    (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false
+    case C.oneOrNoRows (getDb ()) ($`SELECT id FROM WebUser WHERE name = ^(C.stringToSql name)`) of
+       SOME _ => true
+      | NONE => (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false
 
 fun confirm (id, passwd) =
     let