# HG changeset patch # User Adam Chlipala # Date 1406815001 14400 # Node ID ced78ef1c82f24fc316211783b3a661595205664 # Parent 534577e429e1fa12d01a433d4d0df26bdd02fba7 New .urp directive: file diff -r 534577e429e1 -r ced78ef1c82f doc/manual.tex --- a/doc/manual.tex Mon Jul 28 20:18:43 2014 -0400 +++ b/doc/manual.tex Thu Jul 31 09:56:41 2014 -0400 @@ -146,7 +146,8 @@ \item \texttt{database DBSTRING} sets the string to pass to libpq to open a database connection. \item \texttt{debug} saves some intermediate C files, which is mostly useful to help in debugging the compiler itself. \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{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{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} activates work-in-progress support for generating HTML5 instead of XHTML. For now, this option only affects the first few tokens on any page, which are always the same. \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. diff -r 534577e429e1 -r ced78ef1c82f include/urweb/urweb_cpp.h --- a/include/urweb/urweb_cpp.h Mon Jul 28 20:18:43 2014 -0400 +++ b/include/urweb/urweb_cpp.h Thu Jul 31 09:56:41 2014 -0400 @@ -263,6 +263,7 @@ __attribute__((noreturn)) void uw_return_blob(struct uw_context *, uw_Basis_blob, uw_Basis_string mimeType); __attribute__((noreturn)) void uw_return_blob_from_page(struct uw_context *, uw_Basis_string mimeType); __attribute__((noreturn)) void uw_redirect(struct uw_context *, uw_Basis_string url); +void uw_replace_page(struct uw_context *, const char *data, size_t size); uw_Basis_time uw_Basis_now(struct uw_context *); uw_Basis_time uw_Basis_addSeconds(struct uw_context *, uw_Basis_time, uw_Basis_int); diff -r 534577e429e1 -r ced78ef1c82f src/c/urweb.c --- a/src/c/urweb.c Mon Jul 28 20:18:43 2014 -0400 +++ b/src/c/urweb.c Thu Jul 31 09:56:41 2014 -0400 @@ -3861,6 +3861,11 @@ longjmp(ctx->jmp_buf, RETURN_INDIRECTLY); } +void uw_replace_page(uw_context ctx, const char *data, size_t size) { + uw_buffer_reset(&ctx->page); + ctx_uw_buffer_append(ctx, "page", &ctx->page, data, size); +} + __attribute__((noreturn)) void uw_return_blob_from_page(uw_context ctx, uw_Basis_string mimeType) { cleanup *cl; int len; diff -r 534577e429e1 -r ced78ef1c82f src/cjr_print.sml --- a/src/cjr_print.sml Mon Jul 28 20:18:43 2014 -0400 +++ b/src/cjr_print.sml Thu Jul 31 09:56:41 2014 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2012, Adam Chlipala +(* Copyright (c) 2008-2014, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -3293,6 +3293,17 @@ val now = Time.now () val nowD = Date.fromTimeUniv now val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT" + + fun hexifyByte (b : Word8.word) : string = + let + val s = Int.fmt StringCvt.HEX (Word8.toInt b) + in + "\\x" ^ (if size s < 2 then "0" else "") ^ s + end + + fun hexify (v : Word8Vector.vector) : string = + String.concat (Word8Vector.foldr (fn (b, ls) => + hexifyByte b :: ls) [] v) in box [string "#include \"", string (OS.Path.joinDirFile {dir = !Settings.configInclude, @@ -3476,9 +3487,9 @@ string "}", newline, newline, - string "uw_write_header(ctx, \"Content-type: text/javascript\\r\\n\");", + 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 nowD ^ "\\r\\n\");"), newline, string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), newline, @@ -3488,6 +3499,37 @@ newline], string "}", newline, + newline, + + p_list_sep newline (fn r => + box [string "if (!strcmp(request, \"", + string (String.toCString (#Uri r)), + string "\")) {", + newline, + box [(case #ContentType r of + NONE => box [] + | SOME ct => box [string "uw_write_header(ctx, \"Content-Type: ", + string (String.toCString ct), + string "\\r\\n\");", + newline]), + string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"), + newline, + string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"), + newline, + string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), + newline, + string "uw_replace_page(ctx, \"", + string (hexify (#Bytes r)), + string "\", ", + string (Int.toString (Word8Vector.length (#Bytes r))), + string ");", + newline, + string "return;", + newline], + string "};", + newline]) (Settings.listFiles ()), + + newline, p_list_sep newline (fn x => x) pds', newline, string "uw_clear_headers(ctx);", diff -r 534577e429e1 -r ced78ef1c82f src/compiler.sml --- a/src/compiler.sml Mon Jul 28 20:18:43 2014 -0400 +++ b/src/compiler.sml Thu Jul 31 09:56:41 2014 -0400 @@ -461,6 +461,8 @@ end else let + val thisPath = OS.Path.dir fname + val pathmap = ref (!pathmap) val bigLibs = ref [] @@ -876,6 +878,13 @@ | "html5" => Settings.setIsHtml5 true | "lessSafeFfi" => Settings.setLessSafeFfi true + | "file" => + (case String.fields Char.isSpace arg of + [uri, fname] => (Settings.setFilePath thisPath; + Settings.addFile {Uri = uri, + LoadFromFilename = fname}) + | _ => ErrorMsg.error "Bad 'file' arguments") + | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); read () end diff -r 534577e429e1 -r ced78ef1c82f src/settings.sig --- a/src/settings.sig Mon Jul 28 20:18:43 2014 -0400 +++ b/src/settings.sig Thu Jul 31 09:56:41 2014 -0400 @@ -278,4 +278,10 @@ val setLessSafeFfi : bool -> unit val getLessSafeFfi : unit -> bool + + val setFilePath : string -> unit + (* Sets the directory where we look for files being added below. *) + + val addFile : {Uri : string, LoadFromFilename : string} -> unit + val listFiles : unit -> {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector} list end diff -r 534577e429e1 -r ced78ef1c82f src/settings.sml --- a/src/settings.sml Mon Jul 28 20:18:43 2014 -0400 +++ b/src/settings.sml Thu Jul 31 09:56:41 2014 -0400 @@ -744,4 +744,106 @@ fun setLessSafeFfi b = less := b fun getLessSafeFfi () = !less +structure SM = BinaryMapFn(struct + type ord_key = string + val compare = String.compare + end) + +val noMimeFile = ref false + +fun noMime () = + (TextIO.output (TextIO.stdErr, "WARNING: Error opening /etc/mime.types. Static files will be served with no suggested MIME types.\n"); + noMimeFile := true; + SM.empty) + +fun readMimeTypes () = + let + val inf = TextIO.openIn "/etc/mime.types" + + fun loop m = + case TextIO.inputLine inf of + NONE => m + | SOME line => + if size line > 0 andalso String.sub (line, 0) = #"#" then + loop m + else + case String.tokens Char.isSpace line of + typ :: exts => + loop (foldl (fn (ext, m) => SM.insert (m, ext, typ)) m exts) + | _ => loop m + in + loop SM.empty + before TextIO.closeIn inf + end handle IO.Io _ => noMime () + | OS.SysErr _ => noMime () + +val mimeTypes = ref (NONE : string SM.map option) + +fun getMimeTypes () = + case !mimeTypes of + SOME m => m + | NONE => + let + val m = readMimeTypes () + in + mimeTypes := SOME m; + m + end + +fun mimeTypeOf filename = + case OS.Path.ext filename of + NONE => (if !noMimeFile then + () + else + TextIO.output (TextIO.stdErr, "WARNING: No extension found in filename '" ^ filename ^ "'. Header 'Content-Type' will be omitted in HTTP responses.\n"); + NONE) + | SOME ext => + let + val to = SM.find (getMimeTypes (), ext) + in + case to of + NONE => if !noMimeFile then + () + else + TextIO.output (TextIO.stdErr, "WARNING: No MIME type known for extension '" ^ ext ^ "'. Header 'Content-Type' will be omitted in HTTP responses.\n") + | _ => (); + to + end + +val files = ref (SM.empty : (string * {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector}) SM.map) + +val filePath = ref "." + +fun setFilePath path = filePath := path + +fun addFile {Uri, LoadFromFilename} = + let + val path = OS.Path.joinDirFile {dir = !filePath, file = LoadFromFilename} + in + case SM.find (!files, Uri) of + SOME (path', _) => + if path' = path then + () + else + ErrorMsg.error ("Two different files requested for URI " ^ Uri) + | NONE => + let + val inf = BinIO.openIn path + in + files := SM.insert (!files, + Uri, + (path, + {Uri = Uri, + ContentType = mimeTypeOf path, + LastModified = OS.FileSys.modTime path, + Bytes = BinIO.inputAll inf})); + BinIO.closeIn inf + end + end handle IO.Io _ => + ErrorMsg.error ("Error loading file " ^ LoadFromFilename) + | OS.SysErr (s, _) => + ErrorMsg.error ("Error loading file " ^ LoadFromFilename ^ " (" ^ s ^ ")") + +fun listFiles () = map #2 (SM.listItems (!files)) + end diff -r 534577e429e1 -r ced78ef1c82f tests/files.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/files.ur Thu Jul 31 09:56:41 2014 -0400 @@ -0,0 +1,1 @@ +fun main () : transaction page = return Main page diff -r 534577e429e1 -r ced78ef1c82f tests/files.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/files.urp Thu Jul 31 09:56:41 2014 -0400 @@ -0,0 +1,6 @@ +rewrite all Files/* +file /hello_world.txt hello.txt +file /img/web.png web.png +file /files.urp files.urp + +files diff -r 534577e429e1 -r ced78ef1c82f tests/hello.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/hello.txt Thu Jul 31 09:56:41 2014 -0400 @@ -0,0 +1,1 @@ +Hello World! diff -r 534577e429e1 -r ced78ef1c82f tests/web.png Binary file tests/web.png has changed