New .urp option: safeGetDefault

5 files changed, 13 insertions, 1 deletions

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