Specific requests
- Join, with display of pending applications for all members to read
- - apt install requests
- New domain requests
--- /dev/null
+<% @header [("title", ["APT package installation requests"])];
+
+val admin = Group.inGroupName "server";
+
+if $"new" <> "" then
+ val pkgs = String.tokens Char.isSpace ($"new");
+
+ ref ok = true;
+ ref infos = [];
+
+ foreach pkg in pkgs do
+ switch AptQuery.query pkg of
+ NONE =>
+ ok := false;
+ %><b>Error</b>: Unknown package "<% Web.html pkg %>."<br><%
+ | SOME info =>
+ if #installed info then
+ ok := false;
+ %><b>Error</b>: Package "<% pkg %>" is already installed!<br><%
+ else
+ infos := info :: infos
+ end
+ end
+ end;
+
+ if ok then %>
+Are you sure these are the packages you wanted?<br><br>
+<table>
+<% foreach info in infos do %>
+ <tr> <td align="right"><a href="http://packages.debian.org/testing/<% #section info %>/<% #name info %>"><% #name info %></a></td>
+ <td><% Web.html (#descr info) %></td> </tr>
+<% end %>
+ </table><br>
+ <br>
+ <b>Reason:</b> <blockquote><% Web.htmlNl ($"msg") %></blockquote><br>
+ <a href="apt?req=<% foreach info in infos do %><% #name info %>+<% end %>&msg=<% Web.urlEncode ($"msg") %>">Yes, I want to request these packages.</a>
+
+<% end
+
+elseif $"req" <> "" then
+ val pkgs = String.tokens Char.isSpace ($"req");
+
+ ref ok = true;
+
+ foreach pkg in pkgs do
+ switch AptQuery.query pkg of
+ NONE =>
+ ok := false;
+ %><b>Error</b>: Unknown package "<% Web.html pkg %>."<br><%
+ | SOME info =>
+ if #installed info then
+ ok := false;
+ %><b>Error</b>: Package "<% pkg %>" is already installed!<br><%
+ end
+ end
+ end;
+
+ if ok then
+ val id = Apt.addRequest (Init.getUserId(), $"req", $"msg");
+ if not (Apt.notifyNew id) then
+ %><h3><b>Error sending e-mail notification</b></h3><%
+ end
+ %><h3><b>Request added</b></h3><%
+ end
+
+elseif $"cmd" = "open" then
+ %><h3><b>Open requests</b></h3>
+ <a href="apt?cmd=list">List all requests</a><%
+
+ foreach (name, req) in Apt.listOpenRequests () do %>
+<br><hr><br>
+<table>
+<tr> <td align="right"><b>By</b>:</td> <td colspan="2"><a href="user?id=<% #usr req %>"><% name %></a></td> </tr>
+<tr> <td align="right"><b>Time</b>:</td> <td colspan="2"><% #stamp req %></td> </tr>
+<tr> <td align="right"><b>Packages</b>:</td><%
+ ref first = true;
+
+ val pkgs = String.tokens Char.isSpace (#pkgs req);
+
+ foreach pkg in pkgs do
+ if first then
+ first := false
+ else
+ %></tr><tr> <td></td><%
+ end;
+ switch AptQuery.query pkg of
+ NONE =>
+ %><td></td> <td><b>Error</b>: Unknown package "<% Web.html pkg %>."</td><%
+ | SOME info =>
+ %><td align="right"><a href="http://packages.debian.org/testing/<% #section info %>/<% #name info %>"><% #name info %></a></td>
+ <td><% Web.html (#descr info) %></td><%
+ end
+ end %>
+</tr>
+<tr> <td align="right" valign="top"><b>Reason</b>:</td> <td colspan="2"><% Web.html (#msg req) %></td> </tr>
+</table>
+
+<% if admin then %>
+ <br>
+ <a href="apt?mod=<% #id req %>">[Modify]</a>
+ <a href="apt?del=<% #id req %>">[Delete]</a><br>
+ To install, run: <tt>apt-get install<% foreach pkg in pkgs do %> <% pkg %><% end %></tt>
+<% end %>
+
+<% end
+
+elseif $"cmd" = "list" then
+ %><h3><b>All requests</b></h3><%
+
+ foreach (name, req) in Apt.listRequests () do %>
+<br><hr><br>
+<table>
+<tr> <td align="right"><b>By</b>:</td> <td colspan="2"><a href="user?id=<% #usr req %>"><% name %></a></td> </tr>
+<tr> <td align="right"><b>Time</b>:</td> <td colspan="2"><% #stamp req %></td> </tr>
+<tr> <td align="right"><b>Packages</b>:</td><%
+ ref first = true;
+
+ val pkgs = String.tokens Char.isSpace (#pkgs req);
+
+ foreach pkg in pkgs do
+ if first then
+ first := false
+ else
+ %></tr><tr> <td></td><%
+ end;
+ switch AptQuery.query pkg of
+ NONE =>
+ %><td></td> <td><b>Error</b>: Unknown package "<% Web.html pkg %>."</td><%
+ | SOME info =>
+ %><td align="right"><a href="http://packages.debian.org/testing/<% #section info %>/<% #name info %>"><% #name info %></a></td>
+ <td><% Web.html (#descr info) %></td><%
+ end
+ end %>
+</tr>
+<tr> <td align="right" valign="top"><b>Reason</b>:</td> <td colspan="2"><% Web.html (#msg req) %></td> </tr>
+</table>
+
+<% if admin then %>
+ <br>
+ <a href="apt?mod=<% #id req %>">[Modify]</a>
+ <a href="apt?del=<% #id req %>">[Delete]</a>
+<% end %>
+
+<% end
+
+elseif $"mod" <> "" then
+ Group.requireGroupName "server";
+ val id = Web.stoi ($"mod");
+ val req = Apt.lookupRequest id;
+ val user = Init.lookupUser (#usr req) %>
+<h3><b>Handle request</b></h3>
+
+<form action="apt">
+<input type="hidden" name="save" value="<% id %>">
+<table>
+<tr> <td align="right"><b>Requestor</b>:</td> <td><a href="user?id=<% #usr req %>"><% #name user %></a></td> </tr>
+<tr> <td align="right"><b>Time</b>:</td> <td><% #stamp req %></td> </tr>
+<tr> <td align="right"><b>Status</b>:</td> <td><select name="status">
+ <option value="0"<% if #status req = Apt.NEW then %> selected<% end %>>New</option>
+ <option value="1"<% if #status req = Apt.INSTALLED then %> selected<% end %>>Installed</option>
+ <option value="2"<% if #status req = Apt.REJECTED then %> selected<% end %>>Rejected</option>
+</select></td> </tr>
+<tr> <td align="right" valign="top"><b>Packages</b>:</td> <td><textarea name="pkgs" rows="5" cols="40" wrap="soft"><% Web.html (#pkgs req) %></textarea></td> </tr>
+<tr> <td align="right" valign="top"><b>Message</b>:</td> <td><textarea name="msg" rows="10" cols="80" wrap="soft"><% Web.html (#msg req) %></textarea></td> </tr>
+<tr> <td><input type="submit" value="Save"></td> </tr>
+</table>
+</form>
+
+<% elseif $"save" <> "" then
+ Group.requireGroupName "server";
+ val id = Web.stoi ($"save");
+ val req = Apt.lookupRequest id;
+ val oldStatus = #status req;
+ val newStatus = Apt.statusFromInt (Web.stoi ($"status"));
+ Apt.modRequest {req with pkgs = $"pkgs", msg = $"msg", status = newStatus};
+ if oldStatus <> newStatus then
+ if not (Apt.notifyMod (oldStatus, newStatus, Init.getUserName(), id)) then
+ %><h3><b>Error sending e-mail notification</b></h3><%
+ end
+ end
+ %><h3><b>Request modified</b></h3>
+ Back to: <a href="apt?cmd=open">open requests</a>, <a href="apt?cmd=list">all requests</a>
+
+<% elseif $"del" <> "" then
+ Group.requireGroupName "server";
+ val id = Web.stoi ($"del");
+ val req = Apt.lookupRequest id;
+ val user = Init.lookupUser (#usr req)
+ %><h3><b>Are you sure you want to delete request by <% #name user %> for <tt><% #pkgs req %></tt>?</b></h3>
+ <a href="apt?del2=<% id %>">Yes, I'm sure!</a>
+
+<% elseif $"del2" <> "" then
+ Group.requireGroupName "server";
+ val id = Web.stoi ($"del2");
+ Apt.deleteRequest id
+ %><h3><b>Request deleted</b><h3>
+ Back to: <a href="apt?cmd=open">open requests</a>, <a href="apt?cmd=list">all requests</a>
+
+<% else %>
+
+<h3><b>Request new installations</b></h3>
+
+List the package names you'd like, separated by any whitespace characters.
+
+<form action="apt">
+<table>
+<tr> <td align="right" valign="top"><b>Packages</b>:</td> <td><textarea name="new" rows="10" cols="40" wrap="soft"></textarea></td> </tr>
+<tr> <td align="right" valign="top"><b>Reason</b>:</td> <td><textarea name="msg" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
+<tr> <td><input type="submit" value="Request"></td> </tr>
+</table>
+</form>
+
+<% end %>
+
+<% @footer[] %>
\ No newline at end of file
--- /dev/null
+signature APT =
+sig
+ datatype status =
+ NEW
+ | INSTALLED
+ | REJECTED
+
+ type request = { id : int, usr : int, pkgs : string, msg : string, status : status, stamp : Init.C.timestamp }
+
+ val statusFromInt : int -> status
+
+ val addRequest : int * string * string -> int
+ val lookupRequest : int -> request
+ val modRequest : request -> unit
+ val deleteRequest : int -> unit
+ val listRequests : unit -> (string * request) list
+ val listOpenRequests : unit -> (string * request) list
+
+ val notifyNew : int -> bool
+ val notifyMod : status * status * string * int -> bool
+end
\ No newline at end of file
--- /dev/null
+structure Apt :> APT =
+struct
+
+open Util Sql Init
+
+datatype status =
+ NEW
+ | INSTALLED
+ | REJECTED
+
+type request = { id : int, usr : int, pkgs : string, msg : string, status : status, stamp : C.timestamp }
+
+val statusFromInt =
+ fn 0 => NEW
+ | 1 => INSTALLED
+ | 2 => REJECTED
+ | _ => raise C.Sql "Bad APT request status"
+
+val statusToInt =
+ fn NEW => 0
+ | INSTALLED => 1
+ | REJECTED => 2
+
+fun statusFromSql v = statusFromInt (C.intFromSql v)
+fun statusToSql s = C.intToSql (statusToInt s)
+
+fun mkRequestRow [id, usr, pkgs, msg, status, stamp] =
+ {id = C.intFromSql id, usr = C.intFromSql usr, pkgs = C.stringFromSql pkgs,
+ msg = C.stringFromSql msg, status = statusFromSql status, stamp = C.timestampFromSql stamp}
+ | mkRequestRow r = rowError ("APT request", r)
+
+fun addRequest (usr, pkgs, msg) =
+ let
+ val db = getDb ()
+ val id = nextSeq (db, "AptSeq")
+ in
+ C.dml db ($`INSERT INTO Apt (id, usr, pkgs, msg, status, stamp)
+ VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql pkgs), ^(C.stringToSql msg),
+ 0, CURRENT_TIMESTAMP)`);
+ id
+ end
+
+fun modRequest (req : request) =
+ let
+ val db = getDb ()
+ in
+ ignore (C.dml db ($`UPDATE Apt SET
+ usr = ^(C.intToSql (#usr req)), pkgs = ^(C.stringToSql (#pkgs req)),
+ msg = ^(C.stringToSql (#msg req)), status = ^(statusToSql (#status req))
+ WHERE id = ^(C.intToSql (#id req))`))
+ end
+
+fun deleteRequest id =
+ ignore (C.dml (getDb ()) ($`DELETE FROM Apt WHERE id = ^(C.intToSql id)`))
+
+fun lookupRequest id =
+ case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, pkgs, msg, status, stamp
+ FROM Apt
+ WHERE id = ^(C.intToSql id)`) of
+ SOME row => mkRequestRow row
+ | NONE => raise Fail "APT request not found"
+
+fun mkRequestRow' (name :: rest) = (C.stringFromSql name, mkRequestRow rest)
+ | mkRequestRow' r = rowError ("Apt.request'", r)
+
+fun listRequests () =
+ C.map (getDb ()) mkRequestRow' ($`SELECT name, Apt.id, usr, pkgs, msg, status, stamp
+ FROM Apt JOIN WebUser ON usr = WebUser.id
+ ORDER BY stamp DESC`)
+
+fun listOpenRequests () =
+ C.map (getDb ()) mkRequestRow' ($`SELECT name, Apt.id, usr, pkgs, msg, status, stamp
+ FROM Apt JOIN WebUser ON usr = WebUser.id
+ WHERE status = 0
+ ORDER BY stamp DESC`)
+
+fun notify f req =
+ let
+ val grp =
+ case Group.groupNameToId "server" of
+ NONE => 0
+ | SOME grp => grp
+
+ val req = lookupRequest req
+ val user = Init.lookupUser (#usr req)
+
+ val mail = Mail.mopen ()
+
+ fun doOne [name] =
+ let
+ val name = C.stringFromSql name
+ in
+ if name = #name user then
+ ()
+ else
+ (Mail.mwrite (mail, name);
+ Mail.mwrite (mail, ","))
+ end
+ | doOne r = rowError ("apt.doOne", r)
+
+ fun rightJustify (n, s) =
+ let
+ fun pad n =
+ if n <= 0 then
+ ()
+ else
+ (Mail.mwrite (mail, " ");
+ pad (n-1))
+ in
+ pad (n - size s);
+ Mail.mwrite (mail, s)
+ end
+
+ val pkgs = String.tokens Char.isSpace (#pkgs req)
+ val infos = map (valOf o AptQuery.query) pkgs
+ in
+ Mail.mwrite (mail, "From: Hcoop Portal <portal@hcoop.net>\nTo: ");
+ Mail.mwrite (mail, #name user);
+ Mail.mwrite (mail, "@hcoop.net\n");
+ Mail.mwrite (mail, "Bcc: ");
+ C.app (getDb ()) doOne ($`SELECT name
+ FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql grp))`);
+ Mail.mwrite (mail, "\nSubject: Apt package installation request\n\n");
+
+ f (user, mail);
+
+ app (fn info =>
+ (rightJustify (10, #name info);
+ Mail.mwrite (mail, " ");
+ Mail.mwrite (mail, #descr info);
+ Mail.mwrite (mail, "\n"))) infos;
+
+ Mail.mwrite (mail, "\n");
+ Mail.mwrite (mail, #msg req);
+
+ Mail.mwrite (mail, "\n\nOpen requests: ");
+ Mail.mwrite (mail, urlPrefix);
+ Mail.mwrite (mail, "apt?cmd=open\n");
+
+ OS.Process.isSuccess (Mail.mclose mail)
+ end
+
+val notifyNew = notify (fn (user, mail) =>
+ (Mail.mwrite (mail, #name user);
+ Mail.mwrite (mail, " has requested the following packages:\n\n")))
+
+val statusToString =
+ fn NEW => "New"
+ | INSTALLED => "Installed"
+ | REJECTED => "Rejected"
+
+fun notifyMod (oldStatus, newStatus, changer, req) =
+ notify (fn (_, mail) =>
+ (Mail.mwrite (mail, changer);
+ Mail.mwrite (mail, " has changed the status of this request from ");
+ Mail.mwrite (mail, statusToString oldStatus);
+ Mail.mwrite (mail, " to ");
+ Mail.mwrite (mail, statusToString newStatus);
+ Mail.mwrite (mail, ".\n\n"))) req
+
+end
\ No newline at end of file
--- /dev/null
+signature APT_QUERY =
+sig
+ type info = { name : string, section : string, descr : string, installed : bool }
+
+ val validName : string -> bool
+ val query : string -> info option
+end
\ No newline at end of file
--- /dev/null
+structure AptQuery :> APT_QUERY =
+struct
+
+type info = { name : string, section : string, descr : string, installed : bool }
+
+fun validName s = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"-") s
+ andalso (size s > 0 andalso String.sub (s, 0) <> #"-")
+
+fun query name =
+ let
+ val _ =
+ if validName name then
+ ()
+ else
+ raise Fail "Invalid package name"
+
+ val proc = Unix.execute ("/usr/bin/apt-cache", ["show", name])
+ val inf = Unix.textInstreamOf proc
+
+ fun loop (section, descr) =
+ case TextIO.inputLine inf of
+ NONE => (section, descr)
+ | SOME line =>
+ if size line >= 9 andalso String.substring (line, 0, 9) = "Section: " then
+ loop (SOME (String.substring (line, 9, size line - 10)), descr)
+ else if size line >= 13 andalso String.substring (line, 0, 13) = "Description: " then
+ loop (section, SOME (String.substring (line, 13, size line - 14)))
+ else
+ loop (section, descr)
+ in
+ case loop (NONE, NONE) of
+ (SOME section, SOME descr) =>
+ let
+ val _ = Unix.reap proc
+
+ val proc = Unix.execute ("/usr/bin/dpkg", ["-l", name])
+ val inf = Unix.textInstreamOf proc
+ val installed =
+ case TextIO.inputLine inf of
+ NONE => false
+ | SOME line => String.sub (line, 0) = #"D"
+
+ val _ = Unix.reap proc
+ in
+ SOME {name = name, section = section, descr = descr, installed = installed}
+ end
+ | _ => (Unix.reap proc;
+ NONE)
+ end
+
+end
\ No newline at end of file
FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE,
FOREIGN KEY (cat) REFERENCES SupCategory(id) ON DELETE CASCADE);
+CREATE TABLE Apt(
+ id INTEGER PRIMARY KEY,
+ usr INTEGER NOT NULL,
+ pkgs TEXT NOT NULL,
+ msg TEXT NOT NULL,
+ status INTEGER NOT NULL,
+ stamp TIMESTAMP NOT NULL,
+ FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
-
-
+CREATE SEQUENCE AptSeq START 1;
HCoop / hcoop / zz_old / portal.git / commitdiff