X-Git-Url: http://git.hcoop.net/hcoop/zz_old/portal.git/blobdiff_plain/20a679fccfbbdf616a5bc31fc6dfc6659bafabbc..2e72273e17d99c7ad385565cb4245ea94ff66ded:/app/app.sml diff --git a/app/app.sml b/app/app.sml index 0f4f83a..96d9f47 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 = "http://users.hcoop.net/portal/" +val baseUrl = "https://join.hcoop.net/join/" +val portalUrl = "https://members2.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,19 +33,39 @@ 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, 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"]) fun mwrite s = TextIO.output (Unix.textOutstreamOf proc, s) in - mwrite ("From: Hcoop Application Confirmation \nTo: "); + mwrite ("From: Hcoop Application System \nTo: "); mwrite (to); mwrite ("\nSubject: "); mwrite subj; @@ -53,8 +73,14 @@ 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 ("\nE-mail address: "); + mwrite email; mwrite ("\nForward e-mail: "); mwrite (if forward then "yes" else "no"); mwrite ("\n\nDesired uses:\n"); @@ -66,10 +92,30 @@ fun sendMail (to, subj, intro, footer, id) = OS.Process.isSuccess (Unix.reap proc) end -type application = { name : string, rname : string, email : string, - forward : bool, uses : string, other : string } +type application = { name : string, rname : string, gname : string option, email : string, + forward : bool, uses : string, other : string, + paypal : string option, checkout : string option } + +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, email, forward, uses, other} = +fun apply {name, rname, gname, email, forward, uses, other, paypal, checkout} = let val db = getDb () in @@ -78,26 +124,34 @@ fun apply {name, rname, 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, email, forward, uses, other, passwd, status, applied) + 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) @@ -127,17 +181,17 @@ 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 -end \ No newline at end of file +end