New .urp option: safeGetDefault

6 files changed, 14 insertions, 1 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index d2db4816..e064e59e 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -190,6 +190,7 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
 \item \texttt{profile} generates an executable that may be used with gprof.
 \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}.  The \texttt{TO} field may be left empty to express the idea of deleting a prefix.  For instance, \texttt{rewrite url Main/*} will strip all \texttt{Main/} prefixes from URLs.  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.  An optional suffix of \cd{[-]} for a \cd{rewrite} directive asks to additionally replace all \cd{\_} characters with \cd{-} characters, which can be handy for, e.g., interfacing with an off-the-shelf CSS library that prefers hyphens over underscores.
 \item \texttt{safeGet URI} asks to allow the page handler assigned this canonical URI prefix to cause persistent side effects, even if accessed via an HTTP \cd{GET} request.
+\item \texttt{safeGetDefault} asks to allow \emph{any} page handler to cause side effects, even if accessed via an HTTP \cd{GET} request.
 \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.
diff --git a/src/compiler.sig b/src/compiler.sig
index bcf69fd4..7922393d 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -61,6 +61,7 @@ signature COMPILER = sig
          dbms : string option,
          sigFile : string option,
          fileCache : string option,
+         safeGetDefault : bool,
          safeGets : string list,
          onError : (string * string list * string) option,
          minHeap : int,
diff --git a/src/compiler.sml b/src/compiler.sml
index f724bf56..271cf2f1 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -65,6 +65,7 @@ type job = {
      dbms : string option,
      sigFile : string option,
      fileCache : string option,
+     safeGetDefault : bool,
      safeGets : string list,
      onError : (string * string list * string) option,
      minHeap : int,
@@ -385,6 +386,7 @@ fun institutionalizeJob (job : job) =
      Settings.setMetaRules (#filterMeta job);
      Option.app Settings.setProtocol (#protocol job);
      Option.app Settings.setDbms (#dbms job);
+     Settings.setSafeGetDefault (#safeGetDefault job);
      Settings.setSafeGets (#safeGets job);
      Settings.setOnError (#onError job);
      Settings.setMinHeap (#minHeap job);
@@ -470,6 +472,7 @@ fun parseUrp' accLibs fname =
                         dbms = NONE,
                         sigFile = NONE,
                         fileCache = NONE,
+                        safeGetDefault = false,
                         safeGets = [],
                         onError = NONE,
                         minHeap = 0,
@@ -605,6 +608,7 @@ fun parseUrp' accLibs fname =
                      val dbms = ref NONE
                      val sigFile = ref (Settings.getSigFile ())
                      val fileCache = ref (Settings.getFileCache ())
+                     val safeGetDefault = ref false
                      val safeGets = ref []
                      val onError = ref NONE
                      val minHeap = ref 0
@@ -645,6 +649,7 @@ fun parseUrp' accLibs fname =
                                  dbms = !dbms,
                                  sigFile = !sigFile,
                                  fileCache = !fileCache,
+                                 safeGetDefault = !safeGetDefault,
                                  safeGets = rev (!safeGets),
                                  onError = !onError,
                                  minHeap = !minHeap,
@@ -708,6 +713,7 @@ fun parseUrp' accLibs fname =
                                  dbms = mergeO #2 (#dbms old, #dbms new),
                                  sigFile = mergeO #2 (#sigFile old, #sigFile new),
                                  fileCache = mergeO #2 (#fileCache old, #fileCache new),
+                                 safeGetDefault = #safeGetDefault old orelse #safeGetDefault new,
                                  safeGets = #safeGets old @ #safeGets new,
                                  onError = mergeO #2 (#onError old, #onError new),
                                  minHeap = Int.max (#minHeap old, #minHeap new),
@@ -829,6 +835,7 @@ fun parseUrp' accLibs fname =
                                    | "include" => headers := relifyA arg :: !headers
                                    | "script" => scripts := arg :: !scripts
                                    | "clientToServer" => clientToServer := ffiS () :: !clientToServer
+                                   | "safeGetDefault" => safeGetDefault := true
                                    | "safeGet" => safeGets := arg :: !safeGets
                                    | "effectful" => effectful := ffiS () :: !effectful
                                    | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
diff --git a/src/demo.sml b/src/demo.sml
index 1e58e2f8..eaec38bb 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -124,6 +124,7 @@ fun make' {prefix, dirname, guided} =
             dbms = mergeWith #2 (#dbms combined, #dbms urp),
             sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
             fileCache = mergeWith #2 (#fileCache combined, #fileCache urp),
+            safeGetDefault = #safeGetDefault combined orelse #safeGetDefault urp,
             safeGets = #safeGets combined @ #safeGets urp,
             onError = NONE,
             minHeap = 0,
diff --git a/src/settings.sig b/src/settings.sig
index 986d6ed7..6ba7e96a 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -258,6 +258,7 @@ signature SETTINGS = sig
     val getFileCache : unit -> string option
 
     (* Which GET-able functions should be allowed to have side effects? *)
+    val setSafeGetDefault : bool -> unit
     val setSafeGets : string list -> unit
     val isSafeGet : string -> bool
 
diff --git a/src/settings.sml b/src/settings.sml
index cfbe98a5..3772fc04 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -740,9 +740,11 @@ structure SS = BinarySetFn(struct
                            val compare = String.compare
                            end)
 
+val safeGetDefault = ref false
 val safeGet = ref SS.empty
+fun setSafeGetDefault b = safeGetDefault := b
 fun setSafeGets ls = safeGet := SS.addList (SS.empty, ls)
-fun isSafeGet x = SS.member (!safeGet, x)
+fun isSafeGet x = !safeGetDefault orelse SS.member (!safeGet, x)
 
 val onError = ref (NONE : (string * string list * string) option)
 fun setOnError x = onError := x