Mercurial > urweb
comparison src/effectize.sml @ 735:5ccb67665d05
Only use cookie signatures when cookies might be read
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 23 Apr 2009 14:10:10 -0400 |
parents | 5819fb63c93a |
children | a28982de5645 |
comparison
equal
deleted
inserted
replaced
734:f2a2be93331c | 735:5ccb67665d05 |
---|---|
35 structure SS = BinarySetFn(struct | 35 structure SS = BinarySetFn(struct |
36 type ord_key = string | 36 type ord_key = string |
37 val compare = String.compare | 37 val compare = String.compare |
38 end) | 38 end) |
39 | 39 |
40 val effectful = ["dml", "nextval", "send"] | 40 val effectful = ["dml", "nextval", "send", "setCookie"] |
41 val effectful = SS.addList (SS.empty, effectful) | 41 val effectful = SS.addList (SS.empty, effectful) |
42 | 42 |
43 fun effectize file = | 43 fun effectize file = |
44 let | 44 let |
45 fun exp evs e = | 45 fun exp evs e = |
52 | 52 |
53 fun couldWrite evs = U.Exp.exists {kind = fn _ => false, | 53 fun couldWrite evs = U.Exp.exists {kind = fn _ => false, |
54 con = fn _ => false, | 54 con = fn _ => false, |
55 exp = exp evs} | 55 exp = exp evs} |
56 | 56 |
57 fun doDecl (d, evs) = | 57 fun exp evs e = |
58 case e of | |
59 EFfi ("Basis", "getCookie") => true | |
60 | ENamed n => IM.inDomain (evs, n) | |
61 | EServerCall (n, _, _, _) => IM.inDomain (evs, n) | |
62 | _ => false | |
63 | |
64 fun couldReadCookie evs = U.Exp.exists {kind = fn _ => false, | |
65 con = fn _ => false, | |
66 exp = exp evs} | |
67 | |
68 fun doDecl (d, evs as (writers, readers)) = | |
58 case #1 d of | 69 case #1 d of |
59 DVal (x, n, t, e, s) => | 70 DVal (x, n, t, e, s) => |
60 (d, if couldWrite evs e then | 71 (d, (if couldWrite writers e then |
61 IM.insert (evs, n, (#2 d, s)) | 72 IM.insert (writers, n, (#2 d, s)) |
62 else | 73 else |
63 evs) | 74 writers, |
75 if couldReadCookie readers e then | |
76 IM.insert (readers, n, (#2 d, s)) | |
77 else | |
78 readers)) | |
64 | DValRec vis => | 79 | DValRec vis => |
65 let | 80 let |
66 fun oneRound evs = | 81 fun oneRound evs = |
67 foldl (fn ((_, n, _, e, s), (changed, evs)) => | 82 foldl (fn ((_, n, _, e, s), (changed, (writers, readers))) => |
68 if couldWrite evs e andalso not (IM.inDomain (evs, n)) then | 83 let |
69 (true, IM.insert (evs, n, (#2 d, s))) | 84 val (changed, writers) = |
70 else | 85 if couldWrite writers e andalso not (IM.inDomain (writers, n)) then |
71 (changed, evs)) (false, evs) vis | 86 (true, IM.insert (writers, n, (#2 d, s))) |
87 else | |
88 (changed, writers) | |
89 | |
90 val (changed, readers) = | |
91 if couldReadCookie readers e andalso not (IM.inDomain (readers, n)) then | |
92 (true, IM.insert (readers, n, (#2 d, s))) | |
93 else | |
94 (changed, readers) | |
95 in | |
96 (changed, (writers, readers)) | |
97 end) (false, evs) vis | |
72 | 98 |
73 fun loop evs = | 99 fun loop evs = |
74 let | 100 let |
75 val (b, evs) = oneRound evs | 101 val (b, evs) = oneRound evs |
76 in | 102 in |
78 loop evs | 104 loop evs |
79 else | 105 else |
80 evs | 106 evs |
81 end | 107 end |
82 in | 108 in |
83 (d, loop evs) | 109 (d, loop (writers, readers)) |
84 end | 110 end |
85 | DExport (Link, n) => | 111 | DExport (Link, n) => |
86 (case IM.find (evs, n) of | 112 (case IM.find (writers, n) of |
87 NONE => () | 113 NONE => () |
88 | SOME (loc, s) => ErrorMsg.errorAt loc ("A link (" ^ s ^ ") could cause side effects; try implementing it with a form instead"); | 114 | SOME (loc, s) => ErrorMsg.errorAt loc ("A link (" ^ s ^ ") could cause side effects; try implementing it with a form instead"); |
89 (d, evs)) | 115 (d, evs)) |
90 | DExport (Action _, n) => | 116 | DExport (Action _, n) => |
91 ((DExport (Action (if IM.inDomain (evs, n) then | 117 ((DExport (Action (if IM.inDomain (writers, n) then |
92 ReadWrite | 118 if IM.inDomain (readers, n) then |
119 ReadCookieWrite | |
120 else | |
121 ReadWrite | |
93 else | 122 else |
94 ReadOnly), n), #2 d), | 123 ReadOnly), n), #2 d), |
95 evs) | 124 evs) |
96 | DExport (Rpc _, n) => | 125 | DExport (Rpc _, n) => |
97 ((DExport (Rpc (if IM.inDomain (evs, n) then | 126 ((DExport (Rpc (if IM.inDomain (writers, n) then |
98 ReadWrite | 127 if IM.inDomain (readers, n) then |
128 ReadCookieWrite | |
129 else | |
130 ReadWrite | |
99 else | 131 else |
100 ReadOnly), n), #2 d), | 132 ReadOnly), n), #2 d), |
101 evs) | 133 evs) |
102 | _ => (d, evs) | 134 | _ => (d, evs) |
103 | 135 |
104 val (file, _) = ListUtil.foldlMap doDecl IM.empty file | 136 val (file, _) = ListUtil.foldlMap doDecl (IM.empty, IM.empty) file |
105 in | 137 in |
106 file | 138 file |
107 end | 139 end |
108 | 140 |
109 end | 141 end |