changeset 1183:9d3ccb8b39ac

safeGet
author Adam Chlipala <adamc@hcoop.net>
date Tue, 09 Mar 2010 18:28:44 -0500
parents 0b1d666bddb4
children d6f0e972b706
files CHANGELOG doc/manual.tex src/compiler.sig src/compiler.sml src/demo.sml src/effectize.sml src/settings.sig src/settings.sml
diffstat 8 files changed, 40 insertions(+), 8 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGELOG	Tue Mar 09 17:50:42 2010 -0500
+++ b/CHANGELOG	Tue Mar 09 18:28:44 2010 -0500
@@ -1,3 +1,9 @@
+========
+Next
+========
+
+- safeGet .urp directive
+
 ========
 20100213
 ========
--- a/doc/manual.tex	Tue Mar 09 17:50:42 2010 -0500
+++ b/doc/manual.tex	Tue Mar 09 18:28:44 2010 -0500
@@ -151,6 +151,7 @@
 \item \texttt{prefix PREFIX} sets the prefix included before every URI within the generated application.  The default is \texttt{/}.
 \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}.  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{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{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.
--- a/src/compiler.sig	Tue Mar 09 17:50:42 2010 -0500
+++ b/src/compiler.sig	Tue Mar 09 18:28:44 2010 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2009, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -53,7 +53,8 @@
          filterMime : Settings.rule list,
          protocol : string option,
          dbms : string option,
-         sigFile : string option
+         sigFile : string option,
+         safeGets : string list
     }
     val compile : string -> bool
     val compiler : string -> unit
--- a/src/compiler.sml	Tue Mar 09 17:50:42 2010 -0500
+++ b/src/compiler.sml	Tue Mar 09 18:28:44 2010 -0500
@@ -57,7 +57,8 @@
      filterMime : Settings.rule list,
      protocol : string option,
      dbms : string option,
-     sigFile : string option
+     sigFile : string option,
+     safeGets : string list
 }
 
 type ('src, 'dst) phase = {
@@ -385,6 +386,7 @@
                 val protocol = ref NONE
                 val dbms = ref NONE
                 val sigFile = ref (Settings.getSigFile ())
+                val safeGets = ref []
 
                 fun finish sources =
                     let
@@ -413,7 +415,8 @@
                             sources = sources,
                             protocol = !protocol,
                             dbms = !dbms,
-                            sigFile = !sigFile
+                            sigFile = !sigFile,
+                            safeGets = rev (!safeGets)
                         }
 
                         fun mergeO f (old, new) =
@@ -456,7 +459,8 @@
                                                     (#sources old),
                             protocol = mergeO #2 (#protocol old, #protocol new),
                             dbms = mergeO #2 (#dbms old, #dbms new),
-                            sigFile = mergeO #2 (#sigFile old, #sigFile new)
+                            sigFile = mergeO #2 (#sigFile old, #sigFile new),
+                            safeGets = #safeGets old @ #safeGets new
                         }
                     in
                         if accLibs then
@@ -569,7 +573,7 @@
                               | "include" => headers := relifyA arg :: !headers
                               | "script" => scripts := arg :: !scripts
                               | "clientToServer" => clientToServer := ffiS () :: !clientToServer
-                              | "effectful" => effectful := ffiS () :: !effectful
+                              | "safeGet" => safeGets := arg :: !safeGets
                               | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
                               | "clientOnly" => clientOnly := ffiS () :: !clientOnly
                               | "serverOnly" => serverOnly := ffiS () :: !serverOnly
@@ -642,6 +646,7 @@
                 Settings.setMimeRules (#filterMime job);
                 Option.app Settings.setProtocol (#protocol job);
                 Option.app Settings.setDbms (#dbms job);
+                Settings.setSafeGets (#safeGets job);
                 job
             end
     in
--- a/src/demo.sml	Tue Mar 09 17:50:42 2010 -0500
+++ b/src/demo.sml	Tue Mar 09 18:28:44 2010 -0500
@@ -114,7 +114,8 @@
             filterMime = #filterMime combined @ #filterMime urp,
             protocol = mergeWith #2 (#protocol combined, #protocol urp),
             dbms = mergeWith #2 (#dbms combined, #dbms urp),
-            sigFile = mergeWith #2 (#sigFile combined, #sigFile urp)
+            sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
+            safeGets = []
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
--- a/src/effectize.sml	Tue Mar 09 17:50:42 2010 -0500
+++ b/src/effectize.sml	Tue Mar 09 18:28:44 2010 -0500
@@ -143,7 +143,12 @@
               | DExport (Link, n, _) =>
                 (case IM.find (writers, n) of
                      NONE => ()
-                   | SOME (loc, s) => ErrorMsg.errorAt loc ("A link (" ^ s ^ ") could cause side effects; try implementing it with a form instead");
+                   | SOME (loc, s) =>
+                     if Settings.isSafeGet s then
+                         ()
+                     else
+                         ErrorMsg.errorAt loc ("A link (" ^ s
+                                               ^ ") could cause side effects; try implementing it with a form instead");
                  ((DExport (Link, n, IM.inDomain (pushers, n)), #2 d), evs))
               | DExport (Action _, n, _) =>
                 ((DExport (Action (if IM.inDomain (writers, n) then
--- a/src/settings.sig	Tue Mar 09 17:50:42 2010 -0500
+++ b/src/settings.sig	Tue Mar 09 18:28:44 2010 -0500
@@ -198,4 +198,8 @@
     val setSigFile : string option -> unit
     val getSigFile : unit -> string option
 
+    (* Which GET-able functions should be allowed to have side effects? *)
+    val setSafeGets : string list -> unit
+    val isSafeGet : string -> bool
+
 end
--- a/src/settings.sml	Tue Mar 09 17:50:42 2010 -0500
+++ b/src/settings.sml	Tue Mar 09 18:28:44 2010 -0500
@@ -452,4 +452,13 @@
 fun setSigFile v = sigFile := v
 fun getSigFile () = !sigFile
 
+structure SS = BinarySetFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+val safeGet = ref SS.empty
+fun setSafeGets ls = safeGet := SS.addList (SS.empty, ls)
+fun isSafeGet x = SS.member (!safeGet, x)
+
 end