main.ml

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