From: adamch Date: Tue, 19 Apr 2005 19:00:48 +0000 (+0000) Subject: Apt installation requests X-Git-Url: https://git.hcoop.net/hcoop/zz_old/portal.git/commitdiff_plain/36d5f17633bd5cf5d9f044c39110dd761689760e Apt installation requests --- diff --git a/TODO b/TODO index 4baccbe..862fc14 100644 --- a/TODO +++ b/TODO @@ -3,5 +3,4 @@ Member data Specific requests - Join, with display of pending applications for all members to read - - apt install requests - New domain requests diff --git a/apt.mlt b/apt.mlt new file mode 100644 index 0000000..515e97a --- /dev/null +++ b/apt.mlt @@ -0,0 +1,215 @@ +<% @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; + %>Error: Unknown package "<% Web.html pkg %>."
<% + | SOME info => + if #installed info then + ok := false; + %>Error: Package "<% pkg %>" is already installed!
<% + else + infos := info :: infos + end + end + end; + + if ok then %> +Are you sure these are the packages you wanted?

+ +<% foreach info in infos do %> + + +<% end %> +
<% #name info %><% Web.html (#descr info) %>

+
+ Reason:
<% Web.htmlNl ($"msg") %>

+ ">Yes, I want to request these packages. + +<% 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; + %>Error: Unknown package "<% Web.html pkg %>."
<% + | SOME info => + if #installed info then + ok := false; + %>Error: Package "<% pkg %>" is already installed!
<% + end + end + end; + + if ok then + val id = Apt.addRequest (Init.getUserId(), $"req", $"msg"); + if not (Apt.notifyNew id) then + %>

Error sending e-mail notification

<% + end + %>

Request added

<% + end + +elseif $"cmd" = "open" then + %>

Open requests

+ List all requests<% + + foreach (name, req) in Apt.listOpenRequests () do %> +


+ + + +<% + ref first = true; + + val pkgs = String.tokens Char.isSpace (#pkgs req); + + foreach pkg in pkgs do + if first then + first := false + else + %><% + end; + switch AptQuery.query pkg of + NONE => + %><% + | SOME info => + %> + <% + end + end %> + + +
By: <% name %>
Time: <% #stamp req %>
Packages:
Error: Unknown package "<% Web.html pkg %>."<% #name info %><% Web.html (#descr info) %>
Reason: <% Web.html (#msg req) %>
+ +<% if admin then %> +
+ [Modify] + [Delete]
+ To install, run: apt-get install<% foreach pkg in pkgs do %> <% pkg %><% end %> +<% end %> + +<% end + +elseif $"cmd" = "list" then + %>

All requests

<% + + foreach (name, req) in Apt.listRequests () do %> +


+ + + +<% + ref first = true; + + val pkgs = String.tokens Char.isSpace (#pkgs req); + + foreach pkg in pkgs do + if first then + first := false + else + %><% + end; + switch AptQuery.query pkg of + NONE => + %><% + | SOME info => + %> + <% + end + end %> + + +
By: <% name %>
Time: <% #stamp req %>
Packages:
Error: Unknown package "<% Web.html pkg %>."<% #name info %><% Web.html (#descr info) %>
Reason: <% Web.html (#msg req) %>
+ +<% if admin then %> +
+ [Modify] + [Delete] +<% end %> + +<% end + +elseif $"mod" <> "" then + Group.requireGroupName "server"; + val id = Web.stoi ($"mod"); + val req = Apt.lookupRequest id; + val user = Init.lookupUser (#usr req) %> +

Handle request

+ +
+ + + + + + + + +
Requestor: <% #name user %>
Time: <% #stamp req %>
Status:
Packages:
Message:
+
+ +<% 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 + %>

Error sending e-mail notification

<% + end + end + %>

Request modified

+ Back to: open requests, all requests + +<% elseif $"del" <> "" then + Group.requireGroupName "server"; + val id = Web.stoi ($"del"); + val req = Apt.lookupRequest id; + val user = Init.lookupUser (#usr req) + %>

Are you sure you want to delete request by <% #name user %> for <% #pkgs req %>?

+ Yes, I'm sure! + +<% elseif $"del2" <> "" then + Group.requireGroupName "server"; + val id = Web.stoi ($"del2"); + Apt.deleteRequest id + %>

Request deleted

+ Back to: open requests, all requests + +<% else %> + +

Request new installations

+ +List the package names you'd like, separated by any whitespace characters. + +
+ + + + +
Packages:
Reason:
+
+ +<% end %> + +<% @footer[] %> \ No newline at end of file diff --git a/apt.sig b/apt.sig new file mode 100644 index 0000000..2a965d0 --- /dev/null +++ b/apt.sig @@ -0,0 +1,21 @@ +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 diff --git a/apt.sml b/apt.sml new file mode 100644 index 0000000..e5c8f80 --- /dev/null +++ b/apt.sml @@ -0,0 +1,161 @@ +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 \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 diff --git a/aptquery.sig b/aptquery.sig new file mode 100644 index 0000000..9add5bc --- /dev/null +++ b/aptquery.sig @@ -0,0 +1,7 @@ +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 diff --git a/aptquery.sml b/aptquery.sml new file mode 100644 index 0000000..1a5939e --- /dev/null +++ b/aptquery.sml @@ -0,0 +1,51 @@ +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 diff --git a/tables.sql b/tables.sql index 2e638df..861257a 100644 --- a/tables.sql +++ b/tables.sql @@ -174,6 +174,13 @@ CREATE TABLE SupSubscription( 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;