4 val baseUrl = "https://join3.hcoop.net/join/"
5 val portalUrl = Config.urlPrefix
11 val db = ref (NONE : C.conn option)
13 val rnd = ref (Random.rand (0, 0))
17 val c = C.conn Config.dbstring
21 rnd := Random.rand (SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())),
22 SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())))
25 fun getDb () = valOf (!db)
38 val inf = TextIO.openIn fname
41 case TextIO.inputLine inf of
42 NONE => String.concat (List.rev lines)
43 | SOME line => readLines (line :: lines)
46 before TextIO.closeIn inf
49 fun readTosBody () = readFile (Config.staticFilesRoot ^ "tos.body.html")
50 fun readTosAgree () = readFile (Config.staticFilesRoot ^ "tos.agree.html")
51 fun readTosMinorAgree () = readFile (Config.staticFilesRoot ^ "tos.agree.minor.html")
53 fun sendMail (to, subj, intro, footer, id) =
55 val (name, rname, gname, email, forward, uses, other) =
56 case C.oneOrNoRows (getDb ()) ($`SELECT name, rname, gname, email, forward, uses, other FROM MemberApp WHERE id = ^(C.intToSql id)`) of
57 SOME [name, rname, gname, email, forward, uses, other] =>
58 (C.stringFromSql name, C.stringFromSql rname,
59 if C.isNull gname then NONE else SOME (C.stringFromSql gname),
60 C.stringFromSql email,
61 C.boolFromSql forward, C.stringFromSql uses,
62 C.stringFromSql other)
63 | _ => raise Fail "Bad sendMail row"
65 val proc = Unix.execute ("/usr/sbin/sendmail", ["-t"])
66 fun mwrite s = TextIO.output (Unix.textOutstreamOf proc, s)
68 mwrite ("From: Hcoop Application System <join@hcoop.net>\nTo: ");
70 mwrite ("\nSubject: ");
74 mwrite ("\n\nUsername: ");
76 mwrite ("\nMember real name: ");
80 | SOME gname => (mwrite "\nLegal guardian name: ";
82 mwrite ("\nE-mail address: ");
84 mwrite ("\nForward e-mail: ");
85 mwrite (if forward then "yes" else "no");
86 mwrite ("\n\nDesired uses:\n");
88 mwrite ("\n\nOther information:\n");
92 OS.Process.isSuccess (Unix.reap proc)
95 type application = { name : string, rname : string, gname : string option, email : string,
96 forward : bool, uses : string, other : string,
97 paypal : string option, checkout : string option }
99 fun randomPassword () =
101 val proc = Unix.execute ("/usr/bin/pwgen", ["-cCnB", "8", "1"])
103 case TextIO.inputLine (Unix.textInstreamOf proc) of
104 NONE => raise Fail "Couldn't execute pwgen"
106 case String.tokens Char.isSpace line of
108 | _ => raise Fail "Couldn't parse output of pwgen"
111 val allLower = CharVector.map Char.toLower
116 | SOME s => C.stringToSql (allLower s)
118 fun apply {name, rname, gname, email, forward, uses, other, paypal, checkout} =
122 case C.oneRow db ($`SELECT nextval('MemberAppSeq')`) of
125 val id = C.intFromSql id
126 val passwd = Int.toString (Int.abs (Random.randInt (!rnd)))
127 val unix_passwd = randomPassword ()
129 C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd,
130 status, applied, msg, unix_passwd, paypal, checkout)
131 VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname),
132 ^(case gname of NONE => "NULL" | SOME gname => C.stringToSql gname),
133 ^(C.stringToSql email), ^(C.boolToSql forward), ^(C.stringToSql uses),
134 ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP,
135 '', ^(C.stringToSql unix_passwd),
136 ^(emailToSql paypal), ^(emailToSql checkout))`);
137 if sendMail (email, "Confirm membership application",
138 "We've received a request to join the Internet Hosting Cooperative (hcoop.net) with this e-mail address.",
139 fn mwrite => (mwrite ("To confirm this application, visit ");
141 mwrite ("confirm?id=");
142 mwrite (Int.toString id);
151 | _ => raise Fail "Bad next sequence val"
154 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch orelse ch = #"-"
157 size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s)
160 size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
162 fun validUsername name =
164 andalso size name > 0
165 andalso Char.isLower (String.sub (name, 0))
166 andalso CharVector.all Char.isAlphaNum name
168 fun validEmailUser s =
169 size s > 0 andalso size s < 50 andalso List.all
170 (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
174 (case String.fields (fn ch => ch = #"@") s of
175 [user, host] => validEmailUser user andalso validDomain host
178 fun userExists name =
179 case C.oneOrNoRows (getDb ()) ($`SELECT id FROM WebUser WHERE name = ^(C.stringToSql name)`) of
181 | NONE => (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false
183 fun confirm (id, passwd) =
187 case C.oneOrNoRows db ($`SELECT unix_passwd FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of
189 (C.dml db ($`UPDATE MemberApp SET status = 1, confirmed = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql id)`);
190 sendMail ("board@hcoop.net",
191 "New membership application",
192 "We've received a new request to join hcoop.",
193 fn mwrite => (mwrite ("Open applications: ");