parsing_cocci/get_constants.ml

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