Mercurial > urweb

comparison src/sidecheck.sml @ 2116:ebfaab689570

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 7bb8c560f23d
children
comparison
equal deleted inserted replaced
2115:3dc020fb2aa1 2116:ebfaab689570
29 29
30 open Mono 30 open Mono
31 31
32 structure E = ErrorMsg 32 structure E = ErrorMsg
33 33
34 structure SK = struct
35 type ord_key = string
36 val compare = String.compare
37 end
38
39 structure SS = BinarySetFn(SK)
40
41 val envVars = ref SS.empty
42
34 fun check ds = 43 fun check ds =
35 (MonoUtil.File.appLoc (fn (e, loc) => 44 let
36 let 45 val alreadyWarned = ref false
37 fun error (k as (k1, k2)) = 46 in
38 if Settings.isClientOnly k then 47 envVars := SS.empty;
39 let 48 MonoUtil.File.appLoc (fn (e, loc) =>
40 val k2 = case k1 of 49 let
41 "Basis" => 50 fun error (k as (k1, k2)) =
42 (case k2 of 51 if Settings.isClientOnly k then
43 "get_client_source" => "get" 52 let
44 | _ => k2) 53 val k2 = case k1 of
45 | _ => k2 54 "Basis" =>
46 in 55 (case k2 of
47 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"") 56 "get_client_source" => "get"
48 end 57 | _ => k2)
49 else 58 | _ => k2
50 () 59 in
51 in 60 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
52 case e of 61 end
53 EFfi k => error k 62 else
54 | EFfiApp (k1, k2, _) => error (k1, k2) 63 ()
55 | _ => () 64 in
56 end) ds; 65 case e of
57 ds) 66 EFfi k => error k
67 | EFfiApp ("Basis", "getenv", [(e, _)]) =>
68 (case #1 e of
69 EPrim (Prim.String (_, s)) =>
70 envVars := SS.add (!envVars, s)
71 | _ => if !alreadyWarned then
72 ()
73 else
74 (alreadyWarned := true;
75 TextIO.output (TextIO.stdErr, "WARNING: " ^ ErrorMsg.spanToString loc ^ ": reading from an environment variable not determined at compile time, which can confuse CSRF protection")))
76 | EFfiApp (k1, k2, _) => error (k1, k2)
77 | _ => ()
78 end) ds;
79 ds
80 end
81
82 fun readEnvVars () = SS.listItems (!envVars)
58 83
59 end 84 end