payment: note that Stripe has instituted an additional 1% fee for non-US cards

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

diff --git a/app/app.sml b/app/app.sml
index 8a734f2..ec3efcf 100644 (file)
--- a/app/app.sml
+++ b/app/app.sml
@@ -2,7 +2,7 @@ structure App :> APP =
 struct
 
 val baseUrl = "https://join.hcoop.net/join/"
-val portalUrl = "https://members.hcoop.net/portal/"
+val portalUrl = Config.urlPrefix
 
 open Sql
 
@@ -14,7 +14,7 @@ val rnd = ref (Random.rand (0, 0))
 
 fun init () = 
     let
-       val c = C.conn "dbname='hcoop_hcoop' host='postgres'"
+       val c = C.conn Config.dbstring
     in
        db := SOME c;
        C.dml c "BEGIN";
@@ -46,9 +46,9 @@ fun readFile fname =
        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 readTosBody () = readFile (Config.staticFilesRoot ^ "tos.body.html")
+fun readTosAgree () = readFile (Config.staticFilesRoot ^ "tos.agree.html")
+fun readTosMinorAgree () = readFile (Config.staticFilesRoot ^ "tos.agree.minor.html")
 
 fun sendMail (to, subj, intro, footer, id) =
     let
@@ -62,7 +62,7 @@ fun sendMail (to, subj, intro, footer, id) =
                 C.stringFromSql other)
              | _ => raise Fail "Bad sendMail row"
 
-       val proc = Unix.execute ("/usr/sbin/exim4", ["-t"])
+       val proc = Unix.execute ("/usr/sbin/sendmail", ["-t"])
        fun mwrite s = TextIO.output (Unix.textOutstreamOf proc, s)
     in
        mwrite ("From: Hcoop Application System <join@hcoop.net>\nTo: ");
@@ -161,7 +161,7 @@ fun validDomain s =
 
 fun validUsername name =
     size name <= 12
-    andalso size name > 0
+    andalso size name >= 2
     andalso Char.isLower (String.sub (name, 0))
     andalso CharVector.all Char.isAlphaNum name
 
@@ -171,9 +171,9 @@ fun validEmailUser s =
                                               (String.explode s)
 
 fun validEmail s =
-    (case String.fields (fn ch => ch = #"@") s of
-        [user, host] => validEmailUser user andalso validDomain host
-       | _ => false)
+       case String.fields (fn ch => ch = #"@") s of
+           [user, host] => validEmailUser user andalso validDomain host andalso not (List.exists (fn x => x = host) Config.joinBannedEmailDomains)
+         | _ => false
 
 fun userExists name =
     case C.oneOrNoRows (getDb ()) ($`SELECT id FROM WebUser WHERE name = ^(C.stringToSql name)`) of
@@ -197,4 +197,11 @@ fun confirm (id, passwd) =
          | NONE => false
     end
 
+fun appUserName id =
+    case C.oneOrNoRows (getDb ()) ($`SELECT name
+                                    FROM MemberApp
+                                    WHERE id = ^(C.intToSql id)`) of
+       SOME [name] => C.stringFromSql name
+      | NONE => raise Fail "Membership application not found"
+
 end