Commit | Line | Data |
---|---|---|
a90da8b1 AC |
1 | structure App :> APP = |
2 | struct | |
3 | ||
4 | val baseUrl = "http://join.hcoop.net/join/" | |
84e42512 | 5 | val portalUrl = "https://members2.hcoop.net/portal/" |
a90da8b1 AC |
6 | |
7 | open Sql | |
8 | ||
9 | structure C = PgClient | |
10 | ||
11 | val db = ref (NONE : C.conn option) | |
12 | ||
13 | val rnd = ref (Random.rand (0, 0)) | |
14 | ||
15 | fun init () = | |
16 | let | |
1d2cae17 | 17 | val c = C.conn "dbname='hcoop_hcoop'" |
a90da8b1 AC |
18 | in |
19 | db := SOME c; | |
20 | C.dml c "BEGIN"; | |
21 | rnd := Random.rand (SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())), | |
22 | SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ()))) | |
23 | end | |
24 | ||
25 | fun getDb () = valOf (!db) | |
26 | ||
27 | fun done () = | |
28 | let | |
29 | val c = getDb () | |
30 | in | |
31 | C.dml c "COMMIT"; | |
32 | C.close c; | |
33 | db := NONE | |
34 | end | |
35 | ||
f3f3ad24 AC |
36 | fun readFile fname = |
37 | let | |
38 | val inf = TextIO.openIn fname | |
39 | ||
40 | fun readLines lines = | |
41 | case TextIO.inputLine inf of | |
42 | NONE => String.concat (List.rev lines) | |
43 | | SOME line => readLines (line :: lines) | |
44 | in | |
45 | readLines [] | |
46 | before TextIO.closeIn inf | |
47 | end | |
48 | ||
1d2cae17 AC |
49 | fun readTosBody () = readFile "/home/hcoop/public_html/tos.body.html" |
50 | fun readTosAgree () = readFile "/home/hcoop/public_html/tos.agree.html" | |
51 | fun readTosMinorAgree () = readFile "/home/hcoop/public_html/tos.agree.minor.html" | |
f3f3ad24 | 52 | |
a90da8b1 AC |
53 | fun sendMail (to, subj, intro, footer, id) = |
54 | let | |
d50a0cd7 AC |
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] => | |
f3f3ad24 AC |
58 | (C.stringFromSql name, C.stringFromSql rname, |
59 | if C.isNull gname then NONE else SOME (C.stringFromSql gname), | |
d50a0cd7 | 60 | C.stringFromSql email, |
f3f3ad24 AC |
61 | C.boolFromSql forward, C.stringFromSql uses, |
62 | C.stringFromSql other) | |
a90da8b1 AC |
63 | | _ => raise Fail "Bad sendMail row" |
64 | ||
65 | val proc = Unix.execute ("/usr/sbin/exim4", ["-t"]) | |
66 | fun mwrite s = TextIO.output (Unix.textOutstreamOf proc, s) | |
67 | in | |
6f91863c | 68 | mwrite ("From: Hcoop Application System <join@hcoop.net>\nTo: "); |
a90da8b1 AC |
69 | mwrite (to); |
70 | mwrite ("\nSubject: "); | |
71 | mwrite subj; | |
72 | mwrite ("\n\n"); | |
73 | mwrite intro; | |
74 | mwrite ("\n\nUsername: "); | |
75 | mwrite (name); | |
f3f3ad24 | 76 | mwrite ("\nMember real name: "); |
a90da8b1 | 77 | mwrite (rname); |
f3f3ad24 AC |
78 | case gname of |
79 | NONE => () | |
80 | | SOME gname => (mwrite "\nLegal guardian name: "; | |
81 | mwrite gname); | |
d50a0cd7 AC |
82 | mwrite ("\nE-mail address: "); |
83 | mwrite email; | |
a90da8b1 AC |
84 | mwrite ("\nForward e-mail: "); |
85 | mwrite (if forward then "yes" else "no"); | |
86 | mwrite ("\n\nDesired uses:\n"); | |
87 | mwrite (uses); | |
88 | mwrite ("\n\nOther information:\n"); | |
89 | mwrite (other); | |
90 | mwrite ("\n\n"); | |
91 | footer mwrite; | |
92 | OS.Process.isSuccess (Unix.reap proc) | |
93 | end | |
94 | ||
f3f3ad24 | 95 | type application = { name : string, rname : string, gname : string option, email : string, |
a90da8b1 AC |
96 | forward : bool, uses : string, other : string } |
97 | ||
f3f3ad24 | 98 | fun apply {name, rname, gname, email, forward, uses, other} = |
a90da8b1 AC |
99 | let |
100 | val db = getDb () | |
101 | in | |
102 | case C.oneRow db ($`SELECT nextval('MemberAppSeq')`) of | |
103 | [id] => | |
104 | let | |
105 | val id = C.intFromSql id | |
106 | val passwd = Int.toString (Int.abs (Random.randInt (!rnd))) | |
107 | in | |
f3f3ad24 | 108 | C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd, status, applied, msg) |
a90da8b1 | 109 | VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), |
f3f3ad24 | 110 | ^(case gname of NONE => "NULL" | SOME gname => C.stringToSql gname), |
a90da8b1 | 111 | ^(C.stringToSql email), ^(C.boolToSql forward), ^(C.stringToSql uses), |
6f91863c | 112 | ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP, '')`); |
a90da8b1 AC |
113 | sendMail (email, "Confirm membership application", |
114 | "We've received a request to join the Internet Hosting Cooperative (hcoop.net) with this e-mail address.", | |
115 | fn mwrite => (mwrite ("To confirm this application, visit "); | |
116 | mwrite (baseUrl); | |
117 | mwrite ("confirm?id="); | |
118 | mwrite (Int.toString id); | |
119 | mwrite ("&p="); | |
120 | mwrite (passwd); | |
121 | mwrite ("\n")), | |
122 | id) | |
123 | end | |
124 | | _ => raise Fail "Bad next sequence val" | |
125 | end | |
126 | ||
ea8d5198 | 127 | fun isIdent ch = Char.isLower ch orelse Char.isDigit ch orelse ch = #"-" |
a90da8b1 AC |
128 | |
129 | fun validHost s = | |
130 | size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s) | |
131 | ||
132 | fun validDomain s = | |
133 | size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) | |
134 | ||
135 | fun validUser s = | |
136 | size s > 0 andalso size s < 50 andalso List.all | |
137 | (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") | |
138 | (String.explode s) | |
139 | ||
140 | fun validEmailUser s = | |
141 | size s > 0 andalso size s < 50 andalso List.all | |
142 | (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") | |
143 | (String.explode s) | |
144 | ||
145 | fun validEmail s = | |
146 | (case String.fields (fn ch => ch = #"@") s of | |
147 | [user, host] => validEmailUser user andalso validDomain host | |
148 | | _ => false) | |
149 | ||
150 | fun userExists name = | |
151 | (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false | |
152 | ||
153 | fun confirm (id, passwd) = | |
154 | let | |
155 | val db = getDb () | |
156 | in | |
157 | case C.oneOrNoRows db ($`SELECT id FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of | |
158 | SOME _ => | |
159 | (C.dml db ($`UPDATE MemberApp SET status = 1, confirmed = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql id)`); | |
b90b0980 | 160 | sendMail ("board@hcoop.net", |
a90da8b1 AC |
161 | "New membership application", |
162 | "We've received a new request to join hcoop.", | |
163 | fn mwrite => (mwrite ("Open applications: "); | |
164 | mwrite (portalUrl); | |
165 | mwrite ("apps")), | |
166 | id)) | |
167 | | NONE => false | |
168 | end | |
169 | ||
1d2cae17 | 170 | end |