Mercurial > urweb
changeset 2116:ebfaab689570
The 2nd half of proper CSRF protection related to environment variables
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Thu, 12 Feb 2015 15:09:26 -0500 |
| parents | 3dc020fb2aa1 |
| children | f1c4edf0a655 |
| files | src/cjr_print.sml src/sidecheck.sig src/sidecheck.sml |
| diffstat | 3 files changed, 63 insertions(+), 23 deletions(-) [+] |
line wrap: on
line diff
--- 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,
--- 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
--- 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