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