From: Adam Chlipala Date: Mon, 2 May 2005 03:45:38 +0000 (+0000) Subject: New member applications X-Git-Url: https://git.hcoop.net/hcoop/portal.git/commitdiff_plain/a90da8b1a537003cb21a3a4c0199cf3e88c510ad New member applications --- diff --git a/.cvsignore b/.cvsignore index e25901e..a2a33e4 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1,3 +1,2 @@ -out .cm CM diff --git a/app.sig b/app.sig new file mode 100644 index 0000000..0711e74 --- /dev/null +++ b/app.sig @@ -0,0 +1,15 @@ +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 diff --git a/app.sml b/app.sml new file mode 100644 index 0000000..5e2c547 --- /dev/null +++ b/app.sml @@ -0,0 +1,46 @@ +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 diff --git a/app/.cvsignore b/app/.cvsignore new file mode 100644 index 0000000..854c999 --- /dev/null +++ b/app/.cvsignore @@ -0,0 +1,2 @@ +.cm +CM \ No newline at end of file diff --git a/app/after.mlt b/app/after.mlt new file mode 100644 index 0000000..26bef72 --- /dev/null +++ b/app/after.mlt @@ -0,0 +1,3 @@ +<% App.done () %> + + \ No newline at end of file diff --git a/app/app.sig b/app/app.sig new file mode 100644 index 0000000..188aaa4 --- /dev/null +++ b/app/app.sig @@ -0,0 +1,18 @@ +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 diff --git a/app/app.sml b/app/app.sml new file mode 100644 index 0000000..0f4f83a --- /dev/null +++ b/app/app.sml @@ -0,0 +1,143 @@ +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 \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 diff --git a/app/before.mlt b/app/before.mlt new file mode 100644 index 0000000..9217d71 --- /dev/null +++ b/app/before.mlt @@ -0,0 +1,3 @@ +<% App.init () %> + + \ No newline at end of file diff --git a/app/confirm.mlt b/app/confirm.mlt new file mode 100644 index 0000000..74f583f --- /dev/null +++ b/app/confirm.mlt @@ -0,0 +1,14 @@ +<% @header [("title", ["Confirm appliaction"])]; + +val id = Web.stoi ($"id"); +val passwd = $"p"; + +if App.confirm (id, passwd) then + %>

Confirmation successful

+ You should hear from us within a few days from now.<% +else + %>

Error confirming

+ Did you already follow this confirmation link?<% +end; + +@footer[] %> \ No newline at end of file diff --git a/app/exn.mlt b/app/exn.mlt new file mode 100644 index 0000000..43fd157 --- /dev/null +++ b/app/exn.mlt @@ -0,0 +1,21 @@ + +Hcoop: Exception + + +

Exception

+ +<% switch Web.getExn () of + Fail msg => %> +Fail: <% Web.htmlNl msg %> +<% | App.C.Sql msg => %> +SQL: <% Web.htmlNl msg %> +<% | Web.Format s => %> +Format: <% Web.htmlNl s %> +<% | ex => %> +Unknown exception kind. Backtrace: +<% foreach s in SMLofNJ.exnHistory ex do %> +
  • <% Web.html s %>
    • +<% end +end %> + + diff --git a/app/footer.mlt b/app/footer.mlt new file mode 100644 index 0000000..8634a86 --- /dev/null +++ b/app/footer.mlt @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/app/header.mlt b/app/header.mlt new file mode 100644 index 0000000..de7c81a --- /dev/null +++ b/app/header.mlt @@ -0,0 +1,9 @@ + +<% val title = + case $"title" of + "" => "Hcoop" + | t => ("Hcoop: " ^ t) %> +<% Web.html title %> + + +

    <% Web.html title %>

    diff --git a/app/join.mlt b/app/join.mlt new file mode 100644 index 0000000..bfbfe28 --- /dev/null +++ b/app/join.mlt @@ -0,0 +1,52 @@ +<% @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 + %>

    Please enter a username

    <% + elseif rname = "" then + %>

    Please enter your name

    <% + elseif email = "" then + %>

    Please enter your contact e-mail address

    <% + elseif uses = "" then + %>

    Please enter your proposed uses

    <% + elseif not (App.validUser name) then + %>

    Invalid requested username

    <% + elseif App.userExists name then + %>

    That username is already in use.

    <% + elseif not (App.validEmail email) then + %>

    Invalid e-mail address

    <% + elseif not (App.apply { name = name, rname = rname, email = email, + forward = forward, uses = uses, other = other }) then + %>

    Error sending confirmation e-mail

    <% + else + %>

    Application recorded

    + Check your e-mail for a message with further instructions.<% + end +else %> + +
    + + + + + + + + + +
    Desired username:
    + You should follow usual UNIX conventions, and it's helpful to pick a name you wouldn't mind using to identify yourself to strangers.
    Your "real" name:
    Contact e-mail address
    Check this box if you would like to use hcoop as your primary e-mail provider.
    + 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.
    + 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.
    How do you plan to use a hcoop membership?
    Any other information about yourself
    +
    + +<% end %> + +<% @footer[] %> \ No newline at end of file diff --git a/app/mlt.conf b/app/mlt.conf new file mode 100644 index 0000000..a3134a7 --- /dev/null +++ b/app/mlt.conf @@ -0,0 +1,12 @@ +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 diff --git a/tables.sql b/tables.sql index f1c980d..264ecb8 100644 --- a/tables.sql +++ b/tables.sql @@ -210,3 +210,27 @@ CREATE SEQUENCE MailingListSeq START 1; 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); +