struct
val baseUrl = "https://join.hcoop.net/join/"
-val portalUrl = "https://members2.hcoop.net/portal/"
+val portalUrl = "https://members.hcoop.net/portal/"
open Sql
fun init () =
let
- val c = C.conn "dbname='hcoop_hcoop'"
+ val c = C.conn "dbname='hcoop_hcoop' host='postgres'"
in
db := SOME c;
C.dml c "BEGIN";
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 randomPassword () =
let
- val proc = Unix.execute ("/usr/bin/apg", ["/usr/bin/apg", "-n", "1", "-m", "10"])
+ val proc = Unix.execute ("/usr/bin/pwgen", ["-cCnB", "8", "1"])
in
case TextIO.inputLine (Unix.textInstreamOf proc) of
- NONE => raise Fail "Couldn't execute apg"
+ 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 apg"
+ | _ => raise Fail "Couldn't parse output of pwgen"
end
-fun apply {name, rname, gname, email, forward, uses, other} =
+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
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, unix_passwd)
+ 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,
- '', ^(C.stringToSql unix_passwd))`);
- sendMail (email, "Confirm membership application",
+ '', ^(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 ("&p=");
mwrite passwd;
mwrite ("\n")),
- id)
+ id) then
+ SOME unix_passwd
+ else
+ NONE
end
| _ => raise Fail "Bad next sequence val"
end
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 > 0
+ 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
| _ => 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 unix_passwd FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of
- SOME [unix_passwd] =>
+ SOME [_] =>
(C.dml db ($`UPDATE MemberApp SET status = 1, confirmed = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql id)`);
- if 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")),
- id) then
- SOME (C.stringFromSql unix_passwd)
- else
- NONE)
- | NONE => NONE
+ 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")),
+ id))
+ | NONE => false
end
end