HTTP Last-Modified: latest modtime of source files

See issue #38.

13 files changed, 93 insertions, 34 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b2c85a54..2e969c46 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3306,8 +3306,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 +3495,26 @@ fun p_file env (ds, ps) =
 
              string "static void uw_handle(uw_context ctx, char *request) {",
              newline,
+             string "uw_Basis_string ims = uw_Basis_requestHeader(ctx, \"If-modified-since\");",
+             newline,
+             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 "return;",
+                  newline],
+             string "}",
+             newline,
+             newline,
              string "if (!strcmp(request, \"",
              string app_js,
              string "\")) {",
              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 "}",
-                  newline,
-                  newline,
-                  string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
+             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 +3537,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,
diff --git a/src/compiler.sml b/src/compiler.sml
index dccda06d..87d175ed 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,7 +478,7 @@ 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 ()
 
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/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..72e72f6d
--- /dev/null
+++ b/src/fileio.sml
@@ -0,0 +1,34 @@
+structure FileIO :> FILE_IO = struct
+
+val mostRecentModTimeRef = ref (Time.zeroTime)
+
+fun checkFileModTime fname =
+  let val mtime = OS.FileSys.modTime fname in
+      if Time.compare (mtime, !mostRecentModTimeRef) = GREATER andalso
+         Time.compare (mtime, Globals.getResetTime ()) = LESS
+      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..f4d399dc 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -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/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)