That password file writing was right before, gosh darn it

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

diff --git a/app/app.sml b/app/app.sml
index 8ac969e..96d9f47 100644 (file)
--- a/app/app.sml
+++ b/app/app.sml
@@ -1,8 +1,8 @@
 structure App :> APP =
 struct
 
-val baseUrl = "http://join.hcoop.net/join/"
-val portalUrl = "https://members.hcoop.net/portal/"
+val baseUrl = "https://join.hcoop.net/join/"
+val portalUrl = "https://members2.hcoop.net/portal/"
 
 open Sql
 
@@ -52,11 +52,12 @@ fun readTosMinorAgree () = readFile "/home/hcoop/public_html/tos.agree.minor.htm
 
 fun sendMail (to, subj, intro, footer, id) =
     let
-       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] =>
+       val (name, rname, gname, email, forward, uses, other) =
+           case C.oneOrNoRows (getDb ()) ($`SELECT name, rname, gname, email, forward, uses, other FROM MemberApp WHERE id = ^(C.intToSql id)`) of
+               SOME [name, rname, gname, email, forward, uses, other] =>
                (C.stringFromSql name, C.stringFromSql rname,
                 if C.isNull gname then NONE else SOME (C.stringFromSql gname),
+                C.stringFromSql email,
                 C.boolFromSql forward, C.stringFromSql uses,
                 C.stringFromSql other)
              | _ => raise Fail "Bad sendMail row"
@@ -78,6 +79,8 @@ fun sendMail (to, subj, intro, footer, id) =
            NONE => ()
          | SOME gname => (mwrite "\nLegal guardian name: ";
                           mwrite gname);
+       mwrite ("\nE-mail address: ");
+       mwrite email;
        mwrite ("\nForward e-mail: ");
        mwrite (if forward then "yes" else "no");
        mwrite ("\n\nDesired uses:\n");
@@ -90,9 +93,29 @@ fun sendMail (to, subj, intro, footer, id) =
     end
 
 type application = { name : string, rname : string, gname : string option, email : string,
-                    forward : bool, uses : string, other : string }
+                    forward : bool, uses : string, other : string,
+                    paypal : string option, checkout : string option }
 
-fun apply {name, rname, gname, email, forward, uses, other} =
+fun randomPassword () =
+    let
+       val proc = Unix.execute ("/usr/bin/pwgen", ["-cCnB", "8", "1"])
+    in
+       case TextIO.inputLine (Unix.textInstreamOf proc) of
+           NONE => raise Fail "Couldn't execute pwgen"
+         | SOME line =>
+           case String.tokens Char.isSpace line of
+               [s] => s
+             | _ => raise Fail "Couldn't parse output of pwgen"
+    end
+
+val allLower = CharVector.map Char.toLower
+
+fun emailToSql so =
+    case so of
+       NONE => "NULL"
+      | SOME s => C.stringToSql (allLower s)
+
+fun apply {name, rname, gname, email, forward, uses, other, paypal, checkout} =
     let
        val db = getDb ()
     in
@@ -101,27 +124,34 @@ fun apply {name, rname, gname, email, forward, uses, other} =
            let
                val id = C.intFromSql id
                val passwd = Int.toString (Int.abs (Random.randInt (!rnd)))
+               val unix_passwd = randomPassword ()
            in
-               C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, 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, unix_passwd, paypal, checkout)
                            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",
-                         "We've received a request to join the Internet Hosting Cooperative (hcoop.net) with this e-mail address.",
+                                   ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP,
+                                   '', ^(C.stringToSql unix_passwd),
+                                   ^(emailToSql paypal), ^(emailToSql checkout))`);
+               if sendMail (email, "Confirm membership application",
+                            "We've received a request to join the Internet Hosting Cooperative (hcoop.net) with this e-mail address.",
                          fn mwrite => (mwrite ("To confirm this application, visit ");
                                        mwrite (baseUrl);
                                        mwrite ("confirm?id=");
                                        mwrite (Int.toString id);
                                        mwrite ("&p=");
-                                       mwrite (passwd);
+                                       mwrite passwd;
                                        mwrite ("\n")),
-                         id)
+                            id) then
+                   SOME unix_passwd
+               else
+                   NONE
            end
       | _ => raise Fail "Bad next sequence val"
     end
 
-fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
+fun isIdent ch = Char.isLower ch orelse Char.isDigit ch orelse ch = #"-"
 
 fun validHost s =
     size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s)
@@ -151,15 +181,15 @@ fun confirm (id, passwd) =
     let
        val db = getDb ()
     in
-       case C.oneOrNoRows db ($`SELECT id FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of
-           SOME _ =>
+       case C.oneOrNoRows db ($`SELECT unix_passwd FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of
+           SOME [_] =>
            (C.dml db ($`UPDATE MemberApp SET status = 1, confirmed = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql id)`);
             sendMail ("board@hcoop.net",
                       "New membership application",
                       "We've received a new request to join hcoop.",
-                      fn mwrite => (mwrite ("Open applications: ");
-                                    mwrite (portalUrl);
-                                    mwrite ("apps")),
+                   fn mwrite => (mwrite ("Open applications: ");
+                                 mwrite (portalUrl);
+                                 mwrite ("apps")),
                       id))
          | NONE => false
     end