summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2017-10-01 17:13:17 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2017-10-01 17:13:17 -0400
commitb1a6440a3fb285cdfd5301510b96b1ef3b96c050 (patch)
tree427f7fd2345c9f3edef11b6b2475cbdba8ca1971 /src
parent06452188bc3a4f04762214ba7bcf7d4d0e36c9f3 (diff)
New .urp directives: mimeTypes and long form of file
Diffstat (limited to 'src')
-rw-r--r--src/compiler.sig3
-rw-r--r--src/compiler.sml31
-rw-r--r--src/demo.sml3
-rw-r--r--src/settings.sig5
-rw-r--r--src/settings.sml13
5 files changed, 39 insertions, 16 deletions
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