Chat example working nicely, but without dead channel removal

4 files changed, 72 insertions, 40 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 75f7675f..c8fe39ca 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -229,6 +229,7 @@ void uw_client_connect(size_t id, int pass, int sock) {
   if (buf_used(&c->data.used.msgs) > 0) {
     uw_really_send(sock, begin_msgs, sizeof(begin_msgs) - 1);
     uw_really_send(sock, c->data.used.msgs.start, buf_used(&c->data.used.msgs));
+    buf_reset(&c->data.used.msgs);
     close(sock);
   }
   else
@@ -382,10 +383,17 @@ static void uw_release_channel(channel *ch) {
 }
 
 static void uw_subscribe(channel *ch, client *c) {
-  client_list *cs = malloc(sizeof(client_list));
+  client_list *cs;
 
   pthread_mutex_lock(&ch->data.used.lock);
 
+  for (cs = ch->data.used.clients; cs; cs = cs->next)
+    if (cs->data == c) {
+      pthread_mutex_unlock(&ch->data.used.lock);
+      return;
+    }
+
+  cs = malloc(sizeof(client_list));
   cs->data = c;
   cs->next = ch->data.used.clients;
   ch->data.used.clients = cs;
@@ -838,29 +846,29 @@ const char *uw_Basis_get_script(uw_context ctx, uw_unit u) {
     int pass;
     client *c = uw_new_client(&pass);
 
-    char *r = uw_malloc(ctx, strlen(ctx->script_header) + 65 + 3 * INTS_MAX + buf_used(&ctx->script)
-                        + strlen(ctx->url_prefix));
-    sprintf(r, "%s<script>client_id=%d;client_pass=%d;url_prefix=\"%s\";timeout=%d;%s</script>",
+    char *r = uw_malloc(ctx, strlen(ctx->script_header) + 18 + buf_used(&ctx->script));
+    sprintf(r, "%s<script>%s</script>",
             ctx->script_header,
-            (int)c->id,
-            c->data.used.pass,
-            ctx->url_prefix,
-            ctx->timeout,
             ctx->script.start);
     return r;
   }
 }
 
-const char *uw_Basis_get_listener(uw_context ctx, uw_Basis_string onload) {
+const char *uw_Basis_get_settings(uw_context ctx, uw_Basis_string onload) {
   if (ctx->script_header[0] == 0)
     return "";
-  else if (onload[0] == 0)
-    return " onload='listener()'";
   else {
-    uw_Basis_string s = uw_malloc(ctx, strlen(onload) + 22);
+    int pass;
+    client *c = uw_new_client(&pass);
 
-    sprintf(s, " onload='listener();%s'", onload);
-    return s;
+    char *r = uw_malloc(ctx, 41 + 3 * INTS_MAX + strlen(ctx->url_prefix) + strlen(onload));
+    sprintf(r, " onload='client_id=%d;client_pass=%d;url_prefix=\"%s\";timeout=%d;%s'",
+            (int)c->id,
+            c->data.used.pass,
+            ctx->url_prefix,
+            ctx->timeout,
+            onload);
+    return r;
   }
 }
 
@@ -1108,6 +1116,17 @@ char *uw_Basis_urlifyInt(uw_context ctx, uw_Basis_int n) {
   return r;
 }
 
+char *uw_Basis_urlifyChannel(uw_context ctx, uw_Basis_channel n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%lld%n", (long long)n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
 char *uw_Basis_urlifyFloat(uw_context ctx, uw_Basis_float n) {
   int len;
   char *r;
@@ -1163,6 +1182,16 @@ uw_unit uw_Basis_urlifyInt_w(uw_context ctx, uw_Basis_int n) {
   return uw_unit_v;
 }
 
+uw_unit uw_Basis_urlifyChannel_w(uw_context ctx, uw_Basis_channel n) {
+  int len;
+
+  uw_check(ctx, INTS_MAX);
+  sprintf(ctx->page.front, "%lld%n", (long long)n, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
 uw_unit uw_Basis_urlifyFloat_w(uw_context ctx, uw_Basis_float n) {
   int len;
 
@@ -1916,6 +1945,9 @@ static channel_delta *allocate_delta(uw_context ctx, channel *ch) {
     ++ctx->n_deltas;
     ctx->deltas = realloc(ctx->deltas, sizeof(channel_delta) * ctx->n_deltas);
     cd = &ctx->deltas[ctx->n_deltas-1];
+    cd->n_subscribed = 0;
+    cd->subscribed = malloc(0);
+    buf_init(&cd->msgs, 0);
   }
    
   cd->mode = USED;
@@ -1958,7 +1990,7 @@ uw_unit uw_Basis_subscribe(uw_context ctx, uw_Basis_channel chn) {
     } else if (c->data.used.pass != pass) {
       uw_release_channel(ch);
       uw_release_client(c);
-      uw_error(ctx, FATAL, "Wrong client password in subscription request");
+      uw_error(ctx, FATAL, "Wrong client password (%d) in subscription request", pass);
     } else {
       size_t i;
       channel_delta *cd = allocate_delta(ctx, ch);
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 36d42754..f5627e24 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -48,7 +48,7 @@ val funcs = [(("Basis", "alert"), "alert"),
              (("Basis", "stringToInt_error"), "pi"),
              (("Basis", "urlifyInt"), "ts"),
              (("Basis", "urlifyFloat"), "ts"),
-             (("Basis", "urlifyString"), "escape"),
+             (("Basis", "urlifyString"), "uf"),
              (("Basis", "urlifyChannel"), "ts"),
              (("Basis", "recv"), "rv")]
 
@@ -345,9 +345,10 @@ fun process file =
                                     @ ["}"]), st)
                 end
 
-              | TFfi ("Basis", "string") => ("unesc(t[i++])", st)
+              | TFfi ("Basis", "string") => ("uu(t[i++])", st)
               | TFfi ("Basis", "int") => ("parseInt(t[i++])", st)
               | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st)
+              | TFfi ("Basis", "channel") => ("parseInt(t[i++])", st)
 
               | TFfi ("Basis", "bool") => ("t[i++] == \"True\"", st)
 
@@ -806,14 +807,14 @@ fun process file =
                             end
 
                           | ECase (e', pes, {result, ...}) =>
-                            if closedUpto inner e andalso List.all (fn (_, e) => closedUpto inner e) pes then
+                            (*if closedUpto inner e andalso List.all (fn (_, e) => closedUpto inner e) pes then
                                 let
                                     val (e', st) = quoteExp result ((ERel 0, loc), st)
                                 in
                                     ((ELet ("js", result, e, e'), loc),
                                      st)
                                 end
-                            else
+                            else*)
                                 let
                                     val plen = length pes
 
diff --git a/src/monoize.sml b/src/monoize.sml
index eb3f81b3..03ce6311 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1871,7 +1871,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         [] => (NONE, acc)
                       | ("Onload", e, _) :: rest => (SOME e, List.revAppend (acc, rest))
                       | x :: rest => findOnload (rest, x :: acc)
-
+                                     
                 val (onload, attrs) = findOnload (attrs, [])
 
                 fun lowercaseFirst "" = ""
@@ -1972,8 +1972,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             let
                                 val (xml, fm) = monoExp (env, st, fm) xml
                                 val xml = case extraInner of
-                                              NONE => xml
-                                            | SOME ei => (L'.EStrcat (ei, xml), loc)
+                                                   NONE => xml
+                                                 | SOME ei => (L'.EStrcat (ei, xml), loc)
                             in
                                 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
                                               (L'.EStrcat (xml,
@@ -2017,8 +2017,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                     end
             in
                 case tag of
-                    "body" =>
-                    let
+                    "body" => let
                         val onload = case onload of
                                          NONE => (L'.EPrim (Prim.String ""), loc)
                                        | SOME e =>
@@ -2026,10 +2025,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                              val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
                                          in
                                              (L'.EJavaScript (L'.Attribute, e, NONE), loc)
-                                      end
+                                         end
                     in
                         normal ("body",
-                                SOME (L'.EFfiApp ("Basis", "get_listener", [onload]), loc),
+                                SOME (L'.EFfiApp ("Basis", "get_settings", [onload]), loc),
                                 SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc))
                     end
 
diff --git a/src/rpcify.sml b/src/rpcify.sml
index a4bfe71a..dc8ecc52 100644
--- a/src/rpcify.sml
+++ b/src/rpcify.sml
@@ -51,13 +51,12 @@ val ssBasis = SS.addList (SS.empty,
                            "query",
                            "dml",
                            "nextval",
-                           "new_channel",
+                           "channel",
                            "subscribe",
                            "send"])
 
 val csBasis = SS.addList (SS.empty,
-                          ["source",
-                           "get",
+                          ["get",
                            "set",
                            "alert",
                            "recv"])
@@ -76,15 +75,16 @@ type state = {
 fun frob file =
     let
         fun sideish (basis, ssids) e =
-            case #1 e of
-                ERecord _ => false
-              | _ =>
-                U.Exp.exists {kind = fn _ => false,
-                              con = fn _ => false,
-                              exp = fn ENamed n => IS.member (ssids, n)
-                                     | EFfi ("Basis", x) => SS.member (basis, x)
-                                     | EFfiApp ("Basis", x, _) => SS.member (basis, x)
-                                     | _ => false} e
+            U.Exp.exists {kind = fn _ => false,
+                          con = fn _ => false,
+                          exp = fn ENamed n => IS.member (ssids, n)
+                                 | EFfi ("Basis", x) => SS.member (basis, x)
+                                 | EFfiApp ("Basis", x, _) => SS.member (basis, x)
+                                 | _ => false}
+                         (U.Exp.map {kind = fn x => x,
+                                     con = fn x => x,
+                                     exp = fn ERecord _ => ERecord []
+                                            | x => x} e)
 
         fun whichIds basis =
             let
@@ -156,7 +156,7 @@ fun frob file =
                             ENamed n => (n, args)
                           | EApp (e1, e2) => getApp (e1, e2 :: args)
                           | _ => (ErrorMsg.errorAt loc "Mixed client/server code doesn't use a named function for server part";
-                                  Print.prefaces "Bad" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];
+                                  (*Print.prefaces "Bad" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];*)
                                   (0, []))
                     end
 
@@ -184,7 +184,7 @@ fun frob file =
 
                         val ran =
                             case IM.find (tfuncs, n) of
-                                NONE => (Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))];
+                                NONE => ((*Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))];*)
                                          raise Fail ("Rpcify: Undetected transaction function " ^ Int.toString n))
                               | SOME (_, _, ran, _) => ran