Mercurial > urweb

comparison src/scriptcheck.sml @ 695:500e93aa436f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sleep and better Scriptcheck
author Adam Chlipala <adamc@hcoop.net>
date Sat, 04 Apr 2009 15:56:47 -0400
parents 655bcc9b77e0
children 6fc633d990e7
comparison
equal deleted inserted replaced
694:7ea0df9e56b6 695:500e93aa436f
43 val pushBasis = SS.addList (SS.empty, 43 val pushBasis = SS.addList (SS.empty,
44 ["new_channel", 44 ["new_channel",
45 "self"]) 45 "self"])
46 46
47 val scriptWords = ["<script", 47 val scriptWords = ["<script",
48 " onclick=", 48 " onclick='"]
49 " onload="]
50 49
51 val pushWords = ["rv("] 50 val pushWords = ["rv("]
52 51
53 fun classify (ds, ps) = 52 fun classify (ds, ps) =
54 let 53 let
57 val (_, suffix) = Substring.position needle (Substring.full haystack) 56 val (_, suffix) = Substring.position needle (Substring.full haystack)
58 in 57 in
59 not (Substring.isEmpty suffix) 58 not (Substring.isEmpty suffix)
60 end 59 end
61 60
62 fun hasClient {basis, words} csids = 61 fun hasClient {basis, words, onload} csids =
63 let 62 let
63 fun realOnload ss =
64 case ss of
65 [] => false
66 | (EFfiApp ("Basis", "get_settings", _), _) :: ss => realOnload ss
67 | (EPrim (Prim.String s), _) :: ss => not (String.isPrefix "'" s)
68 | _ => true
69
64 fun hasClient e = 70 fun hasClient e =
65 case #1 e of 71 case #1 e of
66 EPrim (Prim.String s) => List.exists (fn n => inString {needle = n, haystack = s}) words 72 EPrim (Prim.String s) => List.exists (fn n => inString {needle = n, haystack = s}) words
67 | EPrim _ => false 73 | EPrim _ => false
68 | ERel _ => false 74 | ERel _ => false
71 | ECon (_, _, SOME e) => hasClient e 77 | ECon (_, _, SOME e) => hasClient e
72 | ENone _ => false 78 | ENone _ => false
73 | ESome (_, e) => hasClient e 79 | ESome (_, e) => hasClient e
74 | EFfi ("Basis", x) => SS.member (basis, x) 80 | EFfi ("Basis", x) => SS.member (basis, x)
75 | EFfi _ => false 81 | EFfi _ => false
82 | EFfiApp ("Basis", "strcat", all as ((EPrim (Prim.String s1), _) :: ss)) =>
83 if onload andalso String.isSuffix " onload='" s1 then
84 realOnload ss orelse List.exists hasClient all
85 else
86 List.exists hasClient all
76 | EFfiApp ("Basis", x, es) => SS.member (basis, x) 87 | EFfiApp ("Basis", x, es) => SS.member (basis, x)
77 orelse List.exists hasClient es 88 orelse List.exists hasClient es
78 | EFfiApp (_, _, es) => List.exists hasClient es 89 | EFfiApp (_, _, es) => List.exists hasClient es
79 | EApp (e, es) => hasClient e orelse List.exists hasClient es 90 | EApp (e, es) => hasClient e orelse List.exists hasClient es
80 | EUnop (_, e) => hasClient e 91 | EUnop (_, e) => hasClient e
95 hasClient 106 hasClient
96 end 107 end
97 108
98 fun decl ((d, _), (pull_ids, push_ids)) = 109 fun decl ((d, _), (pull_ids, push_ids)) =
99 let 110 let
100 val hasClientPull = hasClient {basis = pullBasis, words = scriptWords} pull_ids 111 val hasClientPull = hasClient {basis = pullBasis, words = scriptWords, onload = true} pull_ids
101 val hasClientPush = hasClient {basis = pushBasis, words = pushWords} push_ids 112 val hasClientPush = hasClient {basis = pushBasis, words = pushWords, onload = false} push_ids
102 in 113 in
103 case d of 114 case d of
104 DVal (_, n, _, e) => (if hasClientPull e then 115 DVal (_, n, _, e) => (if hasClientPull e then
105 IS.add (pull_ids, n) 116 IS.add (pull_ids, n)
106 else 117 else