adduser <% #name appl %> "<% #rname appl %>"<% if #forward appl then %>" <% #email appl %>"<% end %>

portal_adduser <% #name appl %> "<% #rname appl %>"<% if #forward appl then %>" <% #email appl %>"<% end %>

You should then run visudo to add <% #name appl %> to the MEMBERS group. If you're not transmitting <% #name appl %>'s password to him by other means, run savepass <% #name appl %> <password> to save it in ~<% #name appl %>/.pass.

+ + diff --git a/apt.mlt b/apt.mlt index 519040b..65c9d76 100644 --- a/apt.mlt +++ b/apt.mlt @@ -150,7 +150,7 @@ elseif $"mod" <> "" then val user = Init.lookupUser (#usr req) %>

Handle request

- +

Name:

@@ -202,7 +202,7 @@ elseif $"mod" <> "" then List the package names you'd like, separated by any whitespace characters. - +

Requestor:

<% #name user %>

diff --git a/balances.mlt b/balances.mlt index 250d28c..a6b9352 100644 --- a/balances.mlt +++ b/balances.mlt @@ -20,7 +20,7 @@ elseif $"mod" <> "" then val balance = Balance.lookupBalance (Web.stoi ($"mod")) %>

Modify balance record

- +">

Packages:
Reason:

@@ -50,7 +50,7 @@ elseif $"mod" <> "" then ref total = 0.0 %>

New balance

- +

Name:

diff --git a/contact.mlt b/contact.mlt index eed7986..d7d0fd8 100644 --- a/contact.mlt +++ b/contact.mlt @@ -13,7 +13,7 @@ if $"cmd" = "add" then

Modify contact entry

- +

Name:

Kind:

@@ -115,7 +115,7 @@ elseif $"mod" <> "" then Enter the full Internet domain name that you own and would like set up here. We don't do domain registration, so it is your responsibility to register this name with your registrar of choice before submitting it here. The "Reason" field is optional. - +

Requestor:

<% #name user %>

diff --git a/groups.mlt b/groups.mlt index d0a1a28..25f86b7 100644 --- a/groups.mlt +++ b/groups.mlt @@ -20,7 +20,7 @@ elseif $"mod" <> "" then val group = Group.lookupGroup (Web.stoi ($"mod")) %>

Modify group record

- +">

Domain:
Reason:

@@ -58,7 +58,7 @@ elseif $"mod" <> "" then

Create group

- +

Name:

@@ -67,7 +67,7 @@ elseif $"mod" <> "" then

Grant membership

- +

Name:

Group:

@@ -70,7 +70,7 @@ end %> else %>

Modify issue

- +

@@ -180,7 +180,7 @@ elseif $"modPost" <> "" then else %>

Modify post

- + @@ -283,7 +283,7 @@ foreach (name, post) in Support.listPosts id do %>

Post to this thread

- + diff --git a/kind.mlt b/kind.mlt index 2f8f08c..11ce043 100644 --- a/kind.mlt +++ b/kind.mlt @@ -13,7 +13,7 @@ if $"cmd" = "add" then val id = Web.stoi ($"mod"); val kind = Contact.lookupKind id %> - +

@@ -53,7 +53,7 @@ if $"cmd" = "add" then

Add a contact kind

- +

Name:

diff --git a/link.mlt b/link.mlt index ddfea35..e2943a9 100644 --- a/link.mlt +++ b/link.mlt @@ -19,7 +19,7 @@ if $"cmd" = "add" then

Modify link

- +

Name:

@@ -78,7 +78,7 @@ if showNormal then %>

Add a link to a site you host with Hcoop

- +

Title:

diff --git a/list.mlt b/list.mlt index 44d8e26..6ea2716 100644 --- a/list.mlt +++ b/list.mlt @@ -64,7 +64,7 @@ elseif $"mod" <> "" then val user = Init.lookupUser (#usr req) %>

Handle request

- +

Title:

@@ -118,7 +118,7 @@ elseif $"mod" <> "" then

If you want to use the Mailman web interface on your new list, and you want this to appear on a different web virtual host than hcoop.net, you should create a file .mailman in the domtool directory for this domain, before submitting a request. In that file, put the hostname of the vhost you want to use, and be sure to include a Mailman directive in that vhost's configuration.

- +

Requestor:

<% #name user %>

diff --git a/location.mlt b/location.mlt index ce8c799..1390955 100644 --- a/location.mlt +++ b/location.mlt @@ -23,7 +23,7 @@ elseif $"mod" <> "" then

Modify a location

- +

List name:
Reason:

Parent:

New hosting bill

- +

Parent:

<% ref indent = 0; foreach item in withUser do @@ -177,7 +177,7 @@ end %>

diff --git a/roll.mlt b/roll.mlt new file mode 100644 index 0000000..16db145 --- /dev/null +++ b/roll.mlt @@ -0,0 +1,144 @@ +<% @header [("title", ["Roll call!"])]; + +val you = Init.getUserId (); + +ref viewingCall = NONE; +ref showNormal = true; + +if $"cmd" = "respond" then + showNormal := false; + + val rol = Web.stoi ($"rol"); + val code = $"code"; + val rc = Roll.lookupEntry (rol, you); + + if code = #code rc then + Roll.respond (rol, you); + %>

Your response has been saved. Thank you!

<% + else + %>

Incorrect code!

<% + end +elseif $"cmd" = "add" then + Group.requireGroupNum 0; + val title = $"title"; + val msg = $"msg"; + if title = "" then + %>

Your roll call must have a title.

<% + else + val id = Roll.addRollCall (title, msg); + viewingCall := SOME id; + %>

Roll call added!

<% + end + +elseif $"mod" <> "" then + Group.requireGroupNum 0; + showNormal := false; + val rc = Roll.lookupRollCall (Web.stoi ($"mod")) %> +

Modify roll call

+ + +"> +

checked<% end %>>

Include me in the public member directory.

+ + + +

Title:
Message:	<% Web.html (#msg rc) %>

+ + +<% elseif $"cmd" = "Save" then + Group.requireGroupNum 0; + val rc = Roll.lookupRollCall (Web.stoi ($"id")); + + val title = $"title"; + val msg = $"msg"; + if title = "" then + %>

Your rol call must have a title.

<% + else + Roll.modRollCall {rc with title = title, msg = msg}; + viewingCall := SOME (#id rc); + %>

Roll call saved.

<% + end + +elseif $"del" <> "" then + Group.requireGroupNum 0; + showNormal := false; + val rc = Roll.lookupRollCall (Web.stoi ($"del")) %> +

Are you sure you want to delete roll call "<% Web.html (#title rc) %>"?

+ ">Yes, delete <% Web.html (#title rc) %>! + +<% elseif $"del2" <> "" then + Group.requireGroupNum 0; + val rc = Roll.lookupRollCall (Web.stoi ($"del2")); + Roll.deleteRollCall (Web.stoi ($"del2")) %> +

<% Web.html (#title rc) %> deleted!

+ +<% elseif $"cmd" = "mailall" then + Group.requireGroupNum 0; + showNormal := false; + ref first = true %> + +Mail everyone! + +<% elseif $"view" <> "" then + Group.requireGroupNum 0; + val id = Web.stoi ($"view"); + viewingCall := SOME id +end; + +if showNormal then + Group.requireGroupNum 0; + + switch viewingCall of + NONE => %> +

Existing roll calls

+ +<% foreach rc in Roll.listRollCalls () do %> +

<% Web.html (#title rc) %> (<% #started rc %>)

+<% end %> + +

New roll call

+ + + +Mail everyone! (provides mailto: link) + +<% | SOME id => + val rc = Roll.lookupRollCall id %> +

Roll call "<% Web.html (#title rc) %>"

+ + + +

Started:	<% #started rc %>
Message:	<% Web.htmlNl (#msg rc) %>

+ [ Modify | Delete ]
+ +<% val (didnt, did) = Roll.listEntries id %> + +

Didn't respond yet:

+<% foreach (usr, ent) in didnt do %> +

<% Web.html (#name usr) %>

+<% end %> + +

Responded:

+<% foreach (usr, ent) in did do %> +

<% Web.html (#name usr) %> (<% + switch #responded ent of SOME st => st end %>)

+<% end %> + +<% end +end %> + +<% @footer[] %> \ No newline at end of file diff --git a/roll.sig b/roll.sig new file mode 100644 index 0000000..bbadf2d --- /dev/null +++ b/roll.sig @@ -0,0 +1,28 @@ +signature ROLL = +sig + val activeUsernames : unit -> string list + + type roll_call = { + id : int, + title : string, + msg : string, + started : Init.C.timestamp + } + + val addRollCall : string * string -> int + val modRollCall : roll_call -> unit + val deleteRollCall : int -> unit + val lookupRollCall : int -> roll_call + val listRollCalls : unit -> roll_call list + + type roll_call_entry = { + rol : int, + usr : int, + code : string, + responded : Init.C.timestamp option + } + + val listEntries : int -> (Init.user * roll_call_entry) list * (Init.user * roll_call_entry) list + val lookupEntry : int * int -> roll_call_entry + val respond : int * int -> unit +end diff --git a/roll.sml b/roll.sml new file mode 100644 index 0000000..31eb9e8 --- /dev/null +++ b/roll.sml @@ -0,0 +1,136 @@ +structure Roll :> ROLL = struct + +open Init Sql Util + +fun activeUsernames () = + let + fun mkRow [name] = C.stringFromSql name + | mkRow row = rowError ("activeUsernames", row) + in + C.map (getDb ()) mkRow "SELECT name FROM WebUserActive ORDER BY name" + end + +type roll_call = { + id : int, + title : string, + msg : string, + started : C.timestamp +} + +fun mkRollRow [id, title, msg, started] = + {id = C.intFromSql id, title = C.stringFromSql title, + msg = C.stringFromSql msg, started = C.timestampFromSql started} + | mkRollRow row = rowError ("roll", row) + +fun addRollCall (title, msg) = + let + val db = getDb () + val id = nextSeq (db, "RollCallSeq") + + fun addUser [uid, name] = + let + val uid = C.intFromSql uid + val name = C.stringFromSql name + val code = randomPassword () + + val _ = C.dml db ($`INSERT INTO RollCallEntry (rol, usr, code, responded) + VALUES (^(C.intToSql id), ^(C.intToSql uid), ^(C.stringToSql code), NULL)`) + + val mail = Mail.mopen () + in + Mail.mwrite (mail, "From: Hcoop Portal \nTo: "); + Mail.mwrite (mail, name); + Mail.mwrite (mail, emailSuffix); + Mail.mwrite (mail, "\nSubject: HCoop Roll Call: "); + Mail.mwrite (mail, title); + Mail.mwrite (mail, "\n\n"); + Mail.mwrite (mail, "The admins want to make sure that they can reach everyone by e-mail. To let them know that you're here, please visit this URL:\n\t"); + Mail.mwrite (mail, urlPrefix); + Mail.mwrite (mail, "roll?cmd=respond&rol="); + Mail.mwrite (mail, Int.toString id); + Mail.mwrite (mail, "&code="); + Mail.mwrite (mail, code); + Mail.mwrite (mail, "\nYou may have to hit \"reload\" in your web browser, if you aren't already logged into the portal.\n\n"); + Mail.mwrite (mail, msg); + ignore (Mail.mclose mail) + end + | addUser row = rowError ("add roll entry", row) + in + C.dml db ($`INSERT INTO RollCall (id, title, msg, started) + VALUES (^(C.intToSql id), ^(C.stringToSql title), ^(C.stringToSql msg), + CURRENT_TIMESTAMP)`); + C.app db addUser "SELECT id, name FROM WebUserActive"; + id + end + +fun modRollCall (rc : roll_call) = + let + val db = getDb () + in + ignore (C.dml db ($`UPDATE RollCall SET + title = ^(C.stringToSql (#title rc)), + msg = ^(C.stringToSql (#msg rc)) + WHERE id = ^(C.intToSql (#id rc))`)) + end + +fun deleteRollCall id = + ignore (C.dml (getDb ()) ($`DELETE FROM RollCall WHERE id = ^(C.intToSql id)`)) + +fun lookupRollCall id = + case C.oneOrNoRows (getDb ()) ($`SELECT id, title, msg, started + FROM RollCall + WHERE id = ^(C.intToSql id)`) of + NONE => raise Fail "Roll call not found" + | SOME row => mkRollRow row + +fun listRollCalls id = + C.map (getDb ()) mkRollRow "SELECT id, title, msg, started FROM RollCall ORDER BY started DESC" + +type roll_call_entry = { + rol : int, + usr : int, + code : string, + responded : C.timestamp option +} + +fun mkEntryRow [rol, usr, code, responded] = + {rol = C.intFromSql rol, usr = C.intFromSql usr, + code = C.stringFromSql code, + responded = (if C.isNull responded then NONE else SOME (C.timestampFromSql responded))} + | mkEntryRow row = rowError ("roll entry", row) + +fun lookupEntry (rol, usr) = + case C.oneOrNoRows (getDb ()) ($`SELECT rol, usr, code, responded + FROM RollCallEntry + WHERE rol = ^(C.intToSql rol) AND usr = ^(C.intToSql usr)`) of + NONE => raise Fail "Roll call entry not found" + | SOME row => mkEntryRow row + +fun listEntries id = + let + fun folder (_ :: row, (didnt, did)) = + let + val ent = mkEntryRow row + val uent = (Init.lookupUser (#usr ent), ent) + in + case #responded ent of + NONE => (uent :: didnt, did) + | SOME _ => (didnt, uent :: did) + end + | folder (row, _) = rowError ("listEntries folder", row) + in + C.fold (getDb ()) folder ([], []) + ($`SELECT name, rol, usr, code, responded + FROM RollCallEntry JOIN WebUser ON id = usr + WHERE rol = ^(C.intToSql id) + ORDER BY responded, name DESC`) + end + +fun respond (rol, usr) = + ignore (C.dml (getDb ()) ($`UPDATE RollCallEntry + SET responded = CURRENT_TIMESTAMP + WHERE rol = ^(C.intToSql rol) AND usr = ^(C.intToSql usr)`)) + +end diff --git a/support.mlt b/support.mlt index 2af6750..a9c64c9 100644 --- a/support.mlt +++ b/support.mlt @@ -26,7 +26,7 @@ if $"sub" <> "" then

Modify category

+ @@ -86,7 +86,7 @@ if showNormal then %>

Add new category

- +

Name:

diff --git a/tables.sql b/tables.sql index 2f40212..555d81b 100644 --- a/tables.sql +++ b/tables.sql @@ -251,8 +251,23 @@ CREATE VIEW WebUserActive AS SELECT id, name, rname, bal, joined, app FROM WebUser LEFT OUTER JOIN (SELECT usr FROM Membership JOIN WebGroup - ON grp = WebGroup.id AND WebGroup.name = 'retired') AS mem + ON grp = WebGroup.id AND (WebGroup.name IN ('retired', 'phantom'))) AS mem ON usr = WebUser.id - WHERE usr IS NULL; +CREATE TABLE RollCall( + id INTEGER PRIMARY KEY, + title TEXT NOT NULL, + msg TEXT NOT NULL, + started TIMESTAMP NOT NULL); + +CREATE SEQUENCE RollCallSeq START 1; + +CREATE TABLE RollCallEntry( + rol INTEGER NOT NULL, + usr INTEGER NOT NULL, + code TEXT NOT NULL, + responded TIMESTAMP, + PRIMARY KEY (rol, usr), + FOREIGN KEY (rol) REFERENCES RollCall(id) ON DELETE CASCADE, + FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE); diff --git a/users.mlt b/users.mlt index 1a60143..fbd60aa 100644 --- a/users.mlt +++ b/users.mlt @@ -40,7 +40,7 @@ elseif $"mod" <> "" then val user = Init.lookupUser (Web.stoi ($"mod")) %>

Modify member record

- +">

Name:

@@ -79,7 +79,7 @@ elseif $"mod" <> "" then <% if showNormal then %>

New member

- +

Name:

diff --git a/util.sml b/util.sml index 801044e..9ac38d0 100644 --- a/util.sml +++ b/util.sml @@ -30,7 +30,7 @@ fun makeSet f items = fun neg (r : real) = ~r fun add (r1 : real, r2) = r1 + r2 -fun isIdent ch = Char.isLower ch orelse Char.isDigit ch +fun isIdent ch = Char.isLower ch orelse Char.isDigit ch orelse ch = #"-" fun validHost s = size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s) -- 2.20.1

Name:
Real name: