Fix Mailman subscription by installing /usr/local/sbin/portalsub
[bpt/portal.git] / app.sml
diff --git a/app.sml b/app.sml
index ecb7f7f..1941e2d 100644 (file)
--- a/app.sml
+++ b/app.sml
@@ -32,32 +32,38 @@ type app = { id : int, name : string, rname : string, gname : string option, ema
             forward : bool, uses : string, other : string,
             passwd : string, status : status, applied : C.timestamp, ipaddr : string option,
             confirmed : C.timestamp option, decided : C.timestamp option,
-            msg : string}
+            msg : string, unix_passwd : string,
+            paypal : string option, checkout : string option }
 
 fun mkAppRow [id, name, rname, gname, email, forward, uses, other, passwd, status,
-             applied, ipaddr, confirmed, decided, msg] =
+             applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout] =
     { id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
-      gname = (if C.isNull gname then NONE else SOME (C.stringFromSql gname)),
+      gname = Init.nullableFromSql C.stringFromSql gname,
       email = C.stringFromSql email, forward = C.boolFromSql forward,
       uses = C.stringFromSql uses, other = C.stringFromSql other, passwd = C.stringFromSql passwd,
       status = statusFromSql status, applied = C.timestampFromSql applied,
-      ipaddr = (if C.isNull ipaddr then NONE else SOME (C.stringFromSql ipaddr)),
-      confirmed = if C.isNull confirmed then NONE else SOME (C.timestampFromSql confirmed),
-      decided = if C.isNull decided then NONE else SOME (C.timestampFromSql decided),
-      msg = C.stringFromSql msg}
+      ipaddr = Init.nullableFromSql C.stringFromSql ipaddr,
+      confirmed = Init.nullableFromSql C.timestampFromSql confirmed,
+      decided = Init.nullableFromSql C.timestampFromSql decided,
+      msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd,
+      paypal = Init.nullableFromSql C.stringFromSql paypal,
+      checkout = Init.nullableFromSql C.stringFromSql checkout}
   | mkAppRow r = rowError ("app", r)
 
 fun lookupApp id =
-    case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg
+    case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided,
+                                           msg, unix_passwd, paypal, checkout
                                     FROM MemberApp
                                     WHERE id = ^(C.intToSql id)`) of
        SOME row => mkAppRow row
       | NONE => raise Fail "Membership application not found"
 
 fun listApps status =
-    C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg
+    C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided,
+                                       msg, unix_passwd, paypal, checkout
                                 FROM MemberApp
                                 WHERE status = ^(statusToSql status)
+                                  AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH')
                                 ORDER BY applied`)
 
 fun mkVoteRow [id, name] = (C.intFromSql id, C.stringFromSql name)
@@ -82,7 +88,9 @@ fun deny (app, msg) =
 
        val mail = Mail.mopen ()
     in
-       Mail.mwrite (mail, "From: Hcoop Application System <join@hcoop.net>\nTo: ");
+       Mail.mwrite (mail, "From: Hcoop Application System <join");
+       Mail.mwrite (mail, emailSuffix);
+       Mail.mwrite (mail, ">\nTo: ");
        Mail.mwrite (mail, #email entry);
        Mail.mwrite (mail, "\nCc: ");
        Mail.mwrite (mail, boardEmail);
@@ -100,19 +108,41 @@ fun approve (app, msg) =
 
        val mail = Mail.mopen ()
     in
-       Mail.mwrite (mail, "From: Hcoop Application System <join@hcoop.net>\nTo: ");
+       Mail.mwrite (mail, "To: ");
        Mail.mwrite (mail, #email entry);
-       Mail.mwrite (mail, "\nCc: ");
-       Mail.mwrite (mail, boardEmail);
-       Mail.mwrite (mail, "\nSubject: Application approved\n\nYour application for membership has been approved!  Welcome to hcoop!\n\n");
+       Mail.mwrite (mail, "\n");
+       Mail.mwrite (mail, Util.readFile "/home/hcoop/portal/welcome.txt");
        Mail.mwrite (mail, msg);
        OS.Process.isSuccess (Mail.mclose mail)
     end
 
 fun add app =
-    ignore (C.dml (getDb ()) ($`UPDATE MemberApp
-                               SET status = 3
-                               WHERE id = ^(C.intToSql app)`))
+    let
+       val _ = C.dml (getDb ()) ($`UPDATE MemberApp
+                                   SET status = 3
+                                   WHERE id = ^(C.intToSql app)`)
+
+       val app = lookupApp app
+
+       val outf = TextIO.openOut (Config.passwordFiles ^ #name app)
+    in
+       TextIO.output (outf, #unix_passwd app);
+       TextIO.output1 (outf, #"\n");
+       TextIO.closeOut outf
+    end
+
+fun welcome app =
+    let
+       val app = lookupApp app
+
+       val mail = Mail.mopen ()
+    in
+       Mail.mwrite (mail, "To: ");
+       Mail.mwrite (mail, #email app);
+       Mail.mwrite (mail, "\n");
+       Mail.mwrite (mail, Util.readFile "/home/hcoop/portal/paid.txt");
+       ignore (Mail.mclose mail)
+    end
 
 fun abortAdd app =
     ignore (C.dml (getDb ()) ($`UPDATE MemberApp
@@ -132,8 +162,26 @@ fun readFile fname =
        before TextIO.closeIn inf
     end
 
-fun readTosBody () = readFile "/var/www/home/html/tos.body.html"
-fun readTosAgree () = readFile "/var/www/home/html/tos.agree.html"
-fun readTosMinorAgree () = readFile "/var/www/home/html/tos.agree.minor.html"
+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 searchPaypal paypal =
+    C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided,
+                                       msg, unix_passwd, paypal, checkout
+                                FROM MemberApp
+                                WHERE paypal = ^(C.stringToSql (normEmail paypal))
+                                  AND status = 2
+                                  AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH'
+                                ORDER BY applied`)
+
+fun searchCheckout checkout =
+    C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided,
+                                       msg, unix_passwd, paypal, checkout
+                                FROM MemberApp
+                                WHERE checkout = ^(C.stringToSql (normEmail checkout))
+                                  AND status = 2
+                                  AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH'
+                                ORDER BY applied`)
 
-end
\ No newline at end of file
+end