From b675b4c57cc9ac04c5e2e149297ccff3ef4c6ae5 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Wed, 21 Feb 2007 01:53:31 +0000
Subject: [PATCH] Start of modifications for Peer1 migration: hosting bills are
 apportioned based on pledges

---
 config.sml |  6 +++---
 mail.sml   |  2 +-
 mlt.conf   |  2 +-
 money.sml  | 30 ++++++++++++++++++++++--------
 4 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/config.sml b/config.sml
index bb09703..2d5f92a 100644
--- 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
--- 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
--- 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
--- 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"
-- 
2.20.1