From b1a6440a3fb285cdfd5301510b96b1ef3b96c050 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 1 Oct 2017 17:13:17 -0400 Subject: New .urp directives: mimeTypes and long form of file --- src/compiler.sig | 3 ++- src/compiler.sml | 31 ++++++++++++++++++++++--------- src/demo.sml | 3 ++- src/settings.sig | 5 ++++- src/settings.sml | 13 +++++++++---- 5 files changed, 39 insertions(+), 16 deletions(-) (limited to 'src') 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 -- cgit v1.2.3