# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1423771766 18000
# Node ID ebfaab689570d827e8c36220053326c1a4f64eb7
# Parent  3dc020fb2aa1e1a669d8edb83ec86b3a3e0ce797
The 2nd half of proper CSRF protection related to environment variables

diff -r 3dc020fb2aa1 -r ebfaab689570 src/cjr_print.sml
--- a/src/cjr_print.sml	Wed Feb 11 13:12:59 2015 -0500
+++ b/src/cjr_print.sml	Thu Feb 12 15:09:26 2015 -0500
@@ -3260,6 +3260,16 @@
                                                               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 -r 3dc020fb2aa1 -r ebfaab689570 src/sidecheck.sig
--- a/src/sidecheck.sig	Wed Feb 11 13:12:59 2015 -0500
+++ b/src/sidecheck.sig	Thu Feb 12 15:09:26 2015 -0500
@@ -29,4 +29,9 @@
 
     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 -r 3dc020fb2aa1 -r ebfaab689570 src/sidecheck.sml
--- a/src/sidecheck.sml	Wed Feb 11 13:12:59 2015 -0500
+++ b/src/sidecheck.sml	Thu Feb 12 15:09:26 2015 -0500
@@ -31,29 +31,54 @@
 
 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