You can subscribe to this list here.
2007 |
Jan
|
Feb
(23) |
Mar
(4) |
Apr
(60) |
May
(80) |
Jun
(24) |
Jul
(12) |
Aug
(12) |
Sep
(27) |
Oct
(59) |
Nov
(152) |
Dec
(135) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2008 |
Jan
(19) |
Feb
(41) |
Mar
(8) |
Apr
(12) |
May
(14) |
Jun
(8) |
Jul
(23) |
Aug
(3) |
Sep
(1) |
Oct
|
Nov
(2) |
Dec
(1) |
2009 |
Jan
(1) |
Feb
(8) |
Mar
(6) |
Apr
(9) |
May
(2) |
Jun
|
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
|
Nov
(3) |
Dec
|
2010 |
Jan
(2) |
Feb
(4) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(1) |
Nov
|
Dec
|
From: Adam C. <ad...@us...> - 2008-05-10 23:19:40
|
Update of /cvsroot/hcoop/portal/remind In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv29888 Modified Files: remind.sml Log Message: Fix low balance reminder script cut-off bug Index: remind.sml =================================================================== RCS file: /cvsroot/hcoop/portal/remind/remind.sml,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** remind.sml 1 Mar 2008 19:30:52 -0000 1.10 --- remind.sml 10 May 2008 23:19:24 -0000 1.11 *************** *** 12,15 **** --- 12,17 ---- Real.fmt (StringCvt.FIX (SOME 2)) n + val basePerMonth = 5.0 + fun main _ = let *************** *** 27,32 **** val amount = C.realFromSql amount ! val perMonth = 900.0 * real shares / real totalShares ! val deposit = 900.0 / real totalShares * 3.0 val headsUp = deposit + perMonth * 2.0 in --- 29,34 ---- val amount = C.realFromSql amount ! val perMonth = basePerMonth * real shares ! val deposit = perMonth * 3.0 val headsUp = deposit + perMonth * 2.0 in *************** *** 76,82 **** write (printReal (headsUp - amount)); ! write "\n\nYour deposit requirement was calculated by dividing our total monthly expenses\n"; ! write "($900) by the sum of all members' pledge amounts and then multiplying by 3. That\n"; ! write "is, the amount covers a minimal share of three months' expenses.\n\n"; write "To make a payment, visit:\n"; --- 78,82 ---- write (printReal (headsUp - amount)); ! write "\n\nThe deposit requirement was calculated as three months of dues at $5/mo..\n\n"; write "To make a payment, visit:\n"; *************** *** 92,96 **** | doOne _ = raise Fail "Bad SQL row" in ! C.app db doOne "SELECT Balance.name, COUNT(*), SUM(WebUserPaying.shares) AS shrs, Balance.amount FROM WebUserPaying JOIN Balance ON WebUserPaying.bal = Balance.id GROUP BY Balance.name, Balance.amount HAVING amount < 10"; C.close db; OS.Process.success --- 92,96 ---- | doOne _ = raise Fail "Bad SQL row" in ! C.app db doOne ("SELECT Balance.name, COUNT(*), SUM(WebUserPaying.shares) AS shrs, Balance.amount FROM WebUserPaying JOIN Balance ON WebUserPaying.bal = Balance.id GROUP BY Balance.name, Balance.amount HAVING amount < " ^ C.realToSql (basePerMonth * 5.0) ^ " * SUM(WebUserPaying.shares)"); C.close db; OS.Process.success |
From: Adam C. <ad...@us...> - 2008-04-26 16:22:27
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv16051 Modified Files: balance.sml money.mlt money.sig money.sml pledge.mlt Log Message: Finish changes to follow dues policy changes Index: balance.sml =================================================================== RCS file: /cvsroot/hcoop/portal/balance.sml,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** balance.sml 1 Mar 2008 19:30:52 -0000 1.12 --- balance.sml 26 Apr 2008 16:21:59 -0000 1.13 *************** *** 106,110 **** fun isNegative (bal : balance) = #amount bal < 0.0 ! fun depositAmount bal = let val db = getDb () --- 106,111 ---- fun isNegative (bal : balance) = #amount bal < 0.0 ! fun depositAmount _ = 5.0 * 3.0 ! (*fun depositAmount bal = let val db = getDb () *************** *** 115,119 **** in 3.0 * 900.0 / real totalShares ! end end --- 116,120 ---- in 3.0 * 900.0 / real totalShares ! end*) end Index: pledge.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/pledge.mlt,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** pledge.mlt 17 May 2007 18:26:30 -0000 1.3 --- pledge.mlt 26 Apr 2008 16:21:59 -0000 1.4 *************** *** 19,23 **** val user = Init.getUser () %> ! <p>HCoop divides expenses among members based on a "sliding scale"-style scheme. We charge you only for our concrete expenses, not adding any expenses beyond what we pay to service providers and vendors. Whenever a concrete expense needs to be paid for, we divide it among the members based on how much each of you has pledged on this web page. Your pledge is a whole number 1 or higher which you can think of as indicating how many times the amount paid by the lowest-contributing members you are willing to pay. Concretely, every expense is divided by the sum of all members' pledges, and each member is charged an amount equal to the result of that division times his pledge number. This way <i>everyone's</i> monthly costs go down automatically as we gain new members.</p> <h2>Set your pledge number</h2> --- 19,25 ---- val user = Init.getUser () %> ! <p>Base HCoop membership dues are set at $5/mo.. On this page, you can set a <i>pledge amount</i> above one, so that you pay 5<i>N</i> dollars a month, where <i>N</i> is your pledge amount, to help offset costs for members with more stringent budgets. If the members listed below weren't making extra pledges, we would need to increase the base dues amount of $5 to cover our costs.</p> ! ! <!--p>HCoop divides expenses among members based on a "sliding scale"-style scheme. We charge you only for our concrete expenses, not adding any expenses beyond what we pay to service providers and vendors. Whenever a concrete expense needs to be paid for, we divide it among the members based on how much each of you has pledged on this web page. Your pledge is a whole number 1 or higher which you can think of as indicating how many times the amount paid by the lowest-contributing members you are willing to pay. Concretely, every expense is divided by the sum of all members' pledges, and each member is charged an amount equal to the result of that division times his pledge number. This way <i>everyone's</i> monthly costs go down automatically as we gain new members.</p--> <h2>Set your pledge number</h2> *************** *** 29,32 **** --- 31,37 ---- <h2>Calculate your share of an expense</h2> + + <p>This form is mostly of historical interest, since we've switched to a flat dues scheme.</p> + <form method="post"> <input type="hidden" name="cmd" value="calc"> Index: money.sml =================================================================== RCS file: /cvsroot/hcoop/portal/money.sml,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** money.sml 9 Apr 2008 13:45:02 -0000 1.14 --- money.sml 26 Apr 2008 16:21:59 -0000 1.15 *************** *** 277,284 **** val graceMonths = 1 fun delinquentPledgers () = let - val costBase = costBase monthlyCost - fun makeRow [id, name, shares, amount] = {id = C.intFromSql id, name = C.stringFromSql name, shares = C.intFromSql shares, balance = C.realFromSql amount} --- 277,284 ---- val graceMonths = 1 + val baseDues = 5.0 + fun delinquentPledgers () = let fun makeRow [id, name, shares, amount] = {id = C.intFromSql id, name = C.stringFromSql name, shares = C.intFromSql shares, balance = C.realFromSql amount} *************** *** 287,291 **** C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, shares, amount FROM WebUserPaying JOIN Balance ON Balance.id = bal ! WHERE amount < shares * ^(C.realToSql costBase) * ^(C.intToSql graceMonths) AND shares > 1 ORDER BY name`) --- 287,291 ---- C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, shares, amount FROM WebUserPaying JOIN Balance ON Balance.id = bal ! WHERE amount < shares * ^(C.realToSql baseDues) * ^(C.intToSql graceMonths) AND shares > 1 ORDER BY name`) *************** *** 297,301 **** fun freezeworthyPledgers () = let ! val costBase = costBase monthlyCost fun makeRow [id, name, amount] = {id = C.intFromSql id, name = C.stringFromSql name, --- 297,301 ---- fun freezeworthyPledgers () = let ! val baseDues = 5.0 fun makeRow [id, name, amount] = {id = C.intFromSql id, name = C.stringFromSql name, *************** *** 305,310 **** C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, amount FROM WebUserPaying JOIN Balance ON Balance.id = bal ! WHERE amount >= ^(C.realToSql costBase) * ^(C.intToSql graceMonths) ! AND amount < ^(C.realToSql costBase) * ^(C.intToSql (graceMonths + 1)) ORDER BY name`) end --- 305,310 ---- C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, amount FROM WebUserPaying JOIN Balance ON Balance.id = bal ! WHERE amount >= ^(C.realToSql baseDues) * ^(C.intToSql graceMonths) ! AND amount < ^(C.realToSql baseDues) * ^(C.intToSql (graceMonths + 1)) ORDER BY name`) end *************** *** 312,316 **** fun bootworthyPledgers () = let ! val costBase = costBase monthlyCost fun makeRow [id, name, amount] = {id = C.intFromSql id, name = C.stringFromSql name, --- 312,316 ---- fun bootworthyPledgers () = let ! val baseDues = 5.0 fun makeRow [id, name, amount] = {id = C.intFromSql id, name = C.stringFromSql name, *************** *** 320,326 **** C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, amount FROM WebUserPaying JOIN Balance ON Balance.id = bal ! WHERE amount < ^(C.realToSql costBase) * ^(C.intToSql graceMonths) ORDER BY name`) end end --- 320,365 ---- C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, amount FROM WebUserPaying JOIN Balance ON Balance.id = bal ! WHERE amount < ^(C.realToSql baseDues) * ^(C.intToSql graceMonths) ORDER BY name`) end + fun billDues {descr, base, date} = + let + val db = getDb () + val paying = + case Group.groupNameToId "paying" of + NONE => raise Fail "No 'paying' group" + | SOME id => id + + 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) + + val total = real shares * base + + val give = addTransaction (descr, ~total, date) + + fun doUser [uid, shares] = + let + val uid = C.intFromSql uid + val shares = C.intFromSql shares + in + addCharge {trn = give, usr = uid, amount = ~(base * real shares)} + end + | doUser r = Init.rowError ("Bad billDues/doUser row", r) + + val receive = addTransaction (descr, total, date) + + val hcoop = valOf (Init.userNameToId "hcoop") + in + C.app db doUser ($`SELECT id, shares + FROM WebUser JOIN Membership ON usr = WebUser.id AND grp = ^(C.intToSql paying)`); + applyCharges give; + + addCharge {trn = receive, usr = hcoop, amount = total}; + applyCharges receive + end + end Index: money.sig =================================================================== RCS file: /cvsroot/hcoop/portal/money.sig,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** money.sig 9 Apr 2008 13:45:02 -0000 1.7 --- money.sig 26 Apr 2008 16:21:59 -0000 1.8 *************** *** 40,42 **** --- 40,44 ---- val freezeworthyPledgers : unit -> { id : int, name : string, balance : real } list val bootworthyPledgers : unit -> { id : int, name : string, balance : real } list + + val billDues : {descr : string, base : real, date : string} -> unit end Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** money.mlt 19 Apr 2008 20:28:04 -0000 1.28 --- money.mlt 26 Apr 2008 16:21:59 -0000 1.29 *************** *** 340,343 **** --- 340,364 ---- </form> + <% elseif $"cmd" = "dues" then + Group.requireGroupName "money"; + showNormal := false %> + + <h3>Monthly dues</h3> + + <form action="money" method="post"> + <input type="hidden" name="cmd" value="dues2"> + <table class="blanks"> + <tr> <td>Description:</td> <td><input name="descr"></td> </tr> + <tr> <td>Date:</td> <td><input name="d"></td> </tr> + <tr> <td>Amount/pledge:</td> <td><input name="base"></td> </tr> + <tr> <td><input type="submit" value="Add"></td> </tr> + </table> + + <% elseif $"cmd" = "dues2" then + Group.requireGroupName "money"; + Money.billDues {descr = $"descr", base = Web.stor ($"base"), date = $"d"}; + + %><h3>Dues debits added.</h3> + <% elseif $"cmd" = "even" then Group.requireGroupName "money"; *************** *** 601,606 **** <br><b><u>New transaction:</u></b><br> <a href="money?cmd=bill">Bill for the co-op</a><br> - <a href="money?cmd=hosting">New hosting bill (old style)</a><br> <a href="money?cmd=pay">Payment from member</a><br> <a href="money?cmd=evenForm">Generic/even</a><br> <br> --- 622,628 ---- <br><b><u>New transaction:</u></b><br> <a href="money?cmd=bill">Bill for the co-op</a><br> <a href="money?cmd=pay">Payment from member</a><br> + <a href="money?cmd=dues">Monthly dues</a><br> + <a href="money?cmd=hosting">New hosting bill (old style)</a><br> <a href="money?cmd=evenForm">Generic/even</a><br> <br> |
From: Adam C. <ad...@us...> - 2008-04-24 19:28:13
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv28161 Modified Files: portal.mlt stats.sig stats.sml Log Message: Add single-user Apache bandwidth report on front page Index: stats.sig =================================================================== RCS file: /cvsroot/hcoop/portal/stats.sig,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** stats.sig 9 Dec 2007 21:21:02 -0000 1.3 --- stats.sig 24 Apr 2008 19:28:07 -0000 1.4 *************** *** 13,16 **** --- 13,19 ---- * totals. *) + val getWebbwUser : {user : string, last : int} -> {total : int, + vhosts : {host : host, size : int} list} + type disk = {uname : string, (* UNIX username *) kbs : int} (* Number of kilobytes space used *) Index: stats.sml =================================================================== RCS file: /cvsroot/hcoop/portal/stats.sml,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** stats.sml 9 Dec 2007 21:45:20 -0000 1.5 --- stats.sml 24 Apr 2008 19:28:07 -0000 1.6 *************** *** 90,94 **** end ! type disk = {uname : string, kbs : int} --- 90,105 ---- end ! fun getWebbwUser {user, last} = ! let ! val {vhosts, users, ...} = getWebbw last ! in ! case List.find (fn {user = u, ...} => u = user) users of ! NONE => {total = 0, vhosts = []} ! | SOME {hosts, size, ...} => ! {total = size, vhosts = List.filter (fn {host, ...} => List.exists (fn host' => host' = host) hosts) vhosts} ! end ! ! ! type disk = {uname : string, kbs : int} Index: portal.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/portal.mlt,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** portal.mlt 1 Mar 2008 19:30:52 -0000 1.19 --- portal.mlt 24 Apr 2008 19:28:07 -0000 1.20 *************** *** 47,49 **** --- 47,60 ---- end; + val {total, vhosts} = Stats.getWebbwUser {user = Init.getUserName (), last = 0}; + switch vhosts of + _ :: _ => + %><h3>Your web traffic this month</h3> + <table><tr><th>Site</th> <th>Data transferred (kB)</th></tr><% + foreach e in vhosts do %> + <tr><td align="right"><a href="<% if #ssl (#host e) then %>https<% else %>http<% end %>://<% #hostname (#host e) %>/"><% #hostname (#host e) %><% if #ssl (#host e) then %> (SSL)<% end %></a> <a href="/webalizer/<% #id (#host e) %>/">[detail]</a></td><td><% #size e %></td></tr> + <% end %> + </table> + <% end; + @footer [] %> |
From: Adam C. <ad...@us...> - 2008-04-22 19:11:46
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv17405 Modified Files: apps.mlt Log Message: Change definition of board majority Index: apps.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/apps.mlt,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** apps.mlt 22 Feb 2008 00:59:15 -0000 1.16 --- apps.mlt 22 Apr 2008 19:11:36 -0000 1.17 *************** *** 197,201 **** <% if board then %> ! <% if length votes >= 2 then %><a href="apps?approve=<% #id appl %>">Approve this member.</a><br><% end %> <a href="apps?deny=<% #id appl %>">Deny this application.</a> <% end %> --- 197,201 ---- <% if board then %> ! <% if length votes >= 3 then %><a href="apps?approve=<% #id appl %>">Approve this member.</a><br><% end %> <a href="apps?deny=<% #id appl %>">Deny this application.</a> <% end %> |
From: Adam C. <ad...@us...> - 2008-04-12 13:21:23
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv27075 Modified Files: money.mlt Log Message: Fix bug in specifying custom payment descriptions Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** money.mlt 9 Apr 2008 13:45:02 -0000 1.25 --- money.mlt 12 Apr 2008 13:21:18 -0000 1.26 *************** *** 206,210 **** val descr = $"descr"; val descr = iff descr = "" then $"descr2" else descr; ! val id = Money.addTransaction ($"descr", amount, $"d"); Money.addCharge {trn = id, usr = Web.stoi ($"usr"), amount = amount}; Money.applyCharges id; --- 206,210 ---- val descr = $"descr"; val descr = iff descr = "" then $"descr2" else descr; ! val id = Money.addTransaction (descr, amount, $"d"); Money.addCharge {trn = id, usr = Web.stoi ($"usr"), amount = amount}; Money.applyCharges id; |
From: Adam C. <ad...@us...> - 2008-04-09 14:33:53
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv29947/src/plugins Modified Files: domtool-postgres Log Message: Fix postgres DB creation Index: domtool-postgres =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/domtool-postgres,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** domtool-postgres 9 Apr 2008 14:23:57 -0000 1.7 --- domtool-postgres 9 Apr 2008 14:33:42 -0000 1.8 *************** *** 15,19 **** DBNAME="${USERNAME}_${DBNAME_BASE}" ! if [ -n $ENCODING ]; then ENCODING="-E $ENCODING" fi --- 15,19 ---- DBNAME="${USERNAME}_${DBNAME_BASE}" ! if [ -n "$ENCODING" ]; then ENCODING="-E $ENCODING" fi |
From: Adam C. <ad...@us...> - 2008-04-09 14:24:07
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv25596/src/plugins Modified Files: domtool-postgres mysql.sml postgres.sml Log Message: Specifying encoding on database creation Index: mysql.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/mysql.sml,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** mysql.sml 22 Nov 2007 21:38:02 -0000 1.6 --- mysql.sml 9 Apr 2008 14:23:57 -0000 1.7 *************** *** 44,50 **** SOME "Password contains characters besides letters, digits, and !.-_" ! fun createdb {user, dbname} = ! Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) ! (Slave.shellOutput [Config.MySQL.createdb, user, " ", dbname]) fun dropdb {user, dbname} = --- 44,53 ---- SOME "Password contains characters besides letters, digits, and !.-_" ! fun createdb {user, dbname, encoding} = ! case encoding of ! SOME _ => SOME "MySQL doesn't support specifying encodings" ! | NONE => ! Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) ! (Slave.shellOutput [Config.MySQL.createdb, user, " ", dbname]) fun dropdb {user, dbname} = Index: domtool-postgres =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/domtool-postgres,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** domtool-postgres 24 Jun 2007 21:53:37 -0000 1.6 --- domtool-postgres 9 Apr 2008 14:23:57 -0000 1.7 *************** *** 12,18 **** USERNAME=$2 DBNAME_BASE=$3 DBNAME="${USERNAME}_${DBNAME_BASE}" ! sudo -u postgres createdb -O $USERNAME -D user_$USERNAME $DBNAME ;; --- 12,23 ---- USERNAME=$2 DBNAME_BASE=$3 + ENCODING=$4 DBNAME="${USERNAME}_${DBNAME_BASE}" ! if [ -n $ENCODING ]; then ! ENCODING="-E $ENCODING" ! fi ! ! sudo -u postgres createdb -O $USERNAME -D user_$USERNAME $ENCODING $DBNAME ;; Index: postgres.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/postgres.sml,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** postgres.sml 22 Nov 2007 21:45:34 -0000 1.7 --- postgres.sml 9 Apr 2008 14:23:57 -0000 1.8 *************** *** 27,33 **** fun passwd _ = SOME "We don't use PostgreSQL passwords." ! fun createdb {user, dbname} = Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) ! (Slave.shellOutput [Config.Postgres.createdb, user, " ", dbname]) fun dropdb {user, dbname} = --- 27,35 ---- fun passwd _ = SOME "We don't use PostgreSQL passwords." ! fun createdb {user, dbname, encoding} = Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) ! (Slave.shellOutput [Config.Postgres.createdb, ! " ", user, " ", dbname, ! case encoding of NONE => "" | SOME e => " " ^ e]) fun dropdb {user, dbname} = |
From: Adam C. <ad...@us...> - 2008-04-09 14:24:02
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv25596/src Modified Files: dbms.sig dbms.sml main-dbtool.sml main.sig main.sml msg.sml msgTypes.sml Log Message: Specifying encoding on database creation Index: msgTypes.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/msgTypes.sml,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** msgTypes.sml 17 Nov 2007 17:44:11 -0000 1.33 --- msgTypes.sml 9 Apr 2008 14:23:57 -0000 1.34 *************** *** 77,81 **** | MsgCreateDbUser of {dbtype : string, passwd : string option} (* Request creation of a user for the named DBMS type *) ! | MsgCreateDb of {dbtype : string, dbname : string} (* Request creation of a DBMS database *) | MsgDropDb of {dbtype : string, dbname : string} --- 77,81 ---- | MsgCreateDbUser of {dbtype : string, passwd : string option} (* Request creation of a user for the named DBMS type *) ! | MsgCreateDb of {dbtype : string, dbname : string, encoding : string option} (* Request creation of a DBMS database *) | MsgDropDb of {dbtype : string, dbname : string} Index: main.sig =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sig,v retrieving revision 1.47 retrieving revision 1.48 diff -C2 -d -r1.47 -r1.48 *** main.sig 25 Feb 2008 01:40:17 -0000 1.47 --- main.sig 9 Apr 2008 14:23:57 -0000 1.48 *************** *** 59,63 **** val requestDbUser : {dbtype : string, passwd : string option} -> unit val requestDbPasswd : {dbtype : string, passwd : string} -> unit ! val requestDbTable : {dbtype : string, dbname : string} -> unit val requestDbDrop : {dbtype : string, dbname : string} -> unit val requestDbGrant : {dbtype : string, dbname : string} -> unit --- 59,63 ---- val requestDbUser : {dbtype : string, passwd : string option} -> unit val requestDbPasswd : {dbtype : string, passwd : string} -> unit ! val requestDbTable : {dbtype : string, dbname : string, encoding : string option} -> unit val requestDbDrop : {dbtype : string, dbname : string} -> unit val requestDbGrant : {dbtype : string, dbname : string} -> unit Index: dbms.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/dbms.sml,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** dbms.sml 13 Nov 2007 23:52:59 -0000 1.7 --- dbms.sml 9 Apr 2008 14:23:57 -0000 1.8 *************** *** 24,32 **** val validDbname = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") type handler = {getpass : (unit -> Client.passwd_result) option, adduser : {user : string, passwd : string option} -> string option, passwd : {user : string, passwd : string} -> string option, ! createdb : {user : string, dbname : string} -> string option, dropdb : {user : string, dbname : string} -> string option, grant : {user : string, dbname : string} -> string option} --- 24,36 ---- val validDbname = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") + fun validEncoding encoding = + case encoding of + NONE => true + | SOME e => size e > 0 andalso size e < 20 andalso CharVector.all Char.isAlphaNum e type handler = {getpass : (unit -> Client.passwd_result) option, adduser : {user : string, passwd : string option} -> string option, passwd : {user : string, passwd : string} -> string option, ! createdb : {user : string, dbname : string, encoding : string option} -> string option, dropdb : {user : string, dbname : string} -> string option, grant : {user : string, dbname : string} -> string option} Index: main-dbtool.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main-dbtool.sml,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** main-dbtool.sml 23 Dec 2007 22:26:39 -0000 1.7 --- main-dbtool.sml 9 Apr 2008 14:23:57 -0000 1.8 *************** *** 59,65 **** | ["createdb", dbname] => if Dbms.validDbname dbname then ! Main.requestDbTable {dbtype = dbtype, dbname = dbname} else print ("Invalid database name " ^ dbname ^ ".\n") | ["dropdb", dbname] => if Dbms.validDbname dbname then --- 59,72 ---- | ["createdb", dbname] => if Dbms.validDbname dbname then ! Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = NONE} else print ("Invalid database name " ^ dbname ^ ".\n") + | ["createdb", dbname, encoding] => + if not (Dbms.validDbname dbname) then + print ("Invalid database name " ^ dbname ^ ".\n") + else if not (Dbms.validEncoding (SOME encoding)) then + print ("Invalid encoding name " ^ encoding ^ ".\n") + else + Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = SOME encoding} | ["dropdb", dbname] => if Dbms.validDbname dbname then Index: dbms.sig =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/dbms.sig,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** dbms.sig 2 Jul 2007 16:14:44 -0000 1.6 --- dbms.sig 9 Apr 2008 14:23:57 -0000 1.7 *************** *** 22,30 **** val validDbname : string -> bool type handler = {getpass : (unit -> Client.passwd_result) option, adduser : {user : string, passwd : string option} -> string option, passwd : {user : string, passwd : string} -> string option, ! createdb : {user : string, dbname : string} -> string option, dropdb : {user : string, dbname : string} -> string option, grant : {user : string, dbname : string} -> string option} --- 22,31 ---- val validDbname : string -> bool + val validEncoding : string option -> bool type handler = {getpass : (unit -> Client.passwd_result) option, adduser : {user : string, passwd : string option} -> string option, passwd : {user : string, passwd : string} -> string option, ! createdb : {user : string, dbname : string, encoding : string option} -> string option, dropdb : {user : string, dbname : string} -> string option, grant : {user : string, dbname : string} -> string option} Index: main.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v retrieving revision 1.102 retrieving revision 1.103 diff -C2 -d -r1.102 -r1.103 *** main.sml 16 Mar 2008 00:07:02 -0000 1.102 --- main.sml 9 Apr 2008 14:23:57 -0000 1.103 *************** *** 1366,1370 **** (fn () => ()) ! | MsgCreateDb {dbtype, dbname} => doIt (fn () => if Dbms.validDbname dbname then --- 1366,1370 ---- (fn () => ()) ! | MsgCreateDb {dbtype, dbname, encoding} => doIt (fn () => if Dbms.validDbname dbname then *************** *** 1373,1381 **** SOME ("Unknown database type " ^ dbtype)) | SOME handler => ! case #createdb handler {user = user, dbname = dbname} of ! NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".", ! NONE) ! | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, ! SOME ("Error creating database: " ^ msg)) else ("Invalid database name " ^ user ^ "_" ^ dbname, --- 1373,1385 ---- SOME ("Unknown database type " ^ dbtype)) | SOME handler => ! if not (Dbms.validEncoding encoding) then ! ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.", ! SOME "Invalid encoding") ! else ! case #createdb handler {user = user, dbname = dbname, encoding = encoding} of ! NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".", ! NONE) ! | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, ! SOME ("Error creating database: " ^ msg)) else ("Invalid database name " ^ user ^ "_" ^ dbname, Index: msg.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/msg.sml,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** msg.sml 17 Nov 2007 19:12:28 -0000 1.34 --- msg.sml 9 Apr 2008 14:23:57 -0000 1.35 *************** *** 174,180 **** OpenSSL.writeString (bio, dbtype); sendOption OpenSSL.writeString (bio, passwd)) ! | MsgCreateDb {dbtype, dbname} => (OpenSSL.writeInt (bio, 17); ! OpenSSL.writeString (bio, dbtype); ! OpenSSL.writeString (bio, dbname)) | MsgNewMailbox {domain, user, passwd, mailbox} => (OpenSSL.writeInt (bio, 18); --- 174,181 ---- OpenSSL.writeString (bio, dbtype); sendOption OpenSSL.writeString (bio, passwd)) ! | MsgCreateDb {dbtype, dbname, encoding} => (OpenSSL.writeInt (bio, 17); ! OpenSSL.writeString (bio, dbtype); ! OpenSSL.writeString (bio, dbname); ! sendOption OpenSSL.writeString (bio, encoding)) | MsgNewMailbox {domain, user, passwd, mailbox} => (OpenSSL.writeInt (bio, 18); *************** *** 290,296 **** SOME (MsgCreateDbUser {dbtype = dbtype, passwd = passwd}) | _ => NONE) ! | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of ! (SOME dbtype, SOME dbname) => ! SOME (MsgCreateDb {dbtype = dbtype, dbname = dbname}) | _ => NONE) | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio, --- 291,297 ---- SOME (MsgCreateDbUser {dbtype = dbtype, passwd = passwd}) | _ => NONE) ! | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio, recvOption OpenSSL.readString bio) of ! (SOME dbtype, SOME dbname, SOME encoding) => ! SOME (MsgCreateDb {dbtype = dbtype, dbname = dbname, encoding = encoding}) | _ => NONE) | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio, |
From: Adam C. <ad...@us...> - 2008-04-09 13:45:14
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv8920 Modified Files: cert.mlt cert.sml money.mlt money.sig money.sml tables.sql Added Files: chooseDomain.mlt chooseDomain.sig chooseDomain.sml sign.mlt sign.sml Log Message: Reports for figuring out which accounts to freeze or boot; most of new SSL request forms; change name of contact kind for non-HCoop e-mail --- NEW FILE: sign.sml --- structure Sign = Request(struct val table = "Sign" val adminGroup = "server" fun subject _ = "SSL certificate signing request" val template = "sign" val descr = "SSL certificate signing" fun body (mail, data) = (Mail.mwrite (mail, " Request: "); Mail.mwrite (mail, data); Mail.mwrite (mail, "\n")) end) Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** money.mlt 1 Mar 2008 19:30:52 -0000 1.24 --- money.mlt 9 Apr 2008 13:45:02 -0000 1.25 *************** *** 477,481 **** %><h3>Pledges reset.</h3><% ! end %> <% if showNormal then --- 477,501 ---- %><h3>Pledges reset.</h3><% ! elseif $"cmd" = "freezeworthy" then ! showNormal := false; ! val dqs = Money.freezeworthyPledgers () %> ! <table> ! <tr> <th>Member</th> <th>Balance</th> </tr> ! <% foreach dq in dqs do %> ! <tr> <td><a href="user?id=<% #id dq %>"><% #name dq %></a></td> <td>$<% #balance dq %></td> </tr> ! <% end %> ! </table> ! ! <% elseif $"cmd" = "bootworthy" then ! showNormal := false; ! val dqs = Money.bootworthyPledgers () %> ! <table> ! <tr> <th>Member</th> <th>Balance</th> </tr> ! <% foreach dq in dqs do %> ! <tr> <td><a href="user?id=<% #id dq %>"><% #name dq %></a></td> <td>$<% #balance dq %></td> </tr> ! <% end %> ! </table> ! ! <% end %> <% if showNormal then *************** *** 494,497 **** --- 514,519 ---- <a href="money?cmd=bals">List active balances</a><br> <a href="money?cmd=nbals">List negative active balances</a><br> + <a href="money?cmd=freezeworthy">List members who deserve account freezing</a><br> + <a href="money?cmd=bootworthy">List members who deserve to be kicked out</a><br> <a href="money?cmd=deadbals">List retired balances</a><br> Index: tables.sql =================================================================== RCS file: /cvsroot/hcoop/portal/tables.sql,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** tables.sql 24 Feb 2008 17:41:23 -0000 1.31 --- tables.sql 9 Apr 2008 13:45:02 -0000 1.32 *************** *** 348,351 **** --- 348,363 ---- CREATE SEQUENCE CertSeq START 1; + CREATE TABLE Sign( + id INTEGER PRIMARY KEY, + usr INTEGER NOT NULL, + data TEXT NOT NULL, + msg TEXT NOT NULL, + status INTEGER NOT NULL, + stamp TIMESTAMP NOT NULL, + cstamp TIMESTAMP, + FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE); + + CREATE SEQUENCE SignSeq START 1; + CREATE TABLE Quota( id INTEGER PRIMARY KEY, Index: money.sig =================================================================== RCS file: /cvsroot/hcoop/portal/money.sig,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** money.sig 24 Feb 2008 17:11:02 -0000 1.6 --- money.sig 9 Apr 2008 13:45:02 -0000 1.7 *************** *** 37,39 **** --- 37,42 ---- val delinquentPledgers : unit -> { id : int, name : string, shares : int, balance : real } list val resetPledges : int list -> unit + + val freezeworthyPledgers : unit -> { id : int, name : string, balance : real } list + val bootworthyPledgers : unit -> { id : int, name : string, balance : real } list end --- NEW FILE: chooseDomain.mlt --- <select name="domain"> <% foreach dom in ChooseDomain.domains (Init.getUserName ()) do %> <option><% dom %></option> <% end %> </select> --- NEW FILE: sign.mlt --- <% @header [("title", ["SSL certificate signing requests"])]; val admin = Group.inGroupName "server"; if $"new" <> "" then val req = $"req"; val key = $"key"; val days = Web.stoi ($"days"); val domain = $"domain"; val msg = $"msg"; if req = "" then %><h3>Please fill in a path to a certificate request.</h3><% elseif key = "" then %><h3>Please fill in a path to a key.</h3><% elseif days <= 0 then %><h3>Please give a positive number of days for the certificate to live.</h3><% elseif not (ChooseDomain.yourDomain {user = Init.getUserName (), domain = domain}) then %><h3>You don't have permissions on domain <tt><% Web.html domain %></tt>.</h3><% else %>Are you sure you want to ask for permissions on an SSL certificate <li> with request <tt><% Web.html req %></tt>,</li> <li> with key <tt><% Web.html key %></tt>,</li> <li> for domain <tt><% domain %></tt>,</li> <li> lasting <% days %> days?</li> <a href="?cmd=request&req=<% Web.html req %>&key=<% Web.html key %>&days=<% days %>&domain=<% Web.html domain %>&msg=<% Web.urlEncode msg %>">Yes, I want to request that.</a><% end elseif $"cmd" = "request" then val req = $"req"; val key = $"key"; val days = Web.stoi ($"days"); val domain = $"domain"; val msg = $"msg"; if req = "" then %><h3>Please fill in a path to a certificate request.</h3><% elseif key = "" then %><h3>Please fill in a path to a key.</h3><% elseif days <= 0 then %><h3>Please give a positive number of days for the certificate to live.</h3><% elseif not (ChooseDomain.yourDomain {user = Init.getUserName (), domain = domain}) then %><h3>You don't have permissions on domain <tt><% Web.html domain %></tt>.</h3><% else val gen = req; val text = "/afs/hcoop.net/common/etc/scripts/ca-sign " ^ Int.toString days ^ " " ^ req ^ " " ^ key ^ " " ^ gen ^ " " ^ domain; val id = Sign.add (Init.getUserId (), text, msg); if not (Sign.notifyNew id) then %><h3>Error sending e-mail notification</h3><% end %><h3>Request added</h3><% end elseif $"cmd" = "open" then %><h3>Open requests</h3> <a href="?cmd=list">List all requests</a><% foreach (name, req) in Sign.listOpen () do %> <br><hr><br> <table class="blanks"> <tr> <td>By:</td> <td><a href="user?id=<% #usr req %>"><% name %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> <tr> <td>Request:</td> <td><tt><% #data req %></tt></td> </tr> <tr> <td>Reason:</td> <td><% Web.html (#msg req) %></td> </tr> </table> <% if admin then %> <br> <a href="?mod=<% #id req %>">[Modify]</a> <a href="?del=<% #id req %>">[Delete]</a><br> <% end %> <% end elseif $"cmd" = "list" then %><h3>All requests</h3><% foreach (name, req) in Sign.list () do %> <br><hr><br> <table class="blanks"> <tr> <td>By:</td> <td><a href="user?id=<% #usr req %>"><% name %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> <tr> <td>Request:</td> <td><tt><% #data req %></tt></td> </tr> <tr> <td>Reason:</td> <td><% Web.html (#msg req) %></td> </tr> </table> <% if admin then %> <br> <a href="?mod=<% #id req %>">[Modify]</a> <a href="?del=<% #id req %>">[Delete]</a> <% end %> <% end elseif $"mod" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"mod"); val req = Sign.lookup id; val user = Init.lookupUser (#usr req) %> <h3>Handle request</h3> <form method="post"> <input type="hidden" name="save" value="<% id %>"> <table class="blanks"> <tr> <td>Requestor:</td> <td><a href="user?id=<% #usr req %>"><% #name user %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> <tr> <td>Status:</td> <td><select name="status"> <option value="0"<% if #status req = Sign.NEW then %> selected<% end %>>New</option> <option value="1"<% if #status req = Sign.INSTALLED then %> selected<% end %>>Installed</option> <option value="2"<% if #status req = Sign.REJECTED then %> selected<% end %>>Rejected</option> </select></td> </tr> <tr> <td>Request:</td> <td><input name="req" size="60" value="<% Web.html (#data req) %>"></td> </tr> <tr> <td>Message:</td> <td><textarea name="msg" rows="10" cols="80" wrap="soft"><% Web.html (#msg req) %></textarea></td> </tr> <tr> <td><input type="submit" value="Save"></td> </tr> </table> </form> <% elseif $"save" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"save"); val req = Sign.lookup id; val oldStatus = #status req; val newStatus = Sign.statusFromInt (Web.stoi ($"status")); Sign.modify {req with data = $"req", msg = $"msg", status = newStatus}; if oldStatus <> newStatus then if not (Sign.notifyMod (oldStatus, newStatus, Init.getUserName(), id)) then %><h3>Error sending e-mail notification</h3><% end end %><h3>Request modified</h3> Back to: <a href="?cmd=open">open requests</a>, <a href="?cmd=list">all requests</a> <% elseif $"del" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"del"); val req = Sign.lookup id; val user = Init.lookupUser (#usr req) %><h3>Are you sure you want to delete request by <% #name user %> for <tt><% #data req %></tt>?</h3> <a href="?del2=<% id %>">Yes, I'm sure!</a> <% elseif $"del2" <> "" then Group.requireGroupName "server"; val id = Web.stoi ($"del2"); Sign.delete id %><h3>Request deleted</b><h3> Back to: <a href="?cmd=open">open requests</a>, <a href="?cmd=list">all requests</a> <% else %> <h3>Request SSL certificate signing</h3> <p>Use this form to request that we sign an an SSL certificate with our certificate authority. Give the location of your certificate request (<tt>.csr</tt> file) and key (<tt>.key</tt> file) within <tt>/afs/hcoop.net</tt>.</p> <p>The <a href="http://wiki.hcoop.net/MemberManual/ServingWebsites/SslCert">instructions on our wiki for creating SSL certificates</a> may be helpful.</p> <form method="post"> <input type="hidden" name="new" value="1"> <table class="blanks"> <tr> <td>Domain:</td> <td><% @chooseDomain[] %></td> </tr> <tr> <td>OpenSSL request file:</td> <td><input name="req" size="60"></td> </tr> <tr> <td>OpenSSL key file:</td> <td><input name="key" size="60"></td> </tr> <tr> <td>Certificate lifetime, in days:</td> <td><input name="days" size="5" value="3650"></td></tr> <tr> <td>Additional comments:</td> <td><textarea name="msg" rows="5" cols="80" wrap="soft"></textarea></td> </tr> <tr> <td><input type="submit" value="Request"></td> </tr> </table> </form> <% end %> <% @footer[] %> Index: cert.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/cert.mlt,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** cert.mlt 19 Jan 2008 20:57:32 -0000 1.7 --- cert.mlt 9 Apr 2008 13:45:02 -0000 1.8 *************** *** 4,43 **** if $"new" <> "" then ! if $"kind" = "cert" then ! if $"req" <> "" then ! %><h3>You filled data in next to a textbox but didn't check the radio button next to it.</h3><% ! elseif $"cert" = "" then ! %><h3>Please fill in a path to a certificate.</h3><% ! else ! val cert = $"cert"; ! val msg = $"msg"; ! ! %>Are you sure you want to ask for permissions on an SSL certificate at <% cert %>?<br><br> ! <a href="cert?cmd=request&req=Certificate+<% cert %>&msg=<% Web.urlEncode msg %>">Yes, I want to request that.</a><% ! end ! else ! if $"cert" <> "" then ! %><h3>You filled data in next to a textbox but didn't check the radio button next to it.</h3><% ! elseif $"req" = "" then ! %><h3>Please fill in a path to an OpenSSL request.</h3><% ! else ! val req = $"req"; ! val msg = $"msg"; ! ! %>Are you sure you want to ask for permissions on an SSL certificate to be created from an OpenSSL request at <% req %>?<br><br> ! <a href="cert?cmd=request&req=OpenSSL+request+<% req %>&msg=<% Web.urlEncode msg %>">Yes, I want to request that.</a><% ! end ! end elseif $"cmd" = "request" then ! val id = Cert.add (Init.getUserId (), $"req", $"msg"); ! if not (Cert.notifyNew id) then ! %><h3>Error sending e-mail notification</h3><% ! end ! %><h3>Request added</h3><% elseif $"cmd" = "open" then %><h3>Open requests</h3> ! <a href="cert?cmd=list">List all requests</a><% foreach (name, req) in Cert.listOpen () do %> --- 4,45 ---- if $"new" <> "" then ! val cert = $"cert"; ! val domain = $"domain"; ! val msg = $"msg"; + if cert = "" then + %><h3>Please fill in a path to a certificate.</h3><% + elseif not (ChooseDomain.yourDomain {user = Init.getUserName (), domain = domain}) then + %><h3>You don't have permissions on domain <tt><% Web.html domain %></tt>.</h3><% + else + %>Are you sure you want to ask for permissions on an SSL certificate + <li> at <tt><% Web.html cert %></tt>,</li> + <li> for domain <tt><% domain %></tt>?</li> + <a href="?cmd=request&cert=<% Web.html cert %>&domain=<% Web.html domain %>&msg=<% Web.urlEncode msg %>">Yes, I want to request that.</a><% + end elseif $"cmd" = "request" then ! val cert = $"cert"; ! val domain = $"domain"; ! val msg = $"msg"; + if cert = "" then + %><h3>Please fill in a path to a certificate.</h3><% + elseif not (ChooseDomain.yourDomain {user = Init.getUserName (), domain = domain}) then + %><h3>You don't have permissions on domain <tt><% Web.html domain %></tt>.</h3><% + else + val text = "/afs/hcoop.net/common/etc/scripts/ca-install " + ^ Init.getUserName () ^ " " + ^ domain ^ " " + ^ cert + + val id = Cert.add (Init.getUserId (), text, msg); + if not (Cert.notifyNew id) then + %><h3>Error sending e-mail notification</h3><% + end + %><h3>Request added</h3><% + end elseif $"cmd" = "open" then %><h3>Open requests</h3> ! <a href="?cmd=list">List all requests</a><% foreach (name, req) in Cert.listOpen () do %> *************** *** 46,50 **** <tr> <td>By:</td> <td><a href="user?id=<% #usr req %>"><% name %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> ! <tr> <td>Request:</td> <td><% #data req %></td> </tr> <tr> <td>Reason:</td> <td><% Web.html (#msg req) %></td> </tr> </table> --- 48,52 ---- <tr> <td>By:</td> <td><a href="user?id=<% #usr req %>"><% name %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> ! <tr> <td>Request:</td> <td><tt><% #data req %></tt></td> </tr> <tr> <td>Reason:</td> <td><% Web.html (#msg req) %></td> </tr> </table> *************** *** 52,58 **** <% if admin then %> <br> ! <a href="cert?mod=<% #id req %>">[Modify]</a> ! <a href="cert?del=<% #id req %>">[Delete]</a><br> ! To install, run: <i>tell adamc what text to put here</i>. <% end %> --- 54,59 ---- <% if admin then %> <br> ! <a href="?mod=<% #id req %>">[Modify]</a> ! <a href="?del=<% #id req %>">[Delete]</a><br> <% end %> *************** *** 67,71 **** <tr> <td>By:</td> <td><a href="user?id=<% #usr req %>"><% name %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> ! <tr> <td>Request:</td> <td><% #data req %></td> </tr> <tr> <td>Reason:</td> <td><% Web.html (#msg req) %></td> </tr> </table> --- 68,72 ---- <tr> <td>By:</td> <td><a href="user?id=<% #usr req %>"><% name %></a></td> </tr> <tr> <td>Time:</td> <td><% #stamp req %> (<% Util.diffFromNow (#stamp req) %> ago)</td> </tr> ! <tr> <td>Request:</td> <td><tt><% #data req %></tt></td> </tr> <tr> <td>Reason:</td> <td><% Web.html (#msg req) %></td> </tr> </table> *************** *** 73,78 **** <% if admin then %> <br> ! <a href="cert?mod=<% #id req %>">[Modify]</a> ! <a href="cert?del=<% #id req %>">[Delete]</a> <% end %> --- 74,79 ---- <% if admin then %> <br> ! <a href="?mod=<% #id req %>">[Modify]</a> ! <a href="?del=<% #id req %>">[Delete]</a> <% end %> *************** *** 115,119 **** end %><h3>Request modified</h3> ! Back to: <a href="cert?cmd=open">open requests</a>, <a href="cert?cmd=list">all requests</a> <% elseif $"del" <> "" then --- 116,120 ---- end %><h3>Request modified</h3> ! Back to: <a href="?cmd=open">open requests</a>, <a href="?cmd=list">all requests</a> <% elseif $"del" <> "" then *************** *** 123,127 **** val user = Init.lookupUser (#usr req) %><h3>Are you sure you want to delete request by <% #name user %> for <tt><% #data req %></tt>?</h3> ! <a href="cert?del2=<% id %>">Yes, I'm sure!</a> <% elseif $"del2" <> "" then --- 124,128 ---- val user = Init.lookupUser (#usr req) %><h3>Are you sure you want to delete request by <% #name user %> for <tt><% #data req %></tt>?</h3> ! <a href="?del2=<% id %>">Yes, I'm sure!</a> <% elseif $"del2" <> "" then *************** *** 130,144 **** Cert.delete id %><h3>Request deleted</b><h3> ! Back to: <a href="cert?cmd=open">open requests</a>, <a href="cert?cmd=list">all requests</a> <% else %> ! <h3>Request permissions on an SSL certificate</h3> ! ! <p>Use this form to request use Domtool permissions to use an SSL certificate. Give the location of your certificate request or certificate within <tt>/afs/hcoop.net</tt>.</p> ! <p>If you have your own certificate signed by an outside provider like Verisign, then choose the second option and give the path to that certificate.</p> ! <p>If you want your certificate authenticated by chaining through HCoop's root certificate, then choose the first option and give the path to an OpenSSL certificate request. In the comments field, be sure to specify the number of days that you would like the certificate to be valid. If you do not specify a value, we will use 3650 days. Make sure that the key file is in the same directory as the certificate request, and that it has a "<tt>.key</tt>" extension.</p> <p>Note that you can't use SSL certificates very well over HTTPS without an IP address assigned to your web virtual host. You can request one separately on <a href="ip">the IP address request page</a>.</p> --- 131,143 ---- Cert.delete id %><h3>Request deleted</b><h3> ! Back to: <a href="?cmd=open">open requests</a>, <a href="?cmd=list">all requests</a> <% else %> ! <h3>Request installation of an SSL certificate</h3> ! <p>Use this form to request Domtool permissions to use an SSL certificate. Give the location of your certificate/key (<tt>.pem</tt>) file within <tt>/afs/hcoop.net</tt>.</p> ! <p>If you want your certificate authenticated by chaining through HCoop's root certificate, then <a href="sign">get it signed</a> before submitting this form.</p> <p>Note that you can't use SSL certificates very well over HTTPS without an IP address assigned to your web virtual host. You can request one separately on <a href="ip">the IP address request page</a>.</p> *************** *** 149,154 **** <input type="hidden" name="new" value="1"> <table class="blanks"> ! <tr> <td>OpenSSL request: <input type="radio" name="kind" value="req" checked></td> <td><input name="req" size="60"></td> </tr> ! <tr> <td>OpenSSL certificate: <input type="radio" name="kind" value="cert"></td> <td><input name="cert" size="60"></td> </tr> <tr> <td>Additional comments:</td> <td><textarea name="msg" rows="5" cols="80" wrap="soft"></textarea></td> </tr> <tr> <td><input type="submit" value="Request"></td> </tr> --- 148,153 ---- <input type="hidden" name="new" value="1"> <table class="blanks"> ! <tr> <td>Domain:</td> <td><% @chooseDomain[] %></td> </tr> ! <tr> <td>OpenSSL certificate:</td> <td><input name="cert" size="60"></td> </tr> <tr> <td>Additional comments:</td> <td><textarea name="msg" rows="5" cols="80" wrap="soft"></textarea></td> </tr> <tr> <td><input type="submit" value="Request"></td> </tr> --- NEW FILE: chooseDomain.sig --- signature CHOOSE_DOMAIN = sig val domains : string -> string list val yourDomain : {user : string, domain : string} -> bool end Index: money.sml =================================================================== RCS file: /cvsroot/hcoop/portal/money.sml,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** money.sml 24 Feb 2008 17:11:02 -0000 1.13 --- money.sml 9 Apr 2008 13:45:02 -0000 1.14 *************** *** 295,297 **** --- 295,326 ---- raise Fail ($`UPDATE WebUser SET shares = 1 WHERE id IN (^(String.concatWith ", " (List.map C.intToSql ids)))`) + fun freezeworthyPledgers () = + let + val costBase = costBase monthlyCost + + fun makeRow [id, name, amount] = {id = C.intFromSql id, name = C.stringFromSql name, + balance = C.realFromSql amount} + | makeRow row = Init.rowError ("Bad freezeworthyPledgers", row) + in + C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, amount + FROM WebUserPaying JOIN Balance ON Balance.id = bal + WHERE amount >= ^(C.realToSql costBase) * ^(C.intToSql graceMonths) + AND amount < ^(C.realToSql costBase) * ^(C.intToSql (graceMonths + 1)) + ORDER BY name`) + end + + fun bootworthyPledgers () = + let + val costBase = costBase monthlyCost + + fun makeRow [id, name, amount] = {id = C.intFromSql id, name = C.stringFromSql name, + balance = C.realFromSql amount} + | makeRow row = Init.rowError ("Bad bootworthyPledgers", row) + in + C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id, WebUserPaying.name, amount + FROM WebUserPaying JOIN Balance ON Balance.id = bal + WHERE amount < ^(C.realToSql costBase) * ^(C.intToSql graceMonths) + ORDER BY name`) + end + end Index: cert.sml =================================================================== RCS file: /cvsroot/hcoop/portal/cert.sml,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** cert.sml 11 Nov 2007 20:34:39 -0000 1.1 --- cert.sml 9 Apr 2008 13:45:02 -0000 1.2 *************** *** 2,6 **** val table = "Cert" val adminGroup = "server" ! fun subject _ = "SSL certificate request" val template = "cert" val descr = "SSL certificate" --- 2,6 ---- val table = "Cert" val adminGroup = "server" ! fun subject _ = "SSL certificate installation request" val template = "cert" val descr = "SSL certificate" --- NEW FILE: chooseDomain.sml --- structure ChooseDomain :> CHOOSE_DOMAIN = struct fun domains user = let val proc = Unix.execute ("/bin/sh", ["-c", "DOMTOOL_USER=hcoop /usr/local/bin/domtool-admin perms " ^ user]) val inf = Unix.textInstreamOf proc fun loop () = case TextIO.inputLine inf of NONE => [] | SOME line => case String.tokens (fn ch => ch = #":") line of ["domain", domains] => String.tokens Char.isSpace domains | _ => loop () in loop () before ignore (Unix.reap proc) end fun yourDomain {user, domain} = List.exists (fn x => x = domain) (domains user) end |
From: Adam C. <ad...@us...> - 2008-04-09 13:45:09
|
Update of /cvsroot/hcoop/portal/contact In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv8920/contact Modified Files: contact.sml Log Message: Reports for figuring out which accounts to freeze or boot; most of new SSL request forms; change name of contact kind for non-HCoop e-mail Index: contact.sml =================================================================== RCS file: /cvsroot/hcoop/portal/contact/contact.sml,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** contact.sml 19 Jan 2008 21:36:25 -0000 1.2 --- contact.sml 9 Apr 2008 13:45:03 -0000 1.3 *************** *** 14,18 **** in C.map db s ! "SELECT v FROM Contact JOIN ContactKind ON knd = ContactKind.id AND ContactKind.name = 'Non-hcoop e-mail' ORDER BY v" end --- 14,18 ---- in C.map db s ! "SELECT v FROM Contact JOIN ContactKind ON knd = ContactKind.id AND ContactKind.name = 'Non-HCoop e-mail' ORDER BY v" end |
From: Adam C. <ad...@us...> - 2008-04-06 13:42:03
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv2121 Modified Files: location.sml Log Message: Ignore retired members in dynamic geographic location pages Index: location.sml =================================================================== RCS file: /cvsroot/hcoop/portal/location.sml,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** location.sml 9 Dec 2007 16:30:39 -0000 1.5 --- location.sml 6 Apr 2008 13:41:58 -0000 1.6 *************** *** 103,107 **** end in ! C.fold db folder NM.empty ($`SELECT loc, usr FROM Lives`) end --- 103,107 ---- end in ! C.fold db folder NM.empty ($`SELECT loc, usr FROM Lives JOIN WebUserActive ON usr = id`) end *************** *** 137,141 **** in C.fold db folder NM.empty ($`SELECT loc, id, name, rname, bal, joined, app, shares, paypal, checkout ! FROM Lives JOIN WebUser ON usr = id`) end --- 137,141 ---- in C.fold db folder NM.empty ($`SELECT loc, id, name, rname, bal, joined, app, shares, paypal, checkout ! FROM Lives JOIN WebUserActive ON usr = id`) end *************** *** 295,299 **** fun residentsOneLevel loc = C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout ! FROM Lives, WebUser WHERE loc = ^(C.intToSql loc) AND usr = id --- 295,299 ---- fun residentsOneLevel loc = C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout ! FROM Lives, WebUserActive WHERE loc = ^(C.intToSql loc) AND usr = id |
From: Adam C. <ad...@us...> - 2008-04-05 20:17:03
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv3041/lib Modified Files: easy_domain.dtl Log Message: Add dnsWildcardIP Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** easy_domain.dtl 23 Mar 2008 21:29:19 -0000 1.29 --- easy_domain.dtl 5 Apr 2008 20:16:57 -0000 1.30 *************** *** 97,98 **** --- 97,99 ---- val dnsDefaultText = \to -> dns (dnsTXT srv_default to); + val dnsWildcardIP = \to -> dns (dnsA wildcard to); |
From: Adam C. <ad...@us...> - 2008-04-01 18:17:45
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv30270 Modified Files: app.sml payment.mlt Log Message: More Checkout payment options Index: app.sml =================================================================== RCS file: /cvsroot/hcoop/portal/app.sml,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** app.sml 22 Feb 2008 00:59:15 -0000 1.14 --- app.sml 1 Apr 2008 18:17:38 -0000 1.15 *************** *** 121,132 **** fun preAdd app = - ignore (C.dml (getDb ()) ($`UPDATE MemberApp - SET status = 5 - WHERE id = ^(C.intToSql app)`)) - - fun add app = let val _ = C.dml (getDb ()) ($`UPDATE MemberApp ! SET status = 4 WHERE id = ^(C.intToSql app)`) --- 121,127 ---- fun preAdd app = let val _ = C.dml (getDb ()) ($`UPDATE MemberApp ! SET status = 5 WHERE id = ^(C.intToSql app)`) *************** *** 140,143 **** --- 135,143 ---- end + fun add app = + ignore (C.dml (getDb ()) ($`UPDATE MemberApp + SET status = 4 + WHERE id = ^(C.intToSql app)`)) + fun welcome app = let Index: payment.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/payment.mlt,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** payment.mlt 18 Feb 2008 17:51:51 -0000 1.4 --- payment.mlt 1 Apr 2008 18:17:39 -0000 1.5 *************** *** 10,25 **** <h3>Add to your balance with <a href="http://checkout.google.com/">Google Checkout</a>: ! <table> ! <form action="https://checkout.google.com/cws/v2/Merchant/641723647067155/checkout" id="BB_BuyButtonForm" method="post" name="BB_BuyButtonForm"> <tr> <td> ! <select name="buyButtonCart"> ! <option value="PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4NCjxjaGVja291dC1zaG9wcGluZy1jYXJ0IHhtbG5zPSJodHRwOi8vY2hlY2tvdXQuZ29vZ2xlLmNvbS9zY2hlbWEvMiI+DQogIDxzaG9wcGluZy1jYXJ0Pg0KICAgIDxpdGVtcz4NCiAgICAgIDxpdGVtPg0KICAgICAgICA8aXRlbS1uYW1lPkFkZCAkMTAgdG8geW91ciBiYWxhbmNlPC9pdGVtLW5hbWU+DQogICAgICAgIDxxdWFudGl0eT4xPC9xdWFudGl0eT4NCiAgICAgICAgPHVuaXQtcHJpY2UgY3VycmVuY3k9IlVTRCI+MTAuMDwvdW5pdC1wcmljZT4NCiAgICAgICAgPGl0ZW0tZGVzY3JpcHRpb24gLz4NCiAgICAgIDwvaXRlbT4NCiAgICA8L2l0ZW1zPg0KICA8L3Nob3BwaW5nLWNhcnQ+DQogIDxjaGVja291dC1mbG93LXN1cHBvcnQ+DQogICAgPG1lcmNoYW50LWNoZWNrb3V0LWZsb3ctc3VwcG9ydCAvPg0KICA8L2NoZWNrb3V0LWZsb3ctc3VwcG9ydD4NCjwvY2hlY2tvdXQtc2hvcHBpbmctY2FydD4NCg0K//separator//JamZPEfPuWdsrp0xWerG2bJmWYg=">$10.00 - Add $10 to your balance</option> ! <option value="PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4NCjxjaGVja291dC1zaG9wcGluZy1jYXJ0IHhtbG5zPSJodHRwOi8vY2hlY2tvdXQuZ29vZ2xlLmNvbS9zY2hlbWEvMiI+DQogIDxzaG9wcGluZy1jYXJ0Pg0KICAgIDxpdGVtcz4NCiAgICAgIDxpdGVtPg0KICAgICAgICA8aXRlbS1uYW1lPkFkZCAkMjAgdG8geW91ciBiYWxhbmNlPC9pdGVtLW5hbWU+DQogICAgICAgIDxxdWFudGl0eT4xPC9xdWFudGl0eT4NCiAgICAgICAgPHVuaXQtcHJpY2UgY3VycmVuY3k9IlVTRCI+MjAuMDwvdW5pdC1wcmljZT4NCiAgICAgICAgPGl0ZW0tZGVzY3JpcHRpb24gLz4NCiAgICAgIDwvaXRlbT4NCiAgICA8L2l0ZW1zPg0KICA8L3Nob3BwaW5nLWNhcnQ+DQogIDxjaGVja291dC1mbG93LXN1cHBvcnQ+DQogICAgPG1lcmNoYW50LWNoZWNrb3V0LWZsb3ctc3VwcG9ydCAvPg0KICA8L2NoZWNrb3V0LWZsb3ctc3VwcG9ydD4NCjwvY2hlY2tvdXQtc2hvcHBpbmctY2FydD4NCg0K//separator//2CDnW1MkNhBy4j1k7V6s2TVEVpI=">$20.00 - Add $20 to your balance</option> ! <option value="PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4NCjxjaGVja291dC1zaG9wcGluZy1jYXJ0IHhtbG5zPSJodHRwOi8vY2hlY2tvdXQuZ29vZ2xlLmNvbS9zY2hlbWEvMiI+DQogIDxzaG9wcGluZy1jYXJ0Pg0KICAgIDxpdGVtcz4NCiAgICAgIDxpdGVtPg0KICAgICAgICA8aXRlbS1uYW1lPkFkZCAkNTAgdG8geW91ciBiYWxhbmNlPC9pdGVtLW5hbWU+DQogICAgICAgIDxxdWFudGl0eT4xPC9xdWFudGl0eT4NCiAgICAgICAgPHVuaXQtcHJpY2UgY3VycmVuY3k9IlVTRCI+NTAuMDwvdW5pdC1wcmljZT4NCiAgICAgICAgPGl0ZW0tZGVzY3JpcHRpb24gLz4NCiAgICAgIDwvaXRlbT4NCiAgICA8L2l0ZW1zPg0KICA8L3Nob3BwaW5nLWNhcnQ+DQogIDxjaGVja291dC1mbG93LXN1cHBvcnQ+DQogICAgPG1lcmNoYW50LWNoZWNrb3V0LWZsb3ctc3VwcG9ydCAvPg0KICA8L2NoZWNrb3V0LWZsb3ctc3VwcG9ydD4NCjwvY2hlY2tvdXQtc2hvcHBpbmctY2FydD4NCg0K//separator//88aQDU37EdF4b2MsvLPL2FiAbRU=">$50.00 - Add $50 to your balance</option> ! <option value="PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4NCjxjaGVja291dC1zaG9wcGluZy1jYXJ0IHhtbG5zPSJodHRwOi8vY2hlY2tvdXQuZ29vZ2xlLmNvbS9zY2hlbWEvMiI+DQogIDxzaG9wcGluZy1jYXJ0Pg0KICAgIDxpdGVtcz4NCiAgICAgIDxpdGVtPg0KICAgICAgICA8aXRlbS1uYW1lPkFkZCAkMTAwIHRvIHlvdXIgYmFsYW5jZTwvaXRlbS1uYW1lPg0KICAgICAgICA8cXVhbnRpdHk+MTwvcXVhbnRpdHk+DQogICAgICAgIDx1bml0LXByaWNlIGN1cnJlbmN5PSJVU0QiPjEwMC4wPC91bml0LXByaWNlPg0KICAgICAgICA8aXRlbS1kZXNjcmlwdGlvbiAvPg0KICAgICAgPC9pdGVtPg0KICAgIDwvaXRlbXM+DQogIDwvc2hvcHBpbmctY2FydD4NCiAgPGNoZWNrb3V0LWZsb3ctc3VwcG9ydD4NCiAgICA8bWVyY2hhbnQtY2hlY2tvdXQtZmxvdy1zdXBwb3J0IC8+DQogIDwvY2hlY2tvdXQtZmxvdy1zdXBwb3J0Pg0KPC9jaGVja291dC1zaG9wcGluZy1jYXJ0Pg0KDQo=//separator//EayZGMDTNKdL75UUBET3ivL5tPU=">$100.00 - Add $100 to your balance</option> ! <option value="PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4NCjxjaGVja291dC1zaG9wcGluZy1jYXJ0IHhtbG5zPSJodHRwOi8vY2hlY2tvdXQuZ29vZ2xlLmNvbS9zY2hlbWEvMiI+DQogIDxzaG9wcGluZy1jYXJ0Pg0KICAgIDxpdGVtcz4NCiAgICAgIDxpdGVtPg0KICAgICAgICA8aXRlbS1uYW1lPkFkZCAkMjAwIHRvIHlvdXIgYmFsYW5jZTwvaXRlbS1uYW1lPg0KICAgICAgICA8cXVhbnRpdHk+MTwvcXVhbnRpdHk+DQogICAgICAgIDx1bml0LXByaWNlIGN1cnJlbmN5PSJVU0QiPjIwMC4wPC91bml0LXByaWNlPg0KICAgICAgICA8aXRlbS1kZXNjcmlwdGlvbiAvPg0KICAgICAgPC9pdGVtPg0KICAgIDwvaXRlbXM+DQogIDwvc2hvcHBpbmctY2FydD4NCiAgPGNoZWNrb3V0LWZsb3ctc3VwcG9ydD4NCiAgICA8bWVyY2hhbnQtY2hlY2tvdXQtZmxvdy1zdXBwb3J0IC8+DQogIDwvY2hlY2tvdXQtZmxvdy1zdXBwb3J0Pg0KPC9jaGVja291dC1zaG9wcGluZy1jYXJ0Pg0KDQo=//separator//wjow2c9hWKClWEf9bZgI00to3Oc=">$200.00 - Add $200 to your balance</option> ! <option value="PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4NCjxjaGVja291dC1zaG9wcGluZy1jYXJ0IHhtbG5zPSJodHRwOi8vY2hlY2tvdXQuZ29vZ2xlLmNvbS9zY2hlbWEvMiI+DQogIDxzaG9wcGluZy1jYXJ0Pg0KICAgIDxpdGVtcz4NCiAgICAgIDxpdGVtPg0KICAgICAgICA8aXRlbS1uYW1lPkFkZCAkNTAwIHRvIHlvdXIgYmFsYW5jZTwvaXRlbS1uYW1lPg0KICAgICAgICA8cXVhbnRpdHk+MTwvcXVhbnRpdHk+DQogICAgICAgIDx1bml0LXByaWNlIGN1cnJlbmN5PSJVU0QiPjUwMC4wPC91bml0LXByaWNlPg0KICAgICAgICA8aXRlbS1kZXNjcmlwdGlvbiAvPg0KICAgICAgPC9pdGVtPg0KICAgIDwvaXRlbXM+DQogIDwvc2hvcHBpbmctY2FydD4NCiAgPGNoZWNrb3V0LWZsb3ctc3VwcG9ydD4NCiAgICA8bWVyY2hhbnQtY2hlY2tvdXQtZmxvdy1zdXBwb3J0IC8+DQogIDwvY2hlY2tvdXQtZmxvdy1zdXBwb3J0Pg0KPC9jaGVja291dC1zaG9wcGluZy1jYXJ0Pg0KDQo=//separator//zAFfJqOZBPuO46sFs25F/VQyAdM=">$500.00 - Add $500 to your balance</option> </select> </td> <td> --- 10,68 ---- <h3>Add to your balance with <a href="http://checkout.google.com/">Google Checkout</a>: ! ! <table> ! <form action="https://checkout.google.com/cws/v2/Merchant/641723647067155/checkoutForm" id="BB_BuyButtonForm" method="post" name="BB_BuyButtonForm"> <tr> <td> ! <select name="item_selection_1"> ! <option value="1">$10.00 - Add $10 to your balance</option> ! <option value="2">$20.00 - Add $20 to your balance</option> ! <option value="3">$30.00 - Add $30 to your balance</option> ! <option value="4">$40.00 - Add $40 to your balance</option> ! <option value="5">$50.00 - Add $50 to your balance</option> ! <option value="6">$100.00 - Add $100 to your balance</option> ! <option value="7">$200.00 - Add $200 to your balance</option> ! <option value="8">$500.00 - Add $500 to your balance</option> </select> + <input name="item_option_name_1" type="hidden" value="Add $10 to your balance"/> + <input name="item_option_price_1" type="hidden" value="10.0"/> + <input name="item_option_description_1" type="hidden" value=""/> + <input name="item_option_quantity_1" type="hidden" value="1"/> + <input name="item_option_currency_1" type="hidden" value="USD"/> + <input name="item_option_name_2" type="hidden" value="Add $20 to your balance"/> + <input name="item_option_price_2" type="hidden" value="20.0"/> + <input name="item_option_description_2" type="hidden" value=""/> + <input name="item_option_quantity_2" type="hidden" value="1"/> + <input name="item_option_currency_2" type="hidden" value="USD"/> + <input name="item_option_name_3" type="hidden" value="Add $30 to your balance"/> + <input name="item_option_price_3" type="hidden" value="30.0"/> + <input name="item_option_description_3" type="hidden" value=""/> + <input name="item_option_quantity_3" type="hidden" value="1"/> + <input name="item_option_currency_3" type="hidden" value="USD"/> + <input name="item_option_name_4" type="hidden" value="Add $40 to your balance"/> + <input name="item_option_price_4" type="hidden" value="40.0"/> + <input name="item_option_description_4" type="hidden" value=""/> + <input name="item_option_quantity_4" type="hidden" value="1"/> + <input name="item_option_currency_4" type="hidden" value="USD"/> + <input name="item_option_name_5" type="hidden" value="Add $50 to your balance"/> + <input name="item_option_price_5" type="hidden" value="50.0"/> + <input name="item_option_description_5" type="hidden" value=""/> + <input name="item_option_quantity_5" type="hidden" value="1"/> + <input name="item_option_currency_5" type="hidden" value="USD"/> + <input name="item_option_name_6" type="hidden" value="Add $100 to your balance"/> + <input name="item_option_price_6" type="hidden" value="100.0"/> + <input name="item_option_description_6" type="hidden" value=""/> + <input name="item_option_quantity_6" type="hidden" value="1"/> + <input name="item_option_currency_6" type="hidden" value="USD"/> + <input name="item_option_name_7" type="hidden" value="Add $200 to your balance"/> + <input name="item_option_price_7" type="hidden" value="200.0"/> + <input name="item_option_description_7" type="hidden" value=""/> + <input name="item_option_quantity_7" type="hidden" value="1"/> + <input name="item_option_currency_7" type="hidden" value="USD"/> + <input name="item_option_name_8" type="hidden" value="Add $500 to your balance"/> + <input name="item_option_price_8" type="hidden" value="500.0"/> + <input name="item_option_description_8" type="hidden" value=""/> + <input name="item_option_quantity_8" type="hidden" value="1"/> + <input name="item_option_currency_8" type="hidden" value="USD"/> </td> <td> *************** *** 27,31 **** </td> </tr> ! </form></table></h3> <% switch #checkout you of --- 70,76 ---- </td> </tr> ! </form> ! </table> ! </h3> <% switch #checkout you of |
From: Michael O. <big...@us...> - 2008-03-31 00:27:59
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv10435 Modified Files: hcoop.dtl Log Message: lib/hcoop.dtl: Add outpost_ip. Index: hcoop.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/hcoop.dtl,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** hcoop.dtl 25 Feb 2008 00:33:05 -0000 1.7 --- hcoop.dtl 31 Mar 2008 00:27:49 -0000 1.8 *************** *** 18,21 **** --- 18,22 ---- val mire_ip : (ip) = "69.90.123.68"; val krunk_ip : (ip) = "69.90.123.70"; + val outpost_ip : (ip) = "89.16.166.179"; val fyodor_ip : (ip) = "64.20.38.170"; |
From: Adam C. <ad...@us...> - 2008-03-23 21:29:25
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv29182/lib Modified Files: easy_domain.dtl Log Message: Make outpost a nameserver for [dom] Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** easy_domain.dtl 1 Mar 2008 21:17:28 -0000 1.28 --- easy_domain.dtl 23 Mar 2008 21:29:19 -0000 1.29 *************** *** 52,55 **** --- 52,56 ---- dns (dnsNS "ns1.hcoop.net"); dns (dnsNS "ns3.hcoop.net"); + dns (dnsNS "ns5.hcoop.net"); dns (dnsA default (ip_of_node (web_node_to_node web_node))); |
From: Adam C. <ad...@us...> - 2008-03-16 00:07:10
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv30932/src Modified Files: main.sml Log Message: Don't revoke ACL entries on rmdom Index: main.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v retrieving revision 1.101 retrieving revision 1.102 diff -C2 -d -r1.101 -r1.102 *** main.sml 25 Feb 2008 01:40:17 -0000 1.101 --- main.sml 16 Mar 2008 00:07:02 -0000 1.102 *************** *** 1286,1292 **** orelse List.all (fn dom => Acl.query {user = user, class = "domain", value = dom}) doms then (Domain.rmdom doms; ! app (fn dom => Acl.revokeFromAll {class = "domain", value = dom}) doms; ! Acl.write Config.aclFile; ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".", NONE)) --- 1286,1292 ---- orelse List.all (fn dom => Acl.query {user = user, class = "domain", value = dom}) doms then (Domain.rmdom doms; ! (*app (fn dom => Acl.revokeFromAll {class = "domain", value = dom}) doms; ! Acl.write Config.aclFile;*) ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".", NONE)) |
From: Adam C. <ad...@us...> - 2008-03-15 16:37:34
|
Update of /cvsroot/hcoop/domtool2/configDefault In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5889/configDefault Modified Files: domtool.cfg Log Message: Changes while getting the slave on outpost working Index: domtool.cfg =================================================================== RCS file: /cvsroot/hcoop/domtool2/configDefault/domtool.cfg,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** domtool.cfg 23 Dec 2007 22:00:21 -0000 1.34 --- domtool.cfg 15 Mar 2008 16:37:25 -0000 1.35 *************** *** 20,34 **** val defaultMinimum = 3600 ! val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68")] val defaultNode = "deleuze" val masterNode = "deleuze" ! val slaveNodes = ["mire"] ! val dnsNodes_all = ["deleuze", "mire"] val dnsNodes_admin = [] val mailNodes_all = ["deleuze"] ! val mailNodes_admin = ["mire"] val aclFile = "/afs/hcoop.net/common/etc/domtool/acl" --- 20,34 ---- val defaultMinimum = 3600 ! val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68"), ("outpost", "89.16.166.179")] val defaultNode = "deleuze" val masterNode = "deleuze" ! val slaveNodes = ["mire", "outpost"] ! val dnsNodes_all = ["deleuze", "mire", "outpost"] val dnsNodes_admin = [] val mailNodes_all = ["deleuze"] ! val mailNodes_admin = ["mire", "outpost"] val aclFile = "/afs/hcoop.net/common/etc/domtool/acl" |
From: Adam C. <ad...@us...> - 2008-03-15 16:37:32
|
Update of /cvsroot/hcoop/domtool2/scripts In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5889/scripts Modified Files: domtool-publish Log Message: Changes while getting the slave on outpost working Index: domtool-publish =================================================================== RCS file: /cvsroot/hcoop/domtool2/scripts/domtool-publish,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** domtool-publish 14 Dec 2007 23:36:32 -0000 1.23 --- domtool-publish 15 Mar 2008 16:37:25 -0000 1.24 *************** *** 43,47 **** /bin/chown root:bind_config /etc/bind/named.conf.local /bin/chmod u=rw,g=rw,o=r /etc/bind/named.conf.local ! /etc/init.d/bind9 reload ;; exim) --- 43,47 ---- /bin/chown root:bind_config /etc/bind/named.conf.local /bin/chmod u=rw,g=rw,o=r /etc/bind/named.conf.local ! /etc/init.d/bind9 restart ;; exim) |
From: Adam C. <ad...@us...> - 2008-03-01 21:17:33
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv12280/lib Modified Files: alias.dtl easy_domain.dtl Log Message: Additions while poking around people's configs Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** easy_domain.dtl 24 Feb 2008 22:03:29 -0000 1.27 --- easy_domain.dtl 1 Mar 2008 21:17:28 -0000 1.28 *************** *** 3,6 **** --- 3,7 ---- val default_node : (node) = "mire"; val web_node : (web_node) = "mire"; + val web_ip = ip_of_node (web_node_to_node web_node); val webAt = Index: alias.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/alias.dtl,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** alias.dtl 15 Dec 2007 20:17:26 -0000 1.8 --- alias.dtl 1 Mar 2008 21:17:28 -0000 1.9 *************** *** 40,41 **** --- 40,43 ---- {{When a message to the current domain doesn't match any other rule, send it to this e-mail address.}} + val defaultAliasDrop = aliasPrim defaultSource dropTarget; + {{Silently drop all mail not matching a specific rule.}} |
From: Adam C. <ad...@us...> - 2008-03-01 19:30:57
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv3314 Modified Files: balance.sml money.mlt portal.mlt Log Message: Putting new balance stuff into action Index: balance.sml =================================================================== RCS file: /cvsroot/hcoop/portal/balance.sml,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** balance.sml 18 Feb 2008 17:46:05 -0000 1.11 --- balance.sml 1 Mar 2008 19:30:52 -0000 1.12 *************** *** 114,122 **** | row => Init.rowError ("Bad depositAmount share count result", row) in ! case C.oneRow db ($`SELECT 3.0 * 900.0 * SUM(shares) / ^(C.intToSql totalShares) ! FROM WebUserPaying ! WHERE bal = ^(C.intToSql bal)`) of ! [amount] => C.realFromSql amount ! | row => Init.rowError ("Bad depositAmount result", row) end --- 114,118 ---- | row => Init.rowError ("Bad depositAmount share count result", row) in ! 3.0 * 900.0 / real totalShares end Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** money.mlt 24 Feb 2008 17:11:02 -0000 1.23 --- money.mlt 1 Mar 2008 19:30:52 -0000 1.24 *************** *** 484,491 **** val deposit = Balance.depositAmount (#id bal) %> ! <!--h3>Your balance: $<% Util.sub (#amount bal, deposit) %><br> ! Deposit: $<% deposit %></b> (3 months of dues at your current <a href="pledge">pledge level</a>)</h3--> ! <h3>Your balance: $<% #amount bal %></h3> <% if (iff Group.inGroupName "money" then $"lookback" = "" else $"audit" <> "") then %><h3>Sum of all active balances: $<% Balance.sumOwnedBalances () %></h3><% end %> --- 484,491 ---- val deposit = Balance.depositAmount (#id bal) %> ! <h3>Your balance: $<% Util.sub (#amount bal, deposit) %><br> ! Deposit: $<% deposit %></b> (3 months of dues at the minimal <a href="pledge">pledge level</a>)</h3> ! <!--h3>Your balance: $<% #amount bal %></h3--> <% if (iff Group.inGroupName "money" then $"lookback" = "" else $"audit" <> "") then %><h3>Sum of all active balances: $<% Balance.sumOwnedBalances () %></h3><% end %> Index: portal.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/portal.mlt,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** portal.mlt 22 Feb 2008 00:59:15 -0000 1.18 --- portal.mlt 1 Mar 2008 19:30:52 -0000 1.19 *************** *** 14,21 **** <% end %> </table> ! <!--b>Balance: $<% Util.sub (#amount bal, deposit) %></b><br> ! <b>Deposit: $<% deposit %></b> (3 months of dues at your current <a href="pledge">pledge level</a>)--> ! <b>Balance: $<% #amount bal %></b> <% val polls = Poll.listCurrentPolls (); --- 14,21 ---- <% end %> </table> ! <b>Balance: $<% Util.sub (#amount bal, deposit) %></b><br> ! <b>Deposit: $<% deposit %></b> (3 months of dues at the minimal <a href="pledge">pledge level</a>) ! <!--b>Balance: $<% #amount bal %></b--> <% val polls = Poll.listCurrentPolls (); |
From: Adam C. <ad...@us...> - 2008-03-01 19:30:57
|
Update of /cvsroot/hcoop/portal/remind In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv3314/remind Modified Files: remind.sml Log Message: Putting new balance stuff into action Index: remind.sml =================================================================== RCS file: /cvsroot/hcoop/portal/remind/remind.sml,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** remind.sml 18 Feb 2008 18:22:48 -0000 1.9 --- remind.sml 1 Mar 2008 19:30:52 -0000 1.10 *************** *** 28,33 **** val perMonth = 900.0 * real shares / real totalShares ! val deposit = perMonth * 3.0 ! val headsUp = perMonth * 5.0 in if amount >= headsUp then --- 28,33 ---- val perMonth = 900.0 * real shares / real totalShares ! val deposit = 900.0 / real totalShares * 3.0 ! val headsUp = deposit + perMonth * 2.0 in if amount >= headsUp then *************** *** 77,83 **** write "\n\nYour deposit requirement was calculated by dividing our total monthly expenses\n"; ! write "($900) by the sum of all members' pledge amounts, multiplying by your pledge amount,\n"; ! write "and then multiplying by 3. That is, the amount covers your share of three months'\n"; ! write "expenses.\n\n"; write "To make a payment, visit:\n"; --- 77,82 ---- write "\n\nYour deposit requirement was calculated by dividing our total monthly expenses\n"; ! write "($900) by the sum of all members' pledge amounts and then multiplying by 3. That\n"; ! write "is, the amount covers a minimal share of three months' expenses.\n\n"; write "To make a payment, visit:\n"; *************** *** 87,92 **** write "\nIf for whatever reason you don't plan to pay the amount suggested in this e-mail,\n"; write "_please_ don't stay silent. Reply to this message explaining your circumstances.\n"; - write "We are doing limited-time monetary grants on request, due to the extra costs\n"; - write "associated with setting up our new servers.\n"; ignore (Mail.mclose m) --- 86,89 ---- |
From: Adam C. <ad...@us...> - 2008-02-25 01:40:22
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv12206/src Modified Files: main.sig main.sml Log Message: Fix regeneration of multi-file dependencies Index: main.sig =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sig,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 *** main.sig 24 Feb 2008 20:10:15 -0000 1.46 --- main.sig 25 Feb 2008 01:40:17 -0000 1.47 *************** *** 30,34 **** val basis : unit -> Env.env ! val reduce : Env.env -> string -> (Env.env * Ast.exp) option val eval : Env.env -> Env.env_vars -> string -> Env.env * Env.env_vars --- 30,34 ---- val basis : unit -> Env.env ! val reduce : Env.env -> string -> Env.env * Ast.exp option val eval : Env.env -> Env.env_vars -> string -> Env.env * Env.env_vars Index: main.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v retrieving revision 1.100 retrieving revision 1.101 diff -C2 -d -r1.100 -r1.101 *** main.sml 24 Feb 2008 20:36:46 -0000 1.100 --- main.sml 25 Feb 2008 01:40:17 -0000 1.101 *************** *** 176,180 **** in if !ErrorMsg.anyErrors then ! NONE else case body of --- 176,180 ---- in if !ErrorMsg.anyErrors then ! (G, NONE) else case body of *************** *** 187,193 **** PD.space 1, p_exp body']))*) ! SOME (G, body') end ! | _ => NONE end --- 187,193 ---- PD.space 1, p_exp body']))*) ! (G, SOME body') end ! | _ => (G, NONE) end *************** *** 196,200 **** fun eval G evs fname = case reduce G fname of ! SOME (G, body') => if !ErrorMsg.anyErrors then raise ErrorMsg.Error --- 196,200 ---- fun eval G evs fname = case reduce G fname of ! (G, SOME body') => if !ErrorMsg.anyErrors then raise ErrorMsg.Error *************** *** 205,209 **** (G, evs') end ! | NONE => (G, evs) val dispatcher = --- 205,209 ---- (G, evs') end ! | (G, NONE) => (G, evs) val dispatcher = |
From: Adam C. <ad...@us...> - 2008-02-25 01:40:21
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv12206/src/plugins Modified Files: apache.sml Log Message: Fix regeneration of multi-file dependencies Index: apache.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/apache.sml,v retrieving revision 1.78 retrieving revision 1.79 diff -C2 -d -r1.78 -r1.79 *** apache.sml 24 Feb 2008 20:53:04 -0000 1.78 --- apache.sml 25 Feb 2008 01:40:18 -0000 1.79 *************** *** 598,604 **** (fn (from, to, port) => (checkRewrite (); ! write "\tRewriteRule\t"; write from; ! write "\thttp://localhost:"; write (Int.toString port); write "/"; --- 598,604 ---- (fn (from, to, port) => (checkRewrite (); ! write "\tRewriteRule\t\""; write from; ! write "\"\thttp://localhost:"; write (Int.toString port); write "/"; *************** *** 628,635 **** (fn (from, to, flags) => (checkRewrite (); ! write "\tRewriteRule\t"; write from; ! write "\t"; write to; case flags of [] => () --- 628,636 ---- (fn (from, to, flags) => (checkRewrite (); ! write "\tRewriteRule\t\""; write from; ! write "\"\t\""; write to; + write "\""; case flags of [] => () *************** *** 645,652 **** (fn (from, to, flags) => (checkRewrite (); ! write "\tRewriteCond\t"; write from; ! write "\t"; write to; case flags of [] => () --- 646,654 ---- (fn (from, to, flags) => (checkRewrite (); ! write "\tRewriteCond\t\""; write from; ! write "\"\t\""; write to; + write "\""; case flags of [] => () *************** *** 662,668 **** (fn prefix => (checkRewrite (); ! write "\tRewriteBase\t"; write prefix; ! write "\n")) val () = Env.action_one "rewriteLogLevel" --- 664,670 ---- (fn prefix => (checkRewrite (); ! write "\tRewriteBase\t\""; write prefix; ! write "\"\n")) val () = Env.action_one "rewriteLogLevel" |
From: Adam C. <ad...@us...> - 2008-02-25 00:33:09
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv18256/lib Modified Files: hcoop.dtl Log Message: Library goodies Index: hcoop.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/hcoop.dtl,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** hcoop.dtl 24 Feb 2008 22:03:30 -0000 1.6 --- hcoop.dtl 25 Feb 2008 00:33:05 -0000 1.7 *************** *** 20,24 **** val fyodor_ip : (ip) = "64.20.38.170"; ! val simple_web = \host -> \docroot -> web host where DocumentRoot = home docroot with end; --- 20,24 ---- val fyodor_ip : (ip) = "64.20.38.170"; ! val simpleWeb = \host -> \docroot -> web host where DocumentRoot = home docroot with end; |
From: Adam C. <ad...@us...> - 2008-02-25 00:32:38
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv17910/src Modified Files: describe.sml Log Message: Improve one kind of error message Index: describe.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/describe.sml,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** describe.sml 24 Feb 2008 21:58:17 -0000 1.5 --- describe.sml 25 Feb 2008 00:32:30 -0000 1.6 *************** *** 113,119 **** fun get_first_arg (t, _) = case t of ! TArrow (t', _) => t' | TUnif (_, ref (SOME t')) => get_first_arg t' ! | _ => raise Fail "get_first_arg failed!" fun hint te = --- 113,119 ---- fun get_first_arg (t, _) = case t of ! TArrow (t', _) => SOME t' | TUnif (_, ref (SOME t')) => get_first_arg t' ! | _ => NONE fun hint te = *************** *** 138,144 **** | WrongForm (place, form, e, t, ueo) => if form = "action" andalso will_be_action t then ! (ErrorMsg.error (SOME loc) ("Not enough arguments passed to configuration function. (" ^ place ^ ")"); ! preface (" Expression so far:", p_exp e); ! preface ("Next argument type:", p_typ (get_first_arg t))) else (ErrorMsg.error (SOME loc) (place ^ " has a non-" ^ form ^ " type."); --- 138,147 ---- | WrongForm (place, form, e, t, ueo) => if form = "action" andalso will_be_action t then ! (case get_first_arg t of ! NONE => ErrorMsg.error (SOME loc) "You probably forgot a 'with' clause here." ! | SOME t' => ! (ErrorMsg.error (SOME loc) ("Not enough arguments passed to configuration function. (" ^ place ^ ")"); ! preface (" Expression so far:", p_exp e); ! preface ("Next argument type:", p_typ t'))) else (ErrorMsg.error (SOME loc) (place ^ " has a non-" ^ form ^ " type."); |