Mercurial > urweb
comparison src/sidecheck.sml @ 2226:e10881cd92da
Merge.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Fri, 27 Mar 2015 11:26:06 -0400 |
parents | ebfaab689570 |
children |
comparison
equal
deleted
inserted
replaced
2225:6262dabc08d6 | 2226:e10881cd92da |
---|---|
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 |