signature INIT = sig
structure C : SQL_CLIENT
+ val urlPrefix : string
+
exception Access of string
type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp}
exception Access of string
+val urlPrefix = "http://users.hcoop.net/portal/"
+
fun conn () = C.conn "dbname='hcoop'"
val close = C.close
<table>
<tr> <td align="right"><b>Title</b>:</td> <td><input name="title"></td> </tr>
<tr> <td align="right"><input type="checkbox" name="priv"></td> <td>Only make this issue accessible to the admins for this support category.</td> </tr>
+<tr> <td align="right"><b>Description</b>:</td> <td><textarea name="body" rows="10" cols="80" wrap="soft"></textarea></td> </tr>
<tr> <td><input type="submit" value="Add"></td> </tr>
</table>
</form>
%><h3><b>Invalid title</b></h3><%
else
val id = Support.addIssue (you, catId, title, $"priv" = "on", Support.NEW);
+ val _ = Support.addPost (you, id, $"body");
+ if not (Support.notifyCreation id) then
+ %><h3><b>Error sending e-mail notification</b></h3><%
+ end;
viewingIssue := SOME id
end
<option value="1"<% if #status issue = Support.PENDING then %> selected<% end %>>Pending</option>
<option value="2"<% if #status issue = Support.CLOSED then %> selected<% end %>>Closed</option>
</select></td> </tr>
-<tr> <td><input type="submit" value="Add"></td> </tr>
+<tr> <td><input type="submit" value="Save"></td> </tr>
</table>
</form>
<% end
val id = Web.stoi ($"save");
val issue = Support.lookupIssue id;
val title = $"title";
+ val oldStatus = #status issue;
val status = Web.stoi ($"status");
val newCat = Support.lookupCategory (Web.stoi ($"newCat"));
elseif (iff status < 0 then false else status > 2) then
%><h3><b>Invalid status</b></h3><%
else
+ val status = (case status of
+ 0 => Support.NEW
+ | 1 => Support.PENDING
+ | _ => Support.CLOSED);
+
Support.modIssue {issue with cat = #id newCat, title = title,
priv = ($"priv" = "on"),
- status = (case status of
- 0 => Support.NEW
- | 1 => Support.PENDING
- | _ => Support.CLOSED)};
+ status = status};
+ if status <> oldStatus then
+ if not (Support.notifyStatus (you, oldStatus, status, id)) then
+ %><h3><b>Error sending e-mail notification</b></h3><%
+ end
+ end;
viewingIssue := SOME id
%><h3><b>Issue saved</b></h3<%
end
%><h3><b>Issue "<% Web.html (#title issue) %>" deleted</b></h3><%
end
+elseif $"cmd" = "post" then
+ val id = Web.stoi ($"iss");
+ viewingIssue := SOME id;
+ val issue = Support.lookupIssue id;
+
+ if catId <> #cat issue then
+ %><h3><b>Inconsistent cat field</b></h3><%
+ elseif not (Support.allowedToSee id) then
+ %><h3><b>Authorization failure</b></h3><%
+ else
+ val id = Support.addPost (you, id, $"body");
+ if not (Support.notifyPost id) then
+ %><h3><b>Error sending e-mail notification</b></h3><%
+ end
+ %><h3><b>Posted</b></h3><%
+ end
+
+elseif $"modPost" <> "" then
+ showNormal := false;
+ val id = Web.stoi ($"modPost");
+ val post = Support.lookupPost id;
+ val issue = Support.lookupIssue (#iss post);
+ if catId <> #cat issue then
+ %><h3><b>Inconsistent cat field</b></h3><%
+ elseif not admin then
+ %><h3><b>You aren't authorized to modify that.</b></h3><%
+ else %>
+<h3><b>Modify post</b></h3>
+
+<form action="issue">
+<input type="hidden" name="cat" value="<% catId %>">
+<input type="hidden" name="savePost" value="<% id %>">
+<textarea name="body" rows="10" cols="80" wrap="soft"><% Web.htmlNl (#body post) %></textarea>
+<input type="submit" value="Save">
+</form>
+<% end
+
+elseif $"savePost" <> "" then
+ val id = Web.stoi ($"savePost");
+ val post = Support.lookupPost id;
+ val issue = Support.lookupIssue (#iss post);
+
+ if catId <> #cat issue then
+ %><h3><b>Inconsistent cat field</b></h3><%
+ elseif not admin then
+ %><h3><b>Authorization failure</b></h3><%
+ else
+ Support.modPost {post with body = $"body"};
+ viewingIssue := SOME (#iss post)
+ %><h3><b>Post saved</b></h3<%
+ end
+
+elseif $"delPost" <> "" then
+ showNormal := false;
+ val id = Web.stoi ($"delPost");
+ val post = Support.lookupPost id;
+ val issue = Support.lookupIssue (#iss post);
+
+ if catId <> #cat issue then
+ %><h3><b>Inconsistent cat field</b></h3><%
+ elseif not admin then
+ %><h3><b>Authorization failure</b></h3><%
+ else
+ %><h3><b>Are you sure you want to delete this post?</b></h3>
+ <blockquote><% Web.htmlNl (#body post) %></blockquote>
+ <a href="issue?cat=<% catId %>&delPost2=<% id %>">Yes, delete it!</a><%
+ end
+
+elseif $"delPost2" <> "" then
+ val id = Web.stoi ($"delPost2");
+ val post = Support.lookupPost id;
+ val issue = Support.lookupIssue (#iss post);
+
+ if catId <> #cat issue then
+ %><h3><b>Inconsistent cat field</b></h3><%
+ elseif not admin then
+ %><h3><b>Authorization failure</b></h3><%
+ else
+ Support.deletePost id;
+ viewingIssue := SOME (#iss post)
+ %><h3><b>Post deleted</b></h3><%
+ end
+
elseif $"id" <> "" then
viewingIssue := SOME (Web.stoi ($"id"))
end;
switch viewingIssue of
SOME id =>
val issue = Support.lookupIssue id;
- val canEdit = (iff #usr issue = you then true else admin);
- val canView = (iff #priv issue then canEdit else true);
+ val canEdit = Support.allowedToEdit id;
+ val canView = Support.allowedToSee id;
if catId <> #cat issue then
%><h3><b>Inconsistent cat field</b></h3><%
elseif not canView then
<% if admin then %>
<a href="issue?cat=<% catId %>&mod=<% id %>">Modify this issue</a><br>
<a href="issue?cat=<% catId %>&del=<% id %>">Delete this issue</a><br>
+<% end;
+
+foreach (name, post) in Support.listPosts id do %>
+<br><hr><br>
+<a href="user?id=<% #usr post %>"><% name %></a> at <% #stamp post %>:
+<% if admin then %>
+<a href="issue?cat=<% catId %>&modPost=<% #id post %>">[Modify]</a>
+<a href="issue?cat=<% catId %>&delPost=<% #id post %>">[Delete]</a>
+<% end %>
+
+<p><% Web.htmlNl (#body post) %></p>
+
<% end %>
-<% end
+<br><hr><br>
+
+<h3><b>Post to this thread</b></h3>
+
+<form action="issue">
+<input type="hidden" name="cat" value="<% catId %>">
+<input type="hidden" name="iss" value="<% id %>">
+<input type="hidden" name="cmd" value="post">
+<textarea name="body" rows="10" cols="80"></textarea><br>
+<input type="submit" value="Post">
+</form>
+
+<% end
| NONE =>
if showNormal then %>
--- /dev/null
+signature MAIL =
+sig
+ type session
+ val mopen : unit -> session
+ val mwrite : session * string -> unit
+ val mclose : session -> OS.Process.status
+end
+
\ No newline at end of file
--- /dev/null
+structure Mail :> MAIL =
+struct
+
+type session = (TextIO.instream, TextIO.outstream) Unix.proc
+
+fun mopen () = Unix.execute ("/usr/sbin/exim4", ["-t"])
+
+fun mwrite (ses, s) = TextIO.output (Unix.textOutstreamOf ses, s)
+
+fun mclose ses = Unix.reap ses
+
+end
\ No newline at end of file
val deleteIssue : int -> unit
val lookupPost : int -> post
- val listPosts : int -> post list
+ val listPosts : int -> (string * post) list
val addPost : int * int * string -> int
val modPost : post -> unit
val deletePost : int -> unit
val unsubscribe : subscription -> unit
val validTitle : string -> bool
+ val allowedToSee : int -> bool
+ val allowedToEdit : int -> bool
+
+ val notifyCreation : int -> bool
+ val notifyPost : int -> bool
+ val notifyStatus : int * status * status * int -> bool
end
\ No newline at end of file
FROM SupPost
WHERE id = ^(C.intToSql id)`))
+fun mkPostRow' (name :: rest) = (C.stringFromSql name, mkPostRow rest)
+ | mkPostRow' row = Init.rowError ("post'", row)
+
fun listPosts iss =
- C.map (getDb ()) mkPostRow ($`SELECT id, usr, iss, body, stamp
- FROM SupPost
- WHERE iss = ^(C.intToSql iss)
- ORDER BY stamp`)
+ C.map (getDb ()) mkPostRow' ($`SELECT name, SupPost.id, usr, iss, body, SupPost.stamp
+ FROM SupPost JOIN WebUser ON usr = WebUser.id
+ WHERE iss = ^(C.intToSql iss)
+ ORDER BY stamp`)
fun addPost (usr, iss, body) =
let
ignore (C.dml (getDb ()) ($`DELETE FROM SupSubscription
WHERE usr = ^(C.intToSql usr) AND cat = ^(C.intToSql cat)`))
+val okChars = [#" ", #"-", #".", #"!", #"?", #":", #";", #"'", #"\""]
+
fun validTitle s = CharVector.exists (fn ch => not (Char.isSpace ch)) s
+ andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse List.exists (fn ch' => ch = ch') okChars) s
+
+fun allowedToSee iss =
+ let
+ val iss = lookupIssue iss
+ val cat = lookupCategory (#cat iss)
+ in
+ not (#priv iss) orelse Group.inGroupNum (#grp cat) orelse (Init.getUserId () = #usr iss)
+ end
+
+fun allowedToEdit iss =
+ let
+ val iss = lookupIssue iss
+ val cat = lookupCategory (#cat iss)
+ in
+ Group.inGroupNum (#grp cat) orelse (Init.getUserId () = #usr iss)
+ end
+
+fun writeRecipients (mail, iss : issue, cat : category) =
+ let
+ val query =
+ if #priv iss then
+ $`SELECT name
+ FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql (#grp cat)))`
+ else
+ $`SELECT name
+ FROM WebUser JOIN SupSubscription ON (usr = id AND cat = ^(C.intToSql (#id cat)))`
+
+ fun doOne [name] = (Mail.mwrite (mail, C.stringFromSql name);
+ Mail.mwrite (mail, ","))
+ in
+ Mail.mwrite (mail, "Bcc: ");
+ C.app (getDb ()) doOne query;
+ Mail.mwrite (mail, "\n")
+ end
+fun notify (prefix, f) iss =
+ let
+ val iss = lookupIssue iss
+ val cat = lookupCategory (#cat iss)
+ val user = Init.lookupUser (#usr iss)
+
+ val mail = Mail.mopen ()
+ in
+ Mail.mwrite (mail, "From: Hcoop Support System <support@hcoop.net>\nTo: ");
+ Mail.mwrite (mail, #name user);
+ Mail.mwrite (mail, "@hcoop.net\n");
+ writeRecipients (mail, iss, cat);
+ Mail.mwrite (mail, "Subject: ");
+ Mail.mwrite (mail, prefix);
+ Mail.mwrite (mail, #title iss);
+ Mail.mwrite (mail, "\n\nURL: ");
+ Mail.mwrite (mail, Init.urlPrefix);
+ Mail.mwrite (mail, "issue?cat=");
+ Mail.mwrite (mail, C.intToSql (#id cat));
+ Mail.mwrite (mail, "&id=");
+ Mail.mwrite (mail, C.intToSql (#id iss));
+ Mail.mwrite (mail, "\n\nSubmitted by: ");
+ Mail.mwrite (mail, #name user);
+ Mail.mwrite (mail, "\n Category: ");
+ Mail.mwrite (mail, #name cat);
+ Mail.mwrite (mail, "\n Issue: ");
+ Mail.mwrite (mail, #title iss);
+ Mail.mwrite (mail, "\n Private: ");
+ Mail.mwrite (mail, if #priv iss then "yes" else "no");
+ Mail.mwrite (mail, "\n\n");
+
+ f (iss, cat, user, mail);
+
+ OS.Process.isSuccess (Mail.mclose mail)
+ end
+
+val notifyCreation = notify ("[New] ",
+ fn (iss, cat, user, mail) =>
+ (case listPosts (#id iss) of
+ [] => ()
+ | [(_, post)] => Mail.mwrite (mail, #body post)
+ | _ => raise Fail "Too many posts for supposedly new support issue"))
+
+fun notifyPost pid =
+ let
+ val post = lookupPost pid
+ val poster = Init.lookupUser (#usr post)
+ in
+ notify ("[Post] ",
+ fn (iss, cat, user, mail) =>
+ (Mail.mwrite (mail, "New post by ");
+ Mail.mwrite (mail, #name poster);
+ Mail.mwrite (mail, ":\n\n");
+ Mail.mwrite (mail, #body post))) (#iss post)
+ end
+
+val statusToString =
+ fn NEW => "New"
+ | PENDING => "Pending"
+ | CLOSED => "Closed"
+
+fun notifyStatus (usr, oldStatus, newStatus, iss) =
+ let
+ val user = Init.lookupUser usr
+ in
+ notify ("[" ^ statusToString newStatus ^ "] ",
+ fn (iss, cat, user, mail) =>
+ (Mail.mwrite (mail, #name user);
+ Mail.mwrite (mail, " changed status from ");
+ Mail.mwrite (mail, statusToString oldStatus);
+ Mail.mwrite (mail, " to ");
+ Mail.mwrite (mail, statusToString newStatus);
+ Mail.mwrite (mail, ".\n"))) iss
+ end
+
end
\ No newline at end of file
HCoop / hcoop / zz_old / portal.git / commitdiff