Menu
▾
▴
hcoop-cvs — CVS commits for hcoop project
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-02-24 22:03:35
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv23676/lib Modified Files: easy_domain.dtl hcoop.dtl Log Message: New vhost shortcut Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.26 retrieving revision 1.27 diff -C2 -d -r1.26 -r1.27 *** easy_domain.dtl 24 Feb 2008 21:40:26 -0000 1.26 --- easy_domain.dtl 24 Feb 2008 22:03:29 -0000 1.27 *************** *** 94,95 **** --- 94,96 ---- val dnsText = \from -> \to -> dns (dnsTXT (srv_literal from) to); val dnsDefaultText = \to -> dns (dnsTXT srv_default to); + Index: hcoop.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/hcoop.dtl,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** hcoop.dtl 18 Feb 2008 17:17:43 -0000 1.5 --- hcoop.dtl 24 Feb 2008 22:03:30 -0000 1.6 *************** *** 19,20 **** --- 19,24 ---- val krunk_ip : (ip) = "69.90.123.70"; val fyodor_ip : (ip) = "64.20.38.170"; + + val simple_web = \host -> \docroot -> web host where + DocumentRoot = home docroot + with end; |
|
From: Adam C. <ad...@us...> - 2008-02-24 21:58:26
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv21351/src Modified Files: describe.sml tycheck.sml Log Message: Improve some error messages Index: tycheck.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/tycheck.sml,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** tycheck.sml 15 Dec 2007 21:05:10 -0000 1.22 --- tycheck.sml 24 Feb 2008 21:58:17 -0000 1.23 *************** *** 444,448 **** end | (TError, _) => t2 ! | _ => (dte (WrongForm ("Action to be sequenced", "action", e2, --- 444,448 ---- end | (TError, _) => t2 ! | _ => (dte (WrongForm ("First action to be sequenced", "action", e2, *************** *** 451,455 **** (TError, loc))) | (TError, _) => t1 ! | _ => (dte (WrongForm ("Action to be sequenced", "action", e1, --- 451,455 ---- (TError, loc))) | (TError, _) => t1 ! | _ => (dte (WrongForm ("Second action to be sequenced", "action", e1, *************** *** 503,507 **** end | (TError, _) => t2 ! | _ => (dte (WrongForm ("Action to be sequenced", "action", e2, --- 503,507 ---- end | (TError, _) => t2 ! | _ => (dte (WrongForm ("Body of local settings", "action", e2, *************** *** 510,514 **** (TError, loc))) | (TError, _) => t1 ! | _ => (dte (WrongForm ("Action to be sequenced", "action", e1, --- 510,514 ---- (TError, loc))) | (TError, _) => t1 ! | _ => (dte (WrongForm ("Local settings", "action", e1, Index: describe.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/describe.sml,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** describe.sml 15 Dec 2007 21:05:10 -0000 1.4 --- describe.sml 24 Feb 2008 21:58:17 -0000 1.5 *************** *** 138,142 **** | 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."; preface (" Expression so far:", p_exp e); preface ("Next argument type:", p_typ (get_first_arg t))) --- 138,142 ---- | 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))) |
|
From: Adam C. <ad...@us...> - 2008-02-24 21:47:11
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv16732/src/plugins Modified Files: easy_domain.sml Log Message: Add back mistakenly removed default env var Index: easy_domain.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/easy_domain.sml,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** easy_domain.sml 24 Feb 2008 21:32:44 -0000 1.4 --- easy_domain.sml 24 Feb 2008 21:47:04 -0000 1.5 *************** *** 35,38 **** --- 35,42 ---- (fn () => (EVar "true", dl))) + val _ = Defaults.registerDefault ("DefaultAlias", + (TBase "bool", dl), + (fn () => (EVar "true", dl))) + val _ = Defaults.registerDefault ("HandleMail", (TBase "bool", dl), |
|
From: Adam C. <ad...@us...> - 2008-02-24 21:40:35
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv14313/lib Modified Files: easy_domain.dtl Log Message: Tweakier dom Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** easy_domain.dtl 24 Feb 2008 20:21:41 -0000 1.25 --- easy_domain.dtl 24 Feb 2008 21:40:26 -0000 1.26 *************** *** 54,59 **** dns (dnsA default (ip_of_node (web_node_to_node web_node))); ! handleMail; ! dns (dnsMX 1 "deleuze.hcoop.net"); createWWW : bool <- CreateWWW; --- 54,70 ---- dns (dnsA default (ip_of_node (web_node_to_node web_node))); ! hmail : bool <- HandleMail; ! if hmail then ! handleMail ! else ! Skip ! end; ! ! amx : bool <- AddMX; ! if amx then ! dns (dnsMX 1 "deleuze.hcoop.net") ! else ! Skip ! end; createWWW : bool <- CreateWWW; |
|
From: Adam C. <ad...@us...> - 2008-02-24 21:32:49
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv11035/src/plugins Modified Files: easy_domain.sml Log Message: Add new Easy_domain env defaults Index: easy_domain.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/easy_domain.sml,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** easy_domain.sml 15 Dec 2007 20:17:28 -0000 1.3 --- easy_domain.sml 24 Feb 2008 21:32:44 -0000 1.4 *************** *** 35,39 **** (fn () => (EVar "true", dl))) ! val _ = Defaults.registerDefault ("DefaultAlias", (TBase "bool", dl), (fn () => (EVar "true", dl))) --- 35,43 ---- (fn () => (EVar "true", dl))) ! val _ = Defaults.registerDefault ("HandleMail", ! (TBase "bool", dl), ! (fn () => (EVar "true", dl))) ! ! val _ = Defaults.registerDefault ("AddMX", (TBase "bool", dl), (fn () => (EVar "true", dl))) |
|
From: Adam C. <ad...@us...> - 2008-02-24 20:53:40
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv27690/src/plugins Modified Files: apache.sml Log Message: testNoHtaccess Index: apache.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/apache.sml,v retrieving revision 1.77 retrieving revision 1.78 diff -C2 -d -r1.77 -r1.78 *** apache.sml 18 Feb 2008 17:17:44 -0000 1.77 --- apache.sml 24 Feb 2008 20:53:04 -0000 1.78 *************** *** 1051,1053 **** --- 1051,1056 ---- heading = fn host => "SSL web vhost " ^ host ^ ":"}]) + val () = Env.action_none "testNoHtaccess" + (fn path => write "\tAllowOverride None\n") + end |
|
From: Adam C. <ad...@us...> - 2008-02-24 20:53:39
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv27690/lib Modified Files: apache.dtl Log Message: testNoHtaccess Index: apache.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/apache.dtl,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** apache.dtl 18 Feb 2008 17:17:43 -0000 1.15 --- apache.dtl 24 Feb 2008 20:53:04 -0000 1.16 *************** *** 80,81 **** --- 80,83 ---- {{Like serverAliasDefault, but adds aliases for the domains being configured instead of any of their hosts/"subdomains".}} + + extern val testNoHtaccess : [Location]; |
|
From: Adam C. <ad...@us...> - 2008-02-24 20:36:51
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv21248/src Modified Files: domain.sml main-admin.sml main.sml openssl.sig openssl.sml Log Message: Less noisy pinging and shutting down Index: domain.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/domain.sml,v retrieving revision 1.64 retrieving revision 1.65 diff -C2 -d -r1.64 -r1.65 *** domain.sml 19 Jan 2008 20:17:27 -0000 1.64 --- domain.sml 24 Feb 2008 20:36:46 -0000 1.65 *************** *** 700,707 **** Slave.handleChanges files else let ! val bio = OpenSSL.connect (valOf (!ssl_context), ! nodeIp site ! ^ ":" ! ^ Int.toString Config.slavePort) in app (fn file => Msg.send (bio, MsgFile file)) files; --- 700,707 ---- Slave.handleChanges files else let ! val bio = OpenSSL.connect true (valOf (!ssl_context), ! nodeIp site ! ^ ":" ! ^ Int.toString Config.slavePort) in app (fn file => Msg.send (bio, MsgFile file)) files; Index: openssl.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/openssl.sml,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** openssl.sml 17 Nov 2007 15:17:44 -0000 1.10 --- openssl.sml 24 Feb 2008 20:36:46 -0000 1.11 *************** *** 267,273 **** end ! fun connect (context, hostname) = let val bio = F_OpenSSL_SML_new_ssl_connect.f' context in if C.Ptr.isNull' bio then --- 267,279 ---- end ! fun connect printErr (context, hostname) = let val bio = F_OpenSSL_SML_new_ssl_connect.f' context + + val ssl_err = + if printErr then + ssl_err + else + (fn _ => ()) in if C.Ptr.isNull' bio then Index: openssl.sig =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/openssl.sig,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** openssl.sig 12 May 2007 21:59:22 -0000 1.6 --- openssl.sig 24 Feb 2008 20:36:46 -0000 1.7 *************** *** 42,46 **** val context : bool -> string * string * string -> context ! val connect : context * string -> bio val close : bio -> unit --- 42,46 ---- val context : bool -> string * string * string -> context ! val connect : bool -> context * string -> bio val close : bio -> unit Index: main.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v retrieving revision 1.99 retrieving revision 1.100 diff -C2 -d -r1.99 -r1.100 *** main.sml 24 Feb 2008 20:13:45 -0000 1.99 --- main.sml 24 Feb 2008 20:36:46 -0000 1.100 *************** *** 234,251 **** end ! fun requestBio f = let val (user, context) = requestContext f in ! (user, OpenSSL.connect (context, dispatcher)) end ! fun requestSlaveBio () = let val (user, context) = requestContext (fn () => ()) in ! (user, OpenSSL.connect (context, self)) end fun request fname = let --- 234,255 ---- end ! fun requestBio' printErr f = let val (user, context) = requestContext f in ! (user, OpenSSL.connect printErr (context, dispatcher)) end ! val requestBio = requestBio' true ! ! fun requestSlaveBio' printErr = let val (user, context) = requestContext (fn () => ()) in ! (user, OpenSSL.connect printErr (context, self)) end + fun requestSlaveBio () = requestSlaveBio' true + fun request fname = let *************** *** 342,346 **** fun requestPing () = let ! val (_, bio) = requestBio (fn () => ()) in OpenSSL.close bio; --- 346,350 ---- fun requestPing () = let ! val (_, bio) = requestBio' false (fn () => ()) in OpenSSL.close bio; *************** *** 355,359 **** Msg.send (bio, MsgShutdown); case Msg.recv bio of ! NONE => print "Server closed connection unexpectedly.\n" | SOME m => case m of --- 359,363 ---- Msg.send (bio, MsgShutdown); case Msg.recv bio of ! NONE => () | SOME m => case m of *************** *** 366,370 **** fun requestSlavePing () = let ! val (_, bio) = requestSlaveBio () in OpenSSL.close bio; --- 370,374 ---- fun requestSlavePing () = let ! val (_, bio) = requestSlaveBio' false in OpenSSL.close bio; *************** *** 379,383 **** Msg.send (bio, MsgShutdown); case Msg.recv bio of ! NONE => print "Server closed connection unexpectedly.\n" | SOME m => case m of --- 383,387 ---- Msg.send (bio, MsgShutdown); case Msg.recv bio of ! NONE => () | SOME m => case m of *************** *** 722,729 **** let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QApt pkg)) --- 726,733 ---- let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect true (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QApt pkg)) *************** *** 751,758 **** let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QCron uname)) --- 755,762 ---- let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect true (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QCron uname)) *************** *** 780,787 **** let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QFtp uname)) --- 784,791 ---- let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect true (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QFtp uname)) *************** *** 809,816 **** let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QTrustedPath uname)) --- 813,820 ---- let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect true (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QTrustedPath uname)) *************** *** 838,845 **** let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QSocket uname)) --- 842,849 ---- let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect true (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) val _ = Msg.send (bio, MsgQuery (QSocket uname)) *************** *** 869,877 **** let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) ! val _ = Msg.send (bio, MsgQuery (QFirewall uname)) --- 873,881 ---- let val (user, context) = requestContext (fn () => ()) ! val bio = OpenSSL.connect true (context, if node = Config.masterNode then ! dispatcher ! else ! Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort) ! val _ = Msg.send (bio, MsgQuery (QFirewall uname)) *************** *** 990,997 **** Domain.resetLocal () else let ! val bio = OpenSSL.connect (context, ! ip ! ^ ":" ! ^ Int.toString Config.slavePort) in Msg.send (bio, MsgRegenerate); --- 994,1001 ---- Domain.resetLocal () else let ! val bio = OpenSSL.connect true (context, ! ip ! ^ ":" ! ^ Int.toString Config.slavePort) in Msg.send (bio, MsgRegenerate); Index: main-admin.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main-admin.sml,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** main-admin.sml 9 Dec 2007 12:52:57 -0000 1.25 --- main-admin.sml 24 Feb 2008 20:36:46 -0000 1.26 *************** *** 62,66 **** | _ => (print "Invalid command-line arguments\n"; ! print "See the documentation: http://wiki2.hcoop.net/DomTool/AdminProcedures\n")) handle OpenSSL.OpenSSL s => (print ("OpenSSL exception: " ^ s ^ "\n"); OS.Process.exit OS.Process.failure) --- 62,66 ---- | _ => (print "Invalid command-line arguments\n"; ! print "See the documentation: http://wiki.hcoop.net/DomTool/AdminProcedures\n")) handle OpenSSL.OpenSSL s => (print ("OpenSSL exception: " ^ s ^ "\n"); OS.Process.exit OS.Process.failure) |
|
From: Adam C. <ad...@us...> - 2008-02-24 20:21:45
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv15465/lib Modified Files: easy_domain.dtl Log Message: Remove dnsKerberos, at mwolson's request Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** easy_domain.dtl 24 Feb 2008 15:50:24 -0000 1.24 --- easy_domain.dtl 24 Feb 2008 20:21:41 -0000 1.25 *************** *** 83,86 **** val dnsText = \from -> \to -> dns (dnsTXT (srv_literal from) to); val dnsDefaultText = \to -> dns (dnsTXT srv_default to); - - val dnsKerberos = \to -> dns (dnsTXT (srv_literal "_kerberos") to); --- 83,84 ---- |
|
From: Adam C. <ad...@us...> - 2008-02-24 20:13:50
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv12345/src Modified Files: domtool.grm main.sml Log Message: Suppress unused env var warnings for lib.dtl Index: domtool.grm =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/domtool.grm,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** domtool.grm 24 Feb 2008 20:10:15 -0000 1.17 --- domtool.grm 24 Feb 2008 20:13:45 -0000 1.18 *************** *** 80,84 **** %% ! file : docOpt decls expOpt SEMIopt (docOpt, decls, expOpt) decls : ([]) --- 80,84 ---- %% ! file : docOpt decls expOpt (docOpt, decls, expOpt) decls : ([]) Index: main.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v retrieving revision 1.98 retrieving revision 1.99 diff -C2 -d -r1.98 -r1.99 *** main.sml 24 Feb 2008 20:10:16 -0000 1.98 --- main.sml 24 Feb 2008 20:13:45 -0000 1.99 *************** *** 47,51 **** G else ! (Option.app (Unused.check G) (#3 prog); Tycheck.checkFile G (Defaults.tInit prog) prog) end --- 47,54 ---- G else ! (if isLib fname then ! () ! else ! Option.app (Unused.check G) (#3 prog); Tycheck.checkFile G (Defaults.tInit prog) prog) end *************** *** 103,107 **** raise ErrorMsg.Error else ! (Option.app (Unused.check G) (#3 prog); (G', #3 prog)) end --- 106,113 ---- raise ErrorMsg.Error else ! (if isLib fname then ! () ! else ! Option.app (Unused.check G) (#3 prog); (G', #3 prog)) end |
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv11070/src Modified Files: autodoc.sml defaults.sig defaults.sml domtool.grm eval.sml main-client.sml main.sig main.sml Log Message: Saving environment variables across file executions Index: defaults.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/defaults.sml,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** defaults.sml 3 Sep 2006 19:38:36 -0000 1.1 --- defaults.sml 24 Feb 2008 20:10:15 -0000 1.2 *************** *** 36,43 **** | SOME _ => raise Fail "Duplicate default environment variable" ! fun tInit () = (TAction ((CRoot, dmy), ! !defaultT, ! StringMap.empty), ! dmy) fun eInit () = SM.map (fn f => f ()) (!defaultV) --- 36,60 ---- | SOME _ => raise Fail "Duplicate default environment variable" ! fun allSets (e, _) = ! case e of ! ESkip => true ! | ESet _ => true ! | ESeq es => List.all allSets es ! | _ => false ! ! val dmy = ErrorMsg.dummyLoc ! ! fun bodyType (_, _, SOME e) = ! if allSets e then ! (CPrefix (CRoot, dmy), dmy) ! else ! (CRoot, dmy) ! | bodyType _ = (CRoot, dmy) ! ! fun tInit p = ! (TAction (bodyType p, ! !defaultT, ! StringMap.empty), ! dmy) fun eInit () = SM.map (fn f => f ()) (!defaultV) Index: autodoc.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/autodoc.sml,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** autodoc.sml 16 Dec 2007 20:22:03 -0000 1.8 --- autodoc.sml 24 Feb 2008 20:10:15 -0000 1.9 *************** *** 37,41 **** G else ! Tycheck.checkFile G (Defaults.tInit ()) prog end --- 37,41 ---- G else ! Tycheck.checkFile G (Defaults.tInit prog) prog end Index: defaults.sig =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/defaults.sig,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** defaults.sig 3 Sep 2006 19:38:36 -0000 1.1 --- defaults.sig 24 Feb 2008 20:10:15 -0000 1.2 *************** *** 22,26 **** val registerDefault : string * Ast.typ * (unit -> Ast.exp) -> unit ! val tInit : unit -> Ast.typ val eInit : unit -> Env.env_vars end --- 22,26 ---- val registerDefault : string * Ast.typ * (unit -> Ast.exp) -> unit ! val tInit : Ast.file -> Ast.typ val eInit : unit -> Env.env_vars end Index: main.sig =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sig,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 *** main.sig 17 Nov 2007 17:44:11 -0000 1.45 --- main.sig 24 Feb 2008 20:10:15 -0000 1.46 *************** *** 24,28 **** val setupUser : unit -> string ! val check : string -> Env.env * Ast.exp option val check' : Env.env -> string -> Env.env val checkDir : string -> unit --- 24,28 ---- val setupUser : unit -> string ! val check : Env.env -> string -> Env.env * Ast.exp option val check' : Env.env -> string -> Env.env val checkDir : string -> unit *************** *** 30,35 **** val basis : unit -> Env.env ! val reduce : string -> Ast.exp option ! val eval : string -> unit val request : string -> unit --- 30,35 ---- 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 val request : string -> unit Index: domtool.grm =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/domtool.grm,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** domtool.grm 15 Dec 2007 20:17:26 -0000 1.16 --- domtool.grm 24 Feb 2008 20:10:15 -0000 1.17 *************** *** 80,84 **** %% ! file : docOpt decls expOpt (docOpt, decls, expOpt) decls : ([]) --- 80,84 ---- %% ! file : docOpt decls expOpt SEMIopt (docOpt, decls, expOpt) decls : ([]) *************** *** 97,102 **** expOpt : (NONE) ! | exp (SOME (ELocal (exp, (ESkip, (expleft, expright))), ! (expleft, expright))) --- 97,101 ---- expOpt : (NONE) ! | exp (SOME exp) Index: eval.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/eval.sml,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** eval.sml 15 Dec 2007 20:17:26 -0000 1.9 --- eval.sml 24 Feb 2008 20:10:15 -0000 1.10 *************** *** 119,121 **** --- 119,123 ---- end + val exec' = fn evs => fn e => conjoin (evs, exec' evs e) + end Index: main-client.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main-client.sml,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** main-client.sml 17 Nov 2007 13:51:22 -0000 1.8 --- main-client.sml 24 Feb 2008 20:10:15 -0000 1.9 *************** *** 34,38 **** val (doit, doitDir, args) = case CommandLine.arguments () of ! "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check fname)), Main.checkDir, args) --- 34,38 ---- val (doit, doitDir, args) = case CommandLine.arguments () of ! "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check (Main.basis ()) fname)), Main.checkDir, args) Index: main.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v retrieving revision 1.97 retrieving revision 1.98 diff -C2 -d -r1.97 -r1.98 *** main.sml 1 Jan 2008 22:27:58 -0000 1.97 --- main.sml 24 Feb 2008 20:10:16 -0000 1.98 *************** *** 26,33 **** fun init () = Acl.read Config.aclFile ! fun check' G fname = let val prog = Parse.parse fname in if !ErrorMsg.anyErrors then --- 26,46 ---- fun init () = Acl.read Config.aclFile ! ! fun isLib fname = OS.Path.file fname = "lib.dtl" ! ! fun wrapFile (fname, file) = ! case (isLib fname, file) of ! (true, (comment, ds, SOME e)) => ! let ! val (_, loc) = e ! in ! (comment, ds, SOME (ELocal (e, (ESkip, loc)), loc)) ! end ! | _ => file ! fun check' G fname = let val prog = Parse.parse fname + val prog = wrapFile (fname, prog) in if !ErrorMsg.anyErrors then *************** *** 35,39 **** else (Option.app (Unused.check G) (#3 prog); ! Tycheck.checkFile G (Defaults.tInit ()) prog) end --- 48,52 ---- else (Option.app (Unused.check G) (#3 prog); ! Tycheck.checkFile G (Defaults.tInit prog) prog) end *************** *** 65,74 **** end ! fun check fname = let val _ = ErrorMsg.reset () val _ = Env.preTycheck () - - val b = basis () in if !ErrorMsg.anyErrors then --- 78,87 ---- end ! (* val b = basis () *) ! ! fun check G fname = let val _ = ErrorMsg.reset () val _ = Env.preTycheck () in if !ErrorMsg.anyErrors then *************** *** 79,82 **** --- 92,96 ---- val _ = ErrorMsg.reset () val prog = Parse.parse fname + val prog = wrapFile (fname, prog) in if !ErrorMsg.anyErrors then *************** *** 84,93 **** else let ! val G' = Tycheck.checkFile b (Defaults.tInit ()) prog in if !ErrorMsg.anyErrors then raise ErrorMsg.Error else ! (Option.app (Unused.check b) (#3 prog); (G', #3 prog)) end --- 98,107 ---- else let ! val G' = Tycheck.checkFile G (Defaults.tInit prog) prog in if !ErrorMsg.anyErrors then raise ErrorMsg.Error else ! (Option.app (Unused.check G) (#3 prog); (G', #3 prog)) end *************** *** 151,157 **** checkDir' dname) ! fun reduce fname = let ! val (G, body) = check fname in if !ErrorMsg.anyErrors then --- 165,171 ---- checkDir' dname) ! fun reduce G fname = let ! val (G, body) = check G fname in if !ErrorMsg.anyErrors then *************** *** 167,192 **** PD.space 1, p_exp body']))*) ! SOME body' end | _ => NONE end ! fun eval fname = ! case reduce fname of ! (SOME body') => ! if !ErrorMsg.anyErrors then ! raise ErrorMsg.Error ! else ! Eval.exec (Defaults.eInit ()) body' ! | NONE => () ! fun eval' fname = ! case reduce fname of ! (SOME body') => if !ErrorMsg.anyErrors then raise ErrorMsg.Error else ! ignore (Eval.exec' (Defaults.eInit ()) body') ! | NONE => () val dispatcher = --- 181,203 ---- PD.space 1, p_exp body']))*) ! SOME (G, body') end | _ => NONE end ! (*(Defaults.eInit ())*) ! fun eval G evs fname = ! case reduce G fname of ! SOME (G, body') => if !ErrorMsg.anyErrors then raise ErrorMsg.Error else ! let ! val evs' = Eval.exec' evs body' ! in ! (G, evs') ! end ! | NONE => (G, evs) val dispatcher = *************** *** 233,237 **** fun request fname = let ! val (user, bio) = requestBio (fn () => ignore (check fname)) val inf = TextIO.openIn fname --- 244,248 ---- fun request fname = let ! val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname)) val inf = TextIO.openIn fname *************** *** 1018,1021 **** --- 1029,1035 ---- val files = loop [] val (_, files) = Order.order (SOME b) files + + fun checker' (file, (G, evs)) = + checker G evs file in if !ErrorMsg.anyErrors then *************** *** 1025,1029 **** else (); ! app checker files end else if String.isSuffix "_admin" user then --- 1039,1043 ---- else (); ! ignore (foldl checker' (basis (), Defaults.eInit ()) files) end else if String.isSuffix "_admin" user then *************** *** 1066,1071 **** end ! val regenerate = regenerateEither false eval' ! val regenerateTc = regenerateEither true (ignore o check) fun rmuser user = --- 1080,1087 ---- end ! val regenerate = regenerateEither false eval ! val regenerateTc = regenerateEither true ! (fn G => fn evs => fn file => ! (#1 (check G file), evs)) fun rmuser user = *************** *** 1166,1170 **** val outname = OS.FileSys.tmpName () ! fun doOne code = let val outf = TextIO.openOut outname --- 1182,1186 ---- val outname = OS.FileSys.tmpName () ! fun doOne (code, (G, evs)) = let val outf = TextIO.openOut outname *************** *** 1172,1180 **** TextIO.output (outf, code); TextIO.closeOut outf; ! eval' outname end in doIt (fn () => (Env.pre (); ! app doOne codes; Env.post (); Msg.send (bio, MsgOk); --- 1188,1196 ---- TextIO.output (outf, code); TextIO.closeOut outf; ! eval G evs outname end in doIt (fn () => (Env.pre (); ! ignore (foldl doOne (basis (), Defaults.eInit ()) codes); Env.post (); Msg.send (bio, MsgOk); |
|
From: Adam C. <ad...@us...> - 2008-02-24 18:33:18
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv6103/src Modified Files: order.sml Log Message: Remove pesky infinite loop Index: order.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/order.sml,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** order.sml 24 Feb 2008 18:23:44 -0000 1.8 --- order.sml 24 Feb 2008 18:33:13 -0000 1.9 *************** *** 301,322 **** end ! fun order basisOpt fnames = ! let ! val (providers, fnames) = order basisOpt fnames ! val (hasLib, fnames) = foldl (fn (fname, (hasLib, fnames)) => ! if OS.Path.file fname = "lib.dtl" then ! (SOME fname, fnames) ! else ! (hasLib, fname :: fnames)) ! (NONE, []) fnames ! val fnames = rev fnames ! val fnames = case hasLib of ! NONE => fnames ! | SOME hasLib => hasLib :: fnames ! in ! (providers, fnames) ! end type providers = {provideC : string SM.map, --- 301,322 ---- end ! val order = fn basisOpt => fn fnames => ! let ! val (providers, fnames) = order basisOpt fnames ! val (hasLib, fnames) = foldl (fn (fname, (hasLib, fnames)) => ! if OS.Path.file fname = "lib.dtl" then ! (SOME fname, fnames) ! else ! (hasLib, fname :: fnames)) ! (NONE, []) fnames ! val fnames = rev fnames ! val fnames = case hasLib of ! NONE => fnames ! | SOME hasLib => hasLib :: fnames ! in ! (providers, fnames) ! end type providers = {provideC : string SM.map, |
|
From: Adam C. <ad...@us...> - 2008-02-24 18:23:48
|
Update of /cvsroot/hcoop/domtool2/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv1907/src Modified Files: order.sml Log Message: Put files called lib.dtl first in dependency orderings Index: order.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/order.sml,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** order.sml 15 Dec 2007 19:52:21 -0000 1.7 --- order.sml 24 Feb 2008 18:23:44 -0000 1.8 *************** *** 301,304 **** --- 301,323 ---- end + fun order basisOpt fnames = + let + val (providers, fnames) = order basisOpt fnames + + val (hasLib, fnames) = foldl (fn (fname, (hasLib, fnames)) => + if OS.Path.file fname = "lib.dtl" then + (SOME fname, fnames) + else + (hasLib, fname :: fnames)) + (NONE, []) fnames + + val fnames = rev fnames + val fnames = case hasLib of + NONE => fnames + | SOME hasLib => hasLib :: fnames + in + (providers, fnames) + end + type providers = {provideC : string SM.map, provideT : string SM.map, |
|
From: Adam C. <ad...@us...> - 2008-02-24 17:41:31
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv17587 Modified Files: poll.mlt poll.sig poll.sml tables.sql Log Message: Poll voting limit by membership length Index: poll.sig =================================================================== RCS file: /cvsroot/hcoop/portal/poll.sig,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** poll.sig 28 Sep 2005 14:54:19 -0000 1.3 --- poll.sig 24 Feb 2008 17:41:23 -0000 1.4 *************** *** 1,4 **** signature POLL = sig ! type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int} val lookupPoll : int -> poll --- 1,4 ---- signature POLL = sig ! type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool} val lookupPoll : int -> poll *************** *** 7,11 **** val listPollsLimit : int -> poll list ! val addPoll : int * string * string * string * string * int -> int val modPoll : poll -> unit val deletePoll : int -> unit --- 7,11 ---- val listPollsLimit : int -> poll list ! val addPoll : int * string * string * string * string * int * bool -> int val modPoll : poll -> unit val deletePoll : int -> unit *************** *** 42,44 **** --- 42,48 ---- val countVoters : int -> int val listPollVoters : int -> Init.user list + + val votingMembershipRequirement : int + + val membershipLength : int -> int end Index: tables.sql =================================================================== RCS file: /cvsroot/hcoop/portal/tables.sql,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** tables.sql 16 Dec 2007 17:06:55 -0000 1.30 --- tables.sql 24 Feb 2008 17:41:23 -0000 1.31 *************** *** 105,108 **** --- 105,109 ---- ends DATE NOT NULL, votes INTEGER NOT NULL, + official BOOL NOT NULL, FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE); Index: poll.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/poll.mlt,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** poll.mlt 24 Jan 2008 23:09:10 -0000 1.9 --- poll.mlt 24 Feb 2008 17:41:22 -0000 1.10 *************** *** 28,34 **** --- 28,38 ---- <tr> <td>End:</td> <td><% Web.html (#ends poll) %></td> </tr> <tr> <td>Votes/person:</td> <td><% #votes poll %></td> </tr> + <tr> <td>Official:</td> <td><% if #official poll then "yes" else "no" end %></td> </tr> <tr> <td>Description:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr> </table> + <% if #official poll and Poll.membershipLength (Init.getUserId ()) < Poll.votingMembershipRequirement then %> + <h3>You haven't been a member long enough to vote in an official poll.</h3> + <% else %> <h3>Choices</h3> *************** *** 48,52 **** </form> ! <% elseif $"vote2" <> "" then val id = Web.stoi ($"vote2"); val poll = Poll.lookupPoll id; --- 52,57 ---- </form> ! <% end ! elseif $"vote2" <> "" then val id = Web.stoi ($"vote2"); val poll = Poll.lookupPoll id; *************** *** 57,61 **** | v => map Web.stoi v; ! if length votes > #votes poll then %><h3>You can't vote for that many different choices!</h3><% elseif not (Poll.noDupes votes) then --- 62,68 ---- | v => map Web.stoi v; ! if #official poll and Poll.membershipLength (Init.getUserId ()) < Poll.votingMembershipRequirement then ! %><h3>You haven't been a member long enough to vote in an official poll.</h3><% ! elseif length votes > #votes poll then %><h3>You can't vote for that many different choices!</h3><% elseif not (Poll.noDupes votes) then *************** *** 71,74 **** --- 78,82 ---- val ends = $"ends"; val votes = Web.stoi ($"votes"); + val official = $"official" = "on"; if title = "" then %><h3>Your poll must have a title.</h3><% *************** *** 80,84 **** %><h3>You must specify a positive number of votes per person.</h3><% else ! val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes); editingPoll := SOME id; %><h3>Poll added!</h3><% --- 88,92 ---- %><h3>You must specify a positive number of votes per person.</h3><% else ! val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes, official); editingPoll := SOME id; %><h3>Poll added!</h3><% *************** *** 99,102 **** --- 107,111 ---- <tr> <td>End date:</td> <td><input name="ends" value="<% Web.html (#ends poll) %>"></td> </tr> <tr> <td>Max votes/person:</td> <td><input name="votes" value="<% #votes poll %>"></td> </tr> + <tr> <td>Official:</td> <td><input type="checkbox" name="official"<% if #official poll then " checked" end %>></td> </tr> <tr> <td>Description:</td> <td><textarea name="descr" wrap="soft" rows="5" cols="80"><% Web.html (#descr poll) %></textarea></td> </tr> <tr> <td><input type="submit" name="cmd" value="Save"></td> </tr> *************** *** 113,116 **** --- 122,126 ---- val ends = $"ends"; val votes = Web.stoi ($"votes"); + val official = $"official" = "on"; if title = "" then %><h3>Your poll must have a title.</h3><% *************** *** 122,126 **** %><h3>You must specify a positive number of votes per person.</h3><% else ! Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes}; editingPoll := SOME (#id poll); %><h3>Poll record saved.</h3><% --- 132,136 ---- %><h3>You must specify a positive number of votes per person.</h3><% else ! Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes, official = official}; editingPoll := SOME (#id poll); %><h3>Poll record saved.</h3><% *************** *** 225,228 **** --- 235,239 ---- <tr> <td>End:</td> <td><% Web.html (#ends poll) %></td> </tr> <tr> <td>Votes/person:</td> <td><% #votes poll %></td> </tr> + <tr> <td>Official:</td> <td><% if #official poll then "yes" else "no" end %></td> </tr> <tr> <td>Description:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr> </table> *************** *** 264,267 **** --- 275,279 ---- <tr> <td>End:</td> <td><% Web.html (#ends poll) %></td> </tr> <tr> <td>Votes/person:</td> <td><% #votes poll %></td> </tr> + <tr> <td>Official:</td> <td><% if #official poll then "yes" else "no" end %></td> </tr> <tr> <td>Description:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr> </table> *************** *** 316,320 **** if showNormal then ! val polls = Poll.listCurrentPolls (); switch polls of _::_ => %> --- 328,336 ---- if showNormal then ! val mlen = Poll.membershipLength (Init.getUserId ()) %> ! ! <p>You have been an HCoop member for <% mlen %> days, so you <b>are<% if mlen < Poll.votingMembershipRequirement then %> not<% end %></b> eligible to vote in official polls.</p> ! ! <% val polls = Poll.listCurrentPolls (); switch polls of _::_ => %> *************** *** 339,342 **** --- 355,359 ---- <tr> <td>End date:</td> <td><input name="ends"></td> </tr> <tr> <td>Max votes/person:</td> <td><input name="votes"></td> </tr> + <tr> <td>Official:</td> <td><input type="checkbox" name="official"></td> </tr> <tr> <td>Description:</td> <td><textarea name="descr" wrap="soft" rows="5" cols="80"></textarea></td> </tr> <tr> <td><input type="submit" value="Create"></td> </tr> Index: poll.sml =================================================================== RCS file: /cvsroot/hcoop/portal/poll.sml,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** poll.sml 22 Nov 2007 19:24:00 -0000 1.7 --- poll.sml 24 Feb 2008 17:41:23 -0000 1.8 *************** *** 4,17 **** open Util Sql Init ! type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int} ! fun mkPollRow [id, usr, title, descr, starts, ends, votes] = {id = C.intFromSql id, usr = C.intFromSql usr, title = C.stringFromSql title, descr = C.stringFromSql descr, starts = C.stringFromSql starts, ! ends = C.stringFromSql ends, votes = C.intFromSql votes} | mkPollRow row = Init.rowError ("poll", row) fun lookupPoll id = ! case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes FROM Poll WHERE id = ^(C.intToSql id)`) of --- 4,17 ---- open Util Sql Init ! type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool} ! fun mkPollRow [id, usr, title, descr, starts, ends, votes, official] = {id = C.intFromSql id, usr = C.intFromSql usr, title = C.stringFromSql title, descr = C.stringFromSql descr, starts = C.stringFromSql starts, ! ends = C.stringFromSql ends, votes = C.intFromSql votes, official = C.boolFromSql official} | mkPollRow row = Init.rowError ("poll", row) fun lookupPoll id = ! case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll WHERE id = ^(C.intToSql id)`) of *************** *** 20,29 **** fun listPolls () = ! C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes FROM Poll ORDER BY ends, starts DESC, title`) fun listCurrentPolls () = ! C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes FROM Poll WHERE EXTRACT(EPOCH FROM starts) <= EXTRACT(EPOCH FROM CURRENT_DATE) --- 20,29 ---- fun listPolls () = ! C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll ORDER BY ends, starts DESC, title`) fun listCurrentPolls () = ! C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll WHERE EXTRACT(EPOCH FROM starts) <= EXTRACT(EPOCH FROM CURRENT_DATE) *************** *** 32,48 **** fun listPollsLimit lim = ! C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes FROM Poll ORDER BY starts DESC, ends, title LIMIT ^(C.intToSql lim)`) ! fun addPoll (usr, title, descr, starts, ends, votes) = let val db = getDb () val id = nextSeq (db, "PollSeq") in ! C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes) VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr), ! ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes))`); id end --- 32,48 ---- fun listPollsLimit lim = ! C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll ORDER BY starts DESC, ends, title LIMIT ^(C.intToSql lim)`) ! fun addPoll (usr, title, descr, starts, ends, votes, official) = let val db = getDb () val id = nextSeq (db, "PollSeq") in ! C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes, official) VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr), ! ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes), ^(C.boolToSql official))`); id end *************** *** 56,60 **** descr = ^(C.stringToSql (#descr poll)), starts = ^(C.stringToSql (#starts poll)), ends = ^(C.stringToSql (#ends poll)), ! votes = ^(C.intToSql (#votes poll)) WHERE id = ^(C.intToSql (#id poll))`)) end --- 56,60 ---- descr = ^(C.stringToSql (#descr poll)), starts = ^(C.stringToSql (#starts poll)), ends = ^(C.stringToSql (#ends poll)), ! votes = ^(C.intToSql (#votes poll)), official = ^(C.boolToSql (#official poll)) WHERE id = ^(C.intToSql (#id poll))`)) end *************** *** 216,218 **** --- 216,227 ---- ORDER BY name`) + val votingMembershipRequirement = 45 + + fun membershipLength id = + case C.oneRow (getDb ()) ($`SELECT EXTRACT(DAY FROM (CURRENT_TIMESTAMP - joined)) + FROM WebUser + WHERE id = ^(C.intToSql id)`) of + [days] => C.intFromSql days + | row => Init.rowError ("membershipLength", row) + end |
|
From: Adam C. <ad...@us...> - 2008-02-24 17:11:10
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5441 Modified Files: money.mlt money.sig money.sml Log Message: Most of lowering of pledges for delinquents Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** money.mlt 22 Feb 2008 00:59:15 -0000 1.22 --- money.mlt 24 Feb 2008 17:11:02 -0000 1.23 *************** *** 460,463 **** --- 460,480 ---- end + elseif $"cmd" = "delinq" then + showNormal := false; + val dqs = Money.delinquentPledgers () %> + <table> + <tr> <th>Member</th> <th>Pledge</th> <th>Balance</th> </tr> + <% foreach dq in dqs do %> + <tr> <td><a href="user?id=<% #id dq %>"><% #name dq %></a></td> <td><% #shares dq %></td> <td>$<% #balance dq %></td> </tr> + <% end %> + </table> + + <a href="?lower=<% String.concatWith "," (List.map (fn dq => Int.toString (#id dq)) dqs) %>">Lower these pledges to 1</a> + + <% elseif $"lower" <> "" then + Money.resetPledges (List.map Web.stoi (String.tokens (fn ch => ch = #",") ($"lower"))) + + %><h3>Pledges reset.</h3><% + end %> *************** *** 481,484 **** --- 498,502 ---- <% if (Group.inGroupName "money" and $"lookback" = "") or $"audit" <> "" then %> + <a href="?cmd=delinq">Drop pledges of delinquent members</a><br> <a href="?lookback=20">Switch to regular member view</a><br> Index: money.sml =================================================================== RCS file: /cvsroot/hcoop/portal/money.sml,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** money.sml 22 Nov 2007 19:24:00 -0000 1.12 --- money.sml 24 Feb 2008 17:11:02 -0000 1.13 *************** *** 274,276 **** --- 274,297 ---- | row => Init.rowError ("Bad costBase result", row) + val monthlyCost = 900.0 + 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} + | makeRow row = Init.rowError ("Bad delinquentPledgers", row) + in + 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`) + end + + fun resetPledges ids = + raise Fail ($`UPDATE WebUser SET shares = 1 WHERE id IN (^(String.concatWith ", " (List.map C.intToSql ids)))`) + end Index: money.sig =================================================================== RCS file: /cvsroot/hcoop/portal/money.sig,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** money.sig 24 Jul 2006 17:21:19 -0000 1.5 --- money.sig 24 Feb 2008 17:11:02 -0000 1.6 *************** *** 34,36 **** --- 34,39 ---- val costBase : real -> real + + val delinquentPledgers : unit -> { id : int, name : string, shares : int, balance : real } list + val resetPledges : int list -> unit end |
|
From: Adam C. <ad...@us...> - 2008-02-24 15:50:31
|
Update of /cvsroot/hcoop/domtool2/src/plugins In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5551/src/plugins Modified Files: bind.sml Log Message: Expanding TXT support Index: bind.sml =================================================================== RCS file: /cvsroot/hcoop/domtool2/src/plugins/bind.sml,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** bind.sml 18 Feb 2008 16:38:00 -0000 1.19 --- bind.sml 24 Feb 2008 15:50:25 -0000 1.20 *************** *** 58,62 **** | TXT of host * string | AFSDB of string ! | SRV of string * int * int * int * string fun hostS (Literal s) = s ^ "." --- 58,62 ---- | TXT of host * string | AFSDB of string ! | SRV of host * int * int * int * string fun hostS (Literal s) = s ^ "." *************** *** 72,75 **** --- 72,83 ---- | _ => NONE + val srv_host = fn (EApp ((EVar "srv_literal", _), e), _) => + Option.map Literal (Env.string e) + | (EVar "srv_wildcard", _) => + SOME Wildcard + | (EVar "srv_default", _) => + SOME Default + | _ => NONE + val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) => (case (host e1, Domain.ip e2) of *************** *** 91,95 **** | _ => NONE) | (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) => ! (case (host e1, Env.string e2) of (SOME v1, SOME v2) => SOME (TXT (v1, v2)) | _ => NONE) --- 99,103 ---- | _ => NONE) | (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) => ! (case (srv_host e1, Env.string e2) of (SOME v1, SOME v2) => SOME (TXT (v1, v2)) | _ => NONE) *************** *** 97,101 **** Option.map AFSDB (Env.string e) | (EApp ((EApp ((EApp ((EApp ((EApp ((EVar "dnsSRV", _), e1), _), e2), _), e3), _), e4), _), e5), _) => ! (case (Env.string e1, Env.int e2, Env.int e3, Env.int e4, Env.string e5) of (SOME v1, SOME v2, SOME v3, SOME v4, SOME v5) => SOME (SRV (v1, v2, v3, v4, v5)) | _ => NONE) --- 105,109 ---- Option.map AFSDB (Env.string e) | (EApp ((EApp ((EApp ((EApp ((EApp ((EVar "dnsSRV", _), e1), _), e2), _), e3), _), e4), _), e5), _) => ! (case (srv_host e1, Env.int e2, Env.int e3, Env.int e4, Env.string e5) of (SOME v1, SOME v2, SOME v3, SOME v4, SOME v5) => SOME (SRV (v1, v2, v3, v4, v5)) | _ => NONE) *************** *** 163,168 **** write host; write ".\n") ! | SRV (from, priority, weight, port, to) => (write from; ! write "."; writeDom (); write ".\t"; --- 171,175 ---- write host; write ".\n") ! | SRV (from, priority, weight, port, to) => (write (hostS from); writeDom (); write ".\t"; *************** *** 352,366 **** showEmpty = false}]) ! fun validHost_ s = size s > 0 andalso size s < 20 andalso CharVector.all (fn ch => Domain.isIdent ch orelse ch = #"-" orelse ch = #"_") s ! fun validSRVDomain s = size s > 0 andalso size s < 100 ! andalso List.all validHost_ (String.fields (fn ch => ch = #".") s) val _ = Env.type_one "srv_domain" Env.string ! validSRVDomain end --- 359,377 ---- showEmpty = false}]) ! fun validSrvHost s = size s > 0 andalso size s < 20 andalso CharVector.all (fn ch => Domain.isIdent ch orelse ch = #"-" orelse ch = #"_") s ! fun validSrvDomain s = size s > 0 andalso size s < 100 ! andalso List.all validSrvHost (String.fields (fn ch => ch = #".") s) ! ! val _ = Env.type_one "srv_host" ! Env.string ! validSrvHost val _ = Env.type_one "srv_domain" Env.string ! validSrvDomain end |
|
From: Adam C. <ad...@us...> - 2008-02-24 15:50:31
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5551/lib Modified Files: bind.dtl easy_domain.dtl Log Message: Expanding TXT support Index: easy_domain.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/easy_domain.dtl,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** easy_domain.dtl 18 Feb 2008 16:40:08 -0000 1.23 --- easy_domain.dtl 24 Feb 2008 15:50:24 -0000 1.24 *************** *** 81,84 **** val dnsDefault = \to -> dns (dnsA default to); val dnsDefaultv6 = \to -> dns (dnsAAAA default to); ! val dnsText = \from -> \to -> dns (dnsTXT (literal from) to); ! val dnsDefaultText = \to -> dns (dnsTXT default to); --- 81,86 ---- val dnsDefault = \to -> dns (dnsA default to); val dnsDefaultv6 = \to -> dns (dnsAAAA default to); ! val dnsText = \from -> \to -> dns (dnsTXT (srv_literal from) to); ! val dnsDefaultText = \to -> dns (dnsTXT srv_default to); ! ! val dnsKerberos = \to -> dns (dnsTXT (srv_literal "_kerberos") to); Index: bind.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/bind.dtl,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** bind.dtl 18 Feb 2008 16:40:08 -0000 1.6 --- bind.dtl 24 Feb 2008 15:50:24 -0000 1.7 *************** *** 15,18 **** --- 15,24 ---- {{A rule applies to every host within the current domain.}} + extern type srv_pattern; + {{Like <tt>bind_pattern</tt>, but for SRV and TXT records, where underscores are allowed in hostnames}} + extern val srv_literal : srv_domain -> srv_pattern; + extern val srv_default : srv_pattern; + extern val srv_wildcard : srv_pattern; + extern val dnsA : bind_pattern -> ip -> dnsRecord; extern val dnsAAAA : bind_pattern -> ipv6 -> dnsRecord; *************** *** 21,26 **** extern val dnsMX : int -> domain -> dnsRecord; extern val dnsNS : domain -> dnsRecord; ! extern val dnsSRV : srv_domain -> int -> int -> int -> domain -> dnsRecord; ! extern val dnsTXT : bind_pattern -> no_newlines -> dnsRecord; extern val dns : dnsRecord -> [Domain] {TTL : int}; --- 27,32 ---- extern val dnsMX : int -> domain -> dnsRecord; extern val dnsNS : domain -> dnsRecord; ! extern val dnsSRV : srv_pattern -> int -> int -> int -> domain -> dnsRecord; ! extern val dnsTXT : srv_pattern -> no_newlines -> dnsRecord; extern val dns : dnsRecord -> [Domain] {TTL : int}; |
|
From: Adam C. <ad...@us...> - 2008-02-22 00:59:21
|
Update of /cvsroot/hcoop/portal/app In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv17903/app Modified Files: app.sig app.sml join.mlt Log Message: Fixing problems various in membership application and addition Index: app.sml =================================================================== RCS file: /cvsroot/hcoop/portal/app/app.sml,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** app.sml 28 Dec 2007 23:24:41 -0000 1.15 --- app.sml 22 Feb 2008 00:59:15 -0000 1.16 *************** *** 160,167 **** size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) ! fun validUser s = ! size s > 0 andalso size s < 50 andalso List.all ! (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") ! (String.explode s) fun validEmailUser s = --- 160,168 ---- size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) ! fun validUsername name = ! size name <= 12 ! andalso size name > 0 ! andalso Char.isLower (String.sub (name, 0)) ! andalso CharVector.all Char.isAlphaNum name fun validEmailUser s = Index: app.sig =================================================================== RCS file: /cvsroot/hcoop/portal/app/app.sig,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** app.sig 22 Nov 2007 19:24:01 -0000 1.5 --- app.sig 22 Feb 2008 00:59:15 -0000 1.6 *************** *** 17,21 **** val validEmail : string -> bool ! val validUser : string -> bool val userExists : string -> bool --- 17,21 ---- val validEmail : string -> bool ! val validUsername : string -> bool val userExists : string -> bool Index: join.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/app/join.mlt,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** join.mlt 1 Jan 2008 00:09:58 -0000 1.12 --- join.mlt 22 Feb 2008 00:59:15 -0000 1.13 *************** *** 23,27 **** elseif uses = "" then %><h3>Please enter your proposed uses</h3><% ! elseif not (App.validUser name) then %><h3>Invalid requested username</h3><% elseif App.userExists name then --- 23,27 ---- elseif uses = "" then %><h3>Please enter your proposed uses</h3><% ! elseif not (App.validUsername name) then %><h3>Invalid requested username</h3><% elseif App.userExists name then |
|
From: Adam C. <ad...@us...> - 2008-02-22 00:59:20
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv17903 Modified Files: app.sig app.sml apps.mlt init.sml money.mlt portal.mlt users.mlt Log Message: Fixing problems various in membership application and addition Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.21 retrieving revision 1.22 diff -C2 -d -r1.21 -r1.22 *** money.mlt 18 Feb 2008 17:46:05 -0000 1.21 --- money.mlt 22 Feb 2008 00:59:15 -0000 1.22 *************** *** 467,472 **** 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> <% if (iff Group.inGroupName "money" then $"lookback" = "" else $"audit" <> "") then %><h3>Sum of all active balances: $<% Balance.sumOwnedBalances () %></h3><% end %> --- 467,475 ---- 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 %> Index: app.sig =================================================================== RCS file: /cvsroot/hcoop/portal/app.sig,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** app.sig 22 Nov 2007 19:24:00 -0000 1.7 --- app.sig 22 Feb 2008 00:59:15 -0000 1.8 *************** *** 7,10 **** --- 7,11 ---- | REJECTED | ADDED + | BEING_ADDED val readTosBody : unit -> string *************** *** 21,25 **** val lookupApp : int -> app ! val listApps : status -> app list val votes : int -> (int * string) list --- 22,26 ---- val lookupApp : int -> app ! val listApps : status list -> app list val votes : int -> (int * string) list *************** *** 29,32 **** --- 30,34 ---- val deny : int * string -> bool val approve : int * string -> bool + val preAdd : int -> unit val add : int -> unit val abortAdd : int -> unit Index: app.sml =================================================================== RCS file: /cvsroot/hcoop/portal/app.sml,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** app.sml 8 Dec 2007 23:08:53 -0000 1.13 --- app.sml 22 Feb 2008 00:59:15 -0000 1.14 *************** *** 10,13 **** --- 10,14 ---- | REJECTED | ADDED + | BEING_ADDED val statusFromInt = *************** *** 17,20 **** --- 18,22 ---- | 3 => REJECTED | 4 => ADDED + | 5 => BEING_ADDED | _ => raise C.Sql "Bad status" *************** *** 25,28 **** --- 27,31 ---- | REJECTED => 3 | ADDED => 4 + | BEING_ADDED => 5 fun statusFromSql v = statusFromInt (C.intFromSql v) *************** *** 59,67 **** | NONE => raise Fail "Membership application not found" ! fun listApps status = C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout FROM MemberApp ! WHERE status = ^(statusToSql status) AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH') ORDER BY applied`) --- 62,70 ---- | NONE => raise Fail "Membership application not found" ! fun listApps statuses = C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout FROM MemberApp ! WHERE status IN (^(String.concatWith "," (map statusToSql statuses))) AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH') ORDER BY applied`) *************** *** 117,124 **** end fun add app = let val _ = C.dml (getDb ()) ($`UPDATE MemberApp ! SET status = 3 WHERE id = ^(C.intToSql app)`) --- 120,132 ---- end + 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)`) Index: users.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/users.mlt,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** users.mlt 8 Dec 2007 19:46:39 -0000 1.14 --- users.mlt 22 Feb 2008 00:59:15 -0000 1.15 *************** *** 28,31 **** --- 28,33 ---- end; + App.add ap; + if $"subscribe" = "on" then if not (Pref.subscribe ("hcoop-announce", $"name" ^ Init.emailSuffix)) then Index: portal.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/portal.mlt,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** portal.mlt 18 Feb 2008 17:46:05 -0000 1.17 --- portal.mlt 22 Feb 2008 00:59:15 -0000 1.18 *************** *** 14,19 **** <% 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>) <% 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 your current <a href="pledge">pledge level</a>)--> ! ! <b>Balance: $<% #amount bal %></b> <% val polls = Poll.listCurrentPolls (); Index: init.sml =================================================================== RCS file: /cvsroot/hcoop/portal/init.sml,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** init.sml 18 Feb 2008 17:46:05 -0000 1.25 --- init.sml 22 Feb 2008 00:59:15 -0000 1.26 *************** *** 160,164 **** fun validUsername name = ! size name <= 10 andalso size name > 0 andalso Char.isLower (String.sub (name, 0)) --- 160,164 ---- fun validUsername name = ! size name <= 12 andalso size name > 0 andalso Char.isLower (String.sub (name, 0)) Index: apps.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/apps.mlt,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** apps.mlt 19 Jan 2008 20:57:32 -0000 1.15 --- apps.mlt 22 Feb 2008 00:59:15 -0000 1.16 *************** *** 84,88 **** %><h3>Pending applications</h3><% ! foreach appl in App.listApps App.ACCEPTED do %> <br><hr><br> <table class="blanks"> --- 84,88 ---- %><h3>Pending applications</h3><% ! foreach appl in App.listApps [App.ACCEPTED, App.BEING_ADDED] do %> <br><hr><br> <table class="blanks"> *************** *** 111,114 **** --- 111,115 ---- <tr> <td>Proposed uses:</td> <td><% Web.htmlNl (#uses appl) %></td> </tr> <tr> <td>Other information:</td> <td><% Web.htmlNl (#other appl) %></td> </tr> + <% if #status appl = App.BEING_ADDED then %><tr> <td colspan="2" align="left"><font color="red"><b>WARNING: Someone already followed the add link for this application. Maybe he forgot to finish.</b></font></td></tr><% end %> </table> *************** *** 122,126 **** val id = Web.stoi ($"add"); val appl = App.lookupApp id; ! App.add id %> First, run this on deleuze: --- 123,127 ---- val id = Web.stoi ($"add"); val appl = App.lookupApp id; ! App.preAdd id %> First, run this on deleuze: *************** *** 161,165 **** <h3>Pending applications</h3> ! <% foreach appl in App.listApps App.PENDING do %> <br><hr><br> <table class="blanks"> --- 162,166 ---- <h3>Pending applications</h3> ! <% foreach appl in App.listApps [App.PENDING] do %> <br><hr><br> <table class="blanks"> |
|
From: Adam C. <ad...@us...> - 2008-02-18 18:22:52
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv21655 Modified Files: mail.sml Log Message: Update low balance reminder for new deposit regime Index: mail.sml =================================================================== RCS file: /cvsroot/hcoop/portal/mail.sml,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** mail.sml 14 Oct 2007 02:37:06 -0000 1.5 --- mail.sml 18 Feb 2008 18:22:48 -0000 1.6 *************** *** 20,22 **** --- 20,30 ---- fun mclose ses = Unix.reap ses + (*type session = unit + + fun mopen () = () + + fun mwrite ((), s) = print s + + fun mclose () = OS.Process.success*) + end |
|
From: Adam C. <ad...@us...> - 2008-02-18 18:22:51
|
Update of /cvsroot/hcoop/portal/remind In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv21655/remind Modified Files: remind.sml Log Message: Update low balance reminder for new deposit regime Index: remind.sml =================================================================== RCS file: /cvsroot/hcoop/portal/remind/remind.sml,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** remind.sml 5 Jan 2008 12:55:27 -0000 1.8 --- remind.sml 18 Feb 2008 18:22:48 -0000 1.9 *************** *** 27,33 **** val amount = C.realFromSql amount ! val minimum = 900.0 * real shares / real totalShares * 2.0 in ! if amount >= minimum then () else --- 27,35 ---- val amount = C.realFromSql amount ! val perMonth = 900.0 * real shares / real totalShares ! val deposit = perMonth * 3.0 ! val headsUp = perMonth * 5.0 in ! if amount >= headsUp then () else *************** *** 35,42 **** val m = Mail.mopen () fun write msg = Mail.mwrite (m, msg) - - val minBal = 900.0 * real shares / real totalShares * 2.0 in ! if amount < 0.0 then write "Subject: Your NEGATIVE HCoop balance\n" else --- 37,42 ---- val m = Mail.mopen () fun write msg = Mail.mwrite (m, msg) in ! if amount < deposit then write "Subject: Your NEGATIVE HCoop balance\n" else *************** *** 51,78 **** write "\n\n"; ! if amount < 0.0 then (write "Your HCoop balance is negative. This means that you've paid less than you've\n"; ! write "been charged to date. Our bylaws allow our board of directors to vote you out\n"; ! write "of the co-op, without any obligation to contact you first, when your balance\n"; ! write "stays negative for three months. Please make a payment as soon as possible, so\n"; ! write "that we don't need to do this!\n\n") else ! (write "Your HCoop balance has dropped below your requested minimum, based on your\n"; ! write "sliding scale pledge amount. Please make a payment as soon as you can.\n\n"); write "Your balance: US$"; ! write (printReal amount); write "\nTotal number of members linked to your balance: "; write (Int.toString members); write "\nTotal pledge amount: "; write (Int.toString shares); ! write "\nRequested minimum balance: US$"; ! write (printReal minBal); ! write "\nPayment to get there: US$"; ! write (printReal (minBal - amount)); ! write "\n\nYour minimum was calculated by dividing our total monthly expenses ($900) by the\n"; ! write "sum of all members' pledge amounts, multiplying by your pledge amount, and then\n"; ! write "multiplying by 2. That is, the amount covers your share of two months' expenses.\n\n"; write "To make a payment, visit:\n"; --- 51,83 ---- write "\n\n"; ! if amount < deposit then (write "Your HCoop balance is negative. This means that you've paid less than you've\n"; ! write "been charged to date, excluding your required deposit. If your account hasn't\n"; ! write "been frozen yet, expect that to happen very soon. Our bylaws allow our board\n"; ! write "of directors to vote you out of the co-op, without any obligation to contact\n"; ! write "you first, when your balance stays negative for three months. Please make a\n"; ! write "payment as soon as possible, so that we don't need to do this!\n\n") else ! (write "With our current dues projections, you have less than two months left until\n"; ! write "your HCoop balance becomes negative, based on your sliding scale pledge amount.\n"; ! write "Please make a payment as soon as you can. We will freeze your account if your\n"; ! write "balance does become negative, and the board of directors will probably vote you\n"; ! write "out of the cooperative shortly thereafter if you don't make a payment.\n\n"); write "Your balance: US$"; ! write (printReal (amount - deposit)); write "\nTotal number of members linked to your balance: "; write (Int.toString members); write "\nTotal pledge amount: "; write (Int.toString shares); ! write "\nDeposit: US$"; ! write (printReal deposit); ! write "\nMinimum amount to pay to not see this message again for two months: US$"; ! 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, 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"; |
|
From: Adam C. <ad...@us...> - 2008-02-18 17:51:55
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv9241 Modified Files: payment.mlt Log Message: Add Checkout fees warning Index: payment.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/payment.mlt,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** payment.mlt 24 Nov 2007 19:57:31 -0000 1.3 --- payment.mlt 18 Feb 2008 17:51:51 -0000 1.4 *************** *** 31,33 **** <% switch #checkout you of NONE => %><p>You haven't set a Google Checkout e-mail address. If you are going to send a payment by Google Checkout, please <a href="pref">set a Checkout e-mail address on the Preferences page</a> first to ensure that you are credited promptly and accurately.</p><% ! end %> \ No newline at end of file --- 31,35 ---- <% switch #checkout you of NONE => %><p>You haven't set a Google Checkout e-mail address. If you are going to send a payment by Google Checkout, please <a href="pref">set a Checkout e-mail address on the Preferences page</a> first to ensure that you are credited promptly and accurately.</p><% ! end %> ! ! <p>Remember that we credit member balances for Checkout payments <b>after subtracting <a href="https://checkout.google.com/seller/fees.html">Checkout's service fees</a></b>. This means that, to increase your balance by a particular amount, you must make a <b>larger</b> payment than just that amount. The current fees are 2% plus 20 cents. This means that you can calculate the amount <i>x</i> to send from the amount <i>y</i> you want us to receive with this formula: <i>x</i> = (<i>y</i> + .2) / (1 - .02).</p> |
|
From: Adam C. <ad...@us...> - 2008-02-18 17:46:12
|
Update of /cvsroot/hcoop/portal In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv7172 Modified Files: balance.sig balance.sml init.sml money.mlt portal.mlt util.sig util.sml Log Message: Subtract deposit amounts from displayed balances Index: util.sml =================================================================== RCS file: /cvsroot/hcoop/portal/util.sml,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** util.sml 19 Jan 2008 20:57:32 -0000 1.16 --- util.sml 18 Feb 2008 17:46:05 -0000 1.17 *************** *** 30,33 **** --- 30,34 ---- fun neg (r : real) = ~r fun add (r1 : real, r2) = r1 + r2 + fun sub (r1 : real, r2) = r1 - r2 fun mult (r1, r2) = real r1 * r2 Index: balance.sml =================================================================== RCS file: /cvsroot/hcoop/portal/balance.sml,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** balance.sml 22 Nov 2007 19:24:00 -0000 1.10 --- balance.sml 18 Feb 2008 17:46:05 -0000 1.11 *************** *** 106,108 **** --- 106,123 ---- fun isNegative (bal : balance) = #amount bal < 0.0 + fun depositAmount bal = + let + val db = getDb () + + val totalShares = case C.oneRow db "SELECT SUM(shares) FROM WebUserPaying" of + [n] => C.intFromSql n + | 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 + end Index: money.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/money.mlt,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** money.mlt 11 Dec 2007 13:27:17 -0000 1.20 --- money.mlt 18 Feb 2008 17:46:05 -0000 1.21 *************** *** 462,468 **** end %> ! <% if showNormal then %> ! <h3>Your balance: $<% #amount (Balance.lookupBalance (#bal (Init.getUser ()))) %></h3> <% if (iff Group.inGroupName "money" then $"lookback" = "" else $"audit" <> "") then %><h3>Sum of all active balances: $<% Balance.sumOwnedBalances () %></h3><% end %> --- 462,472 ---- end %> ! <% if showNormal then ! val you = Init.getUser(); ! val bal = Balance.lookupBalance (#bal you); ! 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> <% if (iff Group.inGroupName "money" then $"lookback" = "" else $"audit" <> "") then %><h3>Sum of all active balances: $<% Balance.sumOwnedBalances () %></h3><% end %> Index: balance.sig =================================================================== RCS file: /cvsroot/hcoop/portal/balance.sig,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** balance.sig 24 Oct 2007 11:48:39 -0000 1.5 --- balance.sig 18 Feb 2008 17:46:05 -0000 1.6 *************** *** 1,5 **** signature BALANCE = sig ! type balance = {id :int, name : string, amount : real} val addBalance : string -> int --- 1,5 ---- signature BALANCE = sig ! type balance = {id : int, name : string, amount : real} val addBalance : string -> int *************** *** 18,20 **** --- 18,22 ---- val sumOwnedBalances : unit -> real val isNegative : balance -> bool + + val depositAmount : int -> real end Index: portal.mlt =================================================================== RCS file: /cvsroot/hcoop/portal/portal.mlt,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** portal.mlt 22 Nov 2007 19:24:00 -0000 1.16 --- portal.mlt 18 Feb 2008 17:46:05 -0000 1.17 *************** *** 1,4 **** --- 1,5 ---- <% val you = Init.getUser(); val bal = Balance.lookupBalance (#bal you); + val deposit = Balance.depositAmount (#id bal); @header [] %> *************** *** 13,17 **** <% end %> </table> ! <b>Balance: $<% #amount bal %></b> <% val polls = Poll.listCurrentPolls (); --- 14,19 ---- <% 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>) <% val polls = Poll.listCurrentPolls (); Index: init.sml =================================================================== RCS file: /cvsroot/hcoop/portal/init.sml,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** init.sml 8 Dec 2007 21:00:07 -0000 1.24 --- init.sml 18 Feb 2008 17:46:05 -0000 1.25 *************** *** 152,156 **** fun byPledge () = C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout ! FROM WebUser WHERE shares > 1 ORDER BY shares DESC, name`) --- 152,156 ---- fun byPledge () = C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout ! FROM WebUserPaying WHERE shares > 1 ORDER BY shares DESC, name`) Index: util.sig =================================================================== RCS file: /cvsroot/hcoop/portal/util.sig,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** util.sig 19 Jan 2008 20:57:32 -0000 1.13 --- util.sig 18 Feb 2008 17:46:05 -0000 1.14 *************** *** 16,19 **** --- 16,20 ---- val neg : real -> real val add : real * real -> real + val sub : real * real -> real val mult : int * real -> real |
|
From: Adam C. <ad...@us...> - 2008-02-18 17:17:51
|
Update of /cvsroot/hcoop/domtool2/lib In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv28000/lib Modified Files: apache.dtl hcoop.dtl php.dtl Log Message: HCoop IP synonyms; PhpVersion env var Index: apache.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/apache.dtl,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** apache.dtl 16 Dec 2007 22:34:31 -0000 1.14 --- apache.dtl 18 Feb 2008 17:17:43 -0000 1.15 *************** *** 31,34 **** --- 31,38 ---- extern val use_cert : ssl_cert_path -> ssl; + extern type php_version; + extern val php4 : php_version; + extern val php5 : php_version; + extern val vhost : host -> Vhost => [Domain] {WebPlaces : [web_place], *************** *** 38,42 **** DocumentRoot : your_path, ServerAdmin : email, ! SuExec : suexec_flag}; {{Add a new named Apache virtual host, specifying which nodes' Apache servers should answer requests for this host, whether it should use SSL, what UNIX --- 42,47 ---- DocumentRoot : your_path, ServerAdmin : email, ! SuExec : suexec_flag, ! PhpVersion : php_version}; {{Add a new named Apache virtual host, specifying which nodes' Apache servers should answer requests for this host, whether it should use SSL, what UNIX *************** *** 52,56 **** DocumentRoot : your_path, ServerAdmin : email, ! SuExec : suexec_flag}; {{Like <tt>vhost</tt>, but for, e.g., <tt>yourdomain.com</tt> instead of <tt>www.yourdomain.com</tt>}} --- 57,62 ---- DocumentRoot : your_path, ServerAdmin : email, ! SuExec : suexec_flag, ! PhpVersion : php_version}; {{Like <tt>vhost</tt>, but for, e.g., <tt>yourdomain.com</tt> instead of <tt>www.yourdomain.com</tt>}} Index: php.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/php.dtl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** php.dtl 19 Jan 2008 20:25:55 -0000 1.1 --- php.dtl 18 Feb 2008 17:17:43 -0000 1.2 *************** *** 1,7 **** {{PHP configuration}} - extern type php_version; - extern val php4 : php_version; - extern val php5 : php_version; - extern val phpVersion : php_version -> [^Vhost]; --- 1,3 ---- Index: hcoop.dtl =================================================================== RCS file: /cvsroot/hcoop/domtool2/lib/hcoop.dtl,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** hcoop.dtl 17 Nov 2007 22:26:18 -0000 1.4 --- hcoop.dtl 18 Feb 2008 17:17:43 -0000 1.5 *************** *** 14,15 **** --- 14,20 ---- {{Configure your domain to have its Mailman mailing lists served on the web at lists.hcoop.net.}} + + val deleuze_ip : (ip) = "69.90.123.67"; + val mire_ip : (ip) = "69.90.123.68"; + val krunk_ip : (ip) = "69.90.123.70"; + val fyodor_ip : (ip) = "64.20.38.170"; |
|
From: Adam C. <ad...@us...> - 2008-02-18 17:17:49
|
Update of /cvsroot/hcoop/domtool2/configDefault In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv28000/configDefault Modified Files: apache.cfg apache.csg Log Message: HCoop IP synonyms; PhpVersion env var Index: apache.cfg =================================================================== RCS file: /cvsroot/hcoop/domtool2/configDefault/apache.cfg,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** apache.cfg 9 Dec 2007 18:30:51 -0000 1.22 --- apache.cfg 18 Feb 2008 17:17:43 -0000 1.23 *************** *** 58,60 **** --- 58,62 ---- "/afs/hcoop.net/common/etc/domtool/backup/apache2/" + val defaultPhpVersion = 4 + end Index: apache.csg =================================================================== RCS file: /cvsroot/hcoop/domtool2/configDefault/apache.csg,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** apache.csg 9 Dec 2007 18:30:51 -0000 1.14 --- apache.csg 18 Feb 2008 17:17:43 -0000 1.15 *************** *** 25,27 **** --- 25,29 ---- val backupLogDirOf : bool -> string + val defaultPhpVersion : int + end |