Merge branch 'upstream' into dfsg_clean20161022+dfsg

20 files changed, 505 insertions, 70 deletions

diff --git a/src/c/Makefile.am b/src/c/Makefile.am
index d117d018..f4d9bef8 100644
--- a/src/c/Makefile.am
+++ b/src/c/Makefile.am
@@ -8,9 +8,14 @@ liburweb_static_la_SOURCES = static.c
 
 AM_CPPFLAGS = -I$(srcdir)/../../include/urweb $(OPENSSL_INCLUDES)
 AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security -Wno-deprecated-declarations -U_FORTIFY_SOURCE $(PTHREAD_CFLAGS)
-liburweb_la_LDFLAGS = $(AM_LDFLAGS) $(OPENSSL_LDFLAGS)
+liburweb_la_LDFLAGS = $(AM_LDFLAGS) $(OPENSSL_LDFLAGS) \
+	-export-symbols-regex '^(client_pruner|pthread_create_big|strcmp_nullsafe|uw_.*)'
 liburweb_la_LIBADD = $(PTHREAD_LIBS) -lm $(OPENSSL_LIBS)
 liburweb_http_la_LIBADD = liburweb.la
+liburweb_http_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
 liburweb_cgi_la_LIBADD = liburweb.la
+liburweb_cgi_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
 liburweb_fastcgi_la_LIBADD = liburweb.la
+liburweb_fastcgi_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
 liburweb_static_la_LIBADD = liburweb.la
+liburweb_static_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
diff --git a/src/c/http.c b/src/c/http.c
index 9059746f..d186e209 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -314,7 +314,7 @@ static void *worker(void *data) {
 }
 
 static void help(char *cmd) {
-  printf("Usage: %s [-p <port>] [-a <IP address>] [-t <thread count>] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe '-T' option sets socket recv timeout (0 disables timeout, default is 5 sec).\n", cmd);
+  printf("Usage: %s [-p <port>] [-a <IPv4 address>] [-A <IPv6 address>] [-t <thread count>] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe '-T' option sets socket recv timeout (0 disables timeout, default is 5 sec).\n", cmd);
 }
 
 static void sigint(int signum) {
@@ -325,19 +325,18 @@ static void sigint(int signum) {
 int main(int argc, char *argv[]) {
   // The skeleton for this function comes from Beej's sockets tutorial.
   int sockfd;  // listen on sock_fd
-  struct sockaddr_in my_addr;
-  struct sockaddr_in their_addr; // connector's address information
+  struct sockaddr_in6 my_addr;
+  struct sockaddr_in6 their_addr; // connector's address information
   socklen_t sin_size;
-  int yes = 1, uw_port = 8080, nthreads = 1, i, *names, opt;
+  int yes = 1, no = 0, uw_port = 8080, nthreads = 1, i, *names, opt;
   int recv_timeout_sec = 5;
  
   signal(SIGINT, sigint);
   signal(SIGPIPE, SIG_IGN); 
 
-  my_addr.sin_addr.s_addr = INADDR_ANY; // auto-fill with my IP
-  memset(my_addr.sin_zero, '\0', sizeof my_addr.sin_zero);
+  my_addr.sin6_addr = in6addr_any; // auto-fill with my IP
 
-  while ((opt = getopt(argc, argv, "hp:a:t:kqT:")) != -1) {
+  while ((opt = getopt(argc, argv, "hp:a:A:t:kqT:")) != -1) {
     switch (opt) {
     case '?':
       fprintf(stderr, "Unknown command-line option\n");
@@ -358,8 +357,21 @@ int main(int argc, char *argv[]) {
       break;
 
     case 'a':
-      if (!inet_pton(AF_INET, optarg, &my_addr.sin_addr)) {
-        fprintf(stderr, "Invalid IP address\n");
+      {
+        char *buf = alloca(strlen(optarg) + 8);
+        strcpy(buf, "::FFFF:");
+        strcpy(buf + 7, optarg);
+        if (!inet_pton(AF_INET6, buf, &my_addr.sin6_addr)) {
+          fprintf(stderr, "Invalid IPv4 address\n");
+          help(argv[0]);
+          return 1;
+        }
+      }
+      break;
+
+    case 'A':
+      if (!inet_pton(AF_INET6, optarg, &my_addr.sin6_addr)) {
+        fprintf(stderr, "Invalid IPv6 address\n");
         help(argv[0]);
         return 1;
       }
@@ -401,7 +413,7 @@ int main(int argc, char *argv[]) {
 
   names = calloc(nthreads, sizeof(int));
 
-  sockfd = socket(PF_INET, SOCK_STREAM, 0); // do some error checking!
+  sockfd = socket(AF_INET6, SOCK_STREAM, 0); // do some error checking!
 
   if (sockfd < 0) {
     fprintf(stderr, "Listener socket creation failed\n");
@@ -413,8 +425,13 @@ int main(int argc, char *argv[]) {
     return 1;
   }
 
-  my_addr.sin_family = AF_INET;         // host byte order
-  my_addr.sin_port = htons(uw_port);    // short, network byte order
+  if (setsockopt(sockfd, IPPROTO_IPV6, IPV6_V6ONLY, &no, sizeof(int)) < 0) {
+    fprintf(stderr, "Listener IPV6_V6ONLY option resetting failed\n");
+    return 1;
+  }
+
+  my_addr.sin6_family = AF_INET6;        // host byte order
+  my_addr.sin6_port = htons(uw_port);    // short, network byte order
 
   if (bind(sockfd, (struct sockaddr *)&my_addr, sizeof my_addr) < 0) {
     fprintf(stderr, "Listener socket bind failed\n");
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b2c85a54..688b3e4d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -55,6 +55,8 @@ structure CM = BinaryMapFn(struct
 
 val debug = ref false
 
+val app_js = ref ""
+
 val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan)
 
 val ident = String.translate (fn #"'" => "PRIME"
@@ -2509,9 +2511,15 @@ fun p_decl env (dAll as (d, loc) : decl) =
       | DDatabase _ => box []
       | DPreparedStatements _ => box []
 
-      | DJavaScript s => box [string "static char jslib[] = \"",
-                              string (Prim.toCString s),
-                              string "\";"]
+      | DJavaScript s =>
+        let
+            val () = app_js := OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
+                                                    file = "app." ^ SHA1.bintohex (SHA1.hash s) ^ ".js"}
+        in
+            box [string "static char jslib[] = \"",
+                 string (Prim.toCString s),
+                 string "\";"]
+        end
       | DCookie s => box [string "/*",
                           space,
                           string "cookie",
@@ -2948,15 +2956,11 @@ fun p_file env (ds, ps) =
                               newline]
             end
 
-        val timestamp = LargeInt.toString (Time.toMilliseconds (Time.now ()))
-        val app_js = OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
-                                          file = "app." ^ timestamp ^ ".js"}
-
-        val allScripts =
+        fun allScripts () =
             foldl (fn (x, scripts) =>
                       scripts
                       ^ "<script type=\\\"text/javascript\\\" src=\\\"" ^ x ^ "\\\"></script>\\n")
-                  "" (Settings.getScripts () @ [app_js])
+                  "" (Settings.getScripts () @ [!app_js])
 
         fun p_page (ek, s, n, ts, ran, side, dbmode, tellSig) =
             let
@@ -3098,7 +3102,7 @@ fun p_file env (ds, ps) =
                                         val scripts =
                                             case side of
                                                 ServerOnly => ""
-                                              | _ => allScripts
+                                              | _ => allScripts ()
                                     in
                                         string scripts
                                     end,
@@ -3306,8 +3310,7 @@ fun p_file env (ds, ps) =
 
         val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds
 
-        val now = Time.now ()
-        val nowD = Date.fromTimeUniv now
+        val lastMod = Date.fromTimeUniv (FileIO.mostRecentModTime ())
         val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT"
 
         fun hexifyByte (b : Word8.word) : string =
@@ -3496,26 +3499,26 @@ fun p_file env (ds, ps) =
 
              string "static void uw_handle(uw_context ctx, char *request) {",
              newline,
-             string "if (!strcmp(request, \"",
-             string app_js,
-             string "\")) {",
+             string "uw_Basis_string ims = uw_Basis_requestHeader(ctx, \"If-modified-since\");",
              newline,
-             box [string "uw_Basis_string ims = uw_Basis_requestHeader(ctx, \"If-modified-since\");",
-                  newline,
-                  string ("if (ims && !strcmp(ims, \"" ^ Date.fmt rfcFmt nowD ^ "\")) {"),
-                  newline,
-                  box [string "uw_clear_headers(ctx);",
-                       newline,
-                       string "uw_write_header(ctx, uw_supports_direct_status ? \"HTTP/1.1 304 Not Modified\\r\\n\" : \"Status: 304 Not Modified\\r\\n\");",
-                       newline,
-                       string "return;",
-                       newline],
-                  string "}",
+             string ("if (ims && !strcmp(ims, \"" ^ Date.fmt rfcFmt lastMod ^ "\")) {"),
+             newline,
+             box [string "uw_clear_headers(ctx);",
                   newline,
+                  string "uw_write_header(ctx, uw_supports_direct_status ? \"HTTP/1.1 304 Not Modified\\r\\n\" : \"Status: 304 Not Modified\\r\\n\");",
                   newline,
-                  string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
+                  string "return;",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (!strcmp(request, \"",
+             string (!app_js),
+             string "\")) {",
+             newline,
+             box [string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
                   newline,
-                  string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
+                  string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt lastMod ^ "\\r\\n\");"),
                   newline,
                   string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
                   newline,
@@ -3538,7 +3541,7 @@ fun p_file env (ds, ps) =
                                                                    string (String.toCString ct),
                                                                    string "\\r\\n\");",
                                                                    newline]),
-                                              string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"),
+                                              string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt lastMod ^ "\\r\\n\");"),
                                               newline,
                                               string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
                                               newline,
@@ -3634,7 +3637,7 @@ fun p_file env (ds, ps) =
                                 newline,
                                 if !hasJs then
                                     box [string "uw_set_script_header(ctx, \"",
-                                         string allScripts,
+                                         string (allScripts ()),
                                          string "\");",
                                          newline]
                                 else
diff --git a/src/compiler.sml b/src/compiler.sml
index dccda06d..4fe2dfd5 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -212,7 +212,7 @@ val parseUrs =
                    val fname = OS.FileSys.tmpName ()
                    val outf = TextIO.openOut fname
                    val () = TextIO.output (outf, "sig\n")
-                   val inf = TextIO.openIn filename
+                   val inf = FileIO.txtOpenIn filename
                    fun loop () =
                        case TextIO.inputLine inf of
                            NONE => ()
@@ -225,7 +225,7 @@ val parseUrs =
                    val () = (ErrorMsg.resetErrors ();
                              ErrorMsg.resetPositioning filename;
                              Lex.UserDeclarations.initialize ())
-	           val file = TextIO.openIn fname
+	           val file = FileIO.txtOpenIn fname
 	           fun get _ = TextIO.input file
 	           fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
 	           val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
@@ -251,7 +251,7 @@ val parseUr = {
                   val () = (ErrorMsg.resetErrors ();
                             ErrorMsg.resetPositioning filename;
                             Lex.UserDeclarations.initialize ())
-	          val file = TextIO.openIn filename
+	          val file = FileIO.txtOpenIn filename
 	          fun get _ = TextIO.input file
 	          fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
 	          val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
@@ -478,13 +478,15 @@ fun parseUrp' accLibs fname =
                      val thisPath = OS.Path.dir filename
 
                      val dir = OS.Path.dir filename
-                     fun opener () = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
+                     fun opener () = FileIO.txtOpenIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
 
                      val inf = opener ()
 
                      fun hasSpaceLine () =
                          case inputCommentableLine inf of
                              Content s => s = "debug" orelse s = "profile"
+                                          orelse s = "html5" orelse s = "xhtml"
+                                          orelse s = "noMangleSql" orelse s = "lessSafeFfi"
                                           orelse CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine ()
                            | EndOfFile => false
                            | OnlyComment => hasSpaceLine ()
@@ -890,6 +892,7 @@ fun parseUrp' accLibs fname =
                                    | "timeFormat" => Settings.setTimeFormat arg
                                    | "noMangleSql" => Settings.setMangleSql false
                                    | "html5" => Settings.setIsHtml5 true
+                                   | "xhtml" => Settings.setIsHtml5 false
                                    | "lessSafeFfi" => Settings.setLessSafeFfi true
 
                                    | "file" =>
diff --git a/src/demo.sml b/src/demo.sml
index 0d9f0f4f..47d22395 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -33,7 +33,7 @@ fun make' {prefix, dirname, guided} =
     let
         val prose = OS.Path.joinDirFile {dir = dirname,
                                          file = "prose"}
-        val inf = TextIO.openIn prose
+        val inf = FileIO.txtOpenIn prose
 
         val outDir = OS.Path.concat (dirname, "out")
 
@@ -351,7 +351,7 @@ fun make' {prefix, dirname, guided} =
                                      SOME "urp" =>
                                      doit (fn (src, html) =>
                                               let
-                                                  val inf = TextIO.openIn src
+                                                  val inf = FileIO.txtOpenIn src
                                                   val out = TextIO.openOut html
 
                                                   fun loop () =
diff --git a/src/elab_err.sml b/src/elab_err.sml
index 33daa118..385caca3 100644
--- a/src/elab_err.sml
+++ b/src/elab_err.sml
@@ -275,7 +275,7 @@ fun p_decl env d =
 
         fun readFromFile () =
             let
-                val inf = TextIO.openIn fname
+                val inf = FileIO.txtOpenIn fname
 
                 fun loop acc =
                     case TextIO.inputLine inf of
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index d1eec2a1..69b0e23c 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -281,7 +281,7 @@ See doc for the variable `urweb-mode-info'."
   "Face name to use for SQL keywords.")
 
 (defface font-lock-cvariable-face
-  '((t (:foreground "dark blue")))
+  '((t (:inherit font-lock-type-face)))
   "Font Lock mode face used to highlight capitalized identifiers."
   :group 'font-lock-highlighting-faces)
 (defvar font-lock-cvariable-face 'font-lock-cvariable-face
diff --git a/src/fileio.sig b/src/fileio.sig
new file mode 100644
index 00000000..37b3b529
--- /dev/null
+++ b/src/fileio.sig
@@ -0,0 +1,9 @@
+signature FILE_IO = sig
+
+    (* When was a source file last modified (excluding files produced after [getResetTime])? *)
+    val mostRecentModTime : unit -> Time.time
+
+    val txtOpenIn : string -> TextIO.instream
+    val binOpenIn : string -> BinIO.instream
+
+end
diff --git a/src/fileio.sml b/src/fileio.sml
new file mode 100644
index 00000000..cab9d8a3
--- /dev/null
+++ b/src/fileio.sml
@@ -0,0 +1,39 @@
+structure FileIO :> FILE_IO = struct
+
+val mostRecentModTimeRef = ref (Time.zeroTime)
+
+fun checkFileModTime fname =
+  let
+      val mtime = OS.FileSys.modTime fname
+      val mostRecentMod = !mostRecentModTimeRef
+      val resetTime = Globals.getResetTime ()
+      fun lessThan (a, b) = LargeInt.compare (Time.toSeconds a, Time.toSeconds b) = LESS
+      infix lessThan
+  in
+      if mostRecentMod lessThan mtime andalso mtime lessThan resetTime
+      then mostRecentModTimeRef := mtime
+      else ()
+  end
+
+fun mostRecentModTime () =
+  if Time.compare (!mostRecentModTimeRef, Time.zeroTime) = EQUAL
+  then Globals.getResetTime ()
+  else !mostRecentModTimeRef
+
+fun txtOpenIn fname =
+  let
+      val inf = TextIO.openIn fname
+      val () = checkFileModTime fname
+  in
+      inf
+  end
+
+fun binOpenIn fname =
+  let
+      val inf = BinIO.openIn fname
+      val () = checkFileModTime fname
+  in
+      inf
+  end
+
+end
diff --git a/src/globals.sig b/src/globals.sig
new file mode 100644
index 00000000..0cff65b5
--- /dev/null
+++ b/src/globals.sig
@@ -0,0 +1,7 @@
+signature GLOBALS = sig
+
+    (* When was the Ur/Web compiler started or reset? *)
+    val setResetTime : unit -> unit
+    val getResetTime : unit -> Time.time
+
+end
diff --git a/src/globals.sml b/src/globals.sml
new file mode 100644
index 00000000..fafc0438
--- /dev/null
+++ b/src/globals.sml
@@ -0,0 +1,7 @@
+structure Globals :> GLOBALS = struct
+
+val resetTime = ref (Time.zeroTime)
+fun setResetTime () = resetTime := Time.now ()
+fun getResetTime () = !resetTime
+
+end
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 65a0fa3a..dedcb554 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -1334,7 +1334,7 @@ fun process (file : file) =
                         maxName = U.File.maxName file + 1}
                        (#1 file)
 
-        val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"})
+        val inf = FileIO.txtOpenIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"})
         fun lines acc =
             case TextIO.inputLine inf of
                 NONE => String.concat (rev acc)
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 6d368106..fb1a1723 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -254,7 +254,8 @@ fun send (sock, s) =
             send (sock, String.extract (s, n, NONE))
     end
 
-val () = case CommandLine.arguments () of
+val () = (Globals.setResetTime ();
+          case CommandLine.arguments () of
              ["daemon", "start"] =>
              (case Posix.Process.fork () of
                   SOME _ => ()
@@ -376,4 +377,4 @@ val () = case CommandLine.arguments () of
                  else
                      (OS.FileSys.remove socket;
                       raise OS.SysErr ("", NONE))
-             end handle OS.SysErr _ => OS.Process.exit (oneRun args)
+             end handle OS.SysErr _ => OS.Process.exit (oneRun args))
diff --git a/src/settings.sig b/src/settings.sig
index dd135bda..05ab5e23 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -302,4 +302,5 @@ signature SETTINGS = sig
 
     val addJsFile : string (* filename *) -> unit
     val listJsFiles : unit -> {Filename : string, Content : string} list
+
 end
diff --git a/src/settings.sml b/src/settings.sml
index b72789df..70ea1861 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -290,7 +290,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("attrifyInt", "ts"),
                           ("attrifyFloat", "ts"),
                           ("attrifyBool", "bs"),
-                          ("boolToString", "ts"),
+                          ("boolToString", "bs"),
                           ("str1", "id"),
                           ("strsub", "sub"),
                           ("strsuffix", "suf"),
@@ -818,7 +818,7 @@ fun mangleSqlCatalog s =
         else
             lowercase s
 
-val html5 = ref false
+val html5 = ref true
 fun setIsHtml5 b = html5 := b
 fun getIsHtml5 () = !html5
 
@@ -844,7 +844,7 @@ fun noMime () =
 
 fun readMimeTypes () =
     let
-        val inf = TextIO.openIn "/etc/mime.types"
+        val inf = FileIO.txtOpenIn "/etc/mime.types"
 
         fun loop m =
             case TextIO.inputLine inf of
@@ -914,7 +914,7 @@ fun addFile {Uri, LoadFromFilename} =
                 ErrorMsg.error ("Two different files requested for URI " ^ Uri ^ " ( " ^ path' ^ " vs. " ^ path ^ ")")
           | NONE =>
             let
-                val inf = BinIO.openIn path
+                val inf = FileIO.binOpenIn path
             in
                 files := SM.insert (!files,
                                     Uri,
@@ -937,7 +937,7 @@ val jsFiles = ref (SM.empty : {Filename : string, Content : string} SM.map)
 fun addJsFile LoadFromFilename =
     let
         val path = OS.Path.concat (!filePath, LoadFromFilename)
-        val inf = TextIO.openIn path
+        val inf = FileIO.txtOpenIn path
     in
         jsFiles := SM.insert (!jsFiles,
                               path,
@@ -952,7 +952,8 @@ fun addJsFile LoadFromFilename =
 fun listJsFiles () = SM.listItems (!jsFiles)
 
 fun reset () =
-    (urlPrefixFull := "/";
+    (Globals.setResetTime ();
+     urlPrefixFull := "/";
      urlPrefix := "/";
      urlPrePrefix := "";
      timeout := 0;
diff --git a/src/sha1.sig b/src/sha1.sig
new file mode 100644
index 00000000..7fda97f5
--- /dev/null
+++ b/src/sha1.sig
@@ -0,0 +1,31 @@
+
+(* Implementation the SHA-1 hash function.
+   Written by Tom 7 in 2004; code in the public domain. *)
+
+signature SHA1 =
+sig
+
+  (* Perform the SHA-1 hash function on a message.
+     Returns the 160 bit (20 byte) hash.
+
+     recall that string = CharVector.vector.
+     The input string may contain non-ascii data;
+     the output certainly will. *)
+
+  val hash : string -> string
+
+  (* pass in a stream as stateful function that returns
+     SOME s for some non-empty prefix of the remainder of
+     the stream, or NONE when the stream has ended. *)
+  val hash_stream : (unit -> string option) -> string
+
+  (* XXX move to hashutil *)
+  (* convert a binary string to one built of hex digits *)
+  val bintohex : string -> string
+
+  (* Parse a hexadecimal SHA-1 string. Uppercase and lowercase
+     are permitted. If the string is not the right length or
+     contains invalid characters, returns NONE. *)
+  val parse_hex : string -> string option
+
+end
diff --git a/src/sha1.sml b/src/sha1.sml
new file mode 100644
index 00000000..d962c4e0
--- /dev/null
+++ b/src/sha1.sml
@@ -0,0 +1,264 @@
+
+(* RFC-3174 (SHA-1) hashing function.
+   By Tom 7, 2004: Code placed in the public domain.
+*)
+
+structure SHA1 :> SHA1 =
+struct
+  exception Unimplemented
+
+  val xorb = Word32.xorb
+  val andb = Word32.andb
+  val orb  = Word32.orb
+  val <<   = Word32.<<
+  val >>   = Word32.>>
+  val notb = Word32.notb
+  val ++   = Word32.+
+
+  type w32 = word
+  infix xorb andb orb << >> ++
+
+  (* workaround for andb bug in MLton 20010706 *)
+  fun mkbyte w = Word32.mod (w, 0w256)
+
+  fun ROL(X, N : Word.word) = (X << N) orb (X >> (0w32-N))
+
+  fun wc hi lo = (hi << 0w16) orb lo
+
+  fun w2b w = map chr
+    [Word32.toInt (mkbyte (w >> 0w24)),
+     Word32.toInt (mkbyte (w >> 0w16)),
+     Word32.toInt (mkbyte (w >> 0w8)),
+     Word32.toInt (mkbyte w)]
+
+  (* the length (arg in bytes, output in bits)
+     as a 64-bit quantity, big-endian *)
+  fun lenbits l =
+    implode (List.tabulate (4, fn _ => chr 0)) ^
+    implode (w2b (Word32.fromInt (l * 8)))
+
+
+  (* executes f for each index lo..hi-1 inclusive *)
+  fun for lo hi f =
+      if lo >= hi then ()
+      else (ignore (f lo); for (lo + 1) hi f)
+
+  fun ford lo hi b f =
+      if lo >= hi then b
+      else
+        let
+          val b = f (lo, b)
+        in
+          (ford (lo + 1) hi b f)
+        end
+
+  fun doblock (aa, bb, cc, dd, ee) msg =
+    let
+      val K0 = wc 0wx5A82 0wx7999
+      val K1 = wc 0wx6ED9 0wxEBA1
+      val K2 = wc 0wx8F1B 0wxBCDC
+      val K3 = wc 0wxCA62 0wxC1D6
+
+      fun mb n = Word32.fromInt (ord (CharVector.sub(msg, n)))
+
+      val W = Array.array(80, 0w0)
+      fun Ws x = Array.sub(W, x)
+
+      val _ =
+        for 0 16
+        (fn t =>
+         let in
+           Array.update(W, t,
+                        (mb (t * 4    ) << 0w24) orb
+                        (mb (t * 4 + 1) << 0w16) orb
+                        (mb (t * 4 + 2) << 0w8)  orb
+                        (mb (t * 4 + 3)))
+         end)
+
+      val _ =
+        for 16 80
+        (fn t =>
+         let
+           val n =
+             Ws (t-3)  xorb
+             Ws (t-8)  xorb
+             Ws (t-14) xorb
+             Ws (t-16)
+           val zz = ROL(n, 0w1)
+         in
+           Array.update(W, t, zz)
+         end)
+
+
+      val (A, B, C, D, E) = (aa, bb, cc, dd, ee)
+
+
+      fun round lo hi f k ctxt =
+        ford lo hi ctxt
+        (fn (t, ctxt as (A, B, C, D, E)) =>
+         let
+           val temp = ROL(A, 0w5) ++ (f ctxt) ++ E ++ Ws t ++ k
+           val E = D;
+           val D = C;
+           val C = ROL(B, 0w30)
+           val B = A
+           val A = temp
+         in
+           (A, B, C, D, E)
+         end)
+
+      val (A, B, C, D, E) =
+        round 0 20 (fn (A, B, C, D, E) =>
+                    ((B andb C) orb ((notb B) andb D)))
+                   K0 (A, B, C, D, E)
+
+      val (A, B, C, D, E) =
+        round 20 40 (fn (A, B, C, D, E) =>
+                     (B xorb C xorb D))
+                    K1 (A, B, C, D, E)
+
+      val (A, B, C, D, E) =
+        round 40 60 (fn (A, B, C, D, E) =>
+                     ((B andb C) orb (B andb D) orb (C andb D)))
+                    K2 (A, B, C, D, E)
+
+      val (A, B, C, D, E) =
+        round 60 80 (fn (A, B, C, D, E) =>
+                     (B xorb C xorb D))
+                    K3 (A, B, C, D, E)
+
+    in
+      (aa ++ A, bb ++ B, cc ++ C, dd ++ D, ee ++ E)
+    end
+
+  datatype 'a stream =
+      Cons of ('a * (unit -> 'a stream))
+    | Nil
+
+  (* turn a stream of oddly chunked strings into
+     one with 512-bit blocks *)
+  fun chunk_512 s =
+    let
+
+      (* the padding required to make a message of length l (bytes)
+         a proper SHA-1 input. Returns either one or two Cons cells.
+         tail is the end of the input (63 bytes or less)
+         l is the total length of the input, *including* the length of the
+         tail end *)
+      fun padding tail l =
+          let val v = l mod 64 in
+            if v < 56 then
+              let val p = 56 - v
+                val padding = implode (List.tabulate (p - 1, fn _ => chr 0))
+              in Cons (tail ^ str (chr 0x80) ^ padding ^ lenbits l,
+                    fn _ => Nil)
+              end
+            else if v < 64 then
+              let val p = 64 - v
+                val padding1 = implode (List.tabulate (p - 1, fn _ => chr 0))
+                val padding2 = implode (List.tabulate (56, fn _ => chr 0))
+              in Cons (tail ^ str (chr 0x80) ^ padding1,
+                    fn _ => Cons (padding2 ^ lenbits l, fn _ => Nil))
+              end
+            else raise Unimplemented (* Impossible? *)
+          end
+
+      (* n is the bytes we've already output.
+         cur is a string (of 64 bytes or less) that will
+         be our next chunk.
+         rest,sofar is a string and index indicating the
+         next bit of data. *)
+      (* PERF Could be more efficient by using an
+         accumulating array instead of a string for cur *)
+      fun ch n cur sofar startat () =
+        (* if we already have 64 bytes, return it *)
+        if size cur = 64
+        then
+          let in
+            Cons(cur, ch (n + 64) "" sofar startat)
+          end
+        else
+          (* do we have any in 'sofar'? *)
+          if startat < size sofar
+          then let
+                 val get = Int.min(size sofar - startat,
+                                   64 - size cur)
+               in
+                 (* be eager, since we need to return something now *)
+                 ch n (cur ^ String.substring(sofar, startat, get))
+                    sofar (startat + get) ()
+               end
+          else
+            (* sofar has been exhausted,
+               so get some from input stream *)
+            (case s () of
+               (* eager, again *)
+               SOME ss => ch n cur ss 0 ()
+             | NONE =>
+                 (* no more data. *)
+                 padding cur (n + size cur))
+    in
+      ch 0 "" "" 0
+    end
+
+  fun hash_stream orig_stream =
+    let
+
+      val stream512 = chunk_512 orig_stream
+
+      (* gets hash context, length of string so far (bytes),
+         and tail of stream *)
+      fun hash_rest stream ctxt =
+        (case stream() of
+           Cons (s, stream) =>
+             let val ctxt = doblock ctxt s
+             in  hash_rest stream ctxt
+             end
+         | Nil => ctxt)
+
+      val init =
+        (wc 0wx6745 0wx2301,
+         wc 0wxefcd 0wxab89,
+         wc 0wx98ba 0wxdcfe,
+         wc 0wx1032 0wx5476,
+         wc 0wxc3d2 0wxe1f0)
+
+      val (a, b, c, d, e) = hash_rest stream512 init
+    in
+      implode (w2b a @ w2b b @ w2b c @ w2b d @ w2b e)
+    end
+
+  fun hash m =
+    hash_stream
+    (let val r = ref true
+     in (fn () =>
+         if !r
+         then (r := false; SOME m)
+         else NONE)
+     end)
+
+  val digits = "0123456789ABCDEF"
+  fun bintohex s =
+    String.translate (fn c =>
+                      implode [CharVector.sub (digits, ord c div 16),
+                               CharVector.sub (digits, ord c mod 16)]) s
+
+  (* ASCII trick: (ch | 4400) % 55 *)
+  fun hexvalue ch =
+    SysWord.toInt (SysWord.orb(SysWord.fromInt(ord ch), SysWord.fromInt 4400)) mod 55
+
+  fun parse_hex s =
+      if size s <> 40
+         orelse not (CharVector.all (fn c => (ord c >= ord #"0" andalso
+                                              ord c <= ord #"9") orelse
+                                     (ord c >= ord #"a" andalso
+                                      ord c <= ord #"f") orelse
+                                     (ord c >= ord #"A" andalso
+                                      ord c <= ord #"F")) s)
+      then NONE
+      else SOME (CharVector.tabulate(20,
+                                     (fn i =>
+                                      chr(hexvalue (String.sub(s, i * 2)) * 16 +
+                                          hexvalue (String.sub(s, i * 2 + 1))))))
+
+end
diff --git a/src/sources b/src/sources
index 1a09e7e8..52b1bdd7 100644
--- a/src/sources
+++ b/src/sources
@@ -1,6 +1,9 @@
 $(SRC)/config.sig
 config.sml
 
+$(SRC)/globals.sig
+$(SRC)/globals.sml
+
 $(SRC)/search.sig
 $(SRC)/search.sml
 
@@ -16,6 +19,9 @@ $(SRC)/errormsg.sml
 $(SRC)/print.sig
 $(SRC)/print.sml
 
+$(SRC)/fileio.sig
+$(SRC)/fileio.sml
+
 $(SRC)/settings.sig
 $(SRC)/settings.sml
 
@@ -227,6 +233,9 @@ $(SRC)/sigcheck.sml
 
 $(SRC)/mono_inline.sml
 
+$(SRC)/sha1.sig
+$(SRC)/sha1.sml
+
 $(SRC)/cjr.sml
 
 $(SRC)/postgres.sig
diff --git a/src/tag.sml b/src/tag.sml
index 6fef50d1..94e5d44f 100644
--- a/src/tag.sml
+++ b/src/tag.sml
@@ -38,6 +38,38 @@ structure SM = BinaryMapFn(struct
                            val compare = String.compare
                            end)
 
+structure UnionFind :> sig
+              type t
+              val empty : t
+              val equate : t * int * int -> t
+              val equal : t * int * int -> bool
+              val rep : t * int -> int
+          end = struct
+
+type t = int IM.map
+
+val empty = IM.empty
+
+fun rep (t, n) =
+    case IM.find (t, n) of
+        NONE => n
+      | SOME n' => rep (t, n')
+
+fun equate (t, n1, n2) =
+    let
+        val r1 = rep (t, n1)
+        val r2 = rep (t, n2)
+    in
+        if r1 = r2 then
+            t
+        else
+            IM.insert (t, r1, r2)
+    end
+
+fun equal (t, n1, n2) = rep (t, n1) = rep (t, n2)
+
+end
+
 fun kind (k, s) = (k, s)
 fun con (c, s) = (c, s)
 
@@ -45,7 +77,7 @@ fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for multip
                      TextIO.output (TextIO.stdErr,
                                     "Make sure that the signature of the containing module hides any form/RPC handlers.\n"))
 
-fun exp env (e, s) =
+fun exp uf env (e, s) =
     let
         fun tagIt (e, ek : export_kind, newAttr, (count, tags, byTag, newTags)) =
             let
@@ -74,13 +106,15 @@ fun exp env (e, s) =
                     (e, (count, tags, byTag, newTags))
                 else
                     let
+                        val f = UnionFind.rep (uf, f)
+
                         val (cn, count, tags, newTags) =
                             case IM.find (tags, f) of
                                 NONE =>
                                 (count, count + 1, IM.insert (tags, f, count),
                                  (ek, f, count) :: newTags)
                               | SOME cn => (cn, count, tags, newTags)
-                                           
+
                         val (_, _, _, s) = E.lookupENamed env f
 
                         val byTag = case SM.find (byTag, s) of
@@ -217,20 +251,20 @@ fun tag file =
     let
         val count = U.File.maxName file
 
-        fun doDecl (d as (d', loc), (env, count, tags, byTag)) =
+        fun doDecl (d as (d', loc), (env, count, tags, byTag, uf)) =
             case d' of
                 DExport (ek, n, _) =>
                 let
                     val (_, _, _, s) = E.lookupENamed env n
                 in
                     case SM.find (byTag, s) of
-                        NONE => ([d], (env, count, tags, byTag))
+                        NONE => ([d], (env, count, tags, byTag, uf))
                       | SOME (ek', n') =>
                         (if ek = ek' then
                              ()
                          else
                              both (loc, s);
-                         ([], (env, count, tags, byTag)))
+                         ([], (env, count, tags, byTag, uf)))
                 end
               | _ =>
                 let
@@ -242,7 +276,7 @@ fun tag file =
                     val (d, (count, tags, byTag, newTags)) =
                         U.Decl.foldMap {kind = kind,
                                         con = con,
-                                        exp = exp env'',
+                                        exp = exp uf env'',
                                         decl = decl}
                                        (count, tags, byTag, []) d
 
@@ -306,11 +340,15 @@ fun tag file =
                     val ds = case d of
                                  (DValRec vis, _) => [(DValRec (vis @ newVals), loc)]
                                | _ => map (fn vi => (DVal vi, loc)) newVals @ [d]
+
+                    val uf = case d' of
+                                 DVal (_, n1, _, (ENamed n2, _), _) => UnionFind.equate (uf, n1, n2)
+                                 | _ => uf
                 in
-                    (ds @ newExports, (env, count, tags, byTag))
+                    (ds @ newExports, (env, count, tags, byTag, uf))
                 end
 
-        val (file, _) = ListUtil.foldlMapConcat doDecl (CoreEnv.empty, count+1, IM.empty, SM.empty) file
+        val (file, _) = ListUtil.foldlMapConcat doDecl (CoreEnv.empty, count+1, IM.empty, SM.empty, UnionFind.empty) file
     in
         file
     end
diff --git a/src/tutorial.sml b/src/tutorial.sml
index dd2d3f7d..0c2f908f 100644
--- a/src/tutorial.sml
+++ b/src/tutorial.sml
@@ -38,7 +38,7 @@ fun readAll inf =
         before TextIO.closeIn inf
     end
 
-val readAllFile = readAll o TextIO.openIn
+val readAllFile = readAll o FileIO.txtOpenIn
 
 fun fixupFile (fname, title) =
     let
@@ -154,7 +154,7 @@ fun fixupFile (fname, title) =
 
 fun doUr fname =
     let
-        val inf = TextIO.openIn fname
+        val inf = FileIO.txtOpenIn fname
 
         val title = case TextIO.inputLine inf of
                         NONE => raise Fail ("No title comment at start of " ^ fname)