The 2nd half of proper CSRF protection related to environment variables

3 files changed, 63 insertions, 23 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 0867f001..b3b12fe8 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3260,6 +3260,16 @@ fun p_file env (ds, ps) =
                                                               string "))"]))
                          NONE cookies
 
+        val cookieCode = foldl (fn (evar, acc) =>
+                                   SOME (case acc of
+                                             NONE => string ("uw_unnull(uw_Basis_getenv(ctx, \""
+                                                             ^ Prim.toCString evar ^ "\"))")
+                                           | SOME acc => box [string ("uw_Basis_strcat(ctx, uw_unnull(uw_Basis_getenv(ctx, \""
+                                                                      ^ Prim.toCString evar ^ "\")), uw_Basis_strcat(ctx, \"/\", "),
+                                                              acc,
+                                                              string "))"]))
+                         cookieCode (SideCheck.readEnvVars ())
+
         fun makeChecker (name, rules : Settings.rule list) =
             box [string "static int ",
                  string name,
diff --git a/src/sidecheck.sig b/src/sidecheck.sig
index 30abced6..1e3e2275 100644
--- a/src/sidecheck.sig
+++ b/src/sidecheck.sig
@@ -29,4 +29,9 @@ signature SIDE_CHECK = sig
 
     val check : Mono.file -> Mono.file
 
+    (* While we're checking, we'll do some other signature-related work, recording
+     * which environment variables are read.  This function conveys the list,
+     * coming from the most recent call to [check]. *)
+    val readEnvVars : unit -> string list
+
 end
diff --git a/src/sidecheck.sml b/src/sidecheck.sml
index b36d4935..bd11223a 100644
--- a/src/sidecheck.sml
+++ b/src/sidecheck.sml
@@ -31,29 +31,54 @@ open Mono
 
 structure E = ErrorMsg
 
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+
+val envVars = ref SS.empty
+
 fun check ds =
-    (MonoUtil.File.appLoc (fn (e, loc) =>
-                              let
-                                  fun error (k as (k1, k2)) =
-                                      if Settings.isClientOnly k then
-                                          let
-                                              val k2 = case k1 of
-                                                           "Basis" =>
-                                                           (case k2 of
-                                                                "get_client_source" => "get"
-                                                              | _ => k2)
-                                                         | _ => k2
-                                          in
-                                              E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
-                                          end
-                                      else
-                                          ()
-                              in
-                                  case e of
-                                      EFfi k => error k
-                                    | EFfiApp (k1, k2, _) => error (k1, k2)
-                                    | _ => ()
-                              end) ds;
-     ds)
+    let
+        val alreadyWarned = ref false
+    in
+        envVars := SS.empty;
+        MonoUtil.File.appLoc (fn (e, loc) =>
+                                 let
+                                     fun error (k as (k1, k2)) =
+                                         if Settings.isClientOnly k then
+                                             let
+                                                 val k2 = case k1 of
+                                                              "Basis" =>
+                                                              (case k2 of
+                                                                   "get_client_source" => "get"
+                                                                 | _ => k2)
+                                                            | _ => k2
+                                             in
+                                                 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
+                                             end
+                                         else
+                                             ()
+                                 in
+                                     case e of
+                                         EFfi k => error k
+                                       | EFfiApp ("Basis", "getenv", [(e, _)]) =>
+                                         (case #1 e of
+                                              EPrim (Prim.String (_, s)) =>
+                                              envVars := SS.add (!envVars, s)
+                                            | _ => if !alreadyWarned then
+                                                       ()
+                                                   else
+                                                       (alreadyWarned := true;
+                                                        TextIO.output (TextIO.stdErr, "WARNING: " ^ ErrorMsg.spanToString loc ^ ": reading from an environment variable not determined at compile time, which can confuse CSRF protection")))
+                                       | EFfiApp (k1, k2, _) => error (k1, k2)
+                                       | _ => ()
+                                 end) ds;
+        ds
+    end
+
+fun readEnvVars () = SS.listItems (!envVars)
 
 end