Start of modifications for Peer1 migration: hosting bills are apportioned based on...

diff --git a/config.sml b/config.sml
index bb09703..2d5f92a 100644 (file)
--- a/config.sml
+++ b/config.sml
@@ -1,10 +1,10 @@
 structure Config :> CONFIG = struct
 
-val scratchDir = "/home/hcoop"
-val urlPrefix = "https://members.hcoop.net/portal/"
+val scratchDir = "/afs/hcoop.net/usr/hcoop"
+val urlPrefix = "https://members2.hcoop.net/portal/"
 val emailSuffix = "@hcoop.net"
 val boardEmail = "board" ^ emailSuffix
 
-val dbstring = "dbname='hcoop_hcoop'"
+val dbstring = "dbname='hcoop_hcoop' user='www-data'"
 
 end

diff --git a/mail.sml b/mail.sml
index a06f36c..4fa6b22 100644 (file)
--- a/mail.sml
+++ b/mail.sml
@@ -3,7 +3,7 @@ struct
 
 fun writeToLog s =
     let
-       val outf = TextIO.openAppend "/home/hcoop/mail.log"
+       val outf = TextIO.openAppend (Init.scratchDir ^ "/log/mail.log")
     in
        TextIO.output (outf, s);
        TextIO.closeOut outf

diff --git a/mlt.conf b/mlt.conf
index f20b644..f27d61d 100644 (file)
--- a/mlt.conf
+++ b/mlt.conf
@@ -6,7 +6,7 @@ after   after
 exn    exn
 
 out    out
-pub    /home/hcoop/public_html/cgi-bin/portal
+pub    /afs/hcoop.net/usr/hcoop/home/public_html/cgi-bin/portal
 
 cm     $/smlnj-lib.cm
 cm     /usr/local/share/smlsql/smlsql.cm

diff --git a/money.sml b/money.sml
index 4689491..6aae9c4 100644 (file)
--- a/money.sml
+++ b/money.sml
@@ -213,21 +213,35 @@ fun addHostingCharges {trn, cutoff, cost, usage} =
 
        val (umap, amount) = walkNvs (nvs, SM.empty, #amount tran)
 
-       val payers = Group.groupMembers paying
-       val even = amount / real (length payers)
+       val db = getDb ()
+
+       val shares =
+           case C.oneRow db ($`SELECT SUM(shares)
+                                 FROM WebUser JOIN Membership ON usr = WebUser.id AND grp = ^(C.intToSql paying)`) of
+               [n] => C.intFromSql n
+             | row => Init.rowError ("Bad addHostingCharges share count result", row)
 
-       fun doUser (usr : Init.user, umap)  =
+       val even = amount / real shares
+
+       fun doUser ([uid, uname, shares], umap)  =
            let
+               val uid = C.intFromSql uid
+               val uname = C.stringFromSql uname
+               val shares = C.intFromSql shares
+
                val (charge, umap) =
-                   case SM.find (umap, #name usr) of
-                       NONE => (even, umap)
-                     | SOME extra => (even - extra, #1 (SM.remove (umap, #name usr)))
+                   case SM.find (umap, uname) of
+                       NONE => (even * real shares, umap)
+                     | SOME extra => (even * real shares - extra, #1 (SM.remove (umap, uname)))
            in
-               addCharge {trn = trn, usr = #id usr, amount = charge};
+               addCharge {trn = trn, usr = uid, amount = charge};
                umap
            end
 
-       val _ = if SM.numItems (foldl doUser umap payers) = 0 then
+       val _ = if SM.numItems (C.fold db doUser umap
+                                      ($`SELECT id, name, shares
+                                           FROM WebUser JOIN Membership ON usr = WebUser.id AND grp = ^(C.intToSql paying)`))
+                  = 0 then
                    applyCharges trn
                else
                    raise Fail "Usage description contains an unknown username"