From 8023de7bf992fe7be73256cece7ba09e320e98f8 Mon Sep 17 00:00:00 2001 From: adamch Date: Sun, 25 Feb 2007 21:05:26 +0000 Subject: [PATCH] Update APT requests to take multiple servers into consideration --- apt.mlt | 42 ++++++++++---- apt.sml | 64 ++++++++++----------- aptquery.sig | 2 +- aptquery.sml | 4 +- exn.mlt | 2 + init.sig | 6 ++ init.sml | 27 +++++++++ requestH.sig | 31 ++++++++++ requestH.sml | 158 +++++++++++++++++++++++++++++++++++++++++++++++++++ sec.mlt | 6 +- tables.sql | 14 +++++ 11 files changed, 308 insertions(+), 48 deletions(-) rewrite apt.sml (99%) create mode 100644 requestH.sig create mode 100644 requestH.sml diff --git a/apt.mlt b/apt.mlt index 0679155..d51c509 100644 --- a/apt.mlt +++ b/apt.mlt @@ -3,13 +3,14 @@ val admin = Group.inGroupName "server"; if $"new" <> "" then + val node = Web.stoi ($"node"); val pkgs = String.tokens Char.isSpace ($"new"); ref ok = true; ref infos = []; foreach pkg in pkgs do - switch AptQuery.query pkg of + switch AptQuery.query {node = node, pkg = pkg} of NONE => ok := false; %>Error: Unknown package "<% Web.html pkg %>."
<% @@ -23,27 +24,29 @@ if $"new" <> "" then end end; - if ok then %> + if ok then + val debian = Init.nodeDebian node %> Are you sure these are the packages you wanted?

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


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

- ">Yes, I want to request these packages. + ">Yes, I want to request these packages. <% end elseif $"req" <> "" then + val node = Web.stoi ($"node"); val pkgs = String.tokens Char.isSpace ($"req"); ref ok = true; foreach pkg in pkgs do - switch AptQuery.query pkg of + switch AptQuery.query {node = node, pkg = pkg} of NONE => ok := false; %>Error: Unknown package "<% Web.html pkg %>."
<% @@ -56,7 +59,7 @@ elseif $"req" <> "" then end; if ok then - val id = Apt.add (Init.getUserId(), $"req", $"msg"); + val id = Apt.add {usr = Init.getUserId(), node = node, data = $"req", msg = $"msg"}; if not (Apt.notifyNew id) then %>

Error sending e-mail notification

<% end @@ -72,10 +75,12 @@ elseif $"cmd" = "open" then +<% ref first = true; val pkgs = String.tokens Char.isSpace (#data req); + val debian = Init.nodeDebian (#node req); foreach pkg in pkgs do if first then @@ -83,11 +88,11 @@ elseif $"cmd" = "open" then else %><% end; - switch AptQuery.query pkg of + switch AptQuery.query {node = #node req, pkg = pkg} of NONE => %><% | SOME info => - %> + %><% end end %> @@ -112,10 +117,12 @@ elseif $"cmd" = "list" then
By: <% name %>
Time: <% #stamp req %>
Node: <% Web.html (Init.nodeName (#node req)) %>
Packages:
Error: Unknown package "<% Web.html pkg %>."<% #name info %><% #name info %> <% Web.html (#descr info) %>
+<% ref first = true; val pkgs = String.tokens Char.isSpace (#data req); + val debian = Init.nodeDebian (#node req); foreach pkg in pkgs do if first then @@ -123,11 +130,11 @@ elseif $"cmd" = "list" then else %><% end; - switch AptQuery.query pkg of + switch AptQuery.query {node = #node req, pkg = pkg} of NONE => %><% | SOME info => - %> + %><% end end %> @@ -155,6 +162,11 @@ elseif $"mod" <> "" then
By: <% name %>
Time: <% #stamp req %>
Node: <% Web.html (Init.nodeName (#node req)) %>
Packages:
Error: Unknown package "<% Web.html pkg %>."<% #name info %><% #name info %> <% Web.html (#descr info) %>
+
Requestor: <% #name user %>
Time: <% #stamp req %>
Node:
Status: + diff --git a/apt.sml b/apt.sml dissimilarity index 99% index fcea967..7aef214 100644 --- a/apt.sml +++ b/apt.sml @@ -1,32 +1,32 @@ -structure Apt = Request(struct - val table = "Apt" - val adminGroup = "server" - fun subject _ = "Apt package installation request" - val template = "apt" - val descr = "packages" - - fun body (mail, pkgs) = - let - val pkgs = String.tokens Char.isSpace pkgs - val infos = map (valOf o AptQuery.query) pkgs - - 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 - in - app (fn info => - (rightJustify (10, #name info); - Mail.mwrite (mail, " "); - Mail.mwrite (mail, #descr info); - Mail.mwrite (mail, "\n"))) infos - end - end) +structure Apt = RequestH(struct + val table = "Apt" + val adminGroup = "server" + fun subject _ = "Apt package installation request" + val template = "apt" + val descr = "packages" + + fun body {node, mail, data = pkgs} = + let + val pkgs = String.tokens Char.isSpace pkgs + val infos = map (valOf o (fn x => AptQuery.query {node = node, pkg = x})) pkgs + + 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 + in + app (fn info => + (rightJustify (10, #name info); + Mail.mwrite (mail, " "); + Mail.mwrite (mail, #descr info); + Mail.mwrite (mail, "\n"))) infos + end + end) diff --git a/aptquery.sig b/aptquery.sig index 9add5bc..1f24f99 100644 --- a/aptquery.sig +++ b/aptquery.sig @@ -3,5 +3,5 @@ sig type info = { name : string, section : string, descr : string, installed : bool } val validName : string -> bool - val query : string -> info option + val query : {node : int, pkg : string} -> info option end \ No newline at end of file diff --git a/aptquery.sml b/aptquery.sml index ba0e761..39b37ef 100644 --- a/aptquery.sml +++ b/aptquery.sml @@ -6,7 +6,7 @@ type info = { name : string, section : string, descr : string, installed : bool fun validName s = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"-" orelse ch = #".") s andalso (size s > 0 andalso String.sub (s, 0) <> #"-") -fun query name = +fun query {node, pkg = name} = let val _ = if validName name then @@ -33,7 +33,7 @@ fun query name = let val _ = Unix.reap proc - val installed = OS.Process.isSuccess (OS.Process.system ("/usr/bin/dpkg -p " ^ name ^ " >/dev/null 2>/dev/null")) + val installed = OS.Process.isSuccess (OS.Process.system ("DOMTOOL_USER=apache2.deleuze.hcoop.net /usr/local/bin/domtool-admin package " ^ Init.nodeName node ^ " " ^ name ^ " >/dev/null 2>/dev/null")) in SOME {name = name, section = section, descr = descr, installed = installed} end diff --git a/exn.mlt b/exn.mlt index 7987ad6..c36e18a 100644 --- a/exn.mlt +++ b/exn.mlt @@ -11,6 +11,8 @@ System error: <% Web.html name %> <% | OS.SysErr (name, SOME syserr) => %> System error: <% Web.html name %>: <% Web.html (OS.errorName syserr) %>: <% Web.htmlNl (OS.errorMsg syserr) %> +<% | IO.Io {name, function, ...} => %> +IO error: <% Web.html name %> for <% Web.html function %> <% | Init.C.Sql msg => %> SQL: <% Web.htmlNl msg %> <% | Init.Access msg => %> diff --git a/init.sig b/init.sig index 2b1a936..39fe4ac 100644 --- a/init.sig +++ b/init.sig @@ -48,4 +48,10 @@ signature INIT = sig val dateString : unit -> string val grandfatherUsers : unit -> unit + + type node = {id : int, name : string, descr : string, debian : string} + + val listNodes : unit -> node list + val nodeName : int -> string + val nodeDebian : int -> string end diff --git a/init.sml b/init.sml index c56044b..d6aae9c 100644 --- a/init.sml +++ b/init.sml @@ -168,4 +168,31 @@ fun grandfatherUsers () = in C.app db mkApp "SELECT id, name, rname FROM WebUser WHERE app IS NULL" end + +type node = {id : int, name : string, descr : string, debian : string} + +fun mkNodeRow [id, name, descr, debian] = + {id = C.intFromSql id, name = C.stringFromSql name, descr = C.stringFromSql descr, + debian = C.stringFromSql debian} + | mkNodeRow row = rowError ("node", row) + +fun listNodes () = + C.map (getDb ()) mkNodeRow ($`SELECT id, name, descr, debian + FROM WebNode + ORDER BY name`) + +fun nodeName id = + case C.oneRow (getDb ()) ($`SELECT name + FROM WebNode + WHERE id = ^(C.intToSql id)`) of + [name] => C.stringFromSql name + | row => rowError ("nodeName", row) + +fun nodeDebian id = + case C.oneRow (getDb ()) ($`SELECT debian + FROM WebNode + WHERE id = ^(C.intToSql id)`) of + [debian] => C.stringFromSql debian + | row => rowError ("nodeDebian", row) + end diff --git a/requestH.sig b/requestH.sig new file mode 100644 index 0000000..1ff14f3 --- /dev/null +++ b/requestH.sig @@ -0,0 +1,31 @@ +signature REQUESTH_IN = +sig + val table : string + val adminGroup : string + val subject : string -> string + val body : {node : int, mail : Mail.session, data : string} -> unit + val template : string + val descr : string +end + +signature REQUESTH_OUT = +sig + datatype status = + NEW + | INSTALLED + | REJECTED + + type request = { id : int, usr : int, node : int, data : string, msg : string, status : status, stamp : Init.C.timestamp } + + val statusFromInt : int -> status + + val add : {usr : int, node : int, data : string, msg : string} -> int + val lookup : int -> request + val modify : request -> unit + val delete : int -> unit + val list : unit -> (string * request) list + val listOpen : unit -> (string * request) list + + val notifyNew : int -> bool + val notifyMod : {old : status, new : status, changer : string, req : int} -> bool +end diff --git a/requestH.sml b/requestH.sml new file mode 100644 index 0000000..f6bb4af --- /dev/null +++ b/requestH.sml @@ -0,0 +1,158 @@ +functor RequestH (T : REQUESTH_IN) :> REQUESTH_OUT = +struct + +open Util Sql Init + +val table = T.table +val seq = table ^ "Seq" + +datatype status = + NEW + | INSTALLED + | REJECTED + +type request = { id : int, usr : int, node : int, data : 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 mkRow [id, usr, node, data, msg, status, stamp] = + {id = C.intFromSql id, usr = C.intFromSql usr, node = C.intFromSql node, + data = C.stringFromSql data, + msg = C.stringFromSql msg, status = statusFromSql status, stamp = C.timestampFromSql stamp} + | mkRow r = rowError ("APT request", r) + +fun add {usr, node, data, msg} = + let + val db = getDb () + val id = nextSeq (db, seq) + in + C.dml db ($`INSERT INTO ^table (id, usr, node, data, msg, status, stamp) + VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql node), ^(C.stringToSql data), ^(C.stringToSql msg), + 0, CURRENT_TIMESTAMP)`); + id + end + +fun modify (req : request) = + let + val db = getDb () + in + ignore (C.dml db ($`UPDATE ^table SET + usr = ^(C.intToSql (#usr req)), data = ^(C.stringToSql (#data req)), + node = ^(C.intToSql (#node req)), + msg = ^(C.stringToSql (#msg req)), status = ^(statusToSql (#status req)) + WHERE id = ^(C.intToSql (#id req))`)) + end + +fun delete id = + ignore (C.dml (getDb ()) ($`DELETE FROM ^table WHERE id = ^(C.intToSql id)`)) + +fun lookup id = + case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, node, data, msg, status, stamp + FROM ^table + WHERE id = ^(C.intToSql id)`) of + SOME row => mkRow row + | NONE => raise Fail ($`^table request not found`) + +fun mkRow' (name :: rest) = (C.stringFromSql name, mkRow rest) + | mkRow' r = rowError ("Apt.request'", r) + +fun list () = + C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, node, data, msg, status, stamp + FROM ^table JOIN WebUser ON usr = WebUser.id + ORDER BY stamp DESC`) + +fun listOpen () = + C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, node, data, msg, status, stamp + FROM ^table JOIN WebUser ON usr = WebUser.id + WHERE status = 0 + ORDER BY stamp DESC`) + +fun notify f req = + let + val grp = + case Group.groupNameToId T.adminGroup of + NONE => 0 + | SOME grp => grp + + val req = lookup 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, emailSuffix); + Mail.mwrite (mail, ",")) + end + | doOne r = rowError (table ^ ".doOne", r) + in + Mail.mwrite (mail, "From: Hcoop Portal \nTo: "); + Mail.mwrite (mail, #name user); + Mail.mwrite (mail, emailSuffix); + Mail.mwrite (mail, "\nBcc: "); + C.app (getDb ()) doOne ($`SELECT name + FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql grp))`); + Mail.mwrite (mail, "\nSubject: "); + Mail.mwrite (mail, T.subject (#data req)); + Mail.mwrite (mail, "\n\n"); + + Mail.mwrite (mail, "Machine: "); + Mail.mwrite (mail, Init.nodeName (#node req)); + Mail.mwrite (mail, "\n\n"); + + f (user, mail); + + T.body {node = #node req, mail = mail, data = #data req}; + + Mail.mwrite (mail, "\n"); + Mail.mwrite (mail, #msg req); + + Mail.mwrite (mail, "\n\nOpen requests: "); + Mail.mwrite (mail, urlPrefix); + Mail.mwrite (mail, T.template); + Mail.mwrite (mail, "?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 "); + Mail.mwrite (mail, T.descr); + Mail.mwrite (mail, ":\n\n"))) + +val statusToString = + fn NEW => "New" + | INSTALLED => "Installed" + | REJECTED => "Rejected" + +fun notifyMod {old, new, changer, req} = + notify (fn (_, mail) => + (Mail.mwrite (mail, changer); + Mail.mwrite (mail, " has changed the status of this request from "); + Mail.mwrite (mail, statusToString old); + Mail.mwrite (mail, " to "); + Mail.mwrite (mail, statusToString new); + Mail.mwrite (mail, ".\n\n"))) req + +end diff --git a/sec.mlt b/sec.mlt index 386da98..2983077 100644 --- a/sec.mlt +++ b/sec.mlt @@ -252,7 +252,7 @@ if showNormal then %>
Machine:
Packages:
Reason:
@@ -262,6 +262,8 @@ if showNormal then %>

Request change to your FTP permissions

+

Please read our wiki instructions on file transfer before requesting FTP access. Almost everyone should use alternative protocols to FTP that provide superior security benefits.

+ @@ -295,6 +297,8 @@ end%>

You can find a description of rule formats on our wiki. Enter here the rule you want, without the initial user portion.

+

Please note that your firewall rule will be useless if you don't first request the corresponding socket privileges at the top of this page.

+ diff --git a/tables.sql b/tables.sql index fc7a8cc..35cfb29 100644 --- a/tables.sql +++ b/tables.sql @@ -204,9 +204,23 @@ CREATE TABLE SupSubscription( FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE, FOREIGN KEY (cat) REFERENCES SupCategory(id) ON DELETE CASCADE); +CREATE TABLE WebNode( + id INTEGER PRIMARY KEY, + name TEXT NOT NULL, + descr TEXT NOT NULL, + debian TEXT NOT NULL); + +INSERT INTO WebNode (id, name, descr, debian) + VALUES (0, 'fyodor', 'old server', 'testing'); +INSERT INTO WebNode (id, name, descr, debian) + VALUES (1, 'deleuze', 'main server', 'stable'); +INSERT INTO WebNode (id, name, descr, debian) + VALUES (2, 'mire', 'member web server', 'stable'); + CREATE TABLE Apt( id INTEGER PRIMARY KEY, usr INTEGER NOT NULL, + node INTEGER NOT NULL, data TEXT NOT NULL, msg TEXT NOT NULL, status INTEGER NOT NULL, -- 2.20.1
Allowed to use cron?
Reason: