diff options
| -rw-r--r-- | src/cjr_print.sml | 10 | ||||
| -rw-r--r-- | src/sidecheck.sig | 5 | ||||
| -rw-r--r-- | src/sidecheck.sml | 71 |
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 |