Random fixin's in preparation for accepting new members

[hcoop/portal.git] / app / app.sml

diff --git a/app/app.sml b/app/app.sml
index 29a82c4..84ca130 100644 (file)
--- a/app/app.sml
+++ b/app/app.sml
@@ -2,7 +2,7 @@ structure App :> APP =
 struct
 
 val baseUrl = "http://join.hcoop.net/join/"
-val portalUrl = "http://users.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'"
+       val c = C.conn "dbname='hcoop_hcoop'"
     in
        db := SOME c;
        C.dml c "BEGIN";
@@ -33,13 +33,32 @@ fun done () =
        db := NONE
     end
 
+fun readFile fname =
+    let
+       val inf = TextIO.openIn fname
+
+       fun readLines lines =
+           case TextIO.inputLine inf of
+               NONE => String.concat (List.rev lines)
+             | SOME line => readLines (line :: lines)
+    in
+       readLines []
+       before TextIO.closeIn inf
+    end
+
+fun readTosBody () = readFile "/home/hcoop/public_html/tos.body.html"
+fun readTosAgree () = readFile "/home/hcoop/public_html/tos.agree.html"
+fun readTosMinorAgree () = readFile "/home/hcoop/public_html/tos.agree.minor.html"
+
 fun sendMail (to, subj, intro, footer, id) =
     let
-       val (name, rname, forward, uses, other) =
-           case C.oneOrNoRows (getDb ()) ($`SELECT name, rname, forward, uses, other FROM MemberApp WHERE id = ^(C.intToSql id)`) of
-               SOME [name, rname, forward, uses, other] => (C.stringFromSql name, C.stringFromSql rname,
-                                                            C.boolFromSql forward, C.stringFromSql uses,
-                                                            C.stringFromSql other)
+       val (name, rname, gname, forward, uses, other) =
+           case C.oneOrNoRows (getDb ()) ($`SELECT name, rname, gname, forward, uses, other FROM MemberApp WHERE id = ^(C.intToSql id)`) of
+               SOME [name, rname, gname, forward, uses, other] =>
+               (C.stringFromSql name, C.stringFromSql rname,
+                if C.isNull gname then NONE else SOME (C.stringFromSql gname),
+                C.boolFromSql forward, C.stringFromSql uses,
+                C.stringFromSql other)
              | _ => raise Fail "Bad sendMail row"
 
        val proc = Unix.execute ("/usr/sbin/exim4", ["-t"])
@@ -53,8 +72,12 @@ fun sendMail (to, subj, intro, footer, id) =
        mwrite intro;
        mwrite ("\n\nUsername: ");
        mwrite (name);
-       mwrite ("\nReal name: ");
+       mwrite ("\nMember real name: ");
        mwrite (rname);
+       case gname of
+           NONE => ()
+         | SOME gname => (mwrite "\nLegal guardian name: ";
+                          mwrite gname);
        mwrite ("\nForward e-mail: ");
        mwrite (if forward then "yes" else "no");
        mwrite ("\n\nDesired uses:\n");
@@ -66,10 +89,10 @@ fun sendMail (to, subj, intro, footer, id) =
        OS.Process.isSuccess (Unix.reap proc)
     end
 
-type application = { name : string, rname : string, email : string,
+type application = { name : string, rname : string, gname : string option, email : string,
                     forward : bool, uses : string, other : string }
 
-fun apply {name, rname, email, forward, uses, other} =
+fun apply {name, rname, gname, email, forward, uses, other} =
     let
        val db = getDb ()
     in
@@ -79,8 +102,9 @@ fun apply {name, rname, email, forward, uses, other} =
                val id = C.intFromSql id
                val passwd = Int.toString (Int.abs (Random.randInt (!rnd)))
            in
-               C.dml db ($`INSERT INTO MemberApp (id, name, rname, email, forward, uses, other, passwd, status, applied, msg)
+               C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd, status, applied, msg)
                            VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname),
+                                   ^(case gname of NONE => "NULL" | SOME gname => C.stringToSql gname),
                                    ^(C.stringToSql email), ^(C.boolToSql forward), ^(C.stringToSql uses),
                                    ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP, '')`);
                sendMail (email, "Confirm membership application",
@@ -140,4 +164,4 @@ fun confirm (id, passwd) =
          | NONE => false
     end
 
-end
\ No newline at end of file
+end