| PENDING
| ACCEPTED
| REJECTED
+ | ADDED
type app = { id : int, name : string, rname : string, email : string,
- forward : bool, uses : string, other : string, passwd : string,
- status : status, stamp : Init.C.timestamp }
+ forward : bool, uses : string, other : string,
+ passwd : string, status : status, applied : Init.C.timestamp,
+ confirmed : Init.C.timestamp option, decided : Init.C.timestamp option,
+ msg : string }
val lookupApp : int -> app
+ val listPending : unit -> app list
+ val votes : int -> (int * string) list
+ val vote : int * int -> unit
+ val unvote : int * int -> unit
+
+ val deny : int * string -> bool
+ val approve : int * string -> bool
end
\ No newline at end of file
| PENDING
| ACCEPTED
| REJECTED
+ | ADDED
val statusFromInt =
fn 0 => CONFIRMING
| 1 => PENDING
| 2 => ACCEPTED
| 3 => REJECTED
+ | 4 => ADDED
| _ => raise C.Sql "Bad status"
val statusToInt =
| PENDING => 1
| ACCEPTED => 2
| REJECTED => 3
+ | ADDED => 4
fun statusFromSql v = statusFromInt (C.intFromSql v)
fun statusToSql s = C.intToSql (statusToInt s)
type app = { id : int, name : string, rname : string, email : string,
forward : bool, uses : string, other : string,
- passwd : string, status : status, stamp : C.timestamp }
+ passwd : string, status : status, applied : C.timestamp,
+ confirmed : C.timestamp option, decided : C.timestamp option,
+ msg : string}
-fun mkAppRow [id, name, rname, email, forward, uses, other, passwd, status, stamp] =
+fun mkAppRow [id, name, rname, email, forward, uses, other, passwd, status, applied, confirmed, decided, msg] =
{ id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
email = C.stringFromSql email, forward = C.boolFromSql forward,
uses = C.stringFromSql uses, other = C.stringFromSql other, passwd = C.stringFromSql passwd,
- status = statusFromSql status, stamp = C.timestampFromSql stamp }
+ 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}
| mkAppRow r = rowError ("app", r)
fun lookupApp id =
- case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, email, forward, uses, other, passwd, status, stamp
- FROM MemberApp
- WHERE id = ^(C.intToSql id)`) of
+ case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, email, forward, uses, other, passwd, status, applied, confirmed, decided, msg
+ 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
+ FROM MemberApp
+ WHERE status = 1
+ ORDER BY applied`)
+
+fun mkVoteRow [id, name] = (C.intFromSql id, C.stringFromSql name)
+ | mkVoteRow row = rowError ("app.vote", row)
+
+fun votes id = C.map (getDb ()) mkVoteRow ($`SELECT usr, name
+ FROM AppVote JOIN WebUser ON usr = id
+ WHERE app = ^(C.intToSql id)
+ ORDER BY name`)
+
+fun vote (usr, app) = ignore (C.dml (getDb ()) ($`INSERT INTO AppVote (app, usr)
+ VALUES (^(C.intToSql app), ^(C.intToSql usr))`))
+
+fun unvote (usr, app) = ignore (C.dml (getDb ()) ($`DELETE FROM AppVote WHERE app = ^(C.intToSql app) AND usr = ^(C.intToSql usr)`))
+
+fun deny (app, msg) =
+ let
+ val entry = lookupApp app
+ val _ = C.dml (getDb ()) ($`UPDATE MemberApp
+ SET status = 3, msg = ^(C.stringToSql msg), decided = CURRENT_TIMESTAMP
+ WHERE id = ^(C.intToSql app)`)
+
+ val mail = Mail.mopen ()
+ in
+ Mail.mwrite (mail, "From: Hcoop Application System <join@hcoop.net>\nTo: ");
+ Mail.mwrite (mail, #email entry);
+ Mail.mwrite (mail, "\nCc: ");
+ Mail.mwrite (mail, boardEmail);
+ Mail.mwrite (mail, "\nSubject: Application denied\n\nYour application for membership has been denied. Reason:\n\n");
+ Mail.mwrite (mail, msg);
+ OS.Process.isSuccess (Mail.mclose mail)
+ end
+
+fun approve (app, msg) =
+ let
+ val entry = lookupApp app
+ val _ = C.dml (getDb ()) ($`UPDATE MemberApp
+ SET status = 2, msg = ^(C.stringToSql msg), decided = CURRENT_TIMESTAMP
+ WHERE id = ^(C.intToSql app)`)
+
+ val mail = Mail.mopen ()
+ in
+ Mail.mwrite (mail, "From: Hcoop Application System <join@hcoop.net>\nTo: ");
+ 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, msg);
+ OS.Process.isSuccess (Mail.mclose mail)
+ end
+
end
\ No newline at end of file
val proc = Unix.execute ("/usr/sbin/exim4", ["-t"])
fun mwrite s = TextIO.output (Unix.textOutstreamOf proc, s)
in
- mwrite ("From: Hcoop Application Confirmation <join@hcoop.net>\nTo: ");
+ mwrite ("From: Hcoop Application System <join@hcoop.net>\nTo: ");
mwrite (to);
mwrite ("\nSubject: ");
mwrite subj;
val id = C.intFromSql id
val passwd = Int.toString (Int.abs (Random.randInt (!rnd)))
in
- C.dml db ($`INSERT INTO MemberApp (id, name, rname, email, forward, uses, other, passwd, status, applied)
+ C.dml db ($`INSERT INTO MemberApp (id, name, rname, email, forward, uses, other, passwd, status, applied, msg)
VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname),
^(C.stringToSql email), ^(C.boolToSql forward), ^(C.stringToSql uses),
- ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP)`);
+ ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP, '')`);
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 ");
--- /dev/null
+<% @header [("title", ["Membership applications"])];
+
+val you = Init.getUserId ();
+val board = Group.inGroupName "board";
+val root = Group.inGroupNum 0;
+
+ref showNormal = true;
+
+if $"vote" <> "" then
+ Group.requireGroupName "board";
+ App.vote (you, Web.stoi ($"vote"))
+ %><h3><b>Vote registered</b></h3><%
+elseif $"unvote" <> "" then
+ Group.requireGroupName "board";
+ App.unvote (you, Web.stoi ($"unvote"))
+ %><h3><b>Unvote registered</b></h3><%
+elseif $"deny" <> "" then
+ showNormal := false;
+ val appl = App.lookupApp (Web.stoi ($"deny"))
+ %><h3><b>Deny application for <% #name appl %></b></h3>
+ <form action="apps" method="post">
+ <input type="hidden" name="deny2" value="<% $"deny" %>">
+ <b>Reason</b>:<br>
+ <textarea name="msg" rows="5" cols="80" wrap="soft"></textarea><br>
+ <input type="submit" value="Submit">
+ </form><%
+elseif $"deny2" <> "" then
+ Group.requireGroupName "board";
+ if not (App.deny (Web.stoi ($"deny2"), $"msg")) then
+ %><h3><b>Error denying application</b></h3><%
+ else
+ %><h3><b>Application denied</b></h3><%
+ end
+elseif $"approve" <> "" then
+ showNormal := false;
+ val appl = App.lookupApp (Web.stoi ($"approve"))
+ %><h3><b>Approve application for <% #name appl %></b></h3>
+ <form action="apps" method="post">
+ <input type="hidden" name="approve2" value="<% $"approve" %>">
+ <b>Message</b>:<br>
+ <textarea name="msg" rows="5" cols="80" wrap="soft"></textarea><br>
+ <input type="submit" value="Submit">
+ </form><%
+elseif $"approve2" <> "" then
+ Group.requireGroupName "board";
+ if not (App.approve (Web.stoi ($"approve2"), $"msg")) then
+ %><h3><b>Error approving application</b></h3><%
+ else
+ %><h3><b>Application approved</b></h3><%
+ end
+end %>
+
+<% if showNormal then %>
+<h3><b>Pending applications</b></h3>
+
+<% foreach appl in App.listPending () do %>
+ <br><hr><br>
+ <table>
+ <tr> <td align="right"><b>Received</b>:</td> <td><% #applied appl %></td> </tr>
+ <tr> <td align="right"><b>Approved by</b>:</td> <td><%
+ ref first = true;
+ ref found = false;
+ foreach (id, name) in App.votes (#id appl) do
+ if first then
+ first := false
+ else
+ %>, <%
+ end
+ %><a href="user?id=<% id %>"><% name %></a><%
+ if id = you then
+ found := true
+ %> <a href="apps?unvote=<% #id appl %>">[Unvote]</a><%
+ end
+ end %> <% if (iff board then not found else false) then %><a href="apps?vote=<% #id appl %>">[Vote]</a><% end %></td> </tr>
+ <tr> <td align="right"><b>Username</b>:</td> <td><% #name appl %></td> </tr>
+ <tr> <td align="right"><b>Real name</b>:</td> <td><% Web.html (#rname appl) %></td> </tr>
+ <tr> <td align="right"><b>E-mail address</b>:</td> <td><a href="mailto:<% #email appl %>"><% #email appl %></a></td> </tr>
+ <tr> <td align="right"><b>Forward e-mail?</b></td> <td><% if #forward appl then %>yes<% else %>no<% end %></td> </tr>
+ <tr> <td align="right" valign="top"><b>Proposed uses</b>:</td> <td><% Web.htmlNl (#uses appl) %></td> </tr>
+ <tr> <td align="right" valign="top"><b>Other information</b>:</td> <td><% Web.htmlNl (#other appl) %></td> </tr>
+ </table>
+
+ <% if board then %>
+ <a href="apps?approve=<% #id appl %>">Add this member.</a><br>
+ <a href="apps?deny=<% #id appl %>">Deny this application.</a>
+ <% end %>
+<% end
+end %>
+
+<% @footer[] %>
\ No newline at end of file
structure C : SQL_CLIENT
val urlPrefix : string
+ val boardEmail : string
exception Access of string
exception Access of string
val urlPrefix = "http://users.hcoop.net/portal/"
+val boardEmail = "board.fake@hcoop.net"
fun conn () = C.conn "dbname='hcoop'"
val close = C.close
status INTEGER NOT NULL,
applied TIMESTAMP NOT NULL,
confirmed TIMESTAMP,
- decided TIMESTAMP);
+ decided TIMESTAMP,
+ msg TEXT NOT NULL);
CREATE SEQUENCE MemberAppSeq START 1;
HCoop / hcoop / zz_old / portal.git / commitdiff