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
fun init () =
let
- val c = C.conn "dbname='hcoop'"
+ val c = C.conn "dbname='hcoop_hcoop'"
in
db := SOME c;
C.dml c "BEGIN";
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 <join@hcoop.net>\nTo: ");
+ mwrite ("From: Hcoop Application System <join@hcoop.net>\nTo: ");
mwrite (to);
mwrite ("\nSubject: ");
mwrite subj;
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");
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
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)
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
HCoop / hcoop / zz_old / portal.git / blobdiff