parsing_cocci/get_constants.ml

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