Merge branch 'master' of https://github.com/urweb/urweb into endpoints

4 files changed, 173 insertions, 28 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index ae2fc0a8..58f7884d 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1954,29 +1954,61 @@ char *uw_Basis_urlifyFloat(uw_context ctx, uw_Basis_float n) {
   return r;
 }
 
+static void aux_urlifyChar(char** ptr, uw_Basis_char c) {
+  char* p = *ptr;
+  
+  if((uint32_t)(c) <= 0x7f) {
+    sprintf(p, ".%02X", (uint8_t)(c));
+    p += 3;
+  } else {
+    if((uint32_t)(c) <= 0x7ff) {
+      sprintf(p, ".%02X", (uint8_t)(((c)>>6)|0xc0));
+      p += 3;
+    } else {
+      if((uint32_t)(c) <= 0xffff) { 
+	sprintf(p, ".%02X", (uint8_t)(((c)>>12)|0xe0));
+	p += 3;
+      } else { 
+	sprintf(p, ".%02X", (uint8_t)(((c)>>18)|0xf0));
+	p += 3;
+	sprintf(p, ".%02X", (uint8_t)((((c)>>12)&0x3f)|0x80));
+	p += 3;
+      } 
+      sprintf(p, ".%02X", (uint8_t)((((c)>>6)&0x3f)|0x80));
+      p += 3;
+    } 
+    sprintf(p, ".%02X", (uint8_t)(((c)&0x3f)|0x80));
+    p += 3;
+  }
+
+  *ptr = p;
+}
+
 char *uw_Basis_urlifyString(uw_context ctx, uw_Basis_string s) {
   char *r, *p;
 
   if (s[0] == '\0')
     return "_";
 
-  uw_check_heap(ctx, strlen(s) * 3 + 1 + !!(s[0] == '_'));
+  uw_check_heap(ctx, strlen(s) * 12 + 1 + !!(s[0] == '_'));
 
   r = p = ctx->heap.front;
   if (s[0] == '_')
     *p++ = '_';
 
-  for (; *s; s++) {
-    unsigned char c = *s;
-
-    if (c == ' ')
+  uw_Basis_char c;
+  int offset = 0, curr = 0;
+  while (s[offset] != 0) {
+    U8_NEXT(s, offset, -1, c);
+  
+    if (U8_IS_SINGLE(s[curr]) && s[curr] == ' ')
       *p++ = '+';
-    else if (U8_IS_SINGLE(c) && isalnum(c))
-      *p++ = c;
+    else if (U8_IS_SINGLE(s[curr]) && isalnum(s[curr]))
+      *p++ = s[curr];
     else {
-      sprintf(p, ".%02X", c);
-      p += 3;
+      aux_urlifyChar(&p, c);
     }
+    curr = offset;
   }
 
   *p++ = 0;
@@ -2046,6 +2078,29 @@ uw_unit uw_Basis_urlifyTime_w(uw_context ctx, uw_Basis_time t) {
   return uw_Basis_urlifyInt_w(ctx, (uw_Basis_int)t.seconds * 1000000 + t.microseconds);
 }
 
+uw_unit uw_Basis_urlifyChar_w(uw_context ctx, uw_Basis_char c) {
+  if (c == '\0') {
+    uw_check(ctx, 1);
+    uw_writec_unsafe(ctx, '_');
+    return uw_unit_v;
+  }
+
+  uw_check(ctx, 12 + !!(c == '_'));
+
+  if (c == '_')
+    uw_writec_unsafe(ctx, '_');
+  
+  if (c == ' ')
+    uw_writec_unsafe(ctx, '+');
+  else if (isalnum(c) && c <= 0x7f)
+    uw_writec_unsafe(ctx, c);
+  else {
+    aux_urlifyChar(&(ctx->page.front), c);
+  }
+  
+  return uw_unit_v;
+}
+
 uw_unit uw_Basis_urlifyString_w(uw_context ctx, uw_Basis_string s) {
   if (s[0] == '\0') {
     uw_check(ctx, 1);
@@ -2053,22 +2108,24 @@ uw_unit uw_Basis_urlifyString_w(uw_context ctx, uw_Basis_string s) {
     return uw_unit_v;
   }
 
-  uw_check(ctx, strlen(s) * 3 + !!(s[0] == '_'));
+  uw_check(ctx, strlen(s) * 12 + !!(s[0] == '_'));
 
   if (s[0] == '_')
     uw_writec_unsafe(ctx, '_');
 
-  for (; *s; s++) {
-    unsigned char c = *s;
-
-    if (c == ' ')
+  uw_Basis_char c;
+  int offset = 0, curr = 0;
+  while (s[offset] != 0) {
+    U8_NEXT(s, offset, -1, c);   
+    
+    if (U8_IS_SINGLE(s[curr]) && s[curr] == ' ')
       uw_writec_unsafe(ctx, '+');
-    else if (U8_IS_SINGLE(c) && isalnum(c))
-      uw_writec_unsafe(ctx, c);
-    else {
-      sprintf(ctx->page.front, ".%02X", c);
-      ctx->page.front += 3;
+    else if (U8_IS_SINGLE(s[curr]) && isalnum(s[curr]))
+      uw_writec_unsafe(ctx, s[curr]);
+    else {      
+      aux_urlifyChar(&(ctx->page.front),  c);
     }
+    curr = offset;
   }
 
   return uw_unit_v;
@@ -4075,6 +4132,20 @@ uw_Basis_blob uw_Basis_textBlob(uw_context ctx, uw_Basis_string s) {
   return b;
 }
 
+uw_Basis_string uw_Basis_textOfBlob(uw_context ctx, uw_Basis_blob b) {
+  size_t i;
+  uw_Basis_string r;
+
+  for (i = 0; i < b.size; ++i)
+    if (b.data[i] == 0)
+      return NULL;
+
+  r = uw_malloc(ctx, b.size + 1);
+  memcpy(r, b.data, b.size);
+  r[b.size] = 0;
+  return r;
+}
+
 uw_Basis_blob uw_Basis_fileData(uw_context ctx, uw_Basis_file f) {
   (void)ctx;
   return f.data;
@@ -5207,7 +5278,7 @@ uw_unit uw_Basis_cache_file(uw_context ctx, uw_Basis_blob contents) {
 
   fd = mkstemp(tempfile);
   if (fd < 0)
-    uw_error(ctx, FATAL, "Error creating temporary file for cache");
+    uw_error(ctx, FATAL, "Error creating temporary file %s for cache", tempfile);
 
   while (written_so_far < contents.size) {
     ssize_t written_just_now = write(fd, contents.data + written_so_far, contents.size - written_so_far);
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 5983b9e5..d7416616 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3393,6 +3393,14 @@ fun p_file env (ds, ps) =
              newline,
              string "#include <time.h>",
              newline,
+             (case Settings.getFileCache () of
+                  NONE => box []
+                | SOME _ => box [string "#include <sys/types.h>",
+                                 newline,
+                                 string "#include <sys/stat.h>",
+                                 newline,
+                                 string "#include <unistd.h>",
+                                 newline]),
              if hasDb then
                  box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"),
                       newline]
@@ -3657,7 +3665,21 @@ fun p_file env (ds, ps) =
              newline,
              string "static void uw_initializer(uw_context ctx) {",
              newline,
-             box [string "uw_begin_initializing(ctx);",
+             box [(case Settings.getFileCache () of
+                       NONE => box []
+                     | SOME dir => box [newline,
+                                        string "struct stat st = {0};",
+                                        newline,
+                                        newline,
+                                        string "if (stat(\"",
+                                        string (Prim.toCString dir),
+                                        string "\", &st) == -1)",
+                                        newline,
+                                        box [string "mkdir(\"",
+                                             string (Prim.toCString dir),
+                                             string "\", 0700);",
+                                             newline]]),
+                  string "uw_begin_initializing(ctx);",
                   newline,
                   p_list_sep newline (fn x => x) (rev (!global_initializers)),
                   string "uw_end_initializing(ctx);",
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 40b865b0..cc85f05b 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -66,9 +66,9 @@ val htmlifyString = String.translate (fn #"<" => "&lt;"
 
 fun htmlifySpecialChar ch = "&#" ^ Int.toString (ord ch) ^ ";"
 
-fun hexIt ch =
+fun hexPad c =
     let
-        val s = Int.fmt StringCvt.HEX (ord ch)
+        val s = Int.fmt StringCvt.HEX c
     in
         case size s of
             0 => "00"
@@ -76,6 +76,54 @@ fun hexIt ch =
           | _ => s
     end
 
+fun rsh a b =
+    Int.fromLarge (IntInf.~>>(IntInf.fromInt a, Word.fromInt b))
+
+fun orb a b =
+    Int.fromLarge (IntInf.orb(IntInf.fromInt a, IntInf.fromInt b))
+
+fun andb a b =
+    Int.fromLarge (IntInf.andb(IntInf.fromInt a, IntInf.fromInt b))
+
+
+fun hexIt ch =
+    let
+        val c = ord ch
+    in
+        if (c <= 0x7f) then
+            hexPad c
+        else
+            ((if (c <= 0x7fff) then
+                 hexPad (orb (rsh c 6) 0xc0) 
+             else
+                 (if (c <= 0xffff) then
+                      hexPad (orb (rsh c 12) 0xe0)
+                  else
+                      hexPad (orb (rsh c 18) 0xf0)
+                      ^ hexPad (orb (andb (rsh c 12) 0x3f) 0x80)
+                 )
+                 ^ hexPad (orb (andb (rsh c 6) 0x3f) 0x80))
+             ) ^ hexPad (orb (andb c 0x3f) 0x80)
+    end
+
+fun urlifyCharAux ch =
+    case ch of
+        #" "  => "+"
+     |  _ =>
+        if ord ch = 0 then
+            "_"
+        else
+            if Char.isAlphaNum ch then
+                str ch
+            else
+                "." ^ hexIt ch
+        
+fun urlifyChar c =
+    case c of
+        #"_" => "_" ^ urlifyCharAux c 
+     |  _ => urlifyCharAux c
+                  
+        
 fun urlifyString s =
     case s of
         "" => "_"
@@ -84,11 +132,7 @@ fun urlifyString s =
              "_"
          else
              "")
-        ^ String.translate (fn #" " => "+"
-                             | ch => if Char.isAlphaNum ch then
-                                         str ch
-                                     else
-                                         "." ^ hexIt ch) s
+        ^ String.translate urlifyCharAux s
 
 
 fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int)
@@ -349,6 +393,13 @@ fun exp e =
       | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) =>
         EFfiApp ("Basis", "urlifyString_w", [e])
 
+      | EFfiApp ("Basis", "urlifyChar", [((EPrim (Prim.Char c), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, urlifyChar c))
+      | EWrite (EFfiApp ("Basis", "urlifyChar", [((EPrim (Prim.Char c), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyChar c)), loc)
+      | EWrite (EFfiApp ("Basis", "urlifyChar", [e]), _) =>
+        EFfiApp ("Basis", "urlifyChar_w", [e])
+                
       | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) =>
         EPrim (Prim.String (Prim.Normal, "1"))
       | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) =>
diff --git a/src/settings.sml b/src/settings.sml
index 0e999587..abb26f72 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -157,6 +157,7 @@ fun isEffectful ("Sqlcache", _) = true
 fun addEffectful x = effectful := S.add (!effectful, x)
 
 val benignBase = basis ["get_cookie",
+                        "getenv",
                         "new_client_source",
                         "get_client_source",
                         "set_client_source",