From e84aceccd570655fbd36593ca20302456e1b501a Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 18 Sep 2005 02:47:28 +0000 Subject: [PATCH] More fun for the new server\! --- init.sig | 1 + init.sml | 1 + list.mlt | 2 +- money.mlt | 5 ++++- money.sig | 4 +++- money.sml | 28 +++++++++++++++++++++++----- stats.sml | 14 +++++++++++++- support.sml | 1 + user.mlt | 2 +- users.mlt | 2 +- 10 files changed, 49 insertions(+), 11 deletions(-) diff --git a/init.sig b/init.sig index 9af4bc6..40db908 100644 --- 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 --- 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 --- a/list.mlt +++ b/list.mlt @@ -31,7 +31,7 @@ elseif $"cmd" = "open" then
[Modify] [Delete]
- To set up, run: newlist <% #data req %> <% name %>@hcoop.net <% Util.randomPassword () %> + To set up, run: newlist <% #data req %> <% name %><% Init.emailSuffix %> <% Util.randomPassword () %> <% end %> <% end diff --git a/money.mlt b/money.mlt index 2b1acfe..02e7233 100644 --- a/money.mlt +++ b/money.mlt @@ -94,7 +94,10 @@ end %> Amount: Free bandwidth cutoff (MB): Cost/GB: - Member usage: + Member usage: diff --git a/money.sig b/money.sig index 185ec4c..81414a9 100644 --- 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 --- 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 --- 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 --- 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 --- a/user.mlt +++ b/user.mlt @@ -6,7 +6,7 @@ val user = Init.lookupUser id; - +
Member: <% #name user %>
Real name: <% Web.html (#rname user) %>
Hcoop e-mail: <% #name user %>@hcoop.net
Hcoop e-mail: <% #name user %><% Init.emailSuffix %>
Joined: <% #joined user %>
Locations: <% ref first = true; diff --git a/users.mlt b/users.mlt index 23ebfa4..1a60143 100644 --- 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 %>

Error subscribing to hcoop-announce

<% end end %> -- 2.20.1