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;
%><b>Error</b>: Unknown package "<% Web.html pkg %>."<br><%
end
end;
- if ok then %>
+ if ok then
+ val debian = Init.nodeDebian node %>
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>
+ <tr> <td align="right"><a href="http://packages.debian.org/<% debian %>/<% #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>
+ <a href="apt?node=<% node %>&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 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;
%><b>Error</b>: Unknown package "<% Web.html pkg %>."<br><%
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
%><h3>Error sending e-mail notification</h3><%
end
<table class="blanks">
<tr> <td>By:</td> <td colspan="2"><a href="user?id=<% #usr req %>"><% name %></a></td> </tr>
<tr> <td>Time:</td> <td colspan="2"><% #stamp req %></td> </tr>
+<tr> <td>Node:</td> <td colspan="2"><% Web.html (Init.nodeName (#node req)) %></td> </tr>
<tr> <td>Packages:</td><%
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
else
%></tr><tr> <td></td><%
end;
- switch AptQuery.query pkg of
+ switch AptQuery.query {node = #node req, pkg = 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 align="right"><a href="http://packages.debian.org/<% debian %>/<% #section info %>/<% #name info %>"><% #name info %></a></td>
<td><% Web.html (#descr info) %></td><%
end
end %>
<table class="blanks">
<tr> <td>By:</td> <td colspan="2"><a href="user?id=<% #usr req %>"><% name %></a></td> </tr>
<tr> <td>Time:</td> <td colspan="2"><% #stamp req %></td> </tr>
+<tr> <td>Node:</td> <td colspan="2"><% Web.html (Init.nodeName (#node req)) %></td> </tr>
<tr> <td>Packages:</td><%
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
else
%></tr><tr> <td></td><%
end;
- switch AptQuery.query pkg of
+ switch AptQuery.query {node = #node req, pkg = 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 align="right"><a href="http://packages.debian.org/<% debian %>/<% #section info %>/<% #name info %>"><% #name info %></a></td>
<td><% Web.html (#descr info) %></td><%
end
end %>
<table class="blanks">
<tr> <td>Requestor:</td> <td><a href="user?id=<% #usr req %>"><% #name user %></a></td> </tr>
<tr> <td>Time:</td> <td><% #stamp req %></td> </tr>
+<tr> <td>Node:</td> <td><select name="node">
+<% foreach node in Init.listNodes () do %>
+ <option value="<% #id node %>"<% if #id node = #node req then %> selected<% end %>><% Web.html (#name node) %> (<% Web.html (#descr node) %>; Debian <% Web.html (#debian node) %>)</option>
+<% end %>
+</select>
<tr> <td>Status:</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>
<% elseif $"save" <> "" then
Group.requireGroupName "server";
val id = Web.stoi ($"save");
+ val node = Web.stoi ($"node");
val req = Apt.lookup id;
val oldStatus = #status req;
val newStatus = Apt.statusFromInt (Web.stoi ($"status"));
- Apt.modify {req with data = $"pkgs", msg = $"msg", status = newStatus};
+ Apt.modify {req with node = node, data = $"pkgs", msg = $"msg", status = newStatus};
if oldStatus <> newStatus then
- if not (Apt.notifyMod (oldStatus, newStatus, Init.getUserName(), id)) then
+ if not (Apt.notifyMod {old = oldStatus, new = newStatus, changer = Init.getUserName(), req = id}) then
%><h3>Error sending e-mail notification</h3><%
end
end
<form action="apt" method="post">
<table class="blanks">
+<tr> <td>Machine:</td> <td><select name="node">
+<% foreach node in Init.listNodes () do %>
+ <option value="<% #id node %>"><% Web.html (#name node) %> (<% Web.html (#descr node) %>; Debian <% Web.html (#debian node) %>)</option>
+<% end %>
+</select></td></tr>
<tr> <td>Packages:</td> <td><textarea name="new" rows="10" cols="40" wrap="soft"></textarea></td> </tr>
<tr> <td>Reason:</td> <td><textarea name="msg" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
<tr> <td><input type="submit" value="Request"></td> </tr>
-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)
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
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
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
<b>System error</b>: <% Web.html name %>
<% | OS.SysErr (name, SOME syserr) => %>
<b>System error</b>: <% Web.html name %>: <% Web.html (OS.errorName syserr) %>: <% Web.htmlNl (OS.errorMsg syserr) %>
+<% | IO.Io {name, function, ...} => %>
+<b>IO error</b>: <% Web.html name %> for <% Web.html function %>
<% | Init.C.Sql msg => %>
<b>SQL</b>: <% Web.htmlNl msg %>
<% | Init.Access msg => %>
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
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
--- /dev/null
+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
--- /dev/null
+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 <portal");
+ Mail.mwrite (mail, emailSuffix);
+ Mail.mwrite (mail, ">\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
<input type="hidden" name="cmd" value="cron">
<table class="blanks">
<tr> <td>Allowed to use cron?</td> <td><select name="cron">
- option value="no"<% if not cron then %> selected<% end %>>No</option>
+ <option value="no"<% if not cron then %> selected<% end %>>No</option>
<option value="yes"<% if cron then %> selected<% end %>>Yes</option>
</select></td> </tr>
<tr> <td>Reason:</td> <td><textarea name="msg" wrap="soft" rows="3" cols="80"></textarea></td> </tr>
<h3>Request change to your FTP permissions</h3>
+<p>Please read <a href="http://wiki.hcoop.net/wiki/FileTransfer">our wiki instructions on file transfer</a> before requesting FTP access. Almost everyone should use alternative protocols to FTP that provide superior security benefits.</p>
+
<form action="sec" method="post">
<input type="hidden" name="uname" value="<% uname %>">
<input type="hidden" name="cmd" value="ftp">
<p>You can find a description of rule formats <a href="http://wiki.hcoop.net/wiki/FirewallRules">on our wiki</a>. Enter here the rule you want, without the initial <tt>user</tt> portion.</p>
+<p>Please note that <b>your firewall rule will be useless</b> if you don't first request the corresponding socket privileges at the top of this page.</p>
+
<form action="sec" method="post">
<input type="hidden" name="uname" value="<% uname %>">
<input type="hidden" name="cmd" value="rule">
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,
HCoop / hcoop / zz_old / portal.git / commitdiff