diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2015-02-12 15:09:26 -0500 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2015-02-12 15:09:26 -0500 |
| commit | fa1ac29899b0a7d37bc8e0d42fc90f98543471fc (patch) | |
| tree | 596746366c6cc096adda95bb8ba55907ef3230f7 /src/sidecheck.sml | |
| parent | a06a5b0fdd2c80ae5d5190b74a5c560ed4b1e0fa (diff) | |
The 2nd half of proper CSRF protection related to environment variables
Diffstat (limited to 'src/sidecheck.sml')
| -rw-r--r-- | src/sidecheck.sml | 71 |
1 files changed, 48 insertions, 23 deletions
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 |