X-Git-Url: https://git.hcoop.net/hcoop/portal.git/blobdiff_plain/1d2cae170dd5040d5214e0dd8bc7751a01db319a..HEAD:/app/app.sml

diff --git a/app/app.sml b/app/app.sml
index 84ca130..ec3efcf 100644
--- 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 = 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'"
+	val c = C.conn Config.dbstring
     in
 	db := SOME c;
 	C.dml c "BEGIN";
@@ -46,22 +46,23 @@ 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
-	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"
 
-	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: ");
@@ -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)
@@ -129,10 +159,11 @@ fun validHost s =
 fun validDomain s =
     size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 
-fun validUser s =
-    size s > 0 andalso size s < 50 andalso List.all
-					       (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
-					       (String.explode s)
+fun validUsername name =
+    size name <= 12
+    andalso size name >= 2
+    andalso Char.isLower (String.sub (name, 0))
+    andalso CharVector.all Char.isAlphaNum name
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50 andalso List.all
@@ -140,28 +171,37 @@ 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 =
-    (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false
+    case C.oneOrNoRows (getDb ()) ($`SELECT id FROM WebUser WHERE name = ^(C.stringToSql name)`) of
+	SOME _ => true
+      | NONE => (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false
 
 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.fake@hcoop.net",
+	     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
 
+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