Mercurial > urweb

annotate src/sidecheck.sml @ 2257:28a541bd2d23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use referenced (rather than all) free variables as keys for pure caches.
author Ziv Scully <ziv@mit.edu>
date Sun, 27 Sep 2015 14:46:12 -0400
parents ebfaab689570
children
rev   line source
adam@1595 1 (* Copyright (c) 2011, Adam Chlipala
adam@1595 2 * All rights reserved.
adam@1595 3 *
adam@1595 4 * Redistribution and use in source and binary forms, with or without
adam@1595 5 * modification, are permitted provided that the following conditions are met:
adam@1595 6 *
adam@1595 7 * - Redistributions of source code must retain the above copyright notice,
adam@1595 8 * this list of conditions and the following disclaimer.
adam@1595 9 * - Redistributions in binary form must reproduce the above copyright notice,
adam@1595 10 * this list of conditions and the following disclaimer in the documentation
adam@1595 11 * and/or other materials provided with the distribution.
adam@1595 12 * - The names of contributors may not be used to endorse or promote products
adam@1595 13 * derived from this software without specific prior written permission.
adam@1595 14 *
adam@1595 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adam@1595 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adam@1595 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adam@1595 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1595 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adam@1595 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adam@1595 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adam@1595 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adam@1595 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adam@1595 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adam@1595 25 * POSSIBILITY OF SUCH DAMAGE.
adam@1595 26 *)
adam@1595 27
adam@1595 28 structure SideCheck :> SIDE_CHECK = struct
adam@1595 29
adam@1595 30 open Mono
adam@1595 31
adam@1595 32 structure E = ErrorMsg
adam@1595 33
adam@2116 34 structure SK = struct
adam@2116 35 type ord_key = string
adam@2116 36 val compare = String.compare
adam@2116 37 end
adam@2116 38
adam@2116 39 structure SS = BinarySetFn(SK)
adam@2116 40
adam@2116 41 val envVars = ref SS.empty
adam@2116 42
adam@1595 43 fun check ds =
adam@2116 44 let
adam@2116 45 val alreadyWarned = ref false
adam@2116 46 in
adam@2116 47 envVars := SS.empty;
adam@2116 48 MonoUtil.File.appLoc (fn (e, loc) =>
adam@2116 49 let
adam@2116 50 fun error (k as (k1, k2)) =
adam@2116 51 if Settings.isClientOnly k then
adam@2116 52 let
adam@2116 53 val k2 = case k1 of
adam@2116 54 "Basis" =>
adam@2116 55 (case k2 of
adam@2116 56 "get_client_source" => "get"
adam@2116 57 | _ => k2)
adam@2116 58 | _ => k2
adam@2116 59 in
adam@2116 60 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
adam@2116 61 end
adam@2116 62 else
adam@2116 63 ()
adam@2116 64 in
adam@2116 65 case e of
adam@2116 66 EFfi k => error k
adam@2116 67 | EFfiApp ("Basis", "getenv", [(e, _)]) =>
adam@2116 68 (case #1 e of
adam@2116 69 EPrim (Prim.String (_, s)) =>
adam@2116 70 envVars := SS.add (!envVars, s)
adam@2116 71 | _ => if !alreadyWarned then
adam@2116 72 ()
adam@2116 73 else
adam@2116 74 (alreadyWarned := true;
adam@2116 75 TextIO.output (TextIO.stdErr, "WARNING: " ^ ErrorMsg.spanToString loc ^ ": reading from an environment variable not determined at compile time, which can confuse CSRF protection")))
adam@2116 76 | EFfiApp (k1, k2, _) => error (k1, k2)
adam@2116 77 | _ => ()
adam@2116 78 end) ds;
adam@2116 79 ds
adam@2116 80 end
adam@2116 81
adam@2116 82 fun readEnvVars () = SS.listItems (!envVars)
adam@1595 83
adam@1595 84 end