File: get_constants.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (311 lines) | stat: -rw-r--r-- 11,146 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
(*
 * This file is part of Coccinelle, licensed under the terms of the GPL v2.
 * See copyright.txt in the Coccinelle source code for more information.
 * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
 *)

(* get a list of all of the constants in the - slice of a SmPL file, to be
used to select which files to process *)

(* This could be made more efficient, by finding only the important things.
eg, if we have a function and its arguments, we could just pick the function.
And we could try to pick only the things annotated with -, and only pick
something else if there is no -.  In general, we only want the most important
constant, not all the constants. *)

module Ast = Ast_cocci
module V = Visitor_ast
module TC = Type_cocci

let keep_some_bind x y = match x with [] -> y | _ -> x
let or_bind x y = match x with [] -> [] | _ -> x
let keep_all_bind = Common.union_set

let get_minus_constants bind orbind =
  let donothing r k e = k e in
  let option_default = [] in
  let mcode _ _ = option_default in

  (* if one branch gives no information, then we have to take anything *)
  let disj_union_all l =
    if List.exists (function [] -> true | _ -> false) l
    then orbind [] (Common.union_all l)
    else Common.union_all l in

  (* need special cases for everything with a disj, because the bind above
     would throw away all but the first disj *)

  let ident r k e =
    match Ast.unwrap e with
      Ast.Id(name) ->
	(match Ast.unwrap_mcode name with
	  "NULL" -> [] (* special case, because this is too generic *)
	| nm -> [nm])
    | _ -> k e in

  let expression r k e =
    match Ast.unwrap e with
      Ast.RecordAccess(exp,_,fld) | Ast.RecordPtAccess(exp,_,fld) ->
	bind
	  (Common.union_all
	     (List.map (function id -> ["."^id;"->"^id])
		(r.V.combiner_ident fld)))
	  (r.V.combiner_expression exp)
    | Ast.SizeOfExpr(sizeof,_) | Ast.SizeOfType(sizeof,_,_,_) ->
	bind (k e) [Ast.unwrap_mcode sizeof]
    | Ast.DisjExpr(exps) ->
	disj_union_all (List.map r.V.combiner_expression exps)
    | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> []
    | Ast.NestExpr(starter,expr_dots,ender,whencode,false) -> []
    | Ast.NestExpr(starter,expr_dots,ender,whencode,true) ->
	r.V.combiner_expression_dots expr_dots
    | _ -> k e in

  let typeC r k e =
    match Ast.unwrap e with
     Ast.TypeOfExpr(tf,_,_,_) | Ast.TypeOfType(tf,_,_,_) ->
	bind (k e) [Ast.unwrap_mcode tf]
    | Ast.TypeName(ty) ->
	if !Flag.sgrep_mode2
	then
	  match ty with
	    (_,_,Ast.MINUS(_,_,_,_),_) -> [Ast.unwrap_mcode ty]
	  | _ -> []
	else [Ast.unwrap_mcode ty]
    | _ -> k e in

  let fullType r k e =
    match Ast.unwrap e with
      Ast.DisjType(types) ->
	disj_union_all (List.map r.V.combiner_fullType types)
    | _ -> k e in

  let declaration r k e =
    match Ast.unwrap e with
      Ast.DisjDecl(decls) ->
	disj_union_all (List.map r.V.combiner_declaration decls)
    | Ast.Ddots(dots,whencode) -> []
    | _ -> k e in

  let rule_elem r k e =
    match Ast.unwrap e with
      Ast.DisjRuleElem(res) ->
	disj_union_all (List.map r.V.combiner_rule_elem res)
    | _ -> k e in

  let statement r k e =
    match Ast.unwrap e with
      Ast.Disj(stmt_dots) ->
	disj_union_all (List.map r.V.combiner_statement_dots stmt_dots)
    | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> []
    | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> []
    | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) ->
	r.V.combiner_statement_dots stmt_dots
    | _ -> k e in

  V.combiner bind option_default
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing donothing
    ident expression fullType typeC donothing donothing declaration
    rule_elem statement donothing donothing donothing

(* ------------------------------------------------------------------------ *)

let get_all_minus_constants =
  let donothing r k e = k e in
  let bind = Common.union_set in
  let option_default = [] in
  let mcode r (x,_,mcodekind,_) =
    match mcodekind with
      Ast.MINUS(_,_,_,_) -> [x]
    | _ -> [] in
  let other r (x,_,mcodekind,_) = [] in

  V.combiner bind option_default
    other mcode other other other other other other other other other other

    donothing donothing donothing donothing
    donothing donothing donothing donothing donothing donothing donothing
    donothing donothing donothing donothing donothing
(* ------------------------------------------------------------------------ *)

let get_plus_constants =
  let donothing r k e = k e in
  let bind = Common.union_set in
  let option_default = [] in
  let mcode r (_,_,mcodekind,_) =
    let recurse l =
      List.fold_left
	(List.fold_left
	   (function prev ->
	     function cur ->
	       let fn = get_minus_constants keep_all_bind keep_all_bind in
	       bind (fn.V.combiner_anything cur) prev))
	[] l in
    match mcodekind with
      Ast.MINUS(_,_,_,anythings) -> recurse anythings
    | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a
    | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a
    | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) ->
	Common.union_set (recurse a1) (recurse a2)
    | _ -> [] in

  V.combiner bind option_default
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing donothing
    donothing donothing donothing donothing donothing donothing donothing
    donothing donothing donothing donothing donothing

(* ------------------------------------------------------------------------ *)
(* see if there are any inherited variables that must be bound for this rule
to match *)

let check_inherited nm =
  let donothing r k e = k e in
  let option_default = false in
  let bind x y = x or y in
  let inherited (nm1,_) = not(nm = nm1) in
  let minherited mc = inherited (Ast.unwrap_mcode mc) in
  let mcode _ x =
    match Ast.get_pos_var x with
      Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name
    | _ -> option_default in

  (* a case for everything for there is a metavariable, also disjunctions
     or optional things *)

  let strictident recursor k i =
    match Ast.unwrap i with
      Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
    | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name)
    | _ -> k i in

  let rec type_collect res = function
      TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
    | TC.Array(ty) -> type_collect res ty
    | TC.MetaType(tyname,_,_) ->
	inherited tyname
    | ty -> res in

  let strictexpr recursor k e =
    match Ast.unwrap e with
      Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
	let types = List.fold_left type_collect option_default type_list in
	bind (minherited name) types
    | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) ->
	bind (k e) (minherited name)
    | Ast.MetaExprList(name,None,_,_) -> bind (k e) (minherited name)
    | Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
	bind (k e) (bind (minherited name) (minherited lenname))
    | Ast.DisjExpr(exps) ->
	(* could see if there are any variables that appear in all branches,
	   but perhaps not worth it *)
	option_default
    | _ -> k e in

  let strictdecls recursor k d =
    match Ast.unwrap d with
      Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) ->
	bind (k p) (minherited name)
    | Ast.DisjDecl(decls) -> option_default
    | _ -> k d in

  let strictfullType recursor k ty =
    match Ast.unwrap ty with
      Ast.DisjType(types) -> option_default
    | _ -> k ty in

  let stricttypeC recursor k ty =
    match Ast.unwrap ty with
      Ast.MetaType(name,_,_) -> bind (k ty) (minherited name)
    | _ -> k ty in

  let strictparam recursor k p =
    match Ast.unwrap p with
      Ast.MetaParam(name,_,_) -> bind (k p) (minherited name)
    | Ast.MetaParamList(name,None,_,_) -> bind (k p) (minherited name)
    | Ast.MetaParamList(name,Some(lenname,_,_),_,_) ->
	bind (k p) (bind (minherited name) (minherited lenname))
    | _ -> k p in

  let strictrule_elem recursor k re =
    (*within a rule_elem, pattern3 manages the coherence of the bindings*)
    match Ast.unwrap re with
      Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_)
    | Ast.MetaStmtList(name,_,_) -> bind (k re) (minherited name)
    | _ -> k re in

  let strictstatement recursor k s =
    match Ast.unwrap s with
      Ast.Disj(stms) -> option_default
    | _ -> k s in

  V.combiner bind option_default
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing donothing
    strictident strictexpr strictfullType stricttypeC donothing strictparam
    strictdecls strictrule_elem strictstatement donothing donothing donothing

(* ------------------------------------------------------------------------ *)

let rec dependent = function
    Ast.Dep s -> true
  | Ast.AntiDep s -> false
  | Ast.EverDep s -> true
  | Ast.NeverDep s -> false
  | Ast.AndDep (d1,d2) -> dependent d1 or dependent d2
  | Ast.OrDep (d1,d2) -> dependent d1 && dependent d2
  | Ast.NoDep -> false
  | Ast.FailDep -> true

(* ------------------------------------------------------------------------ *)

let rule_fn tls in_plus =
  List.fold_left
    (function (rest_info,in_plus) ->
      function cur ->
	let mfn = get_minus_constants keep_some_bind or_bind in
	let minuses = mfn.V.combiner_top_level cur in
	let all_minuses =
	  if !Flag.sgrep_mode2
	  then [] (* nothing removed for sgrep *)
	  else get_all_minus_constants.V.combiner_top_level cur in
	let plusses = get_plus_constants.V.combiner_top_level cur in
	(* the following is for eg -foo(2) +foo(x) then in another rule
	   -foo(10); don't want to consider that foo is guaranteed to be
	   created by the rule.  not sure this works completely: what if foo is
	   in both - and +, but in an or, so the cases aren't related?
	   not sure this whole thing is a good idea.  how do we know that
	   something that is only in plus is really freshly created? *)
	let plusses = Common.minus_set plusses all_minuses in
	let new_minuses = Common.minus_set minuses in_plus in
	let new_plusses = Common.union_set plusses in_plus in
	(Common.union_set new_minuses rest_info, new_plusses))
    ([],in_plus) tls

exception No_info

let get_constants rules =
  try
    let (info,_) =
      List.fold_left
        (function (rest_info,in_plus) ->
          function r ->
            match r with
              Ast.ScriptRule (_,_,_,_)
	    | Ast.InitialScriptRule (_,_,_) | Ast.FinalScriptRule (_,_,_) ->
		(rest_info, in_plus)
            | Ast.CocciRule (nm, (dep,_,_), cur, _, _) ->
                let (cur_info,cur_plus) = rule_fn cur in_plus in
	        let cur_info =
	          (* no dependencies if dependent on another rule; then we
	             need to find the constants of that rule *)
	          if dependent dep or
	            List.for_all (check_inherited nm).V.combiner_top_level cur
	          then []
	          else
		  if cur_info = [] then raise No_info else cur_info in
	        (Common.union_set [cur_info] rest_info,cur_plus))
        ([],[]) rules in
    List.rev info
  with No_info -> List.map (function _ -> []) rules