changeset 1728:95d3b4f26f59

Ensure proper ordering of <script> execution, to bring identifiers into scope in time
author Adam Chlipala <adam@chlipala.net>
date Fri, 27 Apr 2012 09:43:09 -0400
parents 318ba997a149
children 6817ddd6cf1f
files include/urweb.h src/c/urweb.c src/monoize.sml tests/headDyn.ur
diffstat 4 files changed, 65 insertions(+), 49 deletions(-) [+]
line wrap: on
line diff
--- a/include/urweb.h	Fri Apr 27 07:35:59 2012 -0400
+++ b/include/urweb.h	Fri Apr 27 09:43:09 2012 -0400
@@ -76,7 +76,6 @@
 
 void uw_set_script_header(uw_context, const char*);
 char *uw_Basis_get_settings(uw_context, uw_unit);
-char *uw_Basis_get_script(uw_context, uw_unit);
 char *uw_get_real_script(uw_context);
 
 uw_Basis_string uw_Basis_maybe_onload(uw_context, uw_Basis_string);
--- a/src/c/urweb.c	Fri Apr 27 07:35:59 2012 -0400
+++ b/src/c/urweb.c	Fri Apr 27 09:43:09 2012 -0400
@@ -1312,10 +1312,6 @@
   ctx->script.front += len;
 }
 
-const char *uw_Basis_get_script(uw_context ctx, uw_unit u) {
-  return "<sc>";
-}
-
 const char *uw_get_real_script(uw_context ctx) {
   if (strstr(ctx->outHeaders.start, "Set-Cookie: ")) {
     uw_write_script(ctx, "sig=\"");
@@ -3157,6 +3153,8 @@
   return ctx->app ? ctx->app->db_rollback(ctx) : 0;
 }
 
+static const char begin_xhtml[] = "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">";
+
 void uw_commit(uw_context ctx) {
   int i;
 
@@ -3210,36 +3208,53 @@
   uw_check(ctx, 1);
   *ctx->page.front = 0;
 
-  // Splice script data into appropriate part of page
-  if (ctx->returning_indirectly || ctx->script_header[0] == 0) {
-    char *start = strstr(ctx->page.start, "<sc>");
-    if (start) {
-      memmove(start, start + 4, uw_buffer_used(&ctx->page) - (start - ctx->page.start) - 4);
-      ctx->page.front -= 4;
-    }
-  } else if (uw_buffer_used(&ctx->script) == 0) {
-    size_t len = strlen(ctx->script_header);
-    char *start = strstr(ctx->page.start, "<sc>");
-    if (start) {
-      ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) - 4 + len);
-      start = strstr(ctx->page.start, "<sc>");
-      memmove(start + len, start + 4, uw_buffer_used(&ctx->page) - (start - ctx->page.start) - 3);
-      ctx->page.front += len - 4;
-      memcpy(start, ctx->script_header, len);
-    }
-  } else {
-    size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
-    size_t lenP = lenH + 40 + len;
-    char *start = strstr(ctx->page.start, "<sc>");
-    if (start) {
-      ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) - 4 + lenP);
-      start = strstr(ctx->page.start, "<sc>");
-      memmove(start + lenP, start + 4, uw_buffer_used(&ctx->page) - (start - ctx->page.start) - 3);
-      ctx->page.front += lenP - 4;
+  if (!ctx->returning_indirectly && !strncmp(ctx->page.start, begin_xhtml, sizeof begin_xhtml - 1)) {
+    char *s;
+
+    // Splice script data into appropriate part of page, also adding <head> if needed.
+    s = ctx->page.start + sizeof begin_xhtml - 1;
+    s = strchr(s, '<');
+    if (s == NULL) {
+      // Weird.  Document has no tags!
+
+      uw_write(ctx, "<head></head><body></body>");
+      uw_check(ctx, 1);
+      *ctx->page.front = 0;
+    } else if (!strncmp(s, "<head>", 6)) {
+      // <head> is present.  Let's add the <script> tags immediately after it.
+
+      size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
+      size_t lenP = lenH + 40 + len;
+      char *start = s + 6, *oldPage = ctx->page.start;
+
+      ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+      start += ctx->page.start - oldPage;
+      memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+      ctx->page.front += lenP;
       memcpy(start, ctx->script_header, lenH);
       memcpy(start + lenH, "<script type=\"text/javascript\">", 31);
       memcpy(start + lenH + 31, ctx->script.start, len);
       memcpy(start + lenH + 31 + len, "</script>", 9);
+    } else {
+      // No <head>.  At this point, add it, with <script> tags inside.
+
+      size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
+      size_t lenP = lenH + 53 + len;
+      char *start = s, *oldPage = ctx->page.start;
+
+      printf("start = %ld\n", start - ctx->page.start);
+
+      ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+      start += ctx->page.start - oldPage;
+      printf("page1 = %s\n", ctx->page.start);
+      memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+      printf("page2 = %s\n", ctx->page.start);
+      ctx->page.front += lenP;
+      memcpy(start, "<head>", 6);
+      memcpy(start + 6, ctx->script_header, lenH);
+      memcpy(start + 6 + lenH, "<script type=\"text/javascript\">", 31);
+      memcpy(start + 6 + lenH + 31, ctx->script.start, len);
+      memcpy(start + 6 + lenH + 31 + len, "</script></head>", 16);
     }
   }
 }
@@ -3919,8 +3934,6 @@
     return NULL;
 }
 
-static const char begin_xhtml[] = "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">";
-
 failure_kind uw_begin_onError(uw_context ctx, char *msg) {
   int r = setjmp(ctx->jmp_buf);
 
--- a/src/monoize.sml	Fri Apr 27 07:35:59 2012 -0400
+++ b/src/monoize.sml	Fri Apr 27 09:43:09 2012 -0400
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -3179,7 +3179,7 @@
                       | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                               raise Fail "No name passed to input tag")
 
-                fun normal (tag, extra, extraInner) =
+                fun normal (tag, extra) =
                     let
                         val (tagStart, fm) = tagStart tag
                         val tagStart = case extra of
@@ -3189,10 +3189,6 @@
                         fun normal () =
                             let
                                 val (xml, fm) = monoExp (env, st, fm) xml
-
-                                val xml = case extraInner of
-                                              NONE => xml
-                                            | SOME ei => (L'.EStrcat (ei, xml), loc)
                             in
                                 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
                                               (L'.EStrcat (xml,
@@ -3316,8 +3312,7 @@
                                                        loc),
                                                       (L'.EFfiApp ("Basis", "maybe_onunload",
                                                                    [(onunload, s)]),
-                                                       loc)), loc),
-                                    SOME (L'.EFfiApp ("Basis", "get_script", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc))
+                                                       loc)), loc))
 			end
 
                       | "dyn" =>
@@ -3346,9 +3341,9 @@
                               | _ => raise Fail "Monoize: Bad dyn attributes"
 			end
 
-                      | "submit" => normal ("input type=\"submit\"", NONE, NONE)
-                      | "image" => normal ("input type=\"image\"", NONE, NONE)
-                      | "button" => normal ("input type=\"submit\"", NONE, NONE)
+                      | "submit" => normal ("input type=\"submit\"", NONE)
+                      | "image" => normal ("input type=\"image\"", NONE)
+                      | "button" => normal ("input type=\"submit\"", NONE)
                       | "hidden" => input "hidden"
 
                       | "textbox" =>
@@ -3404,8 +3399,7 @@
                              NONE => raise Fail "No name for radioGroup"
                            | SOME name =>
                              normal ("input",
-                                     SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc),
-                                     NONE))
+                                     SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc)))
 
                       | "select" =>
 			(case targs of
@@ -3502,7 +3496,7 @@
 				  fm)
                              end)
 
-                      | "coption" => normal ("option", NONE, NONE)
+                      | "coption" => normal ("option", NONE)
 
                       | "ctextarea" =>
 			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
@@ -3527,8 +3521,8 @@
 				  fm)
                              end)
 
-                      | "tabl" => normal ("table", NONE, NONE)
-                      | _ => normal (tag, NONE, NONE)
+                      | "tabl" => normal ("table", NONE)
+                      | _ => normal (tag, NONE)
 	    in
 		case #1 dynClass of
 		    L'.ENone _ => baseAll
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/headDyn.ur	Fri Apr 27 09:43:09 2012 -0400
@@ -0,0 +1,10 @@
+fun main () : transaction page =
+    x <- source <xml/>;
+    return <xml>
+      <head>
+        <title>Test</title>
+      </head>
+      <body onload={set x <xml>boo</xml>}>
+        <dyn signal={signal x}/>
+      </body>
+    </xml>