From: adamch Date: Sun, 24 Apr 2005 23:20:04 +0000 (+0000) Subject: Refactor APT code to be re-usable for domain requests & other similar things; impleme... X-Git-Url: http://git.hcoop.net/hcoop/zz_old/portal.git/commitdiff_plain/ff2b7604ffdbdae8ddd86c2a4366830ae9d32084 Refactor APT code to be re-usable for domain requests & other similar things; implement domain requests --- diff --git a/TODO b/TODO index 862fc14..f7e0653 100644 --- a/TODO +++ b/TODO @@ -3,4 +3,4 @@ Member data Specific requests - Join, with display of pending applications for all members to read - - New domain requests + - Mailing list requests diff --git a/apt.mlt b/apt.mlt index 515e97a..519040b 100644 --- a/apt.mlt +++ b/apt.mlt @@ -56,7 +56,7 @@ elseif $"req" <> "" then end; if ok then - val id = Apt.addRequest (Init.getUserId(), $"req", $"msg"); + val id = Apt.add (Init.getUserId(), $"req", $"msg"); if not (Apt.notifyNew id) then %>

Error sending e-mail notification

<% end @@ -67,7 +67,7 @@ elseif $"cmd" = "open" then %>

Open requests

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

@@ -75,7 +75,7 @@ elseif $"cmd" = "open" then <% ref first = true; - val pkgs = String.tokens Char.isSpace (#pkgs req); + val pkgs = String.tokens Char.isSpace (#data req); foreach pkg in pkgs do if first then @@ -107,7 +107,7 @@ elseif $"cmd" = "open" then elseif $"cmd" = "list" then %>

All requests

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

By: <% name %>
Packages:
@@ -115,7 +115,7 @@ elseif $"cmd" = "list" then <% ref first = true; - val pkgs = String.tokens Char.isSpace (#pkgs req); + val pkgs = String.tokens Char.isSpace (#data req); foreach pkg in pkgs do if first then @@ -146,7 +146,7 @@ elseif $"cmd" = "list" then elseif $"mod" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"mod"); - val req = Apt.lookupRequest id; + val req = Apt.lookup id; val user = Init.lookupUser (#usr req) %>

Handle request

@@ -160,7 +160,7 @@ elseif $"mod" <> "" then - +
By: <% name %>
Packages:
Packages:
Packages:
Message:
@@ -169,10 +169,10 @@ elseif $"mod" <> "" then <% elseif $"save" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"save"); - val req = Apt.lookupRequest id; + val req = Apt.lookup id; val oldStatus = #status req; val newStatus = Apt.statusFromInt (Web.stoi ($"status")); - Apt.modRequest {req with pkgs = $"pkgs", msg = $"msg", status = newStatus}; + Apt.modify {req with data = $"pkgs", msg = $"msg", status = newStatus}; if oldStatus <> newStatus then if not (Apt.notifyMod (oldStatus, newStatus, Init.getUserName(), id)) then %>

Error sending e-mail notification

<% @@ -184,15 +184,15 @@ elseif $"mod" <> "" then <% elseif $"del" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"del"); - val req = Apt.lookupRequest id; + val req = Apt.lookup id; val user = Init.lookupUser (#usr req) - %>

Are you sure you want to delete request by <% #name user %> for <% #pkgs 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"); - Apt.deleteRequest id + Apt.delete id %>

Request deleted

Back to: open requests, all requests diff --git a/apt.sig b/apt.sig deleted file mode 100644 index 2a965d0..0000000 --- a/apt.sig +++ /dev/null @@ -1,21 +0,0 @@ -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 dissimilarity index 99% index e5c8f80..fcea967 100644 --- a/apt.sml +++ b/apt.sml @@ -1,161 +1,32 @@ -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 +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) diff --git a/domain.mlt b/domain.mlt new file mode 100644 index 0000000..b47367e --- /dev/null +++ b/domain.mlt @@ -0,0 +1,128 @@ +<% @header [("title", ["Domain set-up requests"])]; + +val admin = Group.inGroupName "server"; + +if $"req" <> "" then + val dom = $"req"; + if Util.validDomain dom then + val id = Domain.add (Init.getUserId(), dom, $"msg"); + if not (Domain.notifyNew id) then + %>

Error sending e-mail notification

<% + end + %>

Request added

<% + else + %>

Invalid domain name

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

Open requests

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

+ + + + + +
By: <% name %>
Time: <% #stamp req %>
Domain: <% #data req %>
Reason: <% Web.html (#msg req) %>
+ +<% if admin then %> +
+ [Modify] + [Delete]
+ To set up, run: domtool.real mkdom <% #data req %> <% name %> +<% end %> + +<% end + +elseif $"cmd" = "list" then + %>

All requests

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

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

Handle request

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

Request deleted

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

Request new domain

+ +Enter the full Internet domain name that you own and would like set up here. We don't do domain registration, so it is your responsibility to register this name with your registrar of choice before submitting it here. + +
+ + + + +
Domain:
Reason:
+
+ +<% end %> + +<% @footer[] %> \ No newline at end of file diff --git a/domain.sml b/domain.sml new file mode 100644 index 0000000..cec1eb6 --- /dev/null +++ b/domain.sml @@ -0,0 +1,11 @@ +structure Domain = Request(struct + val table = "Domain" + val adminGroup = "server" + fun subject dom = "Domain set-up request: " ^ dom + val template = "domain" + val descr = "domain" + fun body (mail, dom) = + (Mail.mwrite (mail, "Domain: "); + Mail.mwrite (mail, dom); + Mail.mwrite (mail, "\n")) + end) diff --git a/request.sig b/request.sig new file mode 100644 index 0000000..9d9a272 --- /dev/null +++ b/request.sig @@ -0,0 +1,31 @@ +signature REQUEST_IN = +sig + val table : string + val adminGroup : string + val subject : string -> string + val body : Mail.session * string -> unit + val template : string + val descr : string +end + +signature REQUEST_OUT = +sig + datatype status = + NEW + | INSTALLED + | REJECTED + + type request = { id : int, usr : int, data : string, msg : string, status : status, stamp : Init.C.timestamp } + + val statusFromInt : int -> status + + val add : int * string * 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 : status * status * string * int -> bool +end \ No newline at end of file diff --git a/apt.sml b/request.sml similarity index 51% copy from apt.sml copy to request.sml index e5c8f80..08b7853 100644 --- a/apt.sml +++ b/request.sml @@ -1,14 +1,17 @@ -structure Apt :> APT = +functor Request (T : REQUEST_IN) :> REQUEST_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, pkgs : string, msg : string, status : status, stamp : C.timestamp } +type request = { id : int, usr : int, data : string, msg : string, status : status, stamp : C.timestamp } val statusFromInt = fn 0 => NEW @@ -24,64 +27,64 @@ val statusToInt = 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, +fun mkRow [id, usr, data, msg, status, stamp] = + {id = C.intFromSql id, usr = C.intFromSql usr, data = C.stringFromSql data, msg = C.stringFromSql msg, status = statusFromSql status, stamp = C.timestampFromSql stamp} - | mkRequestRow r = rowError ("APT request", r) + | mkRow r = rowError ("APT request", r) -fun addRequest (usr, pkgs, msg) = +fun add (usr, data, msg) = let val db = getDb () - val id = nextSeq (db, "AptSeq") + val id = nextSeq (db, seq) 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), + C.dml db ($`INSERT INTO ^table (id, usr, data, msg, status, stamp) + VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql data), ^(C.stringToSql msg), 0, CURRENT_TIMESTAMP)`); id end -fun modRequest (req : request) = +fun modify (req : request) = let val db = getDb () in - ignore (C.dml db ($`UPDATE Apt SET - usr = ^(C.intToSql (#usr req)), pkgs = ^(C.stringToSql (#pkgs req)), + ignore (C.dml db ($`UPDATE ^table SET + usr = ^(C.intToSql (#usr req)), data = ^(C.stringToSql (#data 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 delete id = + ignore (C.dml (getDb ()) ($`DELETE FROM ^table WHERE id = ^(C.intToSql id)`)) -fun lookupRequest id = - case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, pkgs, msg, status, stamp - FROM Apt +fun lookup id = + case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, data, msg, status, stamp + FROM ^table WHERE id = ^(C.intToSql id)`) of - SOME row => mkRequestRow row - | NONE => raise Fail "APT request not found" + SOME row => mkRow row + | NONE => raise Fail ($`^table request not found`) -fun mkRequestRow' (name :: rest) = (C.stringFromSql name, mkRequestRow rest) - | mkRequestRow' r = rowError ("Apt.request'", r) +fun mkRow' (name :: rest) = (C.stringFromSql name, mkRow rest) + | mkRow' 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 list () = + C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, data, msg, status, stamp + FROM ^table 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 listOpen () = + C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, 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 "server" of + case Group.groupNameToId T.adminGroup of NONE => 0 | SOME grp => grp - val req = lookupRequest req + val req = lookup req val user = Init.lookupUser (#usr req) val mail = Mail.mopen () @@ -96,23 +99,7 @@ fun notify f req = (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 + | doOne r = rowError (table ^ ".doOne", r) in Mail.mwrite (mail, "From: Hcoop Portal \nTo: "); Mail.mwrite (mail, #name user); @@ -120,29 +107,30 @@ fun notify f req = 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"); + Mail.mwrite (mail, "\nSubject: "); + Mail.mwrite (mail, T.subject (#data req)); + Mail.mwrite (mail, "\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; + T.body (mail, #data req); 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"); + 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 packages:\n\n"))) + Mail.mwrite (mail, " has requested the following "); + Mail.mwrite (mail, T.descr); + Mail.mwrite (mail, " packages:\n\n"))) val statusToString = fn NEW => "New" diff --git a/tables.sql b/tables.sql index 861257a..feaf3db 100644 --- a/tables.sql +++ b/tables.sql @@ -177,10 +177,21 @@ CREATE TABLE SupSubscription( CREATE TABLE Apt( id INTEGER PRIMARY KEY, usr INTEGER NOT NULL, - pkgs TEXT NOT NULL, + data 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; + +CREATE TABLE Domain( + id INTEGER PRIMARY KEY, + usr INTEGER NOT NULL, + data 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 DomainSeq START 1; diff --git a/util.sig b/util.sig index 2c134b8..55b05c3 100644 --- a/util.sig +++ b/util.sig @@ -12,4 +12,8 @@ sig val id : 'a -> 'a val makeSet : ('a -> string) -> 'a list -> string val neg : real -> real + + val validHost : string -> bool + val validDomain : string -> bool + val whoisUrl : string -> string end \ No newline at end of file diff --git a/util.sml b/util.sml index 579482d..44895db 100644 --- a/util.sml +++ b/util.sml @@ -29,4 +29,14 @@ fun makeSet f items = fun neg (r : real) = ~r +fun isIdent ch = Char.isLower ch orelse Char.isDigit ch + +fun validHost s = + size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s) + +fun validDomain s = + size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) + +fun whoisUrl dom = String.concat ["http://reports.internic.net/cgi/whois?whois_nic=", dom, "&type=domain"] + end \ No newline at end of file