parsing_cocci/get_constants.ml

   1 (*
   2  * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
   3  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   4  * This file is part of Coccinelle.
   5  *
   6  * Coccinelle is free software: you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation, according to version 2 of the License.
   9  *
  10  * Coccinelle is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  17  *
  18  * The authors reserve the right to distribute this or future versions of
  19  * Coccinelle under other licenses.
  20  *)
  21
  22
  23 (*
  24  * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
  25  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  26  * This file is part of Coccinelle.
  27  *
  28  * Coccinelle is free software: you can redistribute it and/or modify
  29  * it under the terms of the GNU General Public License as published by
  30  * the Free Software Foundation, according to version 2 of the License.
  31  *
  32  * Coccinelle is distributed in the hope that it will be useful,
  33  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  34  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35  * GNU General Public License for more details.
  36  *
  37  * You should have received a copy of the GNU General Public License
  38  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  39  *
  40  * The authors reserve the right to distribute this or future versions of
  41  * Coccinelle under other licenses.
  42  *)
  43
  44
  45 (* get a list of all of the constants in the - slice of a SmPL file, to be
  46 used to select which files to process *)
  47
  48 (* This could be made more efficient, by finding only the important things.
  49 eg, if we have a function and its arguments, we could just pick the function.
  50 And we could try to pick only the things annotated with -, and only pick
  51 something else if there is no -.  In general, we only want the most important
  52 constant, not all the constants. *)
  53
  54 module Ast = Ast_cocci
  55 module V = Visitor_ast
  56 module TC = Type_cocci
  57
  58 let keep_some_bind x y = match x with [] -> y | _ -> x
  59 let or_bind x y = match x with [] -> [] | _ -> x
  60 let keep_all_bind = Common.union_set
  61
  62 let get_minus_constants bind orbind =
  63   let donothing r k e = k e in
  64   let option_default = [] in
  65   let mcode _ _ = option_default in
  66
  67   (* if one branch gives no information, then we have to take anything *)
  68   let disj_union_all l =
  69     if List.exists (function [] -> true | _ -> false) l
  70     then orbind [] (Common.union_all l)
  71     else Common.union_all l in
  72
  73   (* need special cases for everything with a disj, because the bind above
  74      would throw away all but the first disj *)
  75
  76   let ident r k e =
  77     match Ast.unwrap e with
  78       Ast.Id(name) ->
  79         (match Ast.unwrap_mcode name with
  80           "NULL" -> [] (* special case, because this is too generic *)
  81         | nm -> [nm])
  82     | _ -> k e in
  83
  84   let expression r k e =
  85     match Ast.unwrap e with
  86       Ast.RecordAccess(exp,_,fld) | Ast.RecordPtAccess(exp,_,fld) ->
  87         bind
  88           (Common.union_all
  89              (List.map (function id -> ["."^id;"->"^id])
  90                 (r.V.combiner_ident fld)))
  91           (r.V.combiner_expression exp)
  92     | Ast.SizeOfExpr(sizeof,_) | Ast.SizeOfType(sizeof,_,_,_) ->
  93         bind (k e) [Ast.unwrap_mcode sizeof]
  94     | Ast.DisjExpr(exps) ->
  95         disj_union_all (List.map r.V.combiner_expression exps)
  96     | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> []
  97     | Ast.NestExpr(starter,expr_dots,ender,whencode,false) -> []
  98     | Ast.NestExpr(starter,expr_dots,ender,whencode,true) ->
  99         r.V.combiner_expression_dots expr_dots
 100     | _ -> k e in
 101
 102   let typeC r k e =
 103     match Ast.unwrap e with
 104       Ast.TypeName(ty) ->
 105         if !Flag.sgrep_mode2
 106         then
 107           match ty with
 108             (_,_,Ast.MINUS(_,_,_,_),_) -> [Ast.unwrap_mcode ty]
 109           | _ -> []
 110         else [Ast.unwrap_mcode ty]
 111     | _ -> k e in
 112
 113   let fullType r k e =
 114     match Ast.unwrap e with
 115       Ast.DisjType(types) ->
 116         disj_union_all (List.map r.V.combiner_fullType types)
 117     | _ -> k e in
 118
 119   let declaration r k e =
 120     match Ast.unwrap e with
 121       Ast.DisjDecl(decls) ->
 122         disj_union_all (List.map r.V.combiner_declaration decls)
 123     | Ast.Ddots(dots,whencode) -> []
 124     | _ -> k e in
 125
 126   let rule_elem r k e =
 127     match Ast.unwrap e with
 128       Ast.DisjRuleElem(res) ->
 129         disj_union_all (List.map r.V.combiner_rule_elem res)
 130     | _ -> k e in
 131
 132   let statement r k e =
 133     match Ast.unwrap e with
 134       Ast.Disj(stmt_dots) ->
 135         disj_union_all (List.map r.V.combiner_statement_dots stmt_dots)
 136     | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> []
 137     | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> []
 138     | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) ->
 139         r.V.combiner_statement_dots stmt_dots
 140     | _ -> k e in
 141
 142   V.combiner bind option_default
 143     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 144     donothing donothing donothing donothing
 145     ident expression fullType typeC donothing donothing declaration
 146     rule_elem statement donothing donothing donothing
 147
 148 (* ------------------------------------------------------------------------ *)
 149
 150 let get_all_minus_constants =
 151   let donothing r k e = k e in
 152   let bind = Common.union_set in
 153   let option_default = [] in
 154   let mcode r (x,_,mcodekind,_) =
 155     match mcodekind with
 156       Ast.MINUS(_,_,_,_) -> [x]
 157     | _ -> [] in
 158   let other r (x,_,mcodekind,_) = [] in
 159
 160   V.combiner bind option_default
 161     other mcode other other other other other other other other other other
 162
 163     donothing donothing donothing donothing
 164     donothing donothing donothing donothing donothing donothing donothing
 165     donothing donothing donothing donothing donothing
 166 (* ------------------------------------------------------------------------ *)
 167
 168 let get_plus_constants =
 169   let donothing r k e = k e in
 170   let bind = Common.union_set in
 171   let option_default = [] in
 172   let mcode r (_,_,mcodekind,_) =
 173     let recurse l =
 174       List.fold_left
 175         (List.fold_left
 176            (function prev ->
 177              function cur ->
 178                let fn = get_minus_constants keep_all_bind keep_all_bind in
 179                bind (fn.V.combiner_anything cur) prev))
 180         [] l in
 181     match mcodekind with
 182       Ast.MINUS(_,_,_,anythings) -> recurse anythings
 183     | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a
 184     | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a
 185     | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) ->
 186         Common.union_set (recurse a1) (recurse a2)
 187     | _ -> [] in
 188
 189   V.combiner bind option_default
 190     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 191     donothing donothing donothing donothing
 192     donothing donothing donothing donothing donothing donothing donothing
 193     donothing donothing donothing donothing donothing
 194
 195 (* ------------------------------------------------------------------------ *)
 196 (* see if there are any inherited variables that must be bound for this rule
 197 to match *)
 198
 199 let check_inherited nm =
 200   let donothing r k e = k e in
 201   let option_default = false in
 202   let bind x y = x or y in
 203   let inherited (nm1,_) = not(nm = nm1) in
 204   let minherited mc = inherited (Ast.unwrap_mcode mc) in
 205   let mcode _ x =
 206     match Ast.get_pos_var x with
 207       Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name
 208     | _ -> option_default in
 209
 210   (* a case for everything for there is a metavariable, also disjunctions
 211      or optional things *)
 212
 213   let strictident recursor k i =
 214     match Ast.unwrap i with
 215       Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
 216     | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name)
 217     | _ -> k i in
 218
 219   let rec type_collect res = function
 220       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
 221     | TC.Array(ty) -> type_collect res ty
 222     | TC.MetaType(tyname,_,_) ->
 223         inherited tyname
 224     | ty -> res in
 225
 226   let strictexpr recursor k e =
 227     match Ast.unwrap e with
 228       Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
 229         let types = List.fold_left type_collect option_default type_list in
 230         bind (minherited name) types
 231     | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) ->
 232         bind (k e) (minherited name)
 233     | Ast.MetaExprList(name,None,_,_) -> bind (k e) (minherited name)
 234     | Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
 235         bind (k e) (bind (minherited name) (minherited lenname))
 236     | Ast.DisjExpr(exps) ->
 237         (* could see if there are any variables that appear in all branches,
 238            but perhaps not worth it *)
 239         option_default
 240     | _ -> k e in
 241
 242   let strictdecls recursor k d =
 243     match Ast.unwrap d with
 244       Ast.DisjDecl(decls) -> option_default
 245     | _ -> k d in
 246
 247   let strictfullType recursor k ty =
 248     match Ast.unwrap ty with
 249       Ast.DisjType(types) -> option_default
 250     | _ -> k ty in
 251
 252   let stricttypeC recursor k ty =
 253     match Ast.unwrap ty with
 254       Ast.MetaType(name,_,_) -> bind (k ty) (minherited name)
 255     | _ -> k ty in
 256
 257   let strictparam recursor k p =
 258     match Ast.unwrap p with
 259       Ast.MetaParam(name,_,_) -> bind (k p) (minherited name)
 260     | Ast.MetaParamList(name,None,_,_) -> bind (k p) (minherited name)
 261     | Ast.MetaParamList(name,Some(lenname,_,_),_,_) ->
 262         bind (k p) (bind (minherited name) (minherited lenname))
 263     | _ -> k p in
 264
 265   let strictrule_elem recursor k re =
 266     (*within a rule_elem, pattern3 manages the coherence of the bindings*)
 267     match Ast.unwrap re with
 268       Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_)
 269     | Ast.MetaStmtList(name,_,_) -> bind (k re) (minherited name)
 270     | _ -> k re in
 271
 272   let strictstatement recursor k s =
 273     match Ast.unwrap s with
 274       Ast.Disj(stms) -> option_default
 275     | _ -> k s in
 276
 277   V.combiner bind option_default
 278     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 279     donothing donothing donothing donothing
 280     strictident strictexpr strictfullType stricttypeC donothing strictparam
 281     strictdecls strictrule_elem strictstatement donothing donothing donothing
 282
 283 (* ------------------------------------------------------------------------ *)
 284
 285 let rec dependent = function
 286     Ast.Dep s -> true
 287   | Ast.AntiDep s -> false
 288   | Ast.EverDep s -> true
 289   | Ast.NeverDep s -> false
 290   | Ast.AndDep (d1,d2) -> dependent d1 or dependent d2
 291   | Ast.OrDep (d1,d2) -> dependent d1 && dependent d2
 292   | Ast.NoDep -> false
 293   | Ast.FailDep -> true
 294
 295 (* ------------------------------------------------------------------------ *)
 296
 297 let rule_fn tls in_plus =
 298   List.fold_left
 299     (function (rest_info,in_plus) ->
 300       function cur ->
 301         let mfn = get_minus_constants keep_some_bind or_bind in
 302         let minuses = mfn.V.combiner_top_level cur in
 303         let all_minuses =
 304           if !Flag.sgrep_mode2
 305           then [] (* nothing removed for sgrep *)
 306           else get_all_minus_constants.V.combiner_top_level cur in
 307         let plusses = get_plus_constants.V.combiner_top_level cur in
 308         (* the following is for eg -foo(2) +foo(x) then in another rule
 309            -foo(10); don't want to consider that foo is guaranteed to be
 310            created by the rule.  not sure this works completely: what if foo is
 311            in both - and +, but in an or, so the cases aren't related?
 312            not sure this whole thing is a good idea.  how do we know that
 313            something that is only in plus is really freshly created? *)
 314         let plusses = Common.minus_set plusses all_minuses in
 315         let new_minuses = Common.minus_set minuses in_plus in
 316         let new_plusses = Common.union_set plusses in_plus in
 317         (Common.union_set new_minuses rest_info, new_plusses))
 318     ([],in_plus) tls
 319
 320 exception No_info
 321
 322 let get_constants rules =
 323   try
 324     let (info,_) =
 325       List.fold_left
 326         (function (rest_info,in_plus) ->
 327           function r ->
 328             match r with
 329               Ast.ScriptRule (_,_,_,_)
 330             | Ast.InitialScriptRule (_,_,_) | Ast.FinalScriptRule (_,_,_) ->
 331                 (rest_info, in_plus)
 332             | Ast.CocciRule (nm, (dep,_,_), cur, _, _) ->
 333                 let (cur_info,cur_plus) = rule_fn cur in_plus in
 334                 let cur_info =
 335                   (* no dependencies if dependent on another rule; then we
 336                      need to find the constants of that rule *)
 337                   if dependent dep or
 338                     List.for_all (check_inherited nm).V.combiner_top_level cur
 339                   then []
 340                   else
 341                   if cur_info = [] then raise No_info else cur_info in
 342                 (Common.union_set [cur_info] rest_info,cur_plus))
 343         ([],[]) rules in
 344     List.rev info
 345   with No_info -> List.map (function _ -> []) rules