19 | _
=> raise C
.Sql
"Bad status"
28 fun statusFromSql v
= statusFromInt (C
.intFromSql v
)
29 fun statusToSql s
= C
.intToSql (statusToInt s
)
31 type app
= { id
: int, name
: string, rname
: string, gname
: string option
, email
: string,
32 forward
: bool, uses
: string, other
: string,
33 passwd
: string, status
: status
, applied
: C
.timestamp
, ipaddr
: string option
,
34 confirmed
: C
.timestamp option
, decided
: C
.timestamp option
,
35 msg
: string, unix_passwd
: string}
37 fun mkAppRow
[id
, name
, rname
, gname
, email
, forward
, uses
, other
, passwd
, status
,
38 applied
, ipaddr
, confirmed
, decided
, msg
, unix_passwd
] =
39 { id
= C
.intFromSql id
, name
= C
.stringFromSql name
, rname
= C
.stringFromSql rname
,
40 gname
= (if C
.isNull gname
then NONE
else SOME (C
.stringFromSql gname
)),
41 email
= C
.stringFromSql email
, forward
= C
.boolFromSql forward
,
42 uses
= C
.stringFromSql uses
, other
= C
.stringFromSql other
, passwd
= C
.stringFromSql passwd
,
43 status
= statusFromSql status
, applied
= C
.timestampFromSql applied
,
44 ipaddr
= (if C
.isNull ipaddr
then NONE
else SOME (C
.stringFromSql ipaddr
)),
45 confirmed
= if C
.isNull confirmed
then NONE
else SOME (C
.timestampFromSql confirmed
),
46 decided
= if C
.isNull decided
then NONE
else SOME (C
.timestampFromSql decided
),
47 msg
= C
.stringFromSql msg
, unix_passwd
= C
.stringFromSql unix_passwd
}
48 | mkAppRow r
= rowError ("app", r
)
51 case C
.oneOrNoRows (getDb ()) ($`SELECT id
, name
, rname
, gname
, email
, forward
, uses
, other
, passwd
, status
, applied
, ipaddr
, confirmed
, decided
,
54 WHERE id
= ^
(C
.intToSql id
)`
) of
55 SOME row
=> mkAppRow row
56 | NONE
=> raise Fail
"Membership application not found"
59 C
.map (getDb ()) mkAppRow ($`SELECT id
, name
, rname
, gname
, email
, forward
, uses
, other
, passwd
, status
, applied
, ipaddr
, confirmed
, decided
,
62 WHERE status
= ^
(statusToSql status
)
63 AND
NOT (status
= 2 AND decided
< CURRENT_TIMESTAMP
- INTERVAL
'1 MONTH
')
66 fun mkVoteRow
[id
, name
] = (C
.intFromSql id
, C
.stringFromSql name
)
67 | mkVoteRow row
= rowError ("app.vote", row
)
69 fun votes id
= C
.map (getDb ()) mkVoteRow ($`SELECT usr
, name
70 FROM AppVote JOIN WebUser ON usr
= id
71 WHERE AppVote
.app
= ^
(C
.intToSql id
)
74 fun vote (usr
, app
) = ignore (C
.dml (getDb ()) ($`INSERT INTO
AppVote (app
, usr
)
75 VALUES (^
(C
.intToSql app
), ^
(C
.intToSql usr
))`
))
77 fun unvote (usr
, app
) = ignore (C
.dml (getDb ()) ($`DELETE FROM AppVote WHERE app
= ^
(C
.intToSql app
) AND usr
= ^
(C
.intToSql usr
)`
))
81 val entry
= lookupApp app
82 val _
= C
.dml (getDb ()) ($`UPDATE MemberApp
83 SET status
= 3, msg
= ^
(C
.stringToSql msg
), decided
= CURRENT_TIMESTAMP
84 WHERE id
= ^
(C
.intToSql app
)`
)
86 val mail
= Mail
.mopen ()
88 Mail
.mwrite (mail
, "From: Hcoop Application System <join");
89 Mail
.mwrite (mail
, emailSuffix
);
90 Mail
.mwrite (mail
, ">\nTo: ");
91 Mail
.mwrite (mail
, #email entry
);
92 Mail
.mwrite (mail
, "\nCc: ");
93 Mail
.mwrite (mail
, boardEmail
);
94 Mail
.mwrite (mail
, "\nSubject: Application denied\n\nYour application for membership has been denied. Reason:\n\n");
95 Mail
.mwrite (mail
, msg
);
96 OS
.Process
.isSuccess (Mail
.mclose mail
)
99 fun approve (app
, msg
) =
101 val entry
= lookupApp app
102 val _
= C
.dml (getDb ()) ($`UPDATE MemberApp
103 SET status
= 2, msg
= ^
(C
.stringToSql msg
), decided
= CURRENT_TIMESTAMP
104 WHERE id
= ^
(C
.intToSql app
)`
)
106 val mail
= Mail
.mopen ()
108 Mail
.mwrite (mail
, "To: ");
109 Mail
.mwrite (mail
, #email entry
);
110 Mail
.mwrite (mail
, "\n");
111 Mail
.mwrite (mail
, Util
.readFile
"/home/hcoop/portal/welcome.txt");
112 Mail
.mwrite (mail
, msg
);
113 OS
.Process
.isSuccess (Mail
.mclose mail
)
118 val _
= C
.dml (getDb ()) ($`UPDATE MemberApp
120 WHERE id
= ^
(C
.intToSql app
)`
)
122 val app
= lookupApp app
124 val outf
= TextIO.openOut (Config
.passwordFiles ^ #name app
)
126 TextIO.output (outf
, #unix_passwd app
);
132 val app
= lookupApp app
134 val mail
= Mail
.mopen ()
136 Mail
.mwrite (mail
, "To: ");
137 Mail
.mwrite (mail
, #email app
);
138 Mail
.mwrite (mail
, "\n");
139 Mail
.mwrite (mail
, Util
.readFile
"/home/hcoop/portal/paid.txt");
140 ignore (Mail
.mclose mail
)
144 ignore (C
.dml (getDb ()) ($`UPDATE MemberApp
146 WHERE id
= ^
(C
.intToSql app
)`
))
150 val inf
= TextIO.openIn fname
152 fun readLines lines
=
153 case TextIO.inputLine inf
of
154 NONE
=> String.concat (List.rev lines
)
155 | SOME line
=> readLines (line
:: lines
)
158 before TextIO.closeIn inf
161 fun readTosBody () = readFile
"/home/hcoop/public_html/tos.body.html"
162 fun readTosAgree () = readFile
"/home/hcoop/public_html/tos.agree.html"
163 fun readTosMinorAgree () = readFile
"/home/hcoop/public_html/tos.agree.minor.html"