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(expr_dots,whencode,false) -> []
  54     | Ast.NestExpr(expr_dots,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(stmt_dots,whn,false,_,_) -> []
  94     | Ast.Nest(stmt_dots,whn,true,_,_) -> r.V.combiner_statement_dots stmt_dots
  95     | _ -> k e in
  96
  97   V.combiner bind option_default
  98     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
  99     donothing donothing donothing donothing
 100     ident expression fullType typeC donothing donothing declaration
 101     rule_elem statement donothing donothing donothing
 102
 103 (* ------------------------------------------------------------------------ *)
 104
 105 let get_all_minus_constants =
 106   let donothing r k e = k e in
 107   let bind = Common.union_set in
 108   let option_default = [] in
 109   let mcode r (x,_,mcodekind,_) =
 110     match mcodekind with
 111       Ast.MINUS(_,_,_,_) -> [x]
 112     | _ -> [] in
 113   let other r (x,_,mcodekind,_) = [] in
 114
 115   V.combiner bind option_default
 116     other mcode other other other other other other other other other other
 117
 118     donothing donothing donothing donothing
 119     donothing donothing donothing donothing donothing donothing donothing
 120     donothing donothing donothing donothing donothing
 121 (* ------------------------------------------------------------------------ *)
 122
 123 let get_plus_constants =
 124   let donothing r k e = k e in
 125   let bind = Common.union_set in
 126   let option_default = [] in
 127   let mcode r (_,_,mcodekind,_) =
 128     let recurse l =
 129       List.fold_left
 130         (List.fold_left
 131            (function prev ->
 132              function cur ->
 133                let fn = get_minus_constants keep_all_bind keep_all_bind in
 134                bind (fn.V.combiner_anything cur) prev))
 135         [] l in
 136     match mcodekind with
 137       Ast.MINUS(_,_,_,anythings) -> recurse anythings
 138     | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a
 139     | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a
 140     | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) ->
 141         Common.union_set (recurse a1) (recurse a2)
 142     | _ -> [] in
 143
 144   V.combiner bind option_default
 145     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 146     donothing donothing donothing donothing
 147     donothing donothing donothing donothing donothing donothing donothing
 148     donothing donothing donothing donothing donothing
 149
 150 (* ------------------------------------------------------------------------ *)
 151 (* see if there are any inherited variables that must be bound for this rule
 152 to match *)
 153
 154 let check_inherited nm =
 155   let donothing r k e = k e in
 156   let option_default = false in
 157   let bind x y = x or y in
 158   let inherited (nm1,_) = not(nm = nm1) in
 159   let minherited mc = inherited (Ast.unwrap_mcode mc) in
 160   let mcode _ x =
 161     match Ast.get_pos_var x with
 162       Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name
 163     | _ -> option_default in
 164
 165   (* a case for everything for there is a metavariable, also disjunctions
 166      or optional things *)
 167
 168   let strictident recursor k i =
 169     match Ast.unwrap i with
 170       Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
 171     | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name)
 172     | _ -> k i in
 173
 174   let rec type_collect res = function
 175       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
 176     | TC.Array(ty) -> type_collect res ty
 177     | TC.MetaType(tyname,_,_) -> inherited tyname
 178     | ty -> res in
 179
 180   let strictexpr recursor k e =
 181     match Ast.unwrap e with
 182       Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
 183         let types = List.fold_left type_collect option_default type_list in
 184         bind (minherited name) types
 185     | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) ->
 186         bind (k e) (minherited name)
 187     | Ast.MetaExprList(name,None,_,_) -> bind (k e) (minherited name)
 188     | Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
 189         bind (k e) (bind (minherited name) (minherited lenname))
 190     | Ast.DisjExpr(exps) ->
 191         (* could see if there are any variables that appear in all branches,
 192            but perhaps not worth it *)
 193         option_default
 194     | _ -> k e in
 195
 196   let strictdecls recursor k d =
 197     match Ast.unwrap d with
 198       Ast.DisjDecl(decls) -> option_default
 199     | _ -> k d in
 200
 201   let strictfullType recursor k ty =
 202     match Ast.unwrap ty with
 203       Ast.DisjType(types) -> option_default
 204     | _ -> k ty in
 205
 206   let stricttypeC recursor k ty =
 207     match Ast.unwrap ty with
 208       Ast.MetaType(name,_,_) -> bind (k ty) (minherited name)
 209     | _ -> k ty in
 210
 211   let strictparam recursor k p =
 212     match Ast.unwrap p with
 213       Ast.MetaParam(name,_,_) -> bind (k p) (minherited name)
 214     | Ast.MetaParamList(name,None,_,_) -> bind (k p) (minherited name)
 215     | Ast.MetaParamList(name,Some(lenname,_,_),_,_) ->
 216         bind (k p) (bind (minherited name) (minherited lenname))
 217     | _ -> k p in
 218
 219   let strictrule_elem recursor k re =
 220     (*within a rule_elem, pattern3 manages the coherence of the bindings*)
 221     match Ast.unwrap re with
 222       Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_)
 223     | Ast.MetaStmtList(name,_,_) -> bind (k re) (minherited name)
 224     | _ -> k re in
 225
 226   let strictstatement recursor k s =
 227     match Ast.unwrap s with
 228       Ast.Disj(stms) -> option_default
 229     | _ -> k s in
 230
 231   V.combiner bind option_default
 232     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 233     donothing donothing donothing donothing
 234     strictident strictexpr strictfullType stricttypeC donothing strictparam
 235     strictdecls strictrule_elem strictstatement donothing donothing donothing
 236
 237 (* ------------------------------------------------------------------------ *)
 238
 239 let rec dependent = function
 240     Ast.Dep s -> true
 241   | Ast.AntiDep s -> false
 242   | Ast.EverDep s -> true
 243   | Ast.NeverDep s -> false
 244   | Ast.AndDep (d1,d2) -> dependent d1 or dependent d2
 245   | Ast.OrDep (d1,d2) -> dependent d1 && dependent d2
 246   | Ast.NoDep -> false
 247   | Ast.FailDep -> true
 248
 249 (* ------------------------------------------------------------------------ *)
 250
 251 let rule_fn tls in_plus =
 252   List.fold_left
 253     (function (rest_info,in_plus) ->
 254       function cur ->
 255         let mfn = get_minus_constants keep_some_bind or_bind in
 256         let minuses = mfn.V.combiner_top_level cur in
 257         let all_minuses =
 258           if !Flag.sgrep_mode2
 259           then [] (* nothing removed for sgrep *)
 260           else get_all_minus_constants.V.combiner_top_level cur in
 261         let plusses = get_plus_constants.V.combiner_top_level cur in
 262         (* the following is for eg -foo(2) +foo(x) then in another rule
 263            -foo(10); don't want to consider that foo is guaranteed to be
 264            created by the rule.  not sure this works completely: what if foo is
 265            in both - and +, but in an or, so the cases aren't related?
 266            not sure this whole thing is a good idea.  how do we know that
 267            something that is only in plus is really freshly created? *)
 268         let plusses = Common.minus_set plusses all_minuses in
 269         let new_minuses = Common.minus_set minuses in_plus in
 270         let new_plusses = Common.union_set plusses in_plus in
 271         (Common.union_set new_minuses rest_info, new_plusses))
 272     ([],in_plus) tls
 273
 274 exception No_info
 275
 276 let get_constants rules =
 277   try
 278     let (info,_) =
 279       List.fold_left
 280         (function (rest_info,in_plus) ->
 281           function r ->
 282             match r with
 283               Ast.ScriptRule (_,_,_,_)
 284             | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) ->
 285                 (rest_info, in_plus)
 286             | Ast.CocciRule (nm, (dep,_,_), cur, _, _) ->
 287                 let (cur_info,cur_plus) = rule_fn cur in_plus in
 288                 let cur_info =
 289                   (* no dependencies if dependent on another rule; then we
 290                      need to find the constants of that rule *)
 291                   if dependent dep or
 292                     List.for_all (check_inherited nm).V.combiner_top_level cur
 293                   then []
 294                   else
 295                   if cur_info = [] then raise No_info else cur_info in
 296                 (Common.union_set [cur_info] rest_info,cur_plus))
 297         ([],[]) rules in
 298     List.rev info
 299   with No_info -> List.map (function _ -> []) rules