main.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 open Common
  26 module FC = Flag_cocci
  27
  28 (*****************************************************************************)
  29 (* Flags *)
  30 (*****************************************************************************)
  31
  32 (* In addition to flags that can be tweaked via -xxx options (cf the
  33  * full list of options in "the spatch options" section below), the
  34  * spatch program also depends on external files, described in
  35  * globals/config.ml, mainly a standard.h and standard.iso file *)
  36
  37 let cocci_file = ref ""
  38
  39 let output_file = ref ""
  40 let inplace_modif = ref false  (* but keeps nothing *)
  41 let backup_suffix =
  42   ref (None : string option) (* suffix for backup if one is desired *)
  43 let outplace_modif = ref false (* generates a .cocci_res  *)
  44 let preprocess = ref false     (* run the C preprocessor before cocci *)
  45 let compat_mode = ref false
  46 let ignore_unknown_opt = ref false
  47
  48 (* somehow obsolete now *)
  49 let dir = ref false
  50
  51 let include_headers = ref false
  52 let kbuild_info = ref ""
  53
  54 let macro_file = ref ""
  55
  56 (* test mode *)
  57 let test_mode = ref false
  58 let test_all = ref false
  59 let test_okfailed = ref false
  60 let test_regression_okfailed = ref false
  61 let expected_score_file = ref ""
  62
  63
  64 (* action mode *)
  65 let action = ref ""
  66
  67 (* works with -test but also in "normal" spatch mode *)
  68 let compare_with_expected = ref false
  69
  70 let distrib_index = ref (None : int option)
  71 let distrib_max   = ref (None : int option)
  72 let mod_distrib   = ref false
  73
  74 (*****************************************************************************)
  75 (* Profiles *)
  76 (*****************************************************************************)
  77
  78 (* pair of  (list of flags to set true, list of flags to set false *)
  79 let very_quiet_profile = (
  80   [
  81   ],
  82   [
  83     (* FC.show_diff;   just leave this as it is *)
  84
  85     Common.print_to_stderr;
  86     Flag.show_misc;
  87     Flag.show_trying;
  88     Flag.show_transinfo;
  89
  90     FC.show_c;
  91     FC.show_cocci;
  92     FC.show_flow;
  93     FC.show_before_fixed_flow;
  94     FC.show_ctl_tex;
  95     FC.show_ctl_text;
  96     FC.show_binding_in_out;
  97
  98     FC.verbose_cocci;
  99
 100     Flag_parsing_c.show_parsing_error;
 101
 102     Flag_parsing_c.verbose_lexing;
 103     Flag_parsing_c.verbose_parsing;
 104     Flag_parsing_c.verbose_type;
 105     Flag_parsing_c.verbose_cfg;
 106     Flag_parsing_c.verbose_unparsing;
 107     Flag_parsing_c.verbose_visit;
 108     Flag_parsing_c.verbose_cpp_ast;
 109
 110     Flag_matcher.verbose_matcher;
 111     Flag_matcher.debug_engine;
 112
 113     Flag_parsing_c.debug_unparsing;
 114
 115     Flag_parsing_cocci.show_SP;
 116     Flag_parsing_cocci.show_iso_failures;
 117
 118     Flag_ctl.verbose_ctl_engine;
 119     Flag_ctl.verbose_match;
 120
 121
 122   ])
 123
 124 let quiet_profile = (
 125   [
 126     Common.print_to_stderr
 127   ],
 128   [
 129     (* FC.show_diff;   just leave this as it is *)
 130
 131     Flag.show_misc;
 132     Flag.show_trying;
 133     Flag.show_transinfo;
 134
 135     FC.show_c;
 136     FC.show_cocci;
 137     FC.show_flow;
 138     FC.show_before_fixed_flow;
 139     FC.show_ctl_tex;
 140     FC.show_ctl_text;
 141     FC.show_binding_in_out;
 142
 143     FC.verbose_cocci;
 144
 145     Flag_parsing_c.show_parsing_error;
 146
 147     Flag_parsing_c.verbose_lexing;
 148     Flag_parsing_c.verbose_parsing;
 149     Flag_parsing_c.verbose_type;
 150     Flag_parsing_c.verbose_cfg;
 151     Flag_parsing_c.verbose_unparsing;
 152     Flag_parsing_c.verbose_visit;
 153     Flag_parsing_c.verbose_cpp_ast;
 154
 155     Flag_matcher.verbose_matcher;
 156     Flag_matcher.debug_engine;
 157
 158     Flag_parsing_c.debug_unparsing;
 159
 160     Flag_parsing_cocci.show_SP;
 161     Flag_parsing_cocci.show_iso_failures;
 162
 163     Flag_ctl.verbose_ctl_engine;
 164     Flag_ctl.verbose_match;
 165
 166
 167   ])
 168
 169 (* some information that is useful in seeing why a semantic patch doesn't
 170 work properly *)
 171 let debug_profile = (
 172   [
 173     Common.print_to_stderr;
 174     Flag.show_misc;
 175     Flag.show_transinfo;
 176
 177     FC.show_diff;
 178     FC.show_cocci;
 179     FC.show_binding_in_out;
 180     FC.show_dependencies;
 181
 182     Flag_parsing_cocci.keep_ml_script;
 183     Flag_parsing_cocci.show_iso_failures;
 184
 185     FC.verbose_cocci;
 186
 187     Flag_parsing_c.verbose_cfg;
 188     Flag_parsing_c.verbose_unparsing;
 189     Flag_parsing_c.verbose_visit;
 190
 191     Flag_matcher.verbose_matcher;
 192
 193     Flag_parsing_c.show_parsing_error;
 194   ],
 195   [
 196
 197     Flag.show_misc;
 198
 199     FC.show_c;
 200     FC.show_flow;
 201     FC.show_before_fixed_flow;
 202     FC.show_ctl_tex;
 203     FC.show_ctl_text;
 204
 205     Flag_parsing_cocci.show_SP;
 206     Flag_ctl.verbose_ctl_engine;
 207     Flag_ctl.verbose_match;
 208     Flag_matcher.debug_engine;
 209     Flag_parsing_c.debug_unparsing;
 210     Flag_parsing_c.verbose_type;
 211     Flag_parsing_c.verbose_parsing;
 212   ])
 213
 214 let pad_profile = (
 215   [
 216     FC.show_diff;
 217     Common.print_to_stderr;
 218   ],
 219   [
 220
 221     Flag.show_misc;
 222     Flag.show_transinfo;
 223
 224     FC.show_c;
 225     FC.show_cocci;
 226     FC.show_flow;
 227     FC.show_before_fixed_flow;
 228     FC.show_ctl_tex;
 229     FC.show_ctl_text;
 230     FC.show_binding_in_out;
 231
 232     Flag_parsing_cocci.show_SP;
 233     Flag_parsing_cocci.show_iso_failures;
 234     Flag_ctl.verbose_ctl_engine;
 235     Flag_ctl.verbose_match;
 236     Flag_matcher.debug_engine;
 237     Flag_parsing_c.debug_unparsing;
 238     Flag_parsing_c.verbose_type;
 239     Flag_parsing_c.verbose_parsing;
 240   ])
 241
 242 let run_profile p =
 243   let (set_to_true, set_to_false) = p in
 244   List.iter (fun x -> x := false) set_to_false;
 245   List.iter (fun x -> x := true) set_to_true
 246
 247 (*****************************************************************************)
 248 (* The spatch options *)
 249 (*****************************************************************************)
 250
 251 let usage_msg =
 252   "Usage: " ^ basename Sys.argv.(0) ^
 253     " -sp_file <SP> <infile> [-o <outfile>] [-iso_file <iso>] [options]" ^
 254     "\n" ^ "Options are:"
 255
 256 (* forward reference trick *)
 257 let short_usage_func = ref (fun () -> ())
 258 let long_usage_func  = ref (fun () -> ())
 259
 260
 261 (* The short_options are user-oriented. The other options are for
 262  * the developers of coccinelle or advanced-users that know
 263  * quite well the underlying semantics of coccinelle.
 264  *)
 265
 266
 267 (* will be printed when use only ./spatch. For the rest you have to
 268  * use -longhelp to see them.
 269  *)
 270 let short_options = [
 271   "-sp_file",  Arg.Set_string cocci_file,
 272   " <file> the semantic patch file";
 273
 274   "-o", Arg.Set_string output_file,
 275   "   <file> the output file";
 276   "-in_place", Arg.Set inplace_modif,
 277   "   do the modification on the file directly";
 278   "-backup_suffix", Arg.String (function s -> backup_suffix := Some s),
 279   "   suffix to use when making a backup for inplace";
 280   "-out_place", Arg.Set outplace_modif,
 281   "   store modifications in a .cocci_res file";
 282
 283   "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
 284   "  set number of diff context lines";
 285   "-partial_match",        Arg.Set Flag_ctl.partial_match,
 286   "    report partial matches of the SP on the C file";
 287
 288   "-iso_file", Arg.Set_string Config.std_iso,
 289   " <file> (default=" ^ !Config.std_iso ^")";
 290   "-macro_file", Arg.Set_string macro_file,
 291   " <file>";
 292   "-macro_file_builtins", Arg.Set_string Config.std_h,
 293   " <file> (default=" ^ !Config.std_h ^ ")";
 294
 295   "-recursive_includes",
 296   Arg.Unit (function _ -> FC.include_options := FC.I_REALLY_ALL_INCLUDES),
 297   "  causes all available include files, both those included in the C file(s) and those included in header files, to be used";
 298   "-all_includes",
 299   Arg.Unit (function _ -> FC.include_options := FC.I_ALL_INCLUDES),
 300   "  causes all available include files included in the C file(s) to be used";
 301   "-no_includes",
 302   Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES),
 303   "  causes not even local include files to be used";
 304   "-local_includes",
 305   Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES),
 306   "  causes local include files to be used";
 307   "-ignore_unknown_options", Arg.Set ignore_unknown_opt,
 308   "    For integration in a toolchain (must be set before the first unknown option)";
 309   "-include_headers", Arg.Set include_headers,
 310   "    process header files independently";
 311   "-I",   Arg.String (fun x ->
 312                         FC.include_path:= x::!FC.include_path
 313                      ),
 314   "  <dir> containing the header files (optional)";
 315
 316   "-preprocess", Arg.Set preprocess,
 317   " run the C preprocessor before applying the semantic match";
 318
 319   "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode";
 320
 321   "-dir", Arg.Set dir,
 322   "    <dir> process all files in directory recursively";
 323
 324   "-use_glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse),
 325   "    works with -dir, use info generated by glimpseindex";
 326   "-use_google", Arg.String (function s -> Flag.scanner := Flag.Google s),
 327   "    find relevant files using google code search";
 328   "-use_idutils", Arg.Unit (function s -> Flag.scanner := Flag.IdUtils),
 329   "    find relevant files using id-utils";
 330   "-patch",
 331     Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)),
 332   ("    <dir> path name with respect to which a patch should be created\n"^
 333    "    \"\" for a file in the current directory");
 334   "-kbuild_info", Arg.Set_string kbuild_info,
 335   "    <file> improve -dir by grouping related c files";
 336   "-pyoutput", Arg.Set_string Flag.pyoutput,
 337   "    Sets output routine: Standard values: <coccilib.output.Gtk|coccilib.output.Console>";
 338
 339
 340   "-version",   Arg.Unit (fun () ->
 341     let withpython = if Pycocci.python_support then "with" else "without" in
 342     let whichregexp =
 343       if !Regexp.pcre_support then "with PCRE support"
 344       else "with Str regexp support "
 345     in
 346     pr2 (spf "spatch version %s %s Python support and %s" Config.version withpython whichregexp);
 347     exit 0;
 348   ),
 349     "  guess what";
 350
 351   "-date",   Arg.Unit (fun () ->
 352     pr2 "version: $Date$";
 353     raise (Common.UnixExit 0)
 354     ),
 355   "   guess what";
 356
 357   "-shorthelp", Arg.Unit (fun () ->
 358     !short_usage_func();
 359     raise (Common.UnixExit 0)
 360   ),
 361   "    see short list of options";
 362   "-longhelp", Arg.Unit (fun () ->
 363     !long_usage_func();
 364     raise (Common.UnixExit 0)
 365     ),
 366   "    see all the available options in different categories";
 367   "-help", Arg.Unit (fun () ->
 368     !long_usage_func();
 369     raise (Common.UnixExit 0)
 370   ),
 371   " ";
 372   "--help", Arg.Unit (fun () ->
 373     !long_usage_func();
 374     raise (Common.UnixExit 0)
 375   ),
 376   " ";
 377 ]
 378
 379 (* the format is a list of triples:
 380  *  (title of section * (optional) explanation of sections * option list)
 381  *)
 382 let other_options = [
 383   "aliases and obsolete options",
 384   "",
 385   [
 386     "-sp", Arg.Set_string cocci_file,     " short option of -sp_file";
 387     "-iso", Arg.Set_string Config.std_iso,   " short option of -iso_file";
 388
 389     "-cocci_file", Arg.Set_string cocci_file,
 390     "   <file> the semantic patch file";
 391 (*     "-c", Arg.Set_string cocci_file,     " short option of -sp_file"; *)
 392   ];
 393
 394   "most useful show options",
 395   "",
 396   [
 397     "-show_diff"           , Arg.Set FC.show_diff, " ";
 398     "-no_show_diff"           , Arg.Clear FC.show_diff, " ";
 399     "-force_diff"           , Arg.Set FC.force_diff,
 400        "show diff even if only spacing changes";
 401     "-show_flow"              , Arg.Set FC.show_flow,        " ";
 402     (* works in conjunction with -show_ctl_text *)
 403     "-ctl_inline_let",
 404     Arg.Unit
 405     (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " ";
 406     "-ctl_show_mcodekind",
 407     Arg.Unit
 408     (function _ -> FC.show_ctl_text := true; FC.show_mcodekind_in_ctl := true),
 409     " ";
 410     "-show_bindings",        Arg.Set FC.show_binding_in_out, " ";
 411     "-show_transinfo",    Arg.Set Flag.show_transinfo, " ";
 412     "-show_misc",         Arg.Set Flag.show_misc, " ";
 413     "-show_trying",          Arg.Set Flag.show_trying,
 414     " show the name of each function being processed";
 415     "-show_dependencies",
 416     Arg.Unit (function _ -> FC.show_dependencies := true;
 417       FC.show_binding_in_out := true),
 418     " show the dependencies related to each rule";
 419   ];
 420
 421   "verbose subsystems options",
 422   "",
 423   [
 424     "-verbose_ctl_engine",
 425     Arg.Unit (function _ ->
 426       Flag_ctl.verbose_ctl_engine := true; FC.show_ctl_text := true) , " ";
 427     "-verbose_match",        Arg.Set Flag_ctl.verbose_match, " ";
 428     "-verbose_engine",       Arg.Set Flag_matcher.debug_engine,    " ";
 429     "-graphical_trace",      Arg.Set Flag_ctl.graphical_trace, "  generate a pdf file representing the matching process";
 430     "-gt_without_label",
 431      Arg.Unit (function _ ->
 432        Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true),
 433        "  remove graph label (requires option -graphical_trace)";
 434
 435     "-parse_error_msg", Arg.Set Flag_parsing_c.show_parsing_error, " ";
 436     "-verbose_parsing",
 437        Arg.Unit (fun _ -> Flag_parsing_c.verbose_parsing := true;
 438          Flag_parsing_c.show_parsing_error := true), " ";
 439     "-type_error_msg",  Arg.Set Flag_parsing_c.verbose_type, " ";
 440     (* could also use Flag_parsing_c.options_verbose *)
 441   ];
 442
 443   "other show options",
 444   "",
 445   [
 446     "-show_c"                 , Arg.Set FC.show_c,           " ";
 447     "-show_cocci"             , Arg.Set FC.show_cocci,       " ";
 448     "-show_before_fixed_flow" , Arg.Set FC.show_before_fixed_flow,  " ";
 449     "-show_ctl_tex"           , Arg.Set FC.show_ctl_tex,     " ";
 450     "-show_ctl_text"          , Arg.Set FC.show_ctl_text,     " ";
 451     "-show_SP"             ,    Arg.Set Flag_parsing_cocci.show_SP,  " ";
 452   ];
 453
 454
 455   "debug C parsing/unparsing",
 456   "",
 457   [
 458     "-debug_cpp",          Arg.Set  Flag_parsing_c.debug_cpp, " ";
 459     "-debug_lexer",        Arg.Set  Flag_parsing_c.debug_lexer , " ";
 460     "-debug_etdt",         Arg.Set  Flag_parsing_c.debug_etdt , "  ";
 461     "-debug_typedef",      Arg.Set  Flag_parsing_c.debug_typedef, "  ";
 462
 463     "-filter_msg",         Arg.Set  Flag_parsing_c.filter_msg ,
 464     "  filter some cpp message when the macro is a \"known\" cpp construct";
 465     "-filter_define_error",     Arg.Set Flag_parsing_c.filter_define_error,"  ";
 466     "-filter_msg_define_error", Arg.Set Flag_parsing_c.filter_msg_define_error,
 467     "  filter the error msg";
 468     "-filter_passed_level",     Arg.Set_int Flag_parsing_c.filter_passed_level,"  ";
 469 (*  debug cfg doesn't seem to have any effect, so drop it as an option *)
 470 (*  "-debug_cfg",          Arg.Set Flag_parsing_c.debug_cfg , "  "; *)
 471     "-debug_unparsing",         Arg.Set  Flag_parsing_c.debug_unparsing, "  ";
 472
 473   ];
 474   (* could use Flag_parsing_c.options_debug_with_title instead *)
 475
 476
 477   "shortcut for enabling/disabling a set of debugging options at once",
 478   "",
 479   [
 480     (* todo: other profile ? *)
 481     "-quiet",   Arg.Unit (fun () -> run_profile quiet_profile), " ";
 482     "-very_quiet",   Arg.Unit (fun () -> run_profile very_quiet_profile), " ";
 483     "-debug",   Arg.Unit (fun () -> run_profile debug_profile), " ";
 484     "-pad",     Arg.Unit (fun () -> run_profile pad_profile),   " ";
 485
 486   ];
 487
 488   "bench options",
 489   "",
 490   [
 491     "-profile", Arg.Unit (function () -> Common.profile := Common.PALL) ,
 492     "   gather timing information about the main coccinelle functions";
 493     "-bench", Arg.Int (function x -> Flag_ctl.bench := x),
 494     "   <level> for profiling the CTL engine";
 495     "-timeout", Arg.Int (fun x -> FC.timeout := Some x),
 496     "   <sec> timeout in seconds";
 497     "-steps", Arg.Int (fun x -> Flag_ctl.steps := Some x),
 498     "   max number of model checking steps per code unit";
 499     "-iso_limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x),
 500     "   max depth of iso application";
 501     "-no_iso_limit", Arg.Unit (fun _ -> Flag_parsing_cocci.iso_limit := None),
 502     "   disable limit on max depth of iso application";
 503     "-track_iso", Arg.Set Flag.track_iso_usage,
 504     "   gather information about isomorphism usage";
 505     "-disable_iso",
 506     Arg.String
 507     (fun s -> Flag_parsing_cocci.disabled_isos :=
 508       s :: !Flag_parsing_cocci.disabled_isos),
 509     "   disable a specific isomorphism";
 510     "-profile_iso",
 511     Arg.Unit
 512     (function () ->
 513       Common.profile :=
 514         (*post_engine not included, because it doesn't use isos*)
 515         PSOME ["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
 516     "   gather information about the cost of isomorphism usage"
 517   ];
 518
 519
 520
 521   "change of algorithm options",
 522   "",
 523   [
 524     "-popl", Arg.Set FC.popl,
 525     "    simplified SmPL, for the popl paper";
 526
 527     "-popl_mark_all",
 528     Arg.Unit
 529     (function _ -> FC.popl := true; Flag_popl.mark_all := true),
 530     "    simplified SmPL, for the popl paper";
 531
 532     "-popl_keep_all_wits",
 533     Arg.Unit
 534     (function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
 535     "    simplified SmPL, for the popl paper";
 536
 537     "-hrule", Arg.String
 538     (function s ->
 539       Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
 540     "    semantic patch generation";
 541
 542     "-keep_comments", Arg.Set Flag_parsing_c.keep_comments,
 543     "   keep comments around removed code";
 544
 545     "-loop",              Arg.Set Flag_ctl.loop_in_src_code,    " ";
 546     "-no_loops",          Arg.Set Flag_parsing_c.no_loops,
 547     "   drop all back edges derived from looping constructs - unsafe";
 548     "-no_gotos",          Arg.Set Flag_parsing_c.no_gotos,
 549     "   drop all jumps derived from gotos - unsafe";
 550     "-no_saved_typedefs", Arg.Clear Flag_cocci.use_saved_typedefs,
 551     "   drop all inferred typedefs from one parse of some code to the next";
 552
 553     "-ocaml_regexps", Arg.Clear Regexp.pcre_support,
 554     "   use OCaml Str regular expressions for constraints";
 555
 556     "-l1",                Arg.Clear Flag_parsing_c.label_strategy_2, " ";
 557     "-ifdef_to_if",       Arg.Set FC.ifdef_to_if,
 558     "   convert ifdef to if (experimental)";
 559     "-no_ifdef_to_if",              Arg.Clear FC.ifdef_to_if,
 560     "   convert ifdef to if (experimental)";
 561
 562     "-disable_multi_pass", Arg.Set Flag_parsing_c.disable_multi_pass, " ";
 563
 564     "-noif0_passing",      Arg.Clear Flag_parsing_c.if0_passing,
 565     " ";
 566     "-noadd_typedef_root", Arg.Clear Flag_parsing_c.add_typedef_root, " ";
 567     (* could use Flag_parsing_c.options_algo instead *)
 568
 569
 570     "-disallow_nested_exps", Arg.Set Flag_matcher.disallow_nested_exps,
 571        " disallow an expresion pattern from matching a term and its subterm";
 572     "-disable_worth_trying_opt", Arg.Clear FC.worth_trying_opt,
 573     "  ";
 574     "-only_return_is_error_exit",
 575     Arg.Set Flag_matcher.only_return_is_error_exit,
 576     "if this flag is not set, then break and continue are also error exits";
 577     (* the following is a hack to make it easier to add code in sgrep-like
 578        code, essentially to compensate for the fact that we don't have
 579        any way of printing things out *)
 580     "-allow_inconsistent_paths",
 581     Arg.Set Flag_matcher.allow_inconsistent_paths,
 582     "   if this flag is set don't check for inconsistent paths; dangerous";
 583     "-no_safe_expressions",
 584     Arg.Set Flag_matcher.no_safe_expressions,
 585     "  make an expression disjunction not prioritise the topmost disjunct";
 586     "-int_bits", Arg.Int Flag_parsing_c.set_int_bits,
 587     "  the number of bits in an unsigned int";
 588     "-long_bits", Arg.Int Flag_parsing_c.set_long_bits,
 589     "  the number of bits in an unsigned long";
 590     "-linux_spacing", Arg.Unit Flag_parsing_c.set_linux_spacing,
 591     "  spacing of + code follows the conventions of Linux";
 592     "-smpl_spacing", Arg.Unit Flag_parsing_c.set_smpl_spacing,
 593     "  spacing of + code follows the semantic patch";
 594     "-D", Arg.String Flag.set_defined_virtual_rules,
 595     "  indicate that a virtual rule should be considered to be matched";
 596     "-c++", Arg.Set Flag.c_plus_plus,
 597     "  make a small attempt to parse C++ files"
 598   ];
 599
 600   "misc options",
 601   "",
 602   [
 603     "-debugger",           Arg.Set Common.debugger,
 604     "   option to set if launch spatch in ocamldebug";
 605     "-disable_once",       Arg.Set Common.disable_pr2_once,
 606     "   to print more messages";
 607     "-show_trace_profile", Arg.Set Common.show_trace_profile,
 608     "   show trace";
 609     "-save_tmp_files",     Arg.Set Common.save_tmp_files,   " ";
 610   ];
 611
 612   "concurrency",
 613   "",
 614   [
 615     "-index",       Arg.Int (function x -> distrib_index := Some x) ,
 616     "   the processor to use for this run of spatch";
 617     "-max",         Arg.Int (function x -> distrib_max := Some x) ,
 618     "   the number of processors available";
 619     "-mod_distrib", Arg.Set mod_distrib,
 620     "   use mod to distribute files among the processors";
 621   ];
 622
 623   "pad options",
 624   "",
 625   [
 626     "-use_cache", Arg.Set Flag_parsing_c.use_cache,
 627     "   use .ast_raw pre-parsed cached C file";
 628     "-cache_prefix",
 629     Arg.String (function s ->
 630       Flag_parsing_c.cache_prefix := Some s;
 631       Flag_parsing_c.use_cache := true),
 632     "   directory of cached ASTs, sets -use_cache";
 633     (* could use Flag_parsing_c.options_pad instead *)
 634     "-cache_limit",
 635       Arg.Int (function n ->
 636         Flag_parsing_c.cache_limit := Some n),
 637     "   maximum number of cached ASTs, sets -use_cache";
 638   ];
 639
 640
 641
 642   "test mode and test options (works with tests/ or .ok files)",
 643   "The test options don't work with the -sp_file and so on.",
 644   [
 645     "-test",    Arg.Set test_mode,
 646     "   <file> launch spatch on tests/file.[c,cocci]";
 647     "-testall", Arg.Set test_all,
 648     "   launch spatch on all files in tests/ having a .res";
 649     "-test_okfailed", Arg.Set test_okfailed,
 650     "    generates .{ok,failed,spatch_ok} files using .res files";
 651     "-test_regression_okfailed", Arg.Set test_regression_okfailed,
 652     "    process the .{ok,failed,spatch_ok} files in current dir";
 653
 654     "-compare_with_expected", Arg.Set compare_with_expected,
 655     "   use also file.res";
 656     "-expected_score_file", Arg.Set_string expected_score_file,
 657     "   which score file to compare with in -testall";
 658     "-relax_include_path", Arg.Set FC.relax_include_path,
 659     " ";
 660   ];
 661
 662   "action mode",
 663   ("The action options don't work with the -sp_file and so on." ^ "\n" ^
 664    "It's for the other (internal) uses of the spatch program."
 665   ),
 666
 667     (* -token_c, -parse_c, etc  *)
 668   ((Common.options_of_actions action (Test_parsing_c.actions())) ++
 669     [
 670     (let s = "-parse_cocci"  in s, Arg.Unit (fun () -> action := s),
 671     "   <file>");
 672     (let s = "-compare_c"  in s, Arg.Unit (fun () -> action := s),
 673     "   <file1> <file2>");
 674     ]);
 675 ]
 676
 677
 678 let all_options =
 679   short_options ++ List.concat (List.map Common.thd3 other_options)
 680
 681 (* I don't want the -help and --help that are appended by Arg.align *)
 682 let arg_align2 xs =
 683   Arg.align xs +> List.rev +> Common.drop 2 +> List.rev
 684
 685 (*
 686   Ignore unknown option
 687
 688   This simplifies the integration of Coccinelle in toolchain.  For
 689   instance, spatch can then be used as a checker in the Linux build
 690   system.
 691
 692 *)
 693 let check_include_path () =
 694   let opt = Array.get Sys.argv !Arg.current in
 695   let is_include_re = Str.regexp "-I\\(.*\\)" in
 696   if Str.string_match is_include_re opt 0 then
 697     let path = Str.matched_group 1 opt in
 698         FC.include_path:= path::!FC.include_path
 699   else ()
 700
 701 let rec arg_parse_no_fail l f msg =
 702   try
 703     check_include_path ();
 704     Arg.parse_argv Sys.argv l f msg;
 705   with
 706     | Arg.Bad emsg ->
 707         arg_parse_no_fail l f msg
 708     | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
 709         raise Impossible  (* -help is specified in speclist *)
 710
 711 (* copy paste of Arg.parse. Don't want the default -help msg *)
 712 let arg_parse2 l f msg argv =
 713   (try
 714     Arg.parse_argv argv l f msg;
 715   with
 716   | Arg.Bad emsg -> (* eprintf "%s" msg; exit 2; *)
 717       if not !ignore_unknown_opt then
 718         begin
 719           let xs = Common.lines emsg in
 720             (* take only head, it's where the error msg is *)
 721             pr2 (List.hd xs);
 722             !short_usage_func();
 723             raise (Common.UnixExit (2))
 724         end
 725       else
 726         arg_parse_no_fail l f msg;
 727   | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
 728       raise Impossible  (* -help is specified in speclist *)
 729   )
 730
 731
 732 let short_usage () =
 733  begin
 734   Common.short_usage usage_msg short_options;
 735   pr2 "";
 736   pr2 "Example of use:";
 737   pr2 "  ./spatch -sp_file foo.cocci foo.c -o /tmp/newfoo.c";
 738   pr2 "";
 739  end
 740
 741
 742 let long_usage () =
 743   Common.long_usage usage_msg short_options other_options
 744
 745 let _ = short_usage_func := short_usage
 746 let _ = long_usage_func := long_usage
 747
 748 (*****************************************************************************)
 749 (* Helpers *)
 750 (*****************************************************************************)
 751
 752 (* for fresh identifier information *)
 753 let adjust_stdin cfiles k =
 754   match cfiles with
 755     [] -> failwith "not possible"
 756   | cfile::_ ->
 757       let newin =
 758         try
 759           let (dir, base, ext) = Common.dbe_of_filename cfile in
 760           let varfile = Common.filename_of_dbe (dir, base, "var") in
 761           if ext =$= "c" && Common.lfile_exists varfile
 762           then Some varfile
 763           else None
 764         with Invalid_argument("Filename.chop_extension") -> None in
 765       Common.redirect_stdin_opt newin k
 766
 767 let glimpse_filter (coccifile, isofile) dir =
 768   let (_metavars,astcocci,_free_var_lists,_negated_positions,
 769        _used_after_lists,_positions_lists,(_,query,_)) =
 770     Cocci.sp_of_file coccifile (Some isofile) in
 771   match query with
 772     None -> pr2 "no inferred glimpse keywords"; None
 773   | Some queries ->
 774       let suffixes = if !include_headers then ["c";"h"] else ["c"] in
 775       let rec loop = function
 776           [] -> None (* error, eg due to pattern too big *)
 777         | query::queries ->
 778             Printf.fprintf stderr "%s\n" ("glimpse request = " ^ query);
 779             let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in
 780             let (glimpse_res,stat) = Common.cmd_to_list_and_status command in
 781             match stat with
 782               Unix.WEXITED(0) | Unix.WEXITED(1) ->
 783       Printf.fprintf stderr "got files\n"; flush stderr;
 784                 Some
 785                   (glimpse_res +>
 786                    List.filter
 787                      (fun file -> List.mem (Common.filesuffix file) suffixes))
 788             |   _ -> loop queries (* error, eg due to pattern too big *) in
 789       loop queries
 790
 791 let idutils_filter (coccifile, isofile) dir =
 792   let (_metavars,astcocci,_free_var_lists,_negated_positions,
 793        _used_after_lists,_positions_lists,(_,_,query)) =
 794     Cocci.sp_of_file coccifile (Some isofile) in
 795   match query with
 796     None -> pr2 "no inferred idutils keywords"; None
 797   | Some query ->
 798       let suffixes = if !include_headers then ["c";"h"] else ["c"] in
 799       let files = Id_utils.interpret dir query in
 800       Printf.fprintf stderr "got files\n"; flush stderr;
 801       Some
 802         (files +>
 803          List.filter (fun file -> List.mem (Common.filesuffix file) suffixes))
 804
 805 (*****************************************************************************)
 806 (* Main action *)
 807 (*****************************************************************************)
 808
 809 let get_files path =
 810   let ch =
 811     Common.cmd_to_list (* same as "true, "", _" case *)
 812       (if !include_headers
 813                           (* FIXME : Could we remove xs ?
 814                              -use_glimpse requires a singleton.
 815                              This is checked some lines before.
 816                              then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
 817                              else ("find "^(join " " (x::xs))^" -name \"*.c\"")
 818                           *)
 819       then ("find "^ path ^" -name \"*.[ch]\"")
 820       else ("find "^ path ^" -name \"*.c\"")) in
 821   let cpp =
 822     if !Flag.c_plus_plus
 823     then Common.cmd_to_list ("find "^ path ^" -name \"*.cpp\"")
 824     else [] in
 825   cpp @ ch
 826
 827 let rec main_action xs =
 828   let (cocci_files,xs) =
 829     List.partition (function nm -> Filename.check_suffix nm ".cocci") xs in
 830   (match (!cocci_file,cocci_files) with
 831     "",[fl] -> cocci_file := fl
 832   | _,[] -> ()
 833   | _ -> failwith "only one .cocci file allowed");
 834   Iteration.base_file_list := xs;
 835   let rec toploop = function
 836       [] -> raise Impossible
 837     | x::xs ->
 838       (* a more general solution would be to use
 839        * Common.files_of_dir_or_files (x::xs)
 840        * as some elements in xs may also be directories, or individual
 841        * files.
 842        *)
 843           dir := (Common.is_directory x);
 844
 845           if !cocci_file =$= ""
 846           then failwith "I need a cocci file,  use -sp_file <file>";
 847
 848           if !dir && !Flag.patch =*= None
 849           then
 850             (match xs with
 851             | [] -> Flag.patch := Some (Cocci.normalize_path x)
 852             | _ ->
 853                 pr2
 854                   ("warning: patch output can only be created when only one\n"^
 855                    "directory is specified or when the -patch flag is used")
 856                   );
 857           Flag.dir := x;
 858
 859           let infiles =
 860             Common.profile_code "Main.infiles computation" (fun () ->
 861               match !dir, !kbuild_info, !Flag.scanner with
 862             (* glimpse *)
 863               | false, _, (Flag.Glimpse|Flag.IdUtils) -> [x::xs]
 864               | true, s, (Flag.Glimpse|Flag.IdUtils) when s <> "" ->
 865                   failwith
 866                     "-use_glimpse or -id_utils does not work with -kbuild"
 867               | true, "", Flag.Glimpse ->
 868                   (if not (null xs)
 869                   then failwith "-use_glimpse can accept only one dir");
 870
 871                   let files =
 872                     match glimpse_filter (!cocci_file, !Config.std_iso) x with
 873                       None -> get_files x
 874                     | Some files -> files in
 875                   files +> List.map (fun x -> [x])
 876               | true, "", Flag.IdUtils ->
 877                   (if not (null xs)
 878                   then failwith "-id_utils can accept only one dir");
 879
 880                   let files =
 881                     match idutils_filter (!cocci_file, !Config.std_iso) x with
 882                       None -> get_files x
 883                     | Some files -> files in
 884                   files +> List.map (fun x -> [x])
 885                   (* normal *)
 886               | false, _, _ -> [x::xs]
 887               | true, "", _ ->
 888                   get_files (join " " (x::xs)) +> List.map (fun x -> [x])
 889
 890             (* kbuild *)
 891               | true, kbuild_info_file,_ ->
 892                   let dirs =
 893                     Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d")
 894                   in
 895                   let info = Kbuild.parse_kbuild_info kbuild_info_file in
 896                   let groups = Kbuild.files_in_dirs dirs info in
 897
 898                   groups +> List.map (function Kbuild.Group xs -> xs)
 899                     )
 900           in
 901
 902           (* make cache unique in parallel case *)
 903           (match (!distrib_index,!Flag_parsing_c.cache_prefix) with
 904             (Some index,Some str) ->
 905               Flag_parsing_c.cache_prefix :=
 906                 Some (Printf.sprintf "%s/d%d" str index)
 907           | _ -> ());
 908
 909           let infiles =
 910             match (!distrib_index,!distrib_max) with
 911               (None,None) -> infiles
 912             | (Some index,Some max) ->
 913                 (if index >= max
 914                 then
 915                   failwith "index starts at 0, and so must be less than max");
 916                 if !mod_distrib
 917                 then
 918                   let rec loop ct = function
 919                       [] -> []
 920                     | x::xs ->
 921                         if (ct mod max) =|= index
 922                         then x::(loop (ct+1) xs)
 923                         else loop (ct+1) xs in
 924                   loop 0 infiles
 925                 else
 926                   begin
 927                     let all_files = List.length infiles in
 928                     let regions = (all_files + (max - 1)) / max in
 929                     let this_min = index * regions in
 930                     let this_max = (index+1) * regions in
 931                     let rec loop ct = function
 932                         [] -> []
 933                       | x::xs ->
 934                           if this_min <= ct && ct < this_max
 935                           then x::(loop (ct+1) xs)
 936                           else loop (ct+1) xs in
 937                     loop 0 infiles
 938                   end
 939             | _ -> failwith "inconsistent distribution information" in
 940
 941           let (cocci_infos,outfiles) =
 942             Common.profile_code "Main.outfiles computation" (fun () ->
 943               let cocci_infos =
 944                 Cocci.pre_engine (!cocci_file, !Config.std_iso) in
 945               let res =
 946                 infiles +> List.map (fun cfiles ->
 947                   pr2 ("HANDLING: " ^ (join " " cfiles));
 948                   Common.timeout_function_opt !FC.timeout (fun () ->
 949                     Common.report_if_take_time 10 (join " " cfiles) (fun () ->
 950                       try
 951                         let optfile =
 952                           if !output_file <> "" && !compat_mode then
 953                             Some !output_file
 954                           else
 955                             None
 956                         in
 957                         adjust_stdin cfiles (fun () ->
 958                           Common.redirect_stdout_opt optfile (fun () ->
 959                           (* this is the main call *)
 960                             Cocci.full_engine cocci_infos cfiles
 961                         ))
 962                       with
 963                       | Common.UnixExit x -> raise (Common.UnixExit x)
 964                       | Pycocci.Pycocciexception ->
 965                           raise Pycocci.Pycocciexception
 966                       | e ->
 967                           if !dir
 968                           then begin
 969                             pr2 ("EXN:" ^ Printexc.to_string e);
 970                             [] (* *)
 971                           end
 972                           else raise e))) in
 973               (cocci_infos,res)) in
 974           let outfiles = List.concat outfiles in
 975           (match Iteration.get_pending_instance() with
 976             None ->
 977               (x,xs,cocci_infos,outfiles)
 978           | Some (files,virt_rules,virt_ids) ->
 979               if outfiles = [] or outfiles = [] or not !FC.show_diff
 980                   or !inplace_modif
 981               then
 982                 begin
 983                   (if !inplace_modif then generate_outfiles outfiles x xs);
 984                   Flag.defined_virtual_rules := virt_rules;
 985                   Flag.defined_virtual_env := virt_ids;
 986                   Common.erase_temp_files();
 987                   Common.clear_pr2_once();
 988                   distrib_index := None;
 989                   distrib_max := None;
 990                   toploop files
 991                 end
 992               else
 993                 begin
 994                   Common.pr2
 995                     "Out of place transformation not compatible with iteration. Aborting.\n consider using -no_show_diff or -in_place";
 996                   (x,xs,cocci_infos,outfiles)
 997                 end) in
 998       let (x,xs,cocci_infos,outfiles) = toploop xs in
 999
1000       Cocci.post_engine cocci_infos;
1001       Common.profile_code "Main.result analysis" (fun () ->
1002         Ctlcocci_integration.print_bench();
1003         generate_outfiles outfiles x xs;
1004         if !compare_with_expected
1005         then Testing.compare_with_expected outfiles)
1006
1007 and generate_outfiles outfiles x (* front file *) xs (* other files *) =
1008   let outfiles = Cocci.check_duplicate_modif outfiles in
1009   outfiles +> List.iter (fun (infile, outopt) ->
1010     outopt +> Common.do_option (fun outfile ->
1011       if !inplace_modif
1012       then begin
1013         (match !backup_suffix with
1014           Some backup_suffix ->
1015             Common.command2 ("cp "^infile^" "^infile^backup_suffix)
1016         | None -> ());
1017         Common.command2 ("cp "^outfile^" "^infile);
1018       end;
1019
1020       if !outplace_modif
1021       then Common.command2 ("cp "^outfile^" "^infile^".cocci_res")
1022
1023               (* potential source of security pb if the /tmp/ file is
1024                  * a symlink, so simpler to not produce any regular file
1025                  * (files created by Common.new_temp_file are still ok)
1026                  * anymore in /tmp.
1027               *)
1028               (*
1029                  if !output_file =$= ""
1030                  then begin
1031                  let tmpfile = "/tmp/"^Common.basename infile in
1032                  pr2 (spf "One file modified. Result is here: %s" tmpfile);
1033                  Common.command2 ("cp "^outfile^" "^tmpfile);
1034                  end
1035               *)
1036             ));
1037   if !output_file <> "" && not !compat_mode then
1038     (match outfiles with
1039     | [infile, Some outfile] when infile =$= x && null xs ->
1040         Common.command2 ("cp " ^outfile^ " " ^ !output_file)
1041     | [infile, None] when infile =$= x && null xs ->
1042         Common.command2 ("cp " ^infile^ " " ^ !output_file)
1043     | _ ->
1044         failwith
1045           ("-o can not be applied because there are multiple " ^
1046            "modified files"))
1047
1048 (*****************************************************************************)
1049 (* The coccinelle main entry point *)
1050 (*****************************************************************************)
1051 let main () =
1052   begin
1053     let arglist = Array.to_list Sys.argv in
1054     let arglist = Command_line.command_line arglist in
1055
1056     if not (null (Common.inter_set arglist
1057                     ["-cocci_file";"-sp_file";"-sp";"-test";"-testall";
1058                       "-test_okfailed";"-test_regression_okfailed"]))
1059     then run_profile quiet_profile;
1060
1061     let args = ref [] in
1062
1063     (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*)
1064
1065     (* this call can set up many global flag variables via the cmd line *)
1066     arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg
1067       (Array.of_list arglist);
1068
1069     (* julia hack so that one can override directories specified on
1070        * the command line. *)
1071     (if !dir
1072     then
1073       let chosen_dir =
1074         if List.length !args > 1
1075         then
1076           begin
1077             let chosen = List.hd !args in
1078             Flag.dir := chosen;
1079             pr2 ("ignoring all but the last specified directory: "^chosen);
1080             args := [chosen];
1081             chosen
1082           end
1083         else List.hd !args in
1084       if !FC.include_path =*= []
1085       then FC.include_path := [Filename.concat chosen_dir "include"]);
1086
1087     args := List.rev !args;
1088
1089     if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$"))
1090     then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci";
1091
1092     if !Config.std_iso <> ""
1093     then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso";
1094     if !Config.std_h <> ""
1095     then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h";
1096
1097     if !Config.std_h <> ""
1098     then Parse_c.init_defs_builtins !Config.std_h;
1099
1100     if !macro_file <> ""
1101     then Parse_c.init_defs_macros !macro_file;
1102
1103
1104     (* must be done after Arg.parse, because Common.profile is set by it *)
1105     Common.profile_code "Main total" (fun () ->
1106
1107
1108     let all_actions = Test_parsing_c.actions() in
1109
1110     (match (!args) with
1111
1112     (* --------------------------------------------------------- *)
1113     (* The test framework. Works with tests/ or .ok and .failed  *)
1114     (* --------------------------------------------------------- *)
1115     | [x] when !test_mode    ->
1116         begin
1117           let prefix = "tests/" in
1118           let testfile = x ^ ".cocci" in
1119             if Sys.file_exists (prefix ^ testfile) then
1120               begin
1121                 (if !FC.include_path = []
1122                 then FC.include_path := [prefix^"include"]);
1123                 Testing.testone prefix x !compare_with_expected
1124               end
1125             else
1126               if Sys.file_exists testfile then
1127                 begin
1128                   (if !FC.include_path = []
1129                   then FC.include_path := ["include"]);
1130                   Testing.testone "" x !compare_with_expected
1131                 end
1132               else
1133                 pr2 (spf "ERROR: File %s does not exist" testfile)
1134         end
1135
1136     | []  when !test_all ->
1137         (if !FC.include_path = []
1138         then FC.include_path := ["tests/include"]);
1139         if !expected_score_file <> ""
1140         then Testing.testall ~expected_score_file:!expected_score_file ()
1141         else Testing.testall ()
1142
1143     | [] when !test_regression_okfailed ->
1144         Testing.test_regression_okfailed ()
1145
1146     | ((x::xs) as cfiles) when !test_okfailed ->
1147         (* do its own timeout on FC.timeout internally *)
1148         FC.relax_include_path := true;
1149         adjust_stdin cfiles (fun () ->
1150           Testing.test_okfailed !cocci_file cfiles
1151         )
1152
1153     (* --------------------------------------------------------- *)
1154     (* Actions, useful to debug subpart of coccinelle *)
1155     (* --------------------------------------------------------- *)
1156
1157     | xs when List.mem !action (Common.action_list all_actions) ->
1158         Common.do_action !action xs all_actions
1159
1160     | [file] when !action =$= "-parse_cocci" ->
1161         Testing.test_parse_cocci file
1162
1163      (* I think this is used by some scripts in some Makefile for our
1164       * big-tests. So dont remove.
1165       *)
1166     | [file1;file2] when !action =$= "-compare_c" ->
1167        Test_parsing_c.test_compare_c file1 file2 (* result = unix code *)
1168
1169     (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
1170
1171
1172     (* --------------------------------------------------------- *)
1173     (* This is the main entry *)
1174     (* --------------------------------------------------------- *)
1175     | x::xs -> main_action (x::xs)
1176
1177     (* --------------------------------------------------------- *)
1178     (* empty entry *)
1179     (* --------------------------------------------------------- *)
1180     | [] -> short_usage()
1181   ));
1182     if !Pycocci.initialised && (Pycocci.py_isinitialized ()) != 0 then begin
1183       ignore(Pycocci.pyrun_simplestring "cocci.finalise()");
1184       if !Flag.show_misc
1185       then Common.pr2 "Finalizing python\n";
1186       Pycocci.py_finalize ();
1187     end
1188   end
1189
1190
1191 let main_with_better_error_report () =
1192   if !Common.debugger then main ()
1193   else
1194     try
1195       main ()
1196     with
1197     | Unix.Unix_error (e, "stat", filename) ->
1198         pr2
1199           (spf "ERROR: File %s does not exist: %s"
1200              filename (Unix.error_message e));
1201         raise (UnixExit (-1))
1202     | Parse_cocci.Bad_virt s ->
1203         Common.pr2 (Printf.sprintf "virtual rule %s not supported" s);
1204         raise (UnixExit (-1))
1205
1206 (*****************************************************************************)
1207 let start =
1208   Common.main_boilerplate (fun () ->
1209     main_with_better_error_report ();
1210     Ctlcocci_integration.print_bench();
1211   )