More fun for the new server\!

diff --git a/init.sig b/init.sig
index 9af4bc6..40db908 100644 (file)
--- a/init.sig
+++ b/init.sig
@@ -1,6 +1,7 @@
 signature INIT = sig
     structure C : SQL_CLIENT
 
+    val scratchDir : string
     val urlPrefix : string
     val boardEmail : string
 

diff --git a/init.sml b/init.sml
index 0010c74..81f5b10 100644 (file)
--- a/init.sml
+++ b/init.sml
@@ -7,6 +7,7 @@ structure C = PgClient
 exception Access of string
 exception NeedTos
 
+val scratchDir = "/home/hcoop"
 val urlPrefix = "https://members.hcoop.net/portal/"
 val emailSuffix = "@new.hcoop.net"
 val boardEmail = "board" ^ emailSuffix

diff --git a/list.mlt b/list.mlt
index fc59214..d1f0d09 100644 (file)
--- a/list.mlt
+++ b/list.mlt
@@ -31,7 +31,7 @@ elseif $"cmd" = "open" then
        <br>
        <a href="list?mod=<% #id req %>">[Modify]</a>
        <a href="list?del=<% #id req %>">[Delete]</a><br>
-       To set up, run: <tt>newlist <% #data req %>&nbsp;<% name %>@hcoop.net <% Util.randomPassword () %></tt>
+       To set up, run: <tt>newlist <% #data req %>&nbsp;<% name %><% Init.emailSuffix %> <% Util.randomPassword () %></tt>
 <% end %>
 
 <%     end

diff --git a/money.mlt b/money.mlt
index 2b1acfe..02e7233 100644 (file)
--- a/money.mlt
+++ b/money.mlt
@@ -94,7 +94,10 @@ end %></td> </tr>
 <tr> <td align="right"><b>Amount</b>:</td> <td><input name="amount" value="<% Util.neg (#amount trn) %>"></td> </tr>
 <tr> <td align="right"><b>Free bandwidth cutoff (MB)</b>:</td> <td><input name="cutoff" value="200"></td> </tr>
 <tr> <td align="right"><b>Cost/GB</b>:</td> <td><input name="cost" value="4"></td> </tr>
-<tr> <td align="right" valign="top"><b>Member usage</b>:</td> <td><textarea wrap="soft" name="usage" rows="24" cols="80"></textarea></td> </tr>
+<tr> <td align="right" valign="top"><b>Member usage</b>:</td> <td><textarea wrap="soft" name="usage" rows="24" cols="80"><%
+switch Money.lookupHostingUsage id of
+         SOME s => s
+end %></textarea></td> </tr>
 <tr> <td><input type="submit" value="Save"></td> </tr>
 </table>
 

diff --git a/money.sig b/money.sig
index 185ec4c..81414a9 100644 (file)
--- a/money.sig
+++ b/money.sig
@@ -14,6 +14,8 @@ sig
     val listUsers : int -> (bool * Init.user) list
     (* List users and indicate whether they participated in a transaction *)
 
+    val lookupHostingUsage : int -> string option
+
     type charge = {trn : int, usr : int, amount : real}
 
     val addCharge : charge -> unit
@@ -29,4 +31,4 @@ sig
     val addHostingCharges : hosting -> unit
 
     val equalizeBalances : unit -> unit
-end
\ No newline at end of file
+end

diff --git a/money.sml b/money.sml
index 6372fd5..be65cb0 100644 (file)
--- a/money.sml
+++ b/money.sml
@@ -226,14 +226,32 @@ fun addHostingCharges {trn, cutoff, cost, usage} =
                addCharge {trn = trn, usr = #id usr, amount = charge};
                umap
            end
+
+       val _ = if SM.numItems (foldl doUser umap payers) = 0 then
+                   applyCharges trn
+               else
+                   raise Fail "Usage description contains an unknown username"
+
+       val usageFile = TextIO.openOut (Init.scratchDir ^ "/usage/" ^ Int.toString trn)
     in
-       if SM.numItems (foldl doUser umap payers) = 0 then
-           applyCharges trn
-       else
-           raise Fail "Usage description contains an unknown username"
+       TextIO.output (usageFile, usage);
+       TextIO.closeOut usageFile
     end
 
 fun equalizeBalances () =
     ignore (C.dml (getDb ()) ($`UPDATE Balance SET amount = (SELECT SUM(amount) FROM Charge JOIN WebUser ON usr = WebUser.id WHERE bal = Balance.id)`))
 
-end
\ No newline at end of file
+fun lookupHostingUsage trn =
+    let
+       val usageFile = TextIO.openIn (Init.scratchDir ^ "/usage/" ^ Int.toString trn)
+
+       fun loop acc =
+           case TextIO.inputLine usageFile of
+               NONE => String.concat (List.rev acc)
+             | SOME line => loop (line :: acc)
+    in
+       SOME (loop [])
+       before TextIO.closeIn usageFile
+    end handle _ => NONE
+
+end

diff --git a/stats.sml b/stats.sml
index 620b71e..db719b3 100644 (file)
--- a/stats.sml
+++ b/stats.sml
@@ -99,7 +99,19 @@ struct
                        NONE => done ()
                      | SOME s =>
                        case String.tokens Char.isSpace s of
-                           [uname, dash, blocks, bsoft, bhard, files, fsoft, fhard] =>
+                           [uname, "--", blocks, bsoft, bhard, files, fsoft, fhard] =>
+                           readData ({uname = uname,
+                                      blocks = valOf (Int.fromString blocks),
+                                      files = valOf (Int.fromString files)} :: acc)
+                         | [uname, "+-", blocks, bsoft, bhard, _, files, fsoft, fhard] =>
+                           readData ({uname = uname,
+                                      blocks = valOf (Int.fromString blocks),
+                                      files = valOf (Int.fromString files)} :: acc)
+                         | [uname, "-+", blocks, bsoft, bhard, files, fsoft, fhard, _] =>
+                           readData ({uname = uname,
+                                      blocks = valOf (Int.fromString blocks),
+                                      files = valOf (Int.fromString files)} :: acc)
+                         | [uname, "++", blocks, bsoft, bhard, _, files, fsoft, fhard, _] =>
                            readData ({uname = uname,
                                       blocks = valOf (Int.fromString blocks),
                                       files = valOf (Int.fromString files)} :: acc)

diff --git a/support.sml b/support.sml
index c629b4d..48a818d 100644 (file)
--- a/support.sml
+++ b/support.sml
@@ -273,6 +273,7 @@ fun writeRecipients (mail, iss : issue, cat : category, noName) =
                    ()
                else
                    (Mail.mwrite (mail, name);
+                    Mail.mwrite (mail, emailSuffix);
                     Mail.mwrite (mail, ","))
            end
     in

diff --git a/user.mlt b/user.mlt
index 013cb73..94b3ce9 100644 (file)
--- a/user.mlt
+++ b/user.mlt
@@ -6,7 +6,7 @@ val user = Init.lookupUser id;
 <table>
 <tr> <td align="right"><b>Member</b>:</td> <td><% #name user %></td> </tr>
 <tr> <td align="right"><b>Real name</b>:</td> <td><% Web.html (#rname user) %></td> </tr>
-<tr> <td align="right"><b>Hcoop e-mail</b>:</td> <td><a href="mailto:<% #name user %>@hcoop.net"><tt><% #name user %>@hcoop.net</tt></a></td> </tr>
+<tr> <td align="right"><b>Hcoop e-mail</b>:</td> <td><a href="mailto:<% #name user %><% Init.emailSuffix %>"><tt><% #name user %><% Init.emailSuffix %></tt></a></td> </tr>
 <tr> <td align="right"><b>Joined</b>:</td> <td><% #joined user %></td> </tr>
 <tr> <td align="right"><b>Locations</b>:</td> <td><%
        ref first = true;

diff --git a/users.mlt b/users.mlt
index 23ebfa4..1a60143 100644 (file)
--- a/users.mlt
+++ b/users.mlt
@@ -28,7 +28,7 @@ if $"cmd" = "Create" then
                        end;
 
                        if $"subscribe" = "on" then
-                               if not (Pref.subscribe ("hcoop-announce", $"name" ^ "@hcoop.net")) then
+                               if not (Pref.subscribe ("hcoop-announce", $"name" ^ Init.emailSuffix)) then
                                        %><h3><b>Error subscribing to hcoop-announce</b></h3><%
                                end
                        end %>