--- /dev/null
+signature APP =
+sig
+ datatype status =
+ CONFIRMING
+ | PENDING
+ | ACCEPTED
+ | REJECTED
+
+ type app = { id : int, name : string, rname : string, email : string,
+ forward : bool, uses : string, other : string, passwd : string,
+ status : status, stamp : Init.C.timestamp }
+
+ val lookupApp : int -> app
+
+end
\ No newline at end of file
--- /dev/null
+structure App :> APP =
+struct
+
+open Init Sql Util
+
+datatype status =
+ CONFIRMING
+ | PENDING
+ | ACCEPTED
+ | REJECTED
+
+val statusFromInt =
+ fn 0 => CONFIRMING
+ | 1 => PENDING
+ | 2 => ACCEPTED
+ | 3 => REJECTED
+ | _ => raise C.Sql "Bad status"
+
+val statusToInt =
+ fn CONFIRMING => 0
+ | PENDING => 1
+ | ACCEPTED => 2
+ | REJECTED => 3
+
+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 }
+
+fun mkAppRow [id, name, rname, email, forward, uses, other, passwd, status, stamp] =
+ { 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 }
+ | 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
+ SOME row => mkAppRow row
+ | NONE => raise Fail "Membership application not found"
+
+end
\ No newline at end of file
--- /dev/null
+.cm
+CM
\ No newline at end of file
--- /dev/null
+<% App.done () %>
+
+<!-- After -->
\ No newline at end of file
--- /dev/null
+signature APP =
+sig
+ structure C : SQL_CLIENT
+
+ val init : unit -> unit
+ val done : unit -> unit
+
+ type application = { name : string, rname : string, email : string,
+ forward : bool, uses : string, other : string }
+
+ val apply : application -> bool
+
+ val validEmail : string -> bool
+ val validUser : string -> bool
+ val userExists : string -> bool
+
+ val confirm : int * string -> bool
+end
\ No newline at end of file
--- /dev/null
+structure App :> APP =
+struct
+
+val baseUrl = "http://join.hcoop.net/join/"
+val portalUrl = "http://users.hcoop.net/portal/"
+
+open Sql
+
+structure C = PgClient
+
+val db = ref (NONE : C.conn option)
+
+val rnd = ref (Random.rand (0, 0))
+
+fun init () =
+ let
+ val c = C.conn "dbname='hcoop'"
+ in
+ db := SOME c;
+ C.dml c "BEGIN";
+ rnd := Random.rand (SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())),
+ SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())))
+ end
+
+fun getDb () = valOf (!db)
+
+fun done () =
+ let
+ val c = getDb ()
+ in
+ C.dml c "COMMIT";
+ C.close c;
+ db := NONE
+ end
+
+fun sendMail (to, subj, intro, footer, id) =
+ let
+ val (name, rname, forward, uses, other) =
+ case C.oneOrNoRows (getDb ()) ($`SELECT name, rname, forward, uses, other FROM MemberApp WHERE id = ^(C.intToSql id)`) of
+ SOME [name, rname, forward, uses, other] => (C.stringFromSql name, C.stringFromSql rname,
+ C.boolFromSql forward, C.stringFromSql uses,
+ C.stringFromSql other)
+ | _ => raise Fail "Bad sendMail row"
+
+ 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 (to);
+ mwrite ("\nSubject: ");
+ mwrite subj;
+ mwrite ("\n\n");
+ mwrite intro;
+ mwrite ("\n\nUsername: ");
+ mwrite (name);
+ mwrite ("\nReal name: ");
+ mwrite (rname);
+ mwrite ("\nForward e-mail: ");
+ mwrite (if forward then "yes" else "no");
+ mwrite ("\n\nDesired uses:\n");
+ mwrite (uses);
+ mwrite ("\n\nOther information:\n");
+ mwrite (other);
+ mwrite ("\n\n");
+ footer mwrite;
+ OS.Process.isSuccess (Unix.reap proc)
+ end
+
+type application = { name : string, rname : string, email : string,
+ forward : bool, uses : string, other : string }
+
+fun apply {name, rname, email, forward, uses, other} =
+ let
+ val db = getDb ()
+ in
+ case C.oneRow db ($`SELECT nextval('MemberAppSeq')`) of
+ [id] =>
+ let
+ 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)
+ 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)`);
+ 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 ");
+ mwrite (baseUrl);
+ mwrite ("confirm?id=");
+ mwrite (Int.toString id);
+ mwrite ("&p=");
+ mwrite (passwd);
+ mwrite ("\n")),
+ id)
+ end
+ | _ => raise Fail "Bad next sequence val"
+ end
+
+fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
+
+fun validHost s =
+ size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s)
+
+fun validDomain s =
+ size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
+
+fun validUser s =
+ size s > 0 andalso size s < 50 andalso List.all
+ (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
+ (String.explode s)
+
+fun validEmailUser s =
+ size s > 0 andalso size s < 50 andalso List.all
+ (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
+ (String.explode s)
+
+fun validEmail s =
+ (case String.fields (fn ch => ch = #"@") s of
+ [user, host] => validEmailUser user andalso validDomain host
+ | _ => false)
+
+fun userExists name =
+ (Posix.SysDB.getpwnam name; true) handle OS.SysErr _ => false
+
+fun confirm (id, passwd) =
+ let
+ val db = getDb ()
+ in
+ case C.oneOrNoRows db ($`SELECT id FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of
+ SOME _ =>
+ (C.dml db ($`UPDATE MemberApp SET status = 1, confirmed = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql id)`);
+ sendMail ("board.fake@hcoop.net",
+ "New membership application",
+ "We've received a new request to join hcoop.",
+ fn mwrite => (mwrite ("Open applications: ");
+ mwrite (portalUrl);
+ mwrite ("apps")),
+ id))
+ | NONE => false
+ end
+
+end
\ No newline at end of file
--- /dev/null
+<% App.init () %>
+
+<!-- Before -->
\ No newline at end of file
--- /dev/null
+<% @header [("title", ["Confirm appliaction"])];
+
+val id = Web.stoi ($"id");
+val passwd = $"p";
+
+if App.confirm (id, passwd) then
+ %><h3><b>Confirmation successful</b></h3>
+ You should hear from us within a few days from now.<%
+else
+ %><h3><b>Error confirming</b></h3>
+ Did you already follow this confirmation link?<%
+end;
+
+@footer[] %>
\ No newline at end of file
--- /dev/null
+<html><head>
+<title>Hcoop: Exception</title>
+</head><body>
+
+<h1><b>Exception</b></h1>
+
+<% switch Web.getExn () of
+ Fail msg => %>
+<b>Fail</b>: <% Web.htmlNl msg %>
+<% | App.C.Sql msg => %>
+<b>SQL</b>: <% Web.htmlNl msg %>
+<% | Web.Format s => %>
+<b>Format</b>: <% Web.htmlNl s %>
+<% | ex => %>
+<b>Unknown exception kind.</b> Backtrace:
+<% foreach s in SMLofNJ.exnHistory ex do %>
+<li> <% Web.html s %></li>
+<% end
+end %>
+
+</body></html>
--- /dev/null
+</body></html>
\ No newline at end of file
--- /dev/null
+<html><head>
+<% val title =
+ case $"title" of
+ "" => "Hcoop"
+ | t => ("Hcoop: " ^ t) %>
+<title><% Web.html title %></title>
+</head><body>
+
+<h2><b><% Web.html title %></b></h2>
--- /dev/null
+<% @header [("title", ["Apply for membership"])] %>
+
+<% if $"cmd" = "app" then
+ val name = $"name";
+ val rname = $"rname";
+ val email = $"email";
+ val forward = $"forward" <> "on";
+ val uses = $"uses";
+ val other = $"other";
+
+ if name = "" then
+ %><h3><b>Please enter a username</b></h3><%
+ elseif rname = "" then
+ %><h3><b>Please enter your name</b></h3><%
+ elseif email = "" then
+ %><h3><b>Please enter your contact e-mail address</b></h3><%
+ elseif uses = "" then
+ %><h3><b>Please enter your proposed uses</b></h3><%
+ elseif not (App.validUser name) then
+ %><h3><b>Invalid requested username</b></h3><%
+ elseif App.userExists name then
+ %><h3><b>That username is already in use.</b><h3><%
+ elseif not (App.validEmail email) then
+ %><h3><b>Invalid e-mail address</b></h3><%
+ elseif not (App.apply { name = name, rname = rname, email = email,
+ forward = forward, uses = uses, other = other }) then
+ %><h3><b>Error sending confirmation e-mail</b></h3><%
+ else
+ %><h3><b>Application recorded</b></h3>
+ Check your e-mail for a message with further instructions.<%
+ end
+else %>
+
+<form action="join" method="post">
+<input type="hidden" name="cmd" value="app">
+<table>
+<tr> <td align="right" valign="top"><b>Desired username</b>:</td> <td><input name="name"><br>
+ You should follow usual UNIX conventions, and it's helpful to pick a name you wouldn't mind using to identify yourself to strangers.</td> </tr>
+<tr> <td align="right"><b>Your "real" name</b>:</td> <td><input name="rname"></td> </tr>
+<tr> <td align="right"><b>Contact e-mail address</b></td> <td><input name="email"></td> </tr>
+<tr> <td align="right" valign="top"><input type="checkbox" name="forward"></td> <td>Check this box if you would like to use hcoop as your primary e-mail provider.<br>
+ If you don't select this option and you are approved to join, e-mail to your account will be forwarded to the address you provide here.<br>
+ You can change this option later, but we'll probably have helpul things to e-mail you as soon as you join. It's important that we be able to reach members reliably, so please don't decide to use us as your primary e-mail provider unless you can commit to checking your hcoop mailbox just as often as any other personal accounts you have.</td> </tr>
+<tr> <td align="right" valign="top"><b>How do you plan to use a hcoop membership?</b></td> <td><textarea name="uses" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
+<tr> <td align="right" valign="top"><b>Any other information about yourself</b></td> <td><textarea name="other" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
+<tr> <td><input type="submit" value="Apply"></td> </tr>
+</table>
+</form>
+
+<% end %>
+
+<% @footer[] %>
\ No newline at end of file
--- /dev/null
+print real = Util.printReal
+print int = Util.printInt
+
+before before
+after after
+exn exn
+
+out out
+pub /var/www/join.hcoop.net/cgi/join
+
+cm /usr/local/share/smlsql/smlsql.cm
+cm /usr/local/share/smlsql/libpq/sources.cm
CREATE TABLE DirectoryPref(
usr INTEGER PRIMARY KEY,
FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
+
+CREATE TABLE MemberApp(
+ id INTEGER PRIMARY KEY,
+ name TEXT NOT NULL,
+ rname TEXT NOT NULL,
+ email TEXT NOT NULL,
+ forward BOOLEAN NOT NULL,
+ uses TEXT NOT NULL,
+ other TEXT NOT NULL,
+ passwd TEXT NOT NULL,
+ status INTEGER NOT NULL,
+ applied TIMESTAMP NOT NULL,
+ confirmed TIMESTAMP,
+ decided TIMESTAMP);
+
+CREATE SEQUENCE MemberAppSeq START 1;
+
+CREATE TABLE AppVote(
+ app INTEGER NOT NULL,
+ usr INTEGER NOT NULL,
+ PRIMARY KEY (app, usr),
+ FOREIGN KEY (app) REFERENCES MemberApp(id) ON DELETE CASCADE,
+ FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
+
HCoop / hcoop / zz_old / portal.git / commitdiff