X-Git-Url: http://git.hcoop.net/hcoop/portal.git/blobdiff_plain/2d795343a1fb171dda9c376322e60260cfcb0fa1..f3f3ad24b001552bdb1b7535fc8434d6889ef2bc:/init.sml

diff --git a/init.sml b/init.sml
index 12092b4..2b2df7b 100644
--- a/init.sml
+++ b/init.sml
@@ -5,6 +5,7 @@ open Util Sql
 structure C = PgClient
 
 exception Access of string
+exception NeedTos
 
 val urlPrefix = "http://users.hcoop.net/portal/"
 val boardEmail = "board.fake@hcoop.net"
@@ -12,7 +13,8 @@ val boardEmail = "board.fake@hcoop.net"
 fun conn () = C.conn "dbname='hcoop'"
 val close = C.close
 
-type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp}
+type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp,
+	     app : int}
 
 val db = ref (NONE : C.conn option)
 val user = ref (NONE : user option)
@@ -27,9 +29,10 @@ fun rowError (tab, vs) = raise Fail ("Bad " ^ tab ^ "row: " ^ makeSet fromSql vs
 
 fun getDb () = valOf (!db)
 
-fun mkUserRow [id, name, rname, bal, joined] =
+fun mkUserRow [id, name, rname, bal, joined, app] =
     {id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
-     bal = C.intFromSql bal, joined = C.timestampFromSql joined}
+     bal = C.intFromSql bal, joined = C.timestampFromSql joined,
+     app = C.intFromSql app}
   | mkUserRow row = rowError ("user", row)
 
 fun init () =
@@ -38,16 +41,37 @@ fun init () =
 
 	val c = conn ()
     in
+	db := SOME c;
 	C.dml c "BEGIN";
 	case Web.getCgi "REMOTE_USER" of
 	    NONE => raise Fail "Not logged in"
 	  | SOME name =>
-	    (case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined
+	    (case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app
   				     FROM WebUser
 				     WHERE name=^(C.stringToSql name)`) of
 		 NONE => raise Fail "User not found"
-	       | SOME r => user := SOME (mkUserRow r));
-	    db := SOME c
+	       | SOME r =>
+		 let
+		     val r = mkUserRow r
+		 in
+		     user := SOME r;
+		     case C.oneOrNoRows c ($`SELECT ipaddr
+					        FROM MemberApp
+					        WHERE id = ^(C.intToSql (#app r))
+						   AND ipaddr IS NOT NULL`) of
+			 NONE =>
+			 if Web.getParam "agree" = "on" then
+			     (case Web.getCgi "REMOTE_ADDR" of
+				  NONE => raise Fail "REMOTE_ADDR not set"
+				| SOME ra =>
+				  ignore (C.dml c ($`UPDATE MemberApp
+					                SET ipaddr = ^(C.stringToSql ra),
+						            applied = CURRENT_TIMESTAMP
+						        WHERE id = ^(C.intToSql (#app r))`)))
+			 else
+			     raise NeedTos
+		       | _ => ()
+		 end)
     end
 
 fun done () =
@@ -63,12 +87,12 @@ fun getUserId () = #id (getUser ())
 fun getUserName () = #name (getUser ())
 
 fun lookupUser id =
-    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined
+    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app
 				      FROM WebUser
 			     	      WHERE id = ^(C.intToSql id)`))
 
 fun listUsers () =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app
 			          FROM WebUser
 			          ORDER BY name`)
 
@@ -77,13 +101,13 @@ fun nextSeq (db, seq) =
 	[id] => C.intFromSql id
       | _ => raise Fail "Bad next sequence val"
 
-fun addUser (name, rname, bal) =
+fun addUser (name, rname, bal, app) =
     let
 	val db = getDb ()
 	val id = nextSeq (db, "WebUserSeq")
     in
-	C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined)
-		    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(C.intToSql bal), CURRENT_TIMESTAMP)`);
+	C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app)
+		    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(C.intToSql bal), CURRENT_TIMESTAMP, ^(C.intToSql app))`);
 	id
     end
 
@@ -93,7 +117,7 @@ fun modUser (user : user) =
     in
 	ignore (C.dml db ($`UPDATE WebUser SET
 			    name = ^(C.stringToSql (#name user)), rname = ^(C.stringToSql (#rname user)),
-			       bal = ^(C.intToSql (#bal user))
+			       bal = ^(C.intToSql (#bal user)), app = ^(C.intToSql (#app user))
 			    WHERE id = ^(C.intToSql (#id user))`))
     end
 
@@ -114,4 +138,27 @@ fun dateString () =
 	[d] => C.stringFromSql d
       | r => rowError ("dateString", r)
 
+fun grandfatherUsers () =
+    let
+	val db = getDb ()
+
+	fun mkApp [id, name, rname] =
+	    let
+		val id = C.intFromSql id
+		val name = C.stringFromSql name
+		val rname = C.stringFromSql rname
+
+		val aid = nextSeq (db, "MemberAppSeq")
+	    in
+		ignore (C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other,
+							passwd, status, applied, confirmed, decided, msg)
+			         VALUES (^(C.intToSql aid), ^(C.stringToSql name), ^(C.stringToSql rname),
+					 NULL, '^name@hcoop.net', FALSE, 'GRANDFATHERED', 'GRANDFATHERED',
+					 'GRANDFATHERED', 4, CURRENT_TIMESTAMP, CURRENT_TIMESTAMP,
+					 CURRENT_TIMESTAMP, 'GRANDFATHERED')`));
+		ignore (C.dml db ($`UPDATE WebUser SET app = ^(C.intToSql aid) WHERE id = ^(C.intToSql id)`))
+	    end
+    in
+	C.app db mkApp "SELECT id, name, rname FROM WebUser WHERE app IS NULL"
+    end
 end
\ No newline at end of file