main.ml

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