changeset 1164:8679ba87cf3c

sigfile directive
author Adam Chlipala <adamc@hcoop.net>
date Thu, 11 Feb 2010 09:10:01 -0500
parents 6c507826fae9
children 7a17588edbff
files doc/manual.tex src/c/urweb.c src/cgi.sml src/cjr_print.sml src/compiler.sig src/compiler.sml src/demo.sml src/fastcgi.sml src/http.sml src/main.mlton.sml src/settings.sig src/settings.sml
diffstat 12 files changed, 87 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/doc/manual.tex	Tue Feb 09 20:08:59 2010 -0500
+++ b/doc/manual.tex	Thu Feb 11 09:10:01 2010 -0500
@@ -152,6 +152,7 @@
 \item \texttt{rewrite KIND FROM TO} gives a rule for rewriting canonical module paths.  For instance, the canonical path of a page may be \texttt{Mod1.Mod2.mypage}, while you would rather the page were accessed via a URL containing only \texttt{page}.  The directive \texttt{rewrite url Mod1/Mod2/mypage page} would accomplish that.  The possible values of \texttt{KIND} determine which kinds of objects are affected.  The kind \texttt{all} matches any object, and \texttt{url} matches page URLs.  The kinds \texttt{table}, \texttt{sequence}, and \texttt{view} match those sorts of SQL entities, and \texttt{relation} matches any of those three.  \texttt{cookie} matches HTTP cookies, and \texttt{style} matches CSS class names.  If \texttt{FROM} ends in \texttt{/*}, it is interpreted as a prefix matching rule, and rewriting occurs by replacing only the appropriate prefix of a path with \texttt{TO}.  While the actual external names of relations and styles have parts separated by underscores instead of slashes, all rewrite rules must be written in terms of slashes.
 \item \texttt{script URL} adds \texttt{URL} to the list of extra JavaScript files to be included at the beginning of any page that uses JavaScript.  This is most useful for importing JavaScript versions of functions found in new FFI modules.
 \item \texttt{serverOnly Module.ident} registers an FFI function or transaction that may only be run on the server.
+\item \texttt{sigfile PATH} sets a path where your application should look for a key to use in cryptographic signing.  This is used to prevent cross-site request forgery attacks for any form handler that both reads a cookie and creates side effects.  If the referenced file doesn't exist, an application will create it and read its saved data on future invocations.  You can also initialize the file manually with any contents at least 16 bytes long; the first 16 bytes will be treated as the key.
 \item \texttt{sql FILENAME} sets where to write an SQL file with the commands to create the expected database schema.  The default is not to create such a file.
 \item \texttt{timeout N} sets to \texttt{N} seconds the amount of time that the generated server will wait after the last contact from a client before determining that that client has exited the application.  Clients that remain active will take the timeout setting into account in determining how often to ping the server, so it only makes sense to set a high timeout to cope with browser and network delays and failures.  Higher timeouts can lead to more unnecessary client information taking up memory on the server.  The timeout goes unused by any page that doesn't involve the \texttt{recv} function, since the server only needs to store per-client information for clients that receive asynchronous messages.
 \end{itemize}
@@ -233,6 +234,8 @@
 
     To access the \texttt{foo} function in the \texttt{Bar} module, you would then hit \texttt{http://somewhere/dir/script.exe/Bar/foo}.
 
+    If your application contains form handlers that read cookies before causing side effects, then you will need to use the \texttt{sigfile} \texttt{.urp} directive, too.
+
   \item \texttt{fastcgi}: This is a newer protocol inspired by CGI, wherein web servers can start and reuse persistent external processes to generate dynamic content.  Ur/Web doesn't implement the whole protocol, but Ur/Web's support has been tested to work with the \texttt{mod\_fastcgi}s of Apache and lighttpd.
 
     To configure a FastCGI program with Apache, one could combine the above \texttt{ScriptAlias} line with a line like this:
@@ -260,6 +263,8 @@
 
 \item \texttt{-root Name PATH}: Trigger an alternate module convention for all source files found in directory \texttt{PATH} or any of its subdirectories.  Any file \texttt{PATH/foo.ur} defines a module \texttt{Name.Foo} instead of the usual \texttt{Foo}.  Any file \texttt{PATH/subdir/foo.ur} defines a module \texttt{Name.Subdir.Foo}, and so on for arbitrary nesting of subdirectories.
 
+\item \texttt{-sigfile PATH}: Same as the \texttt{sigfile} directive in \texttt{.urp} files
+
 \item \texttt{-sql FILENAME}: Set where a database set-up SQL script is written.
 
 \item \texttt{-static}: Link the runtime system statically.  The default is to link against dynamic libraries.
--- a/src/c/urweb.c	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/c/urweb.c	Thu Feb 11 09:10:01 2010 -0500
@@ -330,6 +330,7 @@
 
 // Global entry points
 
+extern void uw_global_custom();
 extern void uw_init_crypto();
 
 void uw_global_init() {
@@ -337,6 +338,7 @@
 
   clients = malloc(0);
 
+  uw_global_custom();
   uw_init_crypto();
 }
 
--- a/src/cgi.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/cgi.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -28,11 +28,24 @@
 structure Cgi :> CGI = struct
 
 open Settings
+open Print.PD Print
 
 val () = addProtocol {name = "cgi",
                       compile = "",
                       linkStatic = Config.lib ^ "/../liburweb_cgi.a",
                       linkDynamic = "-lurweb_cgi",
-                      persistent = false}
+                      persistent = false,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "}",
+                                           newline]}
 
 end
--- a/src/cjr_print.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/cjr_print.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -2805,6 +2805,8 @@
              newline,
              newline,
 
+             #code (Settings.currentProtocol ()) (),
+
              if hasDb then
                  #init (Settings.currentDbms ()) {dbstring = !dbstring,
                                                   prepared = !prepped,
--- a/src/compiler.sig	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/compiler.sig	Thu Feb 11 09:10:01 2010 -0500
@@ -51,7 +51,8 @@
          filterUrl : Settings.rule list,
          filterMime : Settings.rule list,
          protocol : string option,
-         dbms : string option
+         dbms : string option,
+         sigFile : string option
     }
     val compile : string -> bool
     val compiler : string -> unit
--- a/src/compiler.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/compiler.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -55,7 +55,8 @@
      filterUrl : Settings.rule list,
      filterMime : Settings.rule list,
      protocol : string option,
-     dbms : string option
+     dbms : string option,
+     sigFile : string option
 }
 
 type ('src, 'dst) phase = {
@@ -379,6 +380,7 @@
                 val libs = ref []
                 val protocol = ref NONE
                 val dbms = ref NONE
+                val sigFile = ref (Settings.getSigFile ())
 
                 fun finish sources =
                     let
@@ -405,7 +407,8 @@
                             filterMime = rev (!mime),
                             sources = sources,
                             protocol = !protocol,
-                            dbms = !dbms
+                            dbms = !dbms,
+                            sigFile = !sigFile
                         }
 
                         fun mergeO f (old, new) =
@@ -446,7 +449,8 @@
                                       @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
                                                     (#sources old),
                             protocol = mergeO #2 (#protocol old, #protocol new),
-                            dbms = mergeO #2 (#dbms old, #dbms new)
+                            dbms = mergeO #2 (#dbms old, #dbms new),
+                            sigFile = mergeO #2 (#sigFile old, #sigFile new)
                         }
                     in
                         if accLibs then
@@ -523,6 +527,14 @@
                                 (case !database of
                                      NONE => database := SOME arg
                                    | SOME _ => ())
+                              | "dbms" =>
+                                (case !dbms of
+                                     NONE => dbms := SOME arg
+                                   | SOME _ => ())
+                              | "sigfile" =>
+                                (case !sigFile of
+                                     NONE => sigFile := SOME arg
+                                   | SOME _ => ())
                               | "exe" =>
                                 (case !exe of
                                      NONE => exe := SOME (relify arg)
--- a/src/demo.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/demo.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -112,7 +112,8 @@
             filterUrl = #filterUrl combined @ #filterUrl urp,
             filterMime = #filterMime combined @ #filterMime urp,
             protocol = mergeWith #2 (#protocol combined, #protocol urp),
-            dbms = mergeWith #2 (#dbms combined, #dbms urp)
+            dbms = mergeWith #2 (#dbms combined, #dbms urp),
+            sigFile = mergeWith #2 (#sigFile combined, #sigFile urp)
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
--- a/src/fastcgi.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/fastcgi.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -28,11 +28,24 @@
 structure Fastcgi :> FASTCGI = struct
 
 open Settings
+open Print.PD Print
 
 val () = addProtocol {name = "fastcgi",
                       compile = "",
                       linkStatic = Config.lib ^ "/../liburweb_fastcgi.a",
                       linkDynamic = "-lurweb_fastcgi",
-                      persistent = true}
+                      persistent = true,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "}",
+                                           newline]}
 
 end
--- a/src/http.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/http.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -28,12 +28,26 @@
 structure Http :> HTTP = struct
 
 open Settings
+open Print.PD Print
 
 val () = addProtocol {name = "http",
                       compile = "",
                       linkStatic = Config.lib ^ "/../liburweb_http.a",
                       linkDynamic = "-lurweb_http",
-                      persistent = true}
+                      persistent = true,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "}",
+                                           newline]}
+
 val () = setProtocol "http"
 
 end
--- a/src/main.mlton.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/main.mlton.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -72,6 +72,9 @@
       | "-root" :: name :: root :: rest =>
         (Compiler.addModuleRoot (root, name);
          doArgs rest)
+      | "-sigfile" :: name :: rest =>
+        (Settings.setSigFile (SOME name);
+         doArgs rest)
       | arg :: rest =>
         (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
              raise Fail ("Unknown flag " ^ arg)
--- a/src/settings.sig	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/settings.sig	Thu Feb 11 09:10:01 2010 -0500
@@ -96,7 +96,8 @@
         compile : string,    (* Pass these `gcc -c' arguments *)
         linkStatic : string, (* Pass these static linker arguments *)
         linkDynamic : string,(* Pass these dynamic linker arguments *)
-        persistent : bool    (* Multiple requests per process? *)
+        persistent : bool,   (* Multiple requests per process? *)
+        code : unit -> Print.PD.pp_desc (* Extra code to include in C files *)
     }
     val addProtocol : protocol -> unit
     val setProtocol : string -> unit
@@ -190,4 +191,7 @@
     val setDeadlines : bool -> unit
     val getDeadlines : unit -> bool
 
+    val setSigFile : string option -> unit
+    val getSigFile : unit -> string option
+
 end
--- a/src/settings.sml	Tue Feb 09 20:08:59 2010 -0500
+++ b/src/settings.sml	Thu Feb 11 09:10:01 2010 -0500
@@ -275,7 +275,8 @@
      compile : string,
      linkStatic : string,
      linkDynamic : string,
-     persistent : bool
+     persistent : bool,
+     code : unit -> Print.PD.pp_desc
 }
 val protocols = ref ([] : protocol list)
 fun addProtocol p = protocols := p :: !protocols
@@ -288,7 +289,8 @@
                     compile = "",
                     linkStatic = "",
                     linkDynamic = "",
-                    persistent = false}
+                    persistent = false,
+                    code = fn () => Print.box []}
 fun setProtocol name =
     case getProtocol name of
         NONE => raise Fail ("Unknown protocol " ^ name)
@@ -441,4 +443,8 @@
 fun setDeadlines b = deadlines := b
 fun getDeadlines () = !deadlines
 
+val sigFile = ref (NONE : string option)
+fun setSigFile v = sigFile := v
+fun getSigFile () = !sigFile
+
 end