Commit | Line | Data |
---|---|---|
6b23a78b AC |
1 | structure Apt :> APT = |
2 | struct | |
3 | ||
4 | open Util Sql Init | |
5 | ||
6 | datatype status = | |
7 | NEW | |
8 | | INSTALLED | |
9 | | REJECTED | |
10 | ||
11 | type request = { id : int, usr : int, pkgs : string, msg : string, status : status, stamp : C.timestamp } | |
12 | ||
13 | val statusFromInt = | |
14 | fn 0 => NEW | |
15 | | 1 => INSTALLED | |
16 | | 2 => REJECTED | |
17 | | _ => raise C.Sql "Bad APT request status" | |
18 | ||
19 | val statusToInt = | |
20 | fn NEW => 0 | |
21 | | INSTALLED => 1 | |
22 | | REJECTED => 2 | |
23 | ||
24 | fun statusFromSql v = statusFromInt (C.intFromSql v) | |
25 | fun statusToSql s = C.intToSql (statusToInt s) | |
26 | ||
27 | fun mkRequestRow [id, usr, pkgs, msg, status, stamp] = | |
28 | {id = C.intFromSql id, usr = C.intFromSql usr, pkgs = C.stringFromSql pkgs, | |
29 | msg = C.stringFromSql msg, status = statusFromSql status, stamp = C.timestampFromSql stamp} | |
30 | | mkRequestRow r = rowError ("APT request", r) | |
31 | ||
32 | fun addRequest (usr, pkgs, msg) = | |
33 | let | |
34 | val db = getDb () | |
35 | val id = nextSeq (db, "AptSeq") | |
36 | in | |
37 | C.dml db ($`INSERT INTO Apt (id, usr, pkgs, msg, status, stamp) | |
38 | VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql pkgs), ^(C.stringToSql msg), | |
39 | 0, CURRENT_TIMESTAMP)`); | |
40 | id | |
41 | end | |
42 | ||
43 | fun modRequest (req : request) = | |
44 | let | |
45 | val db = getDb () | |
46 | in | |
47 | ignore (C.dml db ($`UPDATE Apt SET | |
48 | usr = ^(C.intToSql (#usr req)), pkgs = ^(C.stringToSql (#pkgs req)), | |
49 | msg = ^(C.stringToSql (#msg req)), status = ^(statusToSql (#status req)) | |
50 | WHERE id = ^(C.intToSql (#id req))`)) | |
51 | end | |
52 | ||
53 | fun deleteRequest id = | |
54 | ignore (C.dml (getDb ()) ($`DELETE FROM Apt WHERE id = ^(C.intToSql id)`)) | |
55 | ||
56 | fun lookupRequest id = | |
57 | case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, pkgs, msg, status, stamp | |
58 | FROM Apt | |
59 | WHERE id = ^(C.intToSql id)`) of | |
60 | SOME row => mkRequestRow row | |
61 | | NONE => raise Fail "APT request not found" | |
62 | ||
63 | fun mkRequestRow' (name :: rest) = (C.stringFromSql name, mkRequestRow rest) | |
64 | | mkRequestRow' r = rowError ("Apt.request'", r) | |
65 | ||
66 | fun listRequests () = | |
67 | C.map (getDb ()) mkRequestRow' ($`SELECT name, Apt.id, usr, pkgs, msg, status, stamp | |
68 | FROM Apt JOIN WebUser ON usr = WebUser.id | |
69 | ORDER BY stamp DESC`) | |
70 | ||
71 | fun listOpenRequests () = | |
72 | C.map (getDb ()) mkRequestRow' ($`SELECT name, Apt.id, usr, pkgs, msg, status, stamp | |
73 | FROM Apt JOIN WebUser ON usr = WebUser.id | |
74 | WHERE status = 0 | |
75 | ORDER BY stamp DESC`) | |
76 | ||
77 | fun notify f req = | |
78 | let | |
79 | val grp = | |
80 | case Group.groupNameToId "server" of | |
81 | NONE => 0 | |
82 | | SOME grp => grp | |
83 | ||
84 | val req = lookupRequest req | |
85 | val user = Init.lookupUser (#usr req) | |
86 | ||
87 | val mail = Mail.mopen () | |
88 | ||
89 | fun doOne [name] = | |
90 | let | |
91 | val name = C.stringFromSql name | |
92 | in | |
93 | if name = #name user then | |
94 | () | |
95 | else | |
96 | (Mail.mwrite (mail, name); | |
97 | Mail.mwrite (mail, ",")) | |
98 | end | |
99 | | doOne r = rowError ("apt.doOne", r) | |
100 | ||
101 | fun rightJustify (n, s) = | |
102 | let | |
103 | fun pad n = | |
104 | if n <= 0 then | |
105 | () | |
106 | else | |
107 | (Mail.mwrite (mail, " "); | |
108 | pad (n-1)) | |
109 | in | |
110 | pad (n - size s); | |
111 | Mail.mwrite (mail, s) | |
112 | end | |
113 | ||
114 | val pkgs = String.tokens Char.isSpace (#pkgs req) | |
115 | val infos = map (valOf o AptQuery.query) pkgs | |
116 | in | |
117 | Mail.mwrite (mail, "From: Hcoop Portal <portal@hcoop.net>\nTo: "); | |
118 | Mail.mwrite (mail, #name user); | |
119 | Mail.mwrite (mail, "@hcoop.net\n"); | |
120 | Mail.mwrite (mail, "Bcc: "); | |
121 | C.app (getDb ()) doOne ($`SELECT name | |
122 | FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql grp))`); | |
123 | Mail.mwrite (mail, "\nSubject: Apt package installation request\n\n"); | |
124 | ||
125 | f (user, mail); | |
126 | ||
127 | app (fn info => | |
128 | (rightJustify (10, #name info); | |
129 | Mail.mwrite (mail, " "); | |
130 | Mail.mwrite (mail, #descr info); | |
131 | Mail.mwrite (mail, "\n"))) infos; | |
132 | ||
133 | Mail.mwrite (mail, "\n"); | |
134 | Mail.mwrite (mail, #msg req); | |
135 | ||
136 | Mail.mwrite (mail, "\n\nOpen requests: "); | |
137 | Mail.mwrite (mail, urlPrefix); | |
138 | Mail.mwrite (mail, "apt?cmd=open\n"); | |
139 | ||
140 | OS.Process.isSuccess (Mail.mclose mail) | |
141 | end | |
142 | ||
143 | val notifyNew = notify (fn (user, mail) => | |
144 | (Mail.mwrite (mail, #name user); | |
145 | Mail.mwrite (mail, " has requested the following packages:\n\n"))) | |
146 | ||
147 | val statusToString = | |
148 | fn NEW => "New" | |
149 | | INSTALLED => "Installed" | |
150 | | REJECTED => "Rejected" | |
151 | ||
152 | fun notifyMod (oldStatus, newStatus, changer, req) = | |
153 | notify (fn (_, mail) => | |
154 | (Mail.mwrite (mail, changer); | |
155 | Mail.mwrite (mail, " has changed the status of this request from "); | |
156 | Mail.mwrite (mail, statusToString oldStatus); | |
157 | Mail.mwrite (mail, " to "); | |
158 | Mail.mwrite (mail, statusToString newStatus); | |
159 | Mail.mwrite (mail, ".\n\n"))) req | |
160 | ||
161 | end |