From 1ea383a0e73f63d142d3539d984c9e2f4b7f0076 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 12 Feb 2015 15:09:26 -0500
Subject: The 2nd half of proper CSRF protection related to environment
 variables

---
 src/sidecheck.sml | 71 +++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 48 insertions(+), 23 deletions(-)

(limited to 'src/sidecheck.sml')

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
-- 
cgit v1.2.3