From 6704531cef294b64abf3ccef2817dc83be93af23 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Dec 2007 17:06:55 +0000 Subject: [PATCH] Quota requests --- quota.mlt | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++++ quota.sml | 12 ++++ quotas.sig | 10 ++++ quotas.sml | 81 ++++++++++++++++++++++++++ tables.sql | 15 ++++- 5 files changed, 279 insertions(+), 2 deletions(-) create mode 100644 quota.mlt create mode 100644 quota.sml create mode 100644 quotas.sig create mode 100644 quotas.sml diff --git a/quota.mlt b/quota.mlt new file mode 100644 index 0000000..a10311c --- /dev/null +++ b/quota.mlt @@ -0,0 +1,163 @@ +<% @header [("title", ["Disk quota change requests"])]; + +val admin = Group.inGroupName "server"; + +if $"new" <> "" then + ref url = "?cmd=request&msg=" ^ Web.urlEncode ($"msg"); + ref changed = false; + val uname = Init.getUserName (); + + %>Are you sure you want to request these quota changes? + <% + if changed then %> + Yes, I'm sure! + <% else %> + Hm, no changes! + <% end +elseif $"cmd" = "request" then + ref cmds = ""; + val uname = Init.getUserName (); + + foreach vol in Quotas.getQuotas uname do + val requested = Web.stoi ($(#vol vol)); + if requested <> #quota vol then + cmds := cmds ^ "fs sq " ^ Quotas.path (#vol vol) ^ " " ^ Int.toString requested + ^ "\n# Current quota: " ^ Int.toString (#quota vol) ^ "\n" + end + end; + + val id = Quota.add (Init.getUserId (), cmds, $"msg"); + if not (Quota.notifyNew id) then + %>

Error sending e-mail notification

<% + end + %>

Request added

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

Open requests

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

+ + + + + +
By: <% name %>
Time: <% #stamp req %>
Request: <% Web.htmlNl (#data req) %>
Reason: <% Web.html (#msg req) %>
+ +<% if admin then %> +
+ [Modify] + [Delete]
+<% end %> + +<% end + +elseif $"cmd" = "list" then + %>

All requests

<% + + foreach (name, req) in Quota.list () do %> +

+ + + + + +
By: <% name %>
Time: <% #stamp req %>
Request: <% Web.htmlNl (#data req) %>
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 = Quota.lookup id; + val user = Init.lookupUser (#usr req) %> +

Handle request

+ +
+ + + + + + + + +
Requestor: <% #name user %>
Time: <% #stamp req %>
Status:
Request:
Message:
+
+ +<% elseif $"save" <> "" then + Group.requireGroupName "server"; + val id = Web.stoi ($"save"); + val req = Quota.lookup id; + val oldStatus = #status req; + val newStatus = Quota.statusFromInt (Web.stoi ($"status")); + Quota.modify {req with data = $"req", msg = $"msg", status = newStatus}; + if oldStatus <> newStatus then + if not (Quota.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 = Quota.lookup id; + val user = Init.lookupUser (#usr req) + %>

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

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

Request deleted

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

Request a disk quota change

+ +
+ + + +<% foreach vol in Quotas.getQuotas (Init.getUserName ()) do %> + + +<% end %> +
Volume Used (kB) Quota now (kB) Requested quota (kB)
<% #vol vol %> <% #used vol %> <% #quota vol %>
+ + + + + +
Additional comments:
+
+ +<% end %> + +<% @footer[] %> diff --git a/quota.sml b/quota.sml new file mode 100644 index 0000000..08a84d0 --- /dev/null +++ b/quota.sml @@ -0,0 +1,12 @@ +structure Quota = Request(struct + val table = "Quota" + val adminGroup = "server" + fun subject _ = "Disk quota change request" + val template = "quota" + val descr = "Quota request" + + fun body (mail, data) = + (Mail.mwrite (mail, " Request: "); + Mail.mwrite (mail, data); + Mail.mwrite (mail, "\n")) + end) diff --git a/quotas.sig b/quotas.sig new file mode 100644 index 0000000..018a427 --- /dev/null +++ b/quotas.sig @@ -0,0 +1,10 @@ +signature QUOTAS = sig + + val getQuotas : string -> { vol : string, + used : int, + quota : int } list + + val path : string -> string + +end + diff --git a/quotas.sml b/quotas.sml new file mode 100644 index 0000000..2d38b01 --- /dev/null +++ b/quotas.sml @@ -0,0 +1,81 @@ +structure Quotas :> QUOTAS = +struct + fun getQuotas uname = + let + val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/vos listvol -long deleuze"]) + val inf = Unix.textInstreamOf proc + + fun eatUntilBlankLine () = + case TextIO.inputLine inf of + NONE => () + | SOME "\n" => () + | SOME _ => eatUntilBlankLine () + + val suffix = "." ^ uname + + fun loop acc = + case TextIO.inputLine inf of + NONE => acc + | SOME line => + case String.tokens Char.isSpace line of + [vol, _, _, kbs, _, _] => + if String.isSuffix suffix vol then + let + val _ = TextIO.inputLine inf + val _ = TextIO.inputLine inf + in + case TextIO.inputLine inf of + NONE => loop acc + | SOME line => + let + val quota = + case String.tokens Char.isSpace line of + [_, quota, _] => quota + | _ => raise Fail "Bad quota string" + in + eatUntilBlankLine (); + loop ({vol = vol, + used = valOf (Int.fromString kbs), + quota = valOf (Int.fromString quota)} + :: acc) + end + end + else + (eatUntilBlankLine (); + loop acc) + | _ => acc + + val _ = TextIO.inputLine inf + in + loop [] + before ignore (Unix.reap proc) + end + + fun goofy s = + if size s < 2 then + raise Fail "Username too short" + else + String.concat [String.substring (s, 0, 1), "/", + String.substring (s, 0, 2), "/", + s] + + fun splitVol vol = + let + val (befor, after) = Substring.splitl (fn ch => ch <> #".") (Substring.full vol) + in + (Substring.string befor, + Substring.string (Substring.slice (after, 1, NONE))) + end + + fun path vol = + let + val (kind, uname) = splitVol vol + in + case kind of + "user" => "/afs/hcoop.net/user/" ^ goofy uname + | "db" => "/afs/hcoop.net/.databases/" ^ goofy uname + | "mail" => "/afs/hcoop.net/user/" ^ goofy uname ^ "/Maildir" + | _ => raise Fail ("Don't know how to find mount point for volume " ^ vol) + end + +end diff --git a/tables.sql b/tables.sql index 56a68ed..8ff5251 100644 --- a/tables.sql +++ b/tables.sql @@ -342,7 +342,18 @@ CREATE TABLE Cert( status INTEGER NOT NULL, stamp TIMESTAMP NOT NULL, cstamp TIMESTAMP, - FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE, - FOREIGN KEY (node) REFERENCES WebNode(id) ON DELETE CASCADE); + FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE); CREATE SEQUENCE CertSeq START 1; + +CREATE TABLE Quota( + id INTEGER PRIMARY KEY, + usr INTEGER NOT NULL, + data TEXT NOT NULL, + msg TEXT NOT NULL, + status INTEGER NOT NULL, + stamp TIMESTAMP NOT NULL, + cstamp TIMESTAMP, + FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE); + +CREATE SEQUENCE QuotaSeq START 1; -- 2.20.1