X-Git-Url: https://git.hcoop.net/hcoop/zz_old/portal.git/blobdiff_plain/453d75799fdab30af3360c84ee5dfd308aa1fb92..d7502bbb78e96d1015f179d00c50dc1c1a49d499:/app.sml diff --git a/app.sml b/app.sml index a62c042..299feb5 100644 --- a/app.sml +++ b/app.sml @@ -28,33 +28,42 @@ val statusToInt = fun statusFromSql v = statusFromInt (C.intFromSql v) fun statusToSql s = C.intToSql (statusToInt s) -type app = { id : int, name : string, rname : string, email : string, +type app = { id : int, name : string, rname : string, gname : string option, email : string, forward : bool, uses : string, other : string, - passwd : string, status : status, applied : C.timestamp, + passwd : string, status : status, applied : C.timestamp, ipaddr : string option, confirmed : C.timestamp option, decided : C.timestamp option, - msg : string} + msg : string, unix_passwd : string, + paypal : string option, checkout : string option } -fun mkAppRow [id, name, rname, email, forward, uses, other, passwd, status, applied, confirmed, decided, msg] = +fun mkAppRow [id, name, rname, gname, email, forward, uses, other, passwd, status, + applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout] = { id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname, + gname = Init.nullableFromSql C.stringFromSql gname, email = C.stringFromSql email, forward = C.boolFromSql forward, uses = C.stringFromSql uses, other = C.stringFromSql other, passwd = C.stringFromSql passwd, status = statusFromSql status, applied = C.timestampFromSql applied, - confirmed = if C.isNull confirmed then NONE else SOME (C.timestampFromSql confirmed), - decided = if C.isNull decided then NONE else SOME (C.timestampFromSql decided), - msg = C.stringFromSql msg} + ipaddr = Init.nullableFromSql C.stringFromSql ipaddr, + confirmed = Init.nullableFromSql C.timestampFromSql confirmed, + decided = Init.nullableFromSql C.timestampFromSql decided, + msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd, + paypal = Init.nullableFromSql C.stringFromSql paypal, + checkout = Init.nullableFromSql C.stringFromSql checkout} | mkAppRow r = rowError ("app", r) fun lookupApp id = - case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, email, forward, uses, other, passwd, status, applied, confirmed, decided, msg + case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, + msg, unix_passwd, paypal, checkout FROM MemberApp WHERE id = ^(C.intToSql id)`) of SOME row => mkAppRow row | NONE => raise Fail "Membership application not found" -fun listPending () = - C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, email, forward, uses, other, passwd, status, applied, confirmed, decided, msg +fun listApps status = + C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, + msg, unix_passwd, paypal, checkout FROM MemberApp - WHERE status = 1 + WHERE status = ^(statusToSql status) + AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH') ORDER BY applied`) fun mkVoteRow [id, name] = (C.intFromSql id, C.stringFromSql name) @@ -62,7 +71,7 @@ fun mkVoteRow [id, name] = (C.intFromSql id, C.stringFromSql name) fun votes id = C.map (getDb ()) mkVoteRow ($`SELECT usr, name FROM AppVote JOIN WebUser ON usr = id - WHERE app = ^(C.intToSql id) + WHERE AppVote.app = ^(C.intToSql id) ORDER BY name`) fun vote (usr, app) = ignore (C.dml (getDb ()) ($`INSERT INTO AppVote (app, usr) @@ -79,7 +88,9 @@ fun deny (app, msg) = val mail = Mail.mopen () in - Mail.mwrite (mail, "From: Hcoop Application System \nTo: "); + Mail.mwrite (mail, "From: Hcoop Application System \nTo: "); Mail.mwrite (mail, #email entry); Mail.mwrite (mail, "\nCc: "); Mail.mwrite (mail, boardEmail); @@ -97,13 +108,79 @@ fun approve (app, msg) = val mail = Mail.mopen () in - Mail.mwrite (mail, "From: Hcoop Application System \nTo: "); + Mail.mwrite (mail, "To: "); Mail.mwrite (mail, #email entry); - Mail.mwrite (mail, "\nCc: "); - Mail.mwrite (mail, boardEmail); - Mail.mwrite (mail, "\nSubject: Application approved\n\nYour application for membership has been approved! Welcome to hcoop!\n\n"); + Mail.mwrite (mail, "\n"); + Mail.mwrite (mail, Util.readFile "/home/hcoop/portal/welcome.txt"); Mail.mwrite (mail, msg); OS.Process.isSuccess (Mail.mclose mail) end -end \ No newline at end of file +fun add app = + let + val _ = C.dml (getDb ()) ($`UPDATE MemberApp + SET status = 3 + WHERE id = ^(C.intToSql app)`) + + val app = lookupApp app + + val outf = TextIO.openOut (Config.passwordFiles ^ #name app) + in + TextIO.output (outf, #unix_passwd app); + TextIO.closeOut outf + end + +fun welcome app = + let + val app = lookupApp app + + val mail = Mail.mopen () + in + Mail.mwrite (mail, "To: "); + Mail.mwrite (mail, #email app); + Mail.mwrite (mail, "\n"); + Mail.mwrite (mail, Util.readFile "/home/hcoop/portal/paid.txt"); + ignore (Mail.mclose mail) + end + +fun abortAdd app = + ignore (C.dml (getDb ()) ($`UPDATE MemberApp + SET status = 2 + WHERE id = ^(C.intToSql app)`)) + +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 searchPaypal paypal = + C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, + msg, unix_passwd, paypal, checkout + FROM MemberApp + WHERE paypal = ^(C.stringToSql (normEmail paypal)) + AND status = 2 + AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' + ORDER BY applied`) + +fun searchCheckout checkout = + C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, + msg, unix_passwd, paypal, checkout + FROM MemberApp + WHERE checkout = ^(C.stringToSql (normEmail checkout)) + AND status = 2 + AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' + ORDER BY applied`) + +end