New .urp directives: mimeTypes and long form of file

9 files changed, 49 insertions, 16 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index eaf7aab5..1b476499 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -150,6 +150,7 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
 \item \texttt{effectful Module.ident} registers an FFI function or transaction as having side effects.  The optimizer avoids removing, moving, or duplicating calls to such functions.  This is the default behavior for \texttt{transaction}-based types.
 \item \texttt{exe FILENAME} sets the filename to which to write the output executable.  The default for file \texttt{P.urp} is \texttt{P.exe}.
 \item \texttt{file URI FILENAME} asks for the application executable to respond to requests for \texttt{URI} by serving a snapshot of the contents of \texttt{FILENAME} as of compile time.  That is, the file contents are baked into the executable.  System file \texttt{/etc/mime.types} is consulted (again, at compile time) to figure out the right MIME type to suggest in the HTTP response.
+\item \texttt{file URI FILENAME MIME-TYPE} works like the simpler form of \texttt{file}, but the proper MIME type for the file is given directly.
 \item \texttt{ffi FILENAME} reads the file \texttt{FILENAME.urs} to determine the interface to a new FFI module.  The name of the module is calculated from \texttt{FILENAME} in the same way as for normal source files.  See the files \texttt{include/urweb/urweb\_cpp.h} and \texttt{src/c/urweb.c} for examples of C headers and implementations for FFI modules.  In general, every type or value \texttt{Module.ident} becomes \texttt{uw\_Module\_ident} in C.
 \item \texttt{html5} asks to generate HTML5 code, which primarily affects the first few lines of the output documents, like the \texttt{DOCTYPE}.  This option is on by default.
 \item \texttt{include FILENAME} adds \texttt{FILENAME} to the list of files to be \texttt{\#include}d in C sources.  This is most useful for interfacing with new FFI modules.
@@ -176,6 +177,7 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
   \end{itemize}
 \item \texttt{link FILENAME} adds \texttt{FILENAME} to the list of files to be passed to the linker at the end of compilation.  This is most useful for importing extra libraries needed by new FFI modules.
 \item \texttt{linker CMD} sets \texttt{CMD} as the command line prefix to use for linking C object files.  The command line will be completed with a space-separated list of \texttt{.o} and \texttt{.a} files, \texttt{-L} and \texttt{-l} flags, and finally with a \texttt{-o} flag to set the location where the executable should be written.
+\item \texttt{mimeTypes PATH} sets the name of the file from which the MIME-type database is read, as a substitute for the usual \texttt{/etc/mime.types} on UNIX systems.
 \item \texttt{minHeap NUMBYTES} sets the initial size for thread-local heaps used in handling requests.  These heaps grow automatically as needed (up to any maximum set with \texttt{limit}), but each regrow requires restarting the request handling process.
 \item \texttt{monoInline TREESIZE} sets how many nodes the AST of a function definition may have before the optimizer stops trying hard to inline calls to that function.  (This is one of two options for one of two intermediate languages within the compiler.)
 \item \texttt{neverInline PATH} requests that no call to the referenced function be inlined.  Section \ref{structure} explains how functions are assigned path strings.
diff --git a/src/compiler.sig b/src/compiler.sig
index 952c7070..0ff84f1c 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -62,7 +62,8 @@ signature COMPILER = sig
          sigFile : string option,
          safeGets : string list,
          onError : (string * string list * string) option,
-         minHeap : int
+         minHeap : int,
+         mimeTypes : string option
     }
     val compile : string -> bool
     val compiler : string -> unit
diff --git a/src/compiler.sml b/src/compiler.sml
index c13de304..3fb0b767 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -66,7 +66,8 @@ type job = {
      sigFile : string option,
      safeGets : string list,
      onError : (string * string list * string) option,
-     minHeap : int
+     minHeap : int,
+     mimeTypes : string option
 }
 
 type ('src, 'dst) phase = {
@@ -386,7 +387,8 @@ fun institutionalizeJob (job : job) =
      Settings.setSafeGets (#safeGets job);
      Settings.setOnError (#onError job);
      Settings.setMinHeap (#minHeap job);
-     Settings.setSigFile (#sigFile job))
+     Settings.setSigFile (#sigFile job);
+     Settings.setMimeFilePath (Option.getOpt (#mimeTypes job, "/etc/mime.types")))
 
 datatype commentableLine =
          EndOfFile
@@ -467,7 +469,8 @@ fun parseUrp' accLibs fname =
                         sigFile = NONE,
                         safeGets = [],
                         onError = NONE,
-                        minHeap = 0}
+                        minHeap = 0,
+                        mimeTypes = NONE}
          in
              institutionalizeJob job;
              {Job = job, Libs = []}
@@ -601,6 +604,7 @@ fun parseUrp' accLibs fname =
                      val safeGets = ref []
                      val onError = ref NONE
                      val minHeap = ref 0
+                     val mimeTypes = ref NONE
 
                      fun finish sources =
                          let
@@ -638,7 +642,8 @@ fun parseUrp' accLibs fname =
                                  sigFile = !sigFile,
                                  safeGets = rev (!safeGets),
                                  onError = !onError,
-                                 minHeap = !minHeap
+                                 minHeap = !minHeap,
+                                 mimeTypes = !mimeTypes
                              }
 
                              fun mergeO f (old, new) =
@@ -699,7 +704,8 @@ fun parseUrp' accLibs fname =
                                  sigFile = mergeO #2 (#sigFile old, #sigFile new),
                                  safeGets = #safeGets old @ #safeGets new,
                                  onError = mergeO #2 (#onError old, #onError new),
-                                 minHeap = Int.max (#minHeap old, #minHeap new)
+                                 minHeap = Int.max (#minHeap old, #minHeap new),
+                                 mimeTypes = mergeO #2 (#mimeTypes old, #mimeTypes new)
                              }
                          in
                              if accLibs then
@@ -914,13 +920,20 @@ fun parseUrp' accLibs fname =
                                    | "html5" => Settings.setIsHtml5 true
                                    | "xhtml" => Settings.setIsHtml5 false
                                    | "lessSafeFfi" => Settings.setLessSafeFfi true
+                                   | "mimeTypes" => Settings.setMimeFilePath (relify arg)
 
                                    | "file" =>
                                      (case String.fields Char.isSpace arg of
-                                          [uri, fname] => (Settings.setFilePath thisPath;
-                                                           Settings.addFile {Uri = uri,
-                                                                             LoadFromFilename = fname};
-                                                           url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url)
+                                          uri :: fname :: rest =>
+                                          (Settings.setFilePath thisPath;
+                                           Settings.addFile {Uri = uri,
+                                                             LoadFromFilename = fname,
+                                                             MimeType = case rest of
+                                                                            [] => NONE
+                                                                          | [ty] => SOME ty
+                                                                          | _ => (ErrorMsg.error "Bad 'file' arguments";
+                                                                                  NONE)};
+                                           url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url)
                                         | _ => ErrorMsg.error "Bad 'file' arguments")
 
                                    | "jsFile" =>
diff --git a/src/demo.sml b/src/demo.sml
index 62b9037a..a682d28d 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -125,7 +125,8 @@ fun make' {prefix, dirname, guided} =
             sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
             safeGets = #safeGets combined @ #safeGets urp,
             onError = NONE,
-            minHeap = 0
+            minHeap = 0,
+            mimeTypes = mergeWith #2 (#mimeTypes combined, #mimeTypes urp)
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
diff --git a/src/settings.sig b/src/settings.sig
index 256a12b5..729218ac 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -298,7 +298,7 @@ signature SETTINGS = sig
     val setFilePath : string -> unit
     (* Sets the directory where we look for files being added below. *)
 
-    val addFile : {Uri : string, LoadFromFilename : string} -> unit
+    val addFile : {Uri : string, LoadFromFilename : string, MimeType : string option} -> unit
     val listFiles : unit -> {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector} list
 
     val addJsFile : string (* filename *) -> unit
@@ -306,4 +306,7 @@ signature SETTINGS = sig
 
     val setOutputJsFile : string option (* filename *) -> unit
     val getOutputJsFile : unit -> string option
+
+    val setMimeFilePath : string -> unit
+    (* Set unusual location for /etc/mime.types. *)
 end
diff --git a/src/settings.sml b/src/settings.sml
index a3263c06..d3ac99d4 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -843,14 +843,17 @@ structure SM = BinaryMapFn(struct
 
 val noMimeFile = ref false
 
+val mimeFilePath = ref "/etc/mime.types"
+fun setMimeFilePath file = mimeFilePath := file
+
 fun noMime () =
-    (TextIO.output (TextIO.stdErr, "WARNING: Error opening /etc/mime.types.  Static files will be served with no suggested MIME types.\n");
+    (TextIO.output (TextIO.stdErr, "WARNING: Error opening " ^ !mimeFilePath ^ ".  Static files will be served with no suggested MIME types.\n");
      noMimeFile := true;
      SM.empty)
 
 fun readMimeTypes () =
     let
-        val inf = FileIO.txtOpenIn "/etc/mime.types"
+        val inf = FileIO.txtOpenIn (!mimeFilePath)
 
         fun loop m =
             case TextIO.inputLine inf of
@@ -908,7 +911,7 @@ val filePath = ref "."
 
 fun setFilePath path = filePath := path
 
-fun addFile {Uri, LoadFromFilename} =
+fun addFile {Uri, LoadFromFilename, MimeType} =
     let
         val path = OS.Path.concat (!filePath, LoadFromFilename)
     in
@@ -926,7 +929,9 @@ fun addFile {Uri, LoadFromFilename} =
                                     Uri,
                                     (path,
                                      {Uri = Uri,
-                                      ContentType = mimeTypeOf path,
+                                      ContentType = case MimeType of
+                                                        NONE => mimeTypeOf path
+                                                      | _ => MimeType,
                                       LastModified = OS.FileSys.modTime path,
                                       Bytes = BinIO.inputAll inf}));
                 BinIO.closeIn inf
diff --git a/tests/fake_types b/tests/fake_types
new file mode 100644
index 00000000..405e9d1d
--- /dev/null
+++ b/tests/fake_types
@@ -0,0 +1,2 @@
+horrible_idea/blorpapalooza     txt
+whoa/yowza                      html
diff --git a/tests/mimeTypesDirective.ur b/tests/mimeTypesDirective.ur
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/tests/mimeTypesDirective.ur
diff --git a/tests/mimeTypesDirective.urp b/tests/mimeTypesDirective.urp
new file mode 100644
index 00000000..43f06a00
--- /dev/null
+++ b/tests/mimeTypesDirective.urp
@@ -0,0 +1,6 @@
+mimeTypes fake_types
+file /hello.txt hello.txt
+file /hello.html hello.html
+file /hello2.txt hello.txt gadzooks/yippie
+
+mimeTypesDirective