summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/cjr_print.sml10
-rw-r--r--src/sidecheck.sig5
-rw-r--r--src/sidecheck.sml71
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