cvsimport
authoradamch <adamch>
Tue, 27 Nov 2007 23:55:15 +0000 (23:55 +0000)
committeradamch <adamch>
Tue, 27 Nov 2007 23:55:15 +0000 (23:55 +0000)
22 files changed:
app.sig
app.sml
app/app.sig
app/app.sml
app/confirm.mlt
app/join.mlt
apps.mlt
balance.sml
group.sml
header.mlt.in
init.sig
init.sml
location.sml
money.mlt
money.sml
payment.mlt
poll.sml
portal.mlt
pref.mlt
tables.sql
util.sig
util.sml

diff --git a/app.sig b/app.sig
index 00cc343..f31c5be 100644 (file)
--- a/app.sig
+++ b/app.sig
@@ -16,7 +16,8 @@ sig
                 passwd : string, status : status, applied : Init.C.timestamp,
                 ipaddr : string option,
                 confirmed : Init.C.timestamp option, decided : Init.C.timestamp option,
-                msg : string, unix_passwd : string }
+                msg : string, unix_passwd : string,
+                paypal : string option, checkout : string option }
 
     val lookupApp : int -> app
     val listApps : status -> app list
@@ -30,4 +31,7 @@ sig
     val add : int -> unit
     val abortAdd : int -> unit
     val welcome : int -> unit
+
+    val searchPaypal : string -> app list
+    val searchCheckout : string -> app list
 end
diff --git a/app.sml b/app.sml
index 93a94eb..299feb5 100644 (file)
--- a/app.sml
+++ b/app.sml
@@ -32,24 +32,27 @@ type app = { id : int, name : string, rname : string, gname : string option, ema
             forward : bool, uses : string, other : string,
             passwd : string, status : status, applied : C.timestamp, ipaddr : string option,
             confirmed : C.timestamp option, decided : C.timestamp option,
-            msg : string, unix_passwd : string}
+            msg : string, unix_passwd : string,
+            paypal : string option, checkout : string option }
 
 fun mkAppRow [id, name, rname, gname, email, forward, uses, other, passwd, status,
-             applied, ipaddr, confirmed, decided, msg, unix_passwd] =
+             applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout] =
     { id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
-      gname = (if C.isNull gname then NONE else SOME (C.stringFromSql gname)),
+      gname = Init.nullableFromSql C.stringFromSql gname,
       email = C.stringFromSql email, forward = C.boolFromSql forward,
       uses = C.stringFromSql uses, other = C.stringFromSql other, passwd = C.stringFromSql passwd,
       status = statusFromSql status, applied = C.timestampFromSql applied,
-      ipaddr = (if C.isNull ipaddr then NONE else SOME (C.stringFromSql ipaddr)),
-      confirmed = if C.isNull confirmed then NONE else SOME (C.timestampFromSql confirmed),
-      decided = if C.isNull decided then NONE else SOME (C.timestampFromSql decided),
-      msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd}
+      ipaddr = Init.nullableFromSql C.stringFromSql ipaddr,
+      confirmed = Init.nullableFromSql C.timestampFromSql confirmed,
+      decided = Init.nullableFromSql C.timestampFromSql decided,
+      msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd,
+      paypal = Init.nullableFromSql C.stringFromSql paypal,
+      checkout = Init.nullableFromSql C.stringFromSql checkout}
   | mkAppRow r = rowError ("app", r)
 
 fun lookupApp id =
     case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided,
-                                           msg, unix_passwd
+                                           msg, unix_passwd, paypal, checkout
                                     FROM MemberApp
                                     WHERE id = ^(C.intToSql id)`) of
        SOME row => mkAppRow row
@@ -57,7 +60,7 @@ fun lookupApp id =
 
 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
+                                       msg, unix_passwd, paypal, checkout
                                 FROM MemberApp
                                 WHERE status = ^(statusToSql status)
                                   AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH')
@@ -162,4 +165,22 @@ fun readTosBody () = readFile "/home/hcoop/public_html/tos.body.html"
 fun readTosAgree () = readFile "/home/hcoop/public_html/tos.agree.html"
 fun readTosMinorAgree () = readFile "/home/hcoop/public_html/tos.agree.minor.html"
 
+fun searchPaypal paypal =
+    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 paypal = ^(C.stringToSql (normEmail paypal))
+                                  AND status = 2
+                                  AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH'
+                                ORDER BY applied`)
+
+fun searchCheckout checkout =
+    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 checkout = ^(C.stringToSql (normEmail checkout))
+                                  AND status = 2
+                                  AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH'
+                                ORDER BY applied`)
+
 end
index 7b17423..8df47d8 100644 (file)
@@ -10,13 +10,14 @@ sig
     val readTosMinorAgree : unit -> string
 
     type application = { name : string, rname : string, gname : string option, email : string,
-                        forward : bool, uses : string, other : string }
+                        forward : bool, uses : string, other : string,
+                        paypal : string option, checkout : string option }
 
-    val apply : application -> bool
+    val apply : application -> string option
 
     val validEmail : string -> bool
     val validUser : string -> bool
     val userExists : string -> bool
 
-    val confirm : int * string -> string option
+    val confirm : int * string -> bool
 end
index 1346829..96d9f47 100644 (file)
@@ -93,21 +93,29 @@ fun sendMail (to, subj, intro, footer, id) =
     end
 
 type application = { name : string, rname : string, gname : string option, email : string,
-                    forward : bool, uses : string, other : string }
+                    forward : bool, uses : string, other : string,
+                    paypal : string option, checkout : string option }
 
 fun randomPassword () =
     let
-       val proc = Unix.execute ("/usr/bin/apg", ["/usr/bin/apg", "-n", "1", "-m", "10"])
+       val proc = Unix.execute ("/usr/bin/pwgen", ["-cCnB", "8", "1"])
     in
        case TextIO.inputLine (Unix.textInstreamOf proc) of
-           NONE => raise Fail "Couldn't execute apg"
+           NONE => raise Fail "Couldn't execute pwgen"
          | SOME line =>
            case String.tokens Char.isSpace line of
                [s] => s
-             | _ => raise Fail "Couldn't parse output of apg"
+             | _ => raise Fail "Couldn't parse output of pwgen"
     end
 
-fun apply {name, rname, gname, email, forward, uses, other} =
+val allLower = CharVector.map Char.toLower
+
+fun emailToSql so =
+    case so of
+       NONE => "NULL"
+      | SOME s => C.stringToSql (allLower s)
+
+fun apply {name, rname, gname, email, forward, uses, other, paypal, checkout} =
     let
        val db = getDb ()
     in
@@ -118,13 +126,15 @@ fun apply {name, rname, gname, email, forward, uses, other} =
                val passwd = Int.toString (Int.abs (Random.randInt (!rnd)))
                val unix_passwd = randomPassword ()
            in
-               C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd, status, applied, msg, unix_passwd)
+               C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd,
+                                                  status, applied, msg, unix_passwd, paypal, checkout)
                            VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname),
                                    ^(case gname of NONE => "NULL" | SOME gname => C.stringToSql gname),
                                    ^(C.stringToSql email), ^(C.boolToSql forward), ^(C.stringToSql uses),
                                    ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP,
-                                   '', ^(C.stringToSql unix_passwd))`);
-               sendMail (email, "Confirm membership application",
+                                   '', ^(C.stringToSql unix_passwd),
+                                   ^(emailToSql paypal), ^(emailToSql checkout))`);
+               if sendMail (email, "Confirm membership application",
                             "We've received a request to join the Internet Hosting Cooperative (hcoop.net) with this e-mail address.",
                          fn mwrite => (mwrite ("To confirm this application, visit ");
                                        mwrite (baseUrl);
@@ -133,7 +143,10 @@ fun apply {name, rname, gname, email, forward, uses, other} =
                                        mwrite ("&p=");
                                        mwrite passwd;
                                        mwrite ("\n")),
-                            id)
+                            id) then
+                   SOME unix_passwd
+               else
+                   NONE
            end
       | _ => raise Fail "Bad next sequence val"
     end
@@ -169,19 +182,16 @@ fun confirm (id, passwd) =
        val db = getDb ()
     in
        case C.oneOrNoRows db ($`SELECT unix_passwd FROM MemberApp WHERE id = ^(C.intToSql id) AND passwd = ^(C.stringToSql passwd) AND status = 0`) of
-           SOME [unix_passwd] =>
+           SOME [_] =>
            (C.dml db ($`UPDATE MemberApp SET status = 1, confirmed = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql id)`);
-            if sendMail ("board@hcoop.net",
-                         "New membership application",
-                         "We've received a new request to join hcoop.",
-                      fn mwrite => (mwrite ("Open applications: ");
-                                    mwrite (portalUrl);
-                                    mwrite ("apps")),
-                         id) then
-                SOME (C.stringFromSql unix_passwd)
-            else
-                NONE)
-         | NONE => NONE
+            sendMail ("board@hcoop.net",
+                      "New membership application",
+                      "We've received a new request to join hcoop.",
+                   fn mwrite => (mwrite ("Open applications: ");
+                                 mwrite (portalUrl);
+                                 mwrite ("apps")),
+                      id))
+         | NONE => false
     end
 
 end
dissimilarity index 80%
index 3492118..0cc9776 100644 (file)
@@ -1,16 +1,14 @@
-<% @header [("title", ["Confirm application"])];
-
-val id = Web.stoi ($"id");
-val passwd = $"p";
-
-switch App.confirm (id, passwd) of
-         SOME unix_passwd =>
-               %><h3><b>Confirmation successful</b></h3>
-               You should hear from us within a few days from now.  Save this password, to use to access our servers if your application is approved:
-               <blockquote><tt><% Web.html unix_passwd %></tt></blockquote><%
-       | NONE =>
-               %><h3><b>Error confirming</b></h3>
-                       Did you already follow this confirmation link?<%
-end;
-
-@footer[] %>
\ No newline at end of file
+<% @header [("title", ["Confirm application"])];
+
+val id = Web.stoi ($"id");
+val passwd = $"p";
+
+if App.confirm (id, passwd) then
+   %><h3><b>Confirmation successful</b></h3>
+   You should hear from us within a few days from now.<%
+else
+   %><h3><b>Error confirming</b></h3>
+   Did you already follow this confirmation link?<%
+end;
+
+@footer[] %>
\ No newline at end of file
index 40a6f81..3e715b6 100644 (file)
                %><h3>That username is already in use.</b><h3><%
        elseif not (App.validEmail email) then
                %><h3>Invalid e-mail address</h3><%
-       elseif not (App.apply { name = name, rname = rname, email = email,
+       else switch App.apply { name = name, rname = rname, email = email,
                                gname = (case gname of "" => NONE | _ => SOME gname),
-                               forward = forward, uses = uses, other = other }) then
-               %><h3>Error sending confirmation e-mail</h3><%
-       else
-               %><h3>Application recorded</h3>
-               Check your e-mail for a message with further instructions.<%
+                               forward = forward, uses = uses, other = other,
+                               paypal = (case $"paypal" of "" => NONE | s => SOME s),
+                               checkout = (case $"checkout" of "" => NONE | s => SOME s) } of
+                 NONE => %><h3>Error sending confirmation e-mail</h3><%
+               | SOME unix_passwd =>
+                       %><h3>Application recorded</h3>
+                       Check your e-mail for a message with further instructions.  <b>Save this password to use to access your new account if your application is approved</b>:
+                       <blockquote><tt><% Web.html unix_passwd %></tt></blockquote><%
+               end
        end
 else
        val minor = $"minor" <> "" %>
@@ -51,11 +55,14 @@ else
 <% else %>
 <tr> <td>Your "real" name:</td> <td><input name="rname"> Please enter your full name, as you would on a normal, legally binding contract.</td></tr>
 <% end %>
-<tr> <td>Contact e-mail address</td> <td><input name="email"></td> </tr>
-<tr> <td><input type="checkbox" name="forward"></td> <td>Check this box if you would like to use hcoop as your primary e-mail provider.<br>
+<tr> <td>Contact e-mail address</td> <td><input name="email" size="50"></td> </tr>
+<tr> <td><a href="http://www.paypal.com/">PayPal</a> account e-mail:</td> <td><input name="paypal" size="50"></td> </tr>
+<tr> <td><a href="http://checkout.google.com/">Google Checkout</a> account e-mail:</td> <td><input name="checkout" size="50"><br>
+     These payment service provider e-mail addresses are optional.  You will probably end up using one or the other of these providers if your application is approved, and entering here the e-mail address that you've used to sign up with that provider will help us process your payment accurately and promptly. E-mail addresses you enter here should match those seen by recipients of payments that you send.</td> </tr>
+<tr> <td><input type="checkbox" name="forward"></td> <td>Check this box if you would like to use HCoop as your primary e-mail provider.<br>
        If you don't select this option and you are approved to join, e-mail to your account will be forwarded to the address you provide here.<br>
-       You can change this option later, but we'll probably have helpful things to e-mail you as soon as you join.  It's important that we be able to reach members reliably, so please don't decide to use us as your primary e-mail provider unless you can commit to checking your hcoop mailbox just as often as any other personal accounts you have.</td> </tr>
-<tr> <td>How do you plan to use a hcoop membership?</td> <td><textarea name="uses" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
+       You can change this option later, but we'll probably have helpful things to e-mail you as soon as you join.  It's important that we be able to reach members reliably, so please don't decide to use us as your primary e-mail provider unless you can commit to checking your HCoop mailbox just as often as any other personal accounts you have.</td> </tr>
+<tr> <td>How do you plan to use a HCoop membership?</td> <td><textarea name="uses" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
 <tr> <td>Any other information about yourself</td> <td><textarea name="other" rows="5" cols="80" wrap="soft"></textarea></td> </tr>
 </table>
 
index 395beca..c59d18a 100644 (file)
--- a/apps.mlt
+++ b/apps.mlt
@@ -71,6 +71,12 @@ elseif $"cmd" = "approved" then
        <tr> <td>Username:</td> <td><% #name appl %></td> </tr>
        <tr> <td>Real name:</td> <td><% Web.html (#rname appl) %></td> </tr>
        <tr> <td>E-mail address:</td> <td><a href="mailto:<% #email appl %>"><% #email appl %></a></td> </tr>
+       <% switch #paypal appl of
+         SOME s => %><tr> <td>PayPal:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end;
+       switch #checkout appl of
+         SOME s => %><tr> <td>Google Checkout:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end %>
        <tr> <td>Forward e-mail?</td> <td><% if #forward appl then %>yes<% else %>no<% end %></td> </tr>
        <tr> <td>Proposed uses:</td> <td><% Web.htmlNl (#uses appl) %></td> </tr>
        <tr> <td>Other information:</td> <td><% Web.htmlNl (#other appl) %></td> </tr>
@@ -102,7 +108,7 @@ First, run this on deleuze:
 <% end %>
 </select></td></tr>
 <tr> <td>Initial transaction amount:</td> <td><input name="amount"></td> </tr>
-<tr> <td>Initial transaction description:</td> <td><input name="descr" value="PayPal"></td> </tr>
+<tr> <td>Initial transaction description:</td> <td><input name="descr"></td> </tr>
 <tr> <td><input type="checkbox" name="subscribe" checked></td> <td>Subscribe to hcoop-announce</td> </tr>
 <tr> <td>Groups:</td> <td><select name="grp" size="5" multiple>
 <% foreach group in Group.listGroups () do %>
@@ -147,6 +153,12 @@ end %>
        <tr> <td>Username:</td> <td><% #name appl %></td> </tr>
        <tr> <td>Real name:</td> <td><% Web.html (#rname appl) %></td> </tr>
        <tr> <td>E-mail address:</td> <td><a href="mailto:<% #email appl %>"><% #email appl %></a></td> </tr>
+       <% switch #paypal appl of
+         SOME s => %><tr> <td>PayPal:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end;
+       switch #checkout appl of
+         SOME s => %><tr> <td>Google Checkout:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end %>
        <tr> <td>Forward e-mail?</td> <td><% if #forward appl then %>yes<% else %>no<% end %></td> </tr>
        <tr> <td>Proposed uses:</td> <td><% Web.htmlNl (#uses appl) %></td> </tr>
        <tr> <td>Other information:</td> <td><% Web.htmlNl (#other appl) %></td> </tr>
index 1d639da..98c8657 100644 (file)
@@ -90,7 +90,7 @@ fun balanceNameToId name =
       | _ => NONE
 
 fun listBalanceUsers bal =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                  FROM WebUser
                                  WHERE bal = ^(C.intToSql bal)
                                  ORDER BY name`)
index 6df85de..33cc13e 100644 (file)
--- a/group.sml
+++ b/group.sml
@@ -107,10 +107,11 @@ fun mkMembershipRow [grp, usr] =
   | mkMembershipRow row = Init.rowError ("membership", row)
 
 fun groupMembers grp =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares FROM Membership, WebUser
-                                       WHERE grp = ^(C.intToSql grp)
-                                          AND usr = id
-                                       ORDER BY name`)
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
+                                 FROM Membership, WebUser
+                                 WHERE grp = ^(C.intToSql grp)
+                                   AND usr = id
+                                 ORDER BY name`)
 
 
 (* Checking memberships of the current user *)
index 18fed3c..f77396a 100644 (file)
@@ -64,8 +64,8 @@ Other services<br />
 <li> <a href="/webalizer/">Webalizer</a></li>
 <li> <a href="/mrtg/">MRTG statistics</a></li>
 <li> <a href="http://nms.interserver.net/cac/nms.php?server_name=bmV3Lmhjb29wLm5ldA==">InterServer bandwidth statistics</a></li>
-<li> <a href="/usermin/">Usermin</a></li>
-<li> <a href="/squirrel/">SquirrelMail</a></li>
+<!--li> <a href="/usermin/">Usermin</a></li-->
+<li> <a href="https://mail2.hcoop.net/src/login.php">SquirrelMail</a></li>
 <li> <a href="/passwd">Change vmail passwords</a></li>
 </div>
 
index 19bad59..303e1be 100644 (file)
--- a/init.sig
+++ b/init.sig
@@ -1,5 +1,7 @@
 signature INIT = sig
     structure C : SQL_CLIENT
+    val nullableFromSql : (C.value -> 'a) -> C.value -> 'a option
+    val nullableToSql : ('a -> string) -> 'a option -> string
 
     val scratchDir : string
     val urlPrefix : string
@@ -11,7 +13,7 @@ signature INIT = sig
     val emailSuffix : string
 
     type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp,
-                app : int, shares : int}
+                app : int, shares : int, paypal : string option, checkout : string option }
 
     val rowError : string * C.value list -> 'a
 
@@ -64,4 +66,7 @@ signature INIT = sig
                    {onlyInFirst : string list, onlyInSecond : string list}
     val listUsernames : unit -> string list
     val usersInAfs : unit -> string list
+
+    val searchPaypal : string -> user list
+    val searchCheckout : string -> user list
 end
index c5f5fa9..e01df22 100644 (file)
--- a/init.sml
+++ b/init.sml
@@ -4,6 +4,16 @@ struct
 open Util Sql Config
 structure C = PgClient
 
+fun nullableFromSql f x =
+    if C.isNull x then
+       NONE
+    else
+       SOME (f x)
+fun nullableToSql f x =
+    case x of
+       NONE => "NULL"
+      | SOME x => f x
+
 exception Access of string
 exception NeedTos
 
@@ -11,7 +21,7 @@ fun conn () = C.conn dbstring
 val close = C.close
 
 type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp,
-            app : int, shares : int}
+            app : int, shares : int, paypal : string option, checkout : string option }
 
 val db = ref (NONE : C.conn option)
 val user = ref (NONE : user option)
@@ -26,10 +36,12 @@ fun rowError (tab, vs) = raise Fail ("Bad " ^ tab ^ "row: " ^ makeSet fromSql vs
 
 fun getDb () = valOf (!db)
 
-fun mkUserRow [id, name, rname, bal, joined, app, shares] =
+fun mkUserRow [id, name, rname, bal, joined, app, shares, paypal, checkout] =
     {id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
      bal = C.intFromSql bal, joined = C.timestampFromSql joined,
-     app = C.intFromSql app, shares = C.intFromSql shares}
+     app = C.intFromSql app, shares = C.intFromSql shares,
+     paypal = nullableFromSql C.stringFromSql paypal,
+     checkout = nullableFromSql C.stringFromSql checkout}
   | mkUserRow row = rowError ("user", row)
 
 fun init () =
@@ -50,7 +62,7 @@ fun init () =
                    else
                        name
            in
-               case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares
+               case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                        FROM WebUserActive
                                        WHERE name=^(C.stringToSql name)`) of
                    NONE => raise Fail "User not found"
@@ -92,17 +104,17 @@ fun getUserId () = #id (getUser ())
 fun getUserName () = #name (getUser ())
 
 fun lookupUser id =
-    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app, shares
+    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                      FROM WebUser
                                      WHERE id = ^(C.intToSql id)`))
 
 fun listUsers () =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                  FROM WebUser
                                  ORDER BY name`)
 
 fun listActiveUsers () =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                  FROM WebUserActive
                                  ORDER BY name`)
 
@@ -116,9 +128,11 @@ fun addUser (name, rname, bal, app, shares) =
        val db = getDb ()
        val id = nextSeq (db, "WebUserSeq")
     in
-       C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app, shares)
+       C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app, shares, paypal, checkout)
                    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(C.intToSql bal),
-                           CURRENT_TIMESTAMP, ^(C.intToSql app), ^(C.intToSql shares))`);
+                           CURRENT_TIMESTAMP, ^(C.intToSql app), ^(C.intToSql shares),
+                           (SELECT paypal FROM MemberApp WHERE app = ^(C.intToSql app)),
+                           (SELECT checkout FROM MemberApp WHERE app = ^(C.intToSql app)))`);
        id
     end
 
@@ -129,12 +143,14 @@ fun modUser (user : user) =
        ignore (C.dml db ($`UPDATE WebUser SET
                            name = ^(C.stringToSql (#name user)), rname = ^(C.stringToSql (#rname user)),
                               bal = ^(C.intToSql (#bal user)), app = ^(C.intToSql (#app user)),
-                              shares = ^(C.intToSql (#shares user))
+                              shares = ^(C.intToSql (#shares user)),
+                              paypal = ^(nullableToSql (C.stringToSql o Util.normEmail) (#paypal user)),
+                              checkout = ^(nullableToSql (C.stringToSql o Util.normEmail) (#checkout user))
                            WHERE id = ^(C.intToSql (#id user))`))
     end
 
 fun byPledge () =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                  FROM WebUser
                                  WHERE shares > 1
                                  ORDER BY shares DESC, name`)
@@ -283,4 +299,16 @@ fun usersInAfs () =
        List.map OS.Path.file acc
     end
 
+fun searchPaypal paypal =
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
+                                 FROM WebUser
+                                 WHERE paypal = ^(C.stringToSql (normEmail paypal))
+                                 ORDER BY name`)
+    
+fun searchCheckout checkout =
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
+                                 FROM WebUser
+                                 WHERE checkout = ^(C.stringToSql (normEmail checkout))
+                                 ORDER BY name`)
+
 end
index 5dbf7a6..e4464d1 100644 (file)
@@ -135,7 +135,7 @@ fun recordResidents () =
                addToParents (loc, count)
            end
     in
-       C.fold db folder NM.empty ($`SELECT loc, id, name, rname, bal, joined, app, shares
+       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
 
@@ -293,10 +293,11 @@ fun removeFromLocation (lives : lives) =
     end
 
 fun residentsOneLevel loc =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares FROM Lives, WebUser
-                                       WHERE loc = ^(C.intToSql loc)
-                                          AND usr = id
-                                       ORDER BY name`)
+    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
+                                 ORDER BY name`)
 
 fun alreadyExists (parent, name) =
     case C.oneRow (getDb ()) ($`SELECT COUNT( * ) FROM Location
index 74bc1f6..34002dd 100644 (file)
--- a/money.mlt
+++ b/money.mlt
@@ -1,5 +1,7 @@
 <% @header [("title", ["MoneyMatters"])];
 
+val root = Group.inGroupNum 0;
+
 ref showNormal = true;
 
 if $"hist" <> "" then
@@ -172,6 +174,7 @@ end %></textarea></td> </tr>
 
 <% elseif $"cmd" = "pay" then
        Group.requireGroupName "money";
+       val uid = (case $"user" of "" => ~1 | s => Web.stoi s);
        showNormal := false %>
 
 <h3>New member payment</h3>
@@ -180,17 +183,17 @@ end %></textarea></td> </tr>
 <input type="hidden" name="cmd" value="pay2">
 <table class="blanks">
 <tr> <td>Description:</td> <td><select name="descr">
-       <option selected>PayPal</option>
-       <option>Google Checkout</option>
+       <option<% if "checkout" = "" then %> selected<% end %>>PayPal</option>
+       <option<% if "checkout" <> "" then %> selected<% end %>>Google Checkout</option>
        <option>Check</option>
        <option>Direct transfer</option>
        <option value="">Other:</option>
 </select> <input name="descr2"></td> </tr>
-<tr> <td>Date:</td> <td><input name="d"></td> </tr>
+<tr> <td>Date:</td> <td><input name="d" value="<% Web.html (Date.fmt "%B %d, %Y" (Date.fromTimeLocal (Time.now ()))) %>"></td> </tr>
 <tr> <td>Amount:</td> <td><input name="amount"></td> </tr>
 <tr> <td>Member:</td> <td><select name="usr">
 <% foreach usr in Init.listUsers () do %>
-       <option value="<% #id usr %>"><% #name usr %></option>
+       <option value="<% #id usr %>"<% if #id usr = uid then %> selected<% end %>><% #name usr %></option>
 <% end %>
 </select></td> </tr>
 <tr> <td><input type="submit" value="Add"></td> </tr>
@@ -342,7 +345,121 @@ foreach (name, cha) in Money.listChargesWithNames id do
 end %>
 </table>
 
-<% end %>
+<% elseif $"cmd" = "paypal" then
+   showNormal := false;
+   val apps = App.searchPaypal ($"email");
+   val users = Init.searchPaypal ($"email");
+
+   switch apps of
+     _ :: _ =>
+     %><h3>Approved applications</h3>
+
+     <% foreach appl in apps do %>
+               <br><hr><br>
+               <table class="blanks">
+               <tr> <td>Received:</td> <td><% #applied appl %></td> </tr>
+               <tr> <td>Approved by:</td> <td><%
+                       ref first = true;
+                       ref found = false;
+                       foreach (id, name) in App.votes (#id appl) do
+                               if first then
+                                       first := false
+                               else
+                                       %>, <%
+                               end
+                               %><a href="user?id=<% id %>"><% name %></a><%
+                       end %> </td> </tr>
+       <tr> <td>Username:</td> <td><% #name appl %></td> </tr>
+       <tr> <td>Real name:</td> <td><% Web.html (#rname appl) %></td> </tr>
+       <tr> <td>E-mail address:</td> <td><a href="mailto:<% #email appl %>"><% #email appl %></a></td> </tr>
+       <% switch #paypal appl of
+         SOME s => %><tr> <td>PayPal:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end;
+       switch #checkout appl of
+         SOME s => %><tr> <td>Google Checkout:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end %>
+       <tr> <td>Forward e-mail?</td> <td><% if #forward appl then %>yes<% else %>no<% end %></td> </tr>
+       <tr> <td>Proposed uses:</td> <td><% Web.htmlNl (#uses appl) %></td> </tr>
+       <tr> <td>Other information:</td> <td><% Web.htmlNl (#other appl) %></td> </tr>
+       </table>
+
+       <% if root then %>
+               <a href="apps?add=<% #id appl %>">Add this member.</a><br>
+       <% end
+       end
+   end;
+
+   switch users of
+     _ :: _ =>
+     %><h3>Members</h3>
+
+     <% foreach user in users do %>
+       <li> <a href="user?id=<% #id user %>"><% #name user %></a> <a href="?cmd=pay&user=<% #id user %>">[add payment]</a></li>
+     <% end
+   end;
+
+   switch (apps, users) of
+     (nil, nil) => %>No matches.<%
+   end
+
+elseif $"cmd" = "checkout" then
+   showNormal := false;
+   val apps = App.searchCheckout ($"email");
+   val users = Init.searchCheckout ($"email");
+
+   switch apps of
+     _ :: _ =>
+     %><h3>Approved applications</h3>
+
+     <% foreach appl in apps do %>
+               <br><hr><br>
+               <table class="blanks">
+               <tr> <td>Received:</td> <td><% #applied appl %></td> </tr>
+               <tr> <td>Approved by:</td> <td><%
+                       ref first = true;
+                       ref found = false;
+                       foreach (id, name) in App.votes (#id appl) do
+                               if first then
+                                       first := false
+                               else
+                                       %>, <%
+                               end
+                               %><a href="user?id=<% id %>"><% name %></a><%
+                       end %> </td> </tr>
+       <tr> <td>Username:</td> <td><% #name appl %></td> </tr>
+       <tr> <td>Real name:</td> <td><% Web.html (#rname appl) %></td> </tr>
+       <tr> <td>E-mail address:</td> <td><a href="mailto:<% #email appl %>"><% #email appl %></a></td> </tr>
+       <% switch #paypal appl of
+         SOME s => %><tr> <td>PayPal:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end;
+       switch #checkout appl of
+         SOME s => %><tr> <td>Google Checkout:</td> <td><a href="mailto:<% s %>"><% s %></a></td> </tr>
+       <% end %>
+       <tr> <td>Forward e-mail?</td> <td><% if #forward appl then %>yes<% else %>no<% end %></td> </tr>
+       <tr> <td>Proposed uses:</td> <td><% Web.htmlNl (#uses appl) %></td> </tr>
+       <tr> <td>Other information:</td> <td><% Web.htmlNl (#other appl) %></td> </tr>
+       </table>
+
+       <% if root then %>
+               <a href="apps?add=<% #id appl %>">Add this member.</a><br>
+       <% end
+       end
+   end;
+
+   switch users of
+     _ :: _ =>
+     %><h3>Members</h3>
+
+     <% foreach user in users do %>
+       <li> <a href="user?id=<% #id user %>"><% #name user %></a> <a href="?cmd=pay&user=<% #id user %>&checkout=1">[add payment]</a></li>
+     <% end
+   end;
+
+   switch (apps, users) of
+     (nil, nil) => %>No matches.<%
+   end
+
+end %>
 
 <% if showNormal then %>
 
@@ -364,6 +481,21 @@ end %>
 <a href="money?cmd=evenForm">Generic/even</a><br>
 <br>
 <a href="money?cmd=equalize">Equalize balances</a><br>
+<br>
+
+<h3>Look up a PayPal e-mail address</h3>
+
+<form method="post">
+<input type="hidden" name="cmd" value="paypal">
+<input name="email"> <input type="submit" value="Look up">
+</form>
+
+<h3>Look up a Google Checkout e-mail address</h3>
+
+<form method="post">
+<input type="hidden" name="cmd" value="checkout">
+<input name="email"> <input type="submit" value="Look up">
+</form>
 
 <h3>Most recent transactions</h3>
 
index 6aae9c4..f4423ac 100644 (file)
--- a/money.sml
+++ b/money.sml
@@ -86,7 +86,7 @@ val mkUserRow' =
      | row => Init.rowError ("listUsers", row)
 
 fun listUsers trn =
-    C.map (getDb ()) mkUserRow' ($`SELECT trn, id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow' ($`SELECT trn, id, name, rname, bal, joined, app, shares, paypal, checkout
                                   FROM WebUser LEFT OUTER JOIN Charge ON usr = id AND trn = ^(C.intToSql trn)
                                   ORDER BY name`)
 
index 067bf49..d6ad1cb 100644 (file)
@@ -1,5 +1,13 @@
+<% val you = Init.getUser () %>
+
 <h3><a href="https://www.paypal.com/cgi-bin/webscr?cmd=_xclick&business=payment@hcoop.net&item_name=Member+payment+for+<% Init.getUserName () %>">Add to your balance with PayPal</a></h3>
 
+<% switch #paypal you of
+   NONE => %><p>You haven't set a PayPal e-mail address.  If you are going to send a payment by PayPal, please <a href="pref">set a PayPal 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 PayPal payments <b>after subtracting PayPal's service fees</b>. This means that, to increase your balance by a particular amount, you must make a <b>larger</b> payment than just that amount. You should consult <a href="https://www.paypal.com/us/cgi-bin/webscr?cmd=_display-fees-outside">the PayPal fees page</a> to figure out how much extra to send. We have a business account, which means, for example, a 2.9% plus 30 cent fee for payments from the USA. 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> + .3) / (1 - .029). The fees may be different for other countries.</p>
+
 <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">
@@ -19,3 +27,7 @@
             </td>
         </tr>
     </form></table></h3>
+
+<% 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
index 1d08f70..06d49a8 100644 (file)
--- a/poll.sml
+++ b/poll.sml
@@ -196,7 +196,7 @@ fun noDupes l =
       | h::t => List.all (fn x => x <> h) t andalso noDupes t
 
 fun listVoters cho =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                                  FROM WebUser, Vote
                                  WHERE usr = id
                                     AND cho = ^(C.intToSql cho)
@@ -209,7 +209,7 @@ fun countVoters pol =
       | row => Init.rowError ("countVoters", row)
 
 fun listPollVoters pol =
-    C.map (getDb ()) mkUserRow ($`SELECT DISTINCT WebUser.id, name, rname, bal, joined, app, shares
+    C.map (getDb ()) mkUserRow ($`SELECT DISTINCT WebUser.id, name, rname, bal, joined, app, shares, paypal, checkout
                                  FROM WebUser, Vote JOIN PollChoice ON cho = PollChoice.id
                                  WHERE pol = ^(C.intToSql pol)
                                     AND usr = WebUser.id
index 42d2eb7..3492692 100644 (file)
@@ -40,6 +40,6 @@ switch issues of
 end %>
 <br>
 <% end
-end %>
+end;
 
-<% @footer [] %>
\ No newline at end of file
+@footer [] %>
index 1db9f8b..deea051 100644 (file)
--- a/pref.mlt
+++ b/pref.mlt
@@ -1,10 +1,17 @@
 <% val you = Init.getUserId ();
+
 val yourname = Init.getUserName ();
 val youremail = yourname ^ "@hcoop.net";
 
 @header [("title", ["Member preferences"])];
 
 if $"cmd" = "mod" then
+       val you_all = Init.getUser ();
+
+       Init.modUser {you_all with
+         paypal = (case $"paypal" of "" => NONE | s => SOME s),
+         checkout = (case $"checkout" of "" => NONE | s => SOME s)};
+
        if $"dir" = "on" then
                Pref.setDirectory you
        else
@@ -33,13 +40,19 @@ if $"cmd" = "mod" then
        end;
 
        %><h3>Preferences updated</h3><%
-end %>
+end;
+
+val you_all = Init.lookupUser you %>
 
-<p><h3>This page doesn't work yet.  You should visit <a href="https://members.hcoop.net/portal/pref">the corresponding page on the old portal</a> if you want to change anything.</h3></p>
+<p><h3>The mailing list checkboxes on this page don't work yet.  You should visit <a href="https://members.hcoop.net/portal/pref">the corresponding page on the old portal</a> if you want to change subscriptions.</h3></p>
 
 <form action="pref" method="post">
 <input type="hidden" name="cmd" value="mod">
 <table class="blanks">
+<tr> <td><a href="http://www.paypal.com/">PayPal</a> e-mail address:</td> <td><input name="paypal" size="60" value="<% switch #paypal you_all of NONE => "" | SOME s => s end %>"></td> </tr>
+<tr> <td><a href="http://checkout.google.com/">Google Checkout</a> e-mail address:</td> <td><input name="checkout" size="60" value="<% switch #checkout you_all of NONE => "" | SOME s => s end %>"></td> </tr>
+<tr> <td colspan="2" style="font-weight: normal; text-align: left">(E-mail addresses you enter here should match those seen by recipients of payments that you send.)</td> </tr>
+<tr></tr>
 <tr> <td><input type="checkbox" name="dir"<% if Pref.hasDirectory you then %> checked<% end %>></td> <td>Include me in the public member directory.</td> </tr>
 <tr> <td><input type="checkbox" name="discuss"<% if Pref.subscribed ("hcoop-discuss", youremail) then %> checked<% end %>></td> <td>Include me on the <tt>hcoop-discuss</tt> mailing list. <i>(On-topic discussion and sporadically high volume)</i></td> </tr>
 <tr> <td><input type="checkbox" name="sysadmin"<% if Pref.subscribed ("hcoop-sysadmin", youremail) then %> checked<% end %>></td> <td>Include me on the <tt>hcoop-sysadmin</tt> mailing list. <i>(Discussion about technical adminstrative planning and related issues, not dealing directly with member support requests)</i></td> </tr>
index f0067e8..56a68ed 100644 (file)
@@ -14,7 +14,9 @@ CREATE TABLE MemberApp(
        confirmed TIMESTAMP,
        decided TIMESTAMP,
        msg TEXT NOT NULL,
-       unix_passwd TEXT NOT NULL);
+       unix_passwd TEXT NOT NULL,
+       paypal TEXT,
+       checkout TEXT);
 
 CREATE SEQUENCE MemberAppSeq START 1;
 
@@ -37,6 +39,8 @@ CREATE TABLE WebUser(
        joined TIMESTAMP NOT NULL,
        app INTEGER NOT NULL,
        shares INTEGER NOT NULL,
+       paypal TEXT,
+       checkout TEXT
        FOREIGN KEY (bal) REFERENCES Balance(id) ON DELETE CASCADE,
        FOREIGN KEY (app) REFERENCES MemberApp(id) ON DELETE CASCADE);
 
@@ -270,7 +274,7 @@ CREATE TABLE AppVote(
        FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
 
 CREATE VIEW WebUserPaying
-       AS SELECT id, name, rname, bal, joined, app, shares
+       AS SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                FROM WebUser
                        JOIN (SELECT usr FROM Membership JOIN WebGroup
                                ON grp = WebGroup.id
@@ -278,7 +282,7 @@ CREATE VIEW WebUserPaying
                                ON usr = WebUser.id;
 
 CREATE VIEW WebUserActive
-       AS SELECT id, name, rname, bal, joined, app, shares
+       AS SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
                FROM WebUser
                        LEFT OUTER JOIN (SELECT usr FROM Membership JOIN WebGroup
                                ON grp = WebGroup.id AND (WebGroup.name IN ('retired', 'phantom'))) AS mem
index 5a5697b..1f46916 100644 (file)
--- a/util.sig
+++ b/util.sig
@@ -29,4 +29,7 @@ sig
     val readFile : string -> string
 
     val mem : ''a * ''a list -> bool
+
+    val allLower : string -> string
+    val normEmail : string -> string
 end
index d1c7214..f1bdcbb 100644 (file)
--- a/util.sml
+++ b/util.sml
@@ -81,4 +81,10 @@ fun readFile fname =
 
 fun mem (x, ls) = List.exists (fn y => y = x) ls
 
+val allLower = CharVector.map Char.toLower
+
+fun normEmail s = case String.tokens Char.isSpace (allLower s) of
+                     s :: _ => s
+                   | [] => ""
+
 end