├── dune-project ├── make-instrumentation ├── fsmake-make └── fsmake-shell ├── .gitmodules ├── gradle-instrumentation └── fsgradle-gradle ├── Makefile ├── src ├── dune ├── build │ ├── build_options.ml │ ├── build_analyzer.mli │ ├── build_analyzer.ml │ ├── make.mli │ ├── gradle.mli │ ├── make_parser.mli │ ├── make.ml │ ├── gradle_parser.mli │ ├── gradle.ml │ ├── build_fault.mli │ ├── make_fault.mli │ ├── make_parser.ml │ ├── gradle_parser.ml │ ├── build_fault.ml │ └── make_fault.ml ├── analysis │ ├── interpreter.mli │ ├── fault.mli │ ├── stats.mli │ ├── analyzer.mli │ ├── sys_parser.mli │ ├── fault_detection.mli │ ├── stats.ml │ ├── syntax.mli │ ├── graph.mli │ ├── analyzer.ml │ ├── syntax.ml │ ├── domains.mli │ ├── graph.ml │ ├── fault.ml │ ├── interpreter.ml │ ├── fault_detection.ml │ ├── domains.ml │ └── sys_parser.ml ├── common │ ├── errors.ml │ ├── errors.mli │ ├── util.mli │ └── util.ml ├── task_info.mli ├── task_info.ml ├── executor.mli ├── executor.ml └── main.ml ├── mkcheck-sbuild └── run-mkcheck ├── Dockerfile ├── entrypoint └── process-project.sh └── README.md /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.2) 2 | (name buildfs) 3 | -------------------------------------------------------------------------------- /make-instrumentation/fsmake-make: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Hope they don't use -- 4 | make "$@" -- SHELL='fsmake-shell '\''$@'\'' '\''$+'\''' 5 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "gradle-instrumentation/buildfs-gradle-plugin"] 2 | path = gradle-instrumentation/buildfs-gradle-plugin 3 | url = https://github.com/theosotr/buildfs-gradle-plugin 4 | -------------------------------------------------------------------------------- /make-instrumentation/fsmake-shell: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | target="$1" 4 | prereqs="$2" 5 | echo "##MAKE## Begin $(pwd):$target" 1>&2 6 | shift 2 7 | /bin/bash "$@" 8 | echo "##MAKE## End" 1>&2 9 | -------------------------------------------------------------------------------- /gradle-instrumentation/fsgradle-gradle: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | 4 | if [ -f gradlew ]; then 5 | ./gradlew --stop 6 | ./gradlew "$@" 7 | else 8 | gradle --stop 9 | gradle "$@" 10 | fi 11 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_PREFIX?=/usr/local/bin 2 | .PHONY: buildfs 3 | 4 | buildfs: 5 | dune build -p buildfs 6 | dune install 7 | 8 | clean: 9 | dune clean 10 | 11 | install: 12 | install -D -o root make-instrumentation/fsmake-make "${INSTALL_PREFIX}/fsmake-make" 13 | install -D -o root make-instrumentation/fsmake-shell "${INSTALL_PREFIX}/fsmake-shell" 14 | install -D -o root gradle-instrumentation/fsgradle-gradle "${INSTALL_PREFIX}/fsgradle-gradle" 15 | 16 | uninstall: 17 | rm -f "${INSTALL_PREFIX}/fsmake-make" 18 | rm -f "${INSTALL_PREFIX}/fsmake-shell" 19 | rm -f "${INSTALL_PREFIX}/fsgradle-gradle" 20 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs unqualified) 2 | (env 3 | (profile 4 | (ocamlopt_flags (:standard -p -w -27-32-52-33-34-37-39)) 5 | (flags (:standard -w -27-32-52-33-34-37-39))) 6 | (dev 7 | (flags (:standard -w -27-32-52-33-34-37-39))) 8 | (release 9 | (flags (:standard -w -27-32-52-33-34-37-39)))) 10 | 11 | (library 12 | (name buildfs) 13 | (modules (:standard \ main)) 14 | (libraries core yojson ppx_jane ppx_let str fd-send-recv fpath) 15 | (preprocess (pps ppx_jane))) 16 | 17 | (executable 18 | (name main) 19 | (public_name buildfs) 20 | (modules main) 21 | (libraries buildfs) 22 | (preprocess (pps ppx_jane))) 23 | -------------------------------------------------------------------------------- /src/build/build_options.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type tool_options = 19 | {build_task: string option; 20 | build_dir: string; 21 | ignore_mout: bool; 22 | build_db: string option; 23 | } 24 | -------------------------------------------------------------------------------- /src/build/build_analyzer.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | val adapt_effect : 19 | string 20 | -> Domains.syscall_effect 21 | -> (string * Domains.abstraction_effect) 22 | (** Adapts the effect of a given resource with regards to the semantics 23 | of the build tool. *) 24 | -------------------------------------------------------------------------------- /src/analysis/interpreter.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | val interpret : Syntax.trace -> Domains.state -> Domains.state 19 | (** This function interprets the given trace. 20 | It transitions the given state to a new state based on the semantics 21 | of the given BuildFS statement *) 22 | -------------------------------------------------------------------------------- /src/build/build_analyzer.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | let adapt_effect resource effect = 19 | match effect with 20 | | Domains.Read v 21 | | Domains.Touch v -> v, Domains.Consumed resource 22 | | Domains.Write v -> v, Domains.Modified resource 23 | | Domains.Create v -> v, Domains.Produced resource 24 | | Domains.Remove v -> v, Domains.Expunged resource 25 | -------------------------------------------------------------------------------- /src/build/make.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type tool_options = Build_options.tool_options 19 | 20 | 21 | val validate_options : Executor.mode -> tool_options -> Executor.option_status 22 | 23 | 24 | val construct_command : tool_options -> string array 25 | 26 | 27 | module SysParser : Sys_parser.S 28 | 29 | 30 | module TraceAnalyzer : Analyzer.S 31 | 32 | 33 | module FaultDetector : Fault_detection.S with type tool_options = tool_options 34 | -------------------------------------------------------------------------------- /src/build/gradle.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type tool_options = Build_options.tool_options 19 | 20 | 21 | val validate_options : Executor.mode -> tool_options -> Executor.option_status 22 | 23 | 24 | val construct_command : tool_options -> string array 25 | 26 | 27 | module SysParser : Sys_parser.S 28 | 29 | 30 | module TraceAnalyzer : Analyzer.S 31 | 32 | 33 | module FaultDetector : Fault_detection.S with type tool_options = tool_options 34 | -------------------------------------------------------------------------------- /src/build/make_parser.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | val is_tool_debug_msg : string -> bool 19 | (** Checks if the given system call corresponds to a debug message 20 | produced by the Make instrumented build script. *) 21 | 22 | 23 | val model_syscall : string -> Syntax.statement 24 | (** This function identifies and model the points where 25 | the application of a certain Make task begins or ends. *) 26 | 27 | val stop_parser : string -> bool 28 | (** This function checks whether the execution of a Make script ends. 29 | 30 | This function is used by the parser to ignore any subsequent system calls. *) 31 | -------------------------------------------------------------------------------- /src/build/make.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Build_options 19 | 20 | 21 | type tool_options = Build_options.tool_options 22 | 23 | 24 | let validate_options mode tool_options = 25 | match mode, tool_options with 26 | | Executor.Offline, { build_task = Some _; _ } -> 27 | Executor.Err "Option `-build-task` is only compatible with the mode 'online'" 28 | | _ -> Executor.Ok 29 | 30 | 31 | let construct_command _ = 32 | [| 33 | "fsmake-make"; 34 | |] 35 | 36 | 37 | module SysParser = Sys_parser.Make(Make_parser) 38 | module TraceAnalyzer = Analyzer.Make(Build_analyzer) 39 | module FaultDetector = Fault_detection.Make(Make_fault) 40 | -------------------------------------------------------------------------------- /src/build/gradle_parser.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | val is_tool_debug_msg : string -> bool 19 | (** Checks if the given system call corresponds to a debug message 20 | produced by Gradle. *) 21 | 22 | 23 | val model_syscall : string -> Syntax.statement 24 | (** This function identifies and model the points where 25 | the application of a certain Gradle task begins or ends. 26 | 27 | In the context of Gradle, those points correspond to writes 28 | a file descriptor greater than 100. *) 29 | 30 | val stop_parser : string -> bool 31 | (** This function checks whether the execution of a Gradle script ends. 32 | 33 | This function is used by the parser to ignore any subsequent system calls. *) 34 | -------------------------------------------------------------------------------- /src/common/errors.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type error_kind = 19 | | ParserError of (string * int) 20 | | InterpretationError of Syntax.syscall_desc 21 | | ToolError 22 | | ExecutorError 23 | | InternalError 24 | | GenericError 25 | 26 | 27 | let string_of_error = function 28 | | ParserError (syscall, line) -> 29 | "Parser Error: " ^ syscall ^ ": " ^ (string_of_int line) 30 | | InterpretationError sdesc -> 31 | "Interpretation Error: " ^ (Syntax.string_of_syscall_desc sdesc) 32 | | ToolError -> "Tool Error" 33 | | ExecutorError -> "Executor Error" 34 | | InternalError -> "Internal Error" 35 | | GenericError -> "Error" 36 | 37 | 38 | exception Error of (error_kind * string option) 39 | -------------------------------------------------------------------------------- /src/common/errors.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type error_kind = 19 | | ParserError of (string * int) (* An error that occurs during the parsing of traces. *) 20 | | InterpretationError of Syntax.syscall_desc (* An error that occurs during the interpretation of traces. *) 21 | | ToolError (* An error that occurs and it is tool-specific (e.g., Gradle-specific) *) 22 | | ExecutorError (* An error that occurs in the executor component. *) 23 | | InternalError (* An unexpected error. *) 24 | | GenericError (* A generic and expected error. *) 25 | (** Different kinds of errors that can appear in BuildFS. *) 26 | 27 | 28 | exception Error of (error_kind * string option) 29 | 30 | 31 | val string_of_error : error_kind -> string 32 | (** This function converts an error type to a string. *) 33 | -------------------------------------------------------------------------------- /src/task_info.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type task_desc = 19 | { 20 | name: string; (** The name of task. *) 21 | file: string option; (** The file where this task is declared. *) 22 | line: string option; (** The line where this task is declared. *) 23 | } 24 | 25 | 26 | type task_info 27 | 28 | 29 | type ignored_tasks_t 30 | 31 | 32 | val empty_task_info : unit -> task_info 33 | 34 | 35 | val empty_ignored_tasks : unit -> ignored_tasks_t 36 | 37 | 38 | val add_ignored_task : string -> ignored_tasks_t -> ignored_tasks_t 39 | 40 | 41 | val is_ignored : string -> ignored_tasks_t -> bool 42 | 43 | 44 | val add_task_desc : string -> task_desc -> task_info -> task_info 45 | 46 | 47 | val get_task_desc: string -> task_info -> task_desc option 48 | 49 | 50 | val string_of_task_desc: task_desc -> string 51 | -------------------------------------------------------------------------------- /src/analysis/fault.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type fault_collection 19 | (** A type representing faults. *) 20 | 21 | 22 | val empty_faults : unit -> fault_collection 23 | (** Creates an empty fault collection. *) 24 | 25 | 26 | val report_faults : Task_info.task_info -> fault_collection -> unit 27 | (** Reports the given faults to standard output. *) 28 | 29 | 30 | val add_fault : 31 | string 32 | -> string 33 | -> string 34 | -> Analyzer.file_acc_t 35 | -> fault_collection 36 | -> fault_collection 37 | (** Adds a fault related to a single file access performed by the given task. *) 38 | 39 | 40 | val add_conflict_fault : 41 | string 42 | -> string 43 | -> string 44 | -> Analyzer.file_acc_t * Analyzer.file_acc_t 45 | -> fault_collection 46 | -> fault_collection 47 | (** Adds a fault related to a conlict between the file accesses of two 48 | tasks. *) 49 | -------------------------------------------------------------------------------- /src/build/gradle.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Build_options 19 | 20 | 21 | type tool_options = Build_options.tool_options 22 | 23 | 24 | let validate_options mode tool_options = 25 | match mode, tool_options with 26 | | Executor.Online, { build_task = None; _ } -> 27 | Executor.Err "Mode 'online' requires option '-build-task'" 28 | | Executor.Offline, { build_task = Some _; _ } -> 29 | Executor.Err "Option `-build-task` is only compatible with the mode 'online'" 30 | | _ -> Executor.Ok 31 | 32 | 33 | let construct_command = function 34 | | { build_task = None; _ } -> 35 | raise (Errors.Error (Errors.ToolError, (Some "Cannot create command"))) 36 | | { build_task = Some build_task; _ } -> 37 | [| 38 | "fsgradle-gradle"; 39 | build_task; 40 | "--no-parallel"; 41 | |] 42 | 43 | 44 | module SysParser = Sys_parser.Make(Gradle_parser) 45 | module TraceAnalyzer = Analyzer.Make(Build_analyzer) 46 | module FaultDetector = Fault_detection.Make(Build_fault) 47 | -------------------------------------------------------------------------------- /src/build/build_fault.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type tool_options = Build_options.tool_options 19 | 20 | 21 | type tool_info 22 | 23 | 24 | val ignore_dirs : bool 25 | 26 | 27 | val filter_resource : tool_options -> string -> bool 28 | 29 | 30 | val filter_conflict : Analyzer.file_acc_t * Analyzer.file_acc_t -> bool 31 | 32 | 33 | val adapt_tasks : string -> string -> Graph.graph -> string * string 34 | 35 | 36 | val refine_analysis_out : 37 | tool_options 38 | -> Analyzer.analysis_out 39 | -> (Analyzer.analysis_out * Task_info.task_info * tool_info) 40 | 41 | 42 | val process_file_access : 43 | string 44 | -> tool_options 45 | -> Analyzer.file_acc_t list 46 | -> (Analyzer.analysis_out * tool_info) 47 | -> Fault_detection.t 48 | -> Fault_detection.t 49 | 50 | 51 | val process_access_conflict : 52 | string 53 | -> tool_options 54 | -> Analyzer.file_acc_t * Analyzer.file_acc_t 55 | -> (Analyzer.analysis_out * tool_info) 56 | -> Fault_detection.t 57 | -> Fault_detection.t 58 | -------------------------------------------------------------------------------- /src/build/make_fault.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type tool_options = Build_options.tool_options 19 | 20 | 21 | type tool_info 22 | 23 | 24 | val ignore_dirs : bool 25 | 26 | 27 | val filter_resource : tool_options -> string -> bool 28 | 29 | 30 | val filter_conflict : Analyzer.file_acc_t * Analyzer.file_acc_t -> bool 31 | 32 | 33 | val adapt_tasks : string -> string -> Graph.graph -> string * string 34 | 35 | 36 | val refine_analysis_out : 37 | tool_options 38 | -> Analyzer.analysis_out 39 | -> (Analyzer.analysis_out * Task_info.task_info * tool_info) 40 | 41 | 42 | val process_file_access : 43 | string 44 | -> tool_options 45 | -> Analyzer.file_acc_t list 46 | -> (Analyzer.analysis_out * tool_info) 47 | -> Fault_detection.t 48 | -> Fault_detection.t 49 | 50 | 51 | val process_access_conflict : 52 | string 53 | -> tool_options 54 | -> Analyzer.file_acc_t * Analyzer.file_acc_t 55 | -> (Analyzer.analysis_out * tool_info) 56 | -> Fault_detection.t 57 | -> Fault_detection.t 58 | -------------------------------------------------------------------------------- /src/analysis/stats.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type t 19 | (** Type for representing statistics. *) 20 | 21 | 22 | val begin_counter : t -> t 23 | (** Start counting time. *) 24 | 25 | 26 | val add_analysis_time : t -> t 27 | (** Consider elapsed time (from the last `begin_counter()` call) 28 | as the analysis time. *) 29 | 30 | 31 | val add_bug_detection_time : t -> t 32 | (** Consider elapsed time (from the last `begin_counter()` call) 33 | as the bug detection time. *) 34 | 35 | 36 | val add_trace_entry : t -> t 37 | (** Increment the trace entry counter. *) 38 | 39 | 40 | val add_task : string -> t -> t 41 | (** Add the given task. *) 42 | 43 | 44 | val add_files : int -> t -> t 45 | (** Add the number of files. *) 46 | 47 | 48 | val add_conflict : t -> t 49 | (** Increment the conflict counter. *) 50 | 51 | 52 | val add_dfs_taversal : t -> t 53 | (** Increment the DFS traversal counter. *) 54 | 55 | 56 | val init_stats : unit -> t 57 | (** Initializes stats. *) 58 | 59 | 60 | val print_stats : t -> unit 61 | (** Print stats to standard output. *) 62 | -------------------------------------------------------------------------------- /src/task_info.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | open Util 18 | 19 | 20 | type task_desc = 21 | { 22 | name: string; (** The name of task. *) 23 | file: string option; (** The file where this task is declared. *) 24 | line: string option; (** The line where this task is declared. *) 25 | } 26 | 27 | 28 | type task_info = task_desc Util.Strings.t 29 | 30 | 31 | type ignored_tasks_t = Util.StringSet.t 32 | 33 | 34 | let empty_task_info () = 35 | Util.Strings.empty 36 | 37 | 38 | let empty_ignored_tasks () = 39 | Util.StringSet.empty 40 | 41 | 42 | let add_ignored_task task ignored_tasks = 43 | task ++ ignored_tasks 44 | 45 | 46 | let is_ignored task ignored_tasks = 47 | Util.StringSet.exists (fun elem -> task = elem) ignored_tasks 48 | 49 | 50 | let add_task_desc task task_desc task_info = 51 | Util.Strings.add task task_desc task_info 52 | 53 | 54 | let get_task_desc task task_info = 55 | Util.Strings.find_opt task task_info 56 | 57 | 58 | let string_of_task_desc task_desc = 59 | match task_desc with 60 | | { file = Some file; line = Some line; _ } -> 61 | task_desc.name ^ ": " ^ file ^ ": " ^ line 62 | | _ -> task_desc.name 63 | -------------------------------------------------------------------------------- /src/build/make_parser.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | let make_msg = "##MAKE##[ ]\\(.*\\)" 19 | let make_regex = Str.regexp ("write[v]?(1,[ ]+\"" ^ make_msg ^ "\\\\n\".*") 20 | let regex_group = 1 21 | 22 | let stop_pattern = "##MAKE## BUILD ENDED" 23 | 24 | 25 | let is_tool_debug_msg syscall_line = 26 | Util.check_prefix "writev(1," syscall_line || 27 | Util.check_prefix "write(1," syscall_line 28 | 29 | 30 | let model_syscall syscall_line = 31 | if Str.string_match make_regex syscall_line 0 32 | then 33 | try 34 | match 35 | syscall_line 36 | |> Str.matched_group regex_group 37 | |> Core.String.strip ~drop: (fun x -> x = '\n') 38 | |> Core.String.split_on_chars ~on: [ ' ' ] 39 | with 40 | | [ "End" ] -> Syntax.End_task "" 41 | | [ "Begin"; t; ] -> ( 42 | let len = String.length t in 43 | match String.get t (len - 1) with 44 | | ':' -> Syntax.Begin_task Syntax.main_block 45 | | _ -> Syntax.Begin_task t) 46 | | _ -> 47 | raise (Errors.Error (Errors.GenericError, Some "Unable to parse line")) 48 | with Not_found -> Syntax.Nop 49 | else Syntax.Nop 50 | 51 | 52 | let stop_parser line = 53 | Util.string_contains line stop_pattern 54 | -------------------------------------------------------------------------------- /src/build/gradle_parser.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | let gradle_msg = "##GRADLE##[ ]\\(.*\\)" 19 | let gradle_regex = Str.regexp ("write[v]?([12][0-9][0-9],[ ]+\"" ^ gradle_msg ^ "\".*") 20 | let regex_group = 1 21 | 22 | 23 | let stop_pattern = "##GRADLE## BUILD ENDED" 24 | 25 | 26 | let is_tool_debug_msg syscall_line = 27 | Util.check_prefix "writev(" syscall_line || 28 | Util.check_prefix "write(" syscall_line 29 | 30 | 31 | let regex = Str.regexp "@@" 32 | 33 | 34 | let replace_spaces str = 35 | Str.global_replace regex " " str 36 | 37 | 38 | let model_syscall syscall_line = 39 | if Str.string_match gradle_regex syscall_line 0 40 | then 41 | try 42 | let gradle_line = Str.matched_group regex_group syscall_line in 43 | match Core.String.split_on_chars ~on: [ ' ' ] gradle_line with 44 | | "newTask" :: _ -> Syntax.Nop 45 | | [ "Begin"; t; ] -> Syntax.Begin_task t 46 | | [ "End"; t; ] -> Syntax.End_task t 47 | | [ "dependsOn"; t1; t2; ] -> Syntax.DependsOn (t1, t2) 48 | | [ "consumes"; t; p; ] -> Syntax.Input (t, p |> replace_spaces) 49 | | [ "produces"; t; p; ] -> Syntax.Output (t, p |> replace_spaces) 50 | | _ -> 51 | raise (Errors.Error (Errors.GenericError, Some "Unable to parse line")) 52 | with Not_found -> Syntax.Nop 53 | else Syntax.Nop 54 | 55 | 56 | let stop_parser line = 57 | Util.string_contains line stop_pattern 58 | -------------------------------------------------------------------------------- /src/analysis/analyzer.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type file_acc_t = Domains.abstraction_effect * Syntax.syscall_desc 19 | (** This type represents a a file access. 20 | A file access is a pair of effect and a syscall description. 21 | 22 | The effect denotes the effect of a particular task execution 23 | on this file, while the system call description is used for debugging 24 | purposes and indicates the actual system call that we stem this 25 | effect from. *) 26 | 27 | 28 | type f_accesses = file_acc_t list Util.Strings.t 29 | (** This type captures all file accesses performed 30 | during the task executions of the tool. 31 | 32 | For example, it captures what kind of system resources, 33 | every task consumes or produces. *) 34 | 35 | 36 | type analysis_out = { 37 | facc: f_accesses; (** File accesses. *) 38 | task_graph: Graph.graph; (** Task graph. *) 39 | dirs: Util.StringSet.t; (** Set of directories. *) 40 | } 41 | (** Record representing analysis output. *) 42 | 43 | 44 | module type ToolType = 45 | sig 46 | val adapt_effect : 47 | string 48 | -> Domains.syscall_effect 49 | -> (string * Domains.abstraction_effect) 50 | (** Adapts the effect on a system resource based on the given 51 | resource name. *) 52 | end 53 | 54 | 55 | module type S = 56 | sig 57 | val analyze_traces : 58 | Stats.t 59 | -> Syntax.trace Syntax.stream 60 | -> Stats.t * analysis_out 61 | (** Analyzes every trace and produces file accesses and task graph. *) 62 | end 63 | 64 | 65 | module Make (T : ToolType) : S 66 | (** A functor for building the implementation of an analyzer 67 | that computes file accesses and infers task graph 68 | through examining execution trace of tool script. *) 69 | -------------------------------------------------------------------------------- /src/common/util.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | module Strings : Map.S with type key = string 19 | (** A module that implements a map of strings. *) 20 | 21 | 22 | module Ints : Map.S with type key = int 23 | (** A module that implements a map of integers. *) 24 | 25 | 26 | module StringPair : Map.S with type key = (string * string) 27 | (** A module that implements a map of pairs of strings. *) 28 | 29 | 30 | module StringSet : Set.S with type elt = string 31 | (** A module that implements a set of strings. *) 32 | 33 | 34 | val check_prefix : string -> string -> bool 35 | (** Check whether the second string starts with the second one. *) 36 | 37 | 38 | val is_absolute : string -> bool 39 | (** Checks if the given path is absolute. *) 40 | 41 | 42 | val to_quotes : string -> string 43 | (* Surround a string with double quotes. *) 44 | 45 | 46 | val has_elem : 'a list -> 'a -> bool 47 | (** Checks if a list contains the given element. *) 48 | 49 | 50 | val string_contains : string -> string -> bool 51 | (** Checks if the first string contains the second one. *) 52 | 53 | 54 | val int_stream : int -> int Stream.t 55 | (** This function initializes a stream of integers. *) 56 | 57 | 58 | val (~+) : string -> StringSet.t 59 | (** An prefix operator that creates a singleton set of strings. *) 60 | 61 | 62 | val (~@) : StringSet.t -> string list 63 | (** An prefix operator that converts a set of strings into a list of strings. *) 64 | 65 | 66 | val (++) : string -> StringSet.t -> StringSet.t 67 | (** An infix operator that adds a string into a set. *) 68 | 69 | 70 | val (+-) : string -> StringSet.t -> StringSet.t 71 | (** An infix operator that removes a string from a set. *) 72 | 73 | 74 | val extract_arg: string -> int -> string 75 | 76 | 77 | val extract_pathname: int -> string -> Syntax.path option 78 | -------------------------------------------------------------------------------- /mkcheck-sbuild/run-mkcheck: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | basedir=/data 4 | path=$1 5 | project=$2 6 | with_strace=$3 7 | iterations=$4 8 | 9 | 10 | pip install requests beautifulsoup4 11 | 12 | mkdir -p $basedir/$project/mkcheck 13 | cd $path 14 | echo $(pwd) > $basedir/$project/$project.path 15 | 16 | debian/rules clean 17 | debian/rules build 18 | if [ ! -f Makefile ]; then 19 | echo "Couln't find Makefile" > $basedir/$project/$project.warning 20 | fi 21 | 22 | make clean 23 | for i in {1..$iterations}; do 24 | if [ $with_strace -eq 0 ]; then 25 | echo "Building the Make project $project without BuildFS..." 26 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 27 | start_time=$(date +%s.%N) 28 | make 29 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 30 | # Compute the time spent on build. 31 | printf "%.2f\n" $elapsed_time >> $basedir/$project/base-build.time 32 | else 33 | echo "Building Make project $project with mkcheck..." 34 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 35 | echo " 36 | filter_in: 37 | - Makefile.* 38 | - /usr/.* 39 | - /etc/.* 40 | - //.* 41 | - /lib/.* 42 | - /bin/.* 43 | - /.*/debian/.* 44 | " > filter.yaml 45 | start_time=$(date +%s.%N) 46 | fuzz_test --graph-path=foo.json build 2> /dev/null 47 | if [ $? -ne 0 ]; then 48 | return 49 | fi 50 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 51 | printf "%.2f\n" $elapsed_time > $basedir/$project/mkcheck/$project.time 52 | 53 | cp foo.json $basedir/$project/mkcheck/$project.json 54 | 55 | echo "Fuzz testing..." 56 | start_time=$(date +%s.%N) 57 | fuzz_test --graph-path=foo.json \ 58 | --rule-path filter.yaml fuzz \ 59 | > $basedir/$project/mkcheck/$project.fuzz 2> /dev/null 60 | if [ $? -ne 0 ]; then 61 | exit 1 62 | fi 63 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 64 | printf "%.2f\n" $elapsed_time >> $basedir/$project/mkcheck/$project.time 65 | 66 | echo "Race testing..." 67 | start_time=$(date +%s.%N) 68 | fuzz_test --graph-path=foo.json \ 69 | --rule-path filter.yaml race \ 70 | > $basedir/$project/mkcheck/$project.race 2> /dev/null 71 | 72 | if [ $? -ne 0 ]; then 73 | exit 1 74 | fi 75 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 76 | printf "%.2f\n" $elapsed_time >> $basedir/$project/mkcheck/$project.time 77 | fi 78 | done 79 | -------------------------------------------------------------------------------- /src/analysis/sys_parser.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | module type ToolParserType = 19 | sig 20 | val is_tool_debug_msg : string -> bool 21 | (** Checks if the given system call is a debug message 22 | produced by the tool. *) 23 | 24 | 25 | val model_syscall : string -> Syntax.statement 26 | (** This function identifies and model the points where 27 | the execution of a certain build task begins or ends. *) 28 | 29 | val stop_parser : string -> bool 30 | (** This function checks whether a certain build has terminated. 31 | 32 | This function is used by the parser to ignore any subsequent system calls. *) 33 | end 34 | 35 | 36 | module type S = 37 | sig 38 | val parse_trace_fd : 39 | string option 40 | -> Unix.file_descr 41 | -> Syntax.trace Syntax.stream 42 | (** Reads strace output from a file descriptor and parses it 43 | to produce a stream of traces. 44 | 45 | This file descriptor can correspond to a pipe, so this enables 46 | to run the analysis while executing the build 47 | (online analysis). *) 48 | 49 | val parse_trace_file : 50 | string option 51 | -> string 52 | -> Syntax.trace Syntax.stream 53 | (** Parses a trace file (produced by the strace tool) and 54 | produces a stream of traces. 55 | 56 | For memory efficiency and in order to handle large files of 57 | execution traces, every line of the file is parsed only when it 58 | is needed (i.e. only when the resulting trace is used). *) 59 | end 60 | 61 | 62 | module Make (T : ToolParserType) : S 63 | (** Functor for building an implementation of parser given a 64 | a tool type that gives the rule for identifying tool-related 65 | debug messages which are useful for detecting what kind 66 | of tool-related resources are executed each time. *) 67 | -------------------------------------------------------------------------------- /src/analysis/fault_detection.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | type t = 18 | {faults: Fault.fault_collection; 19 | stats: Stats.t; 20 | } 21 | 22 | 23 | module type ToolType = 24 | sig 25 | type tool_options 26 | 27 | type tool_info 28 | 29 | val ignore_dirs : bool 30 | 31 | val filter_resource : tool_options -> string -> bool 32 | 33 | val filter_conflict : Analyzer.file_acc_t * Analyzer.file_acc_t -> bool 34 | 35 | val adapt_tasks : string -> string -> Graph.graph -> string * string 36 | 37 | val refine_analysis_out : 38 | tool_options 39 | -> Analyzer.analysis_out 40 | -> (Analyzer.analysis_out * Task_info.task_info * tool_info) 41 | (** Refines graph generated by the trace analyzer. 42 | 43 | This is done through a static analysis on tool-specific entities. 44 | This step is entirely specific to tool and it is also an 45 | optional step. *) 46 | 47 | val process_file_access : 48 | string 49 | -> tool_options 50 | -> Analyzer.file_acc_t list 51 | -> (Analyzer.analysis_out * tool_info) 52 | -> t 53 | -> t 54 | 55 | val process_access_conflict : 56 | string 57 | -> tool_options 58 | -> Analyzer.file_acc_t * Analyzer.file_acc_t 59 | -> (Analyzer.analysis_out * tool_info) 60 | -> t 61 | -> t 62 | end 63 | 64 | 65 | module type S = 66 | sig 67 | type tool_options 68 | (** Type representing user-specified tool options. *) 69 | 70 | val detect_faults : 71 | ?print_stats: bool 72 | -> ?graph_format: Graph.graph_format 73 | -> Stats.t 74 | -> string option 75 | -> tool_options 76 | -> Analyzer.analysis_out 77 | -> unit 78 | (** Detects and reports faults to standard output. 79 | This function exploits and the trace analysis output, 80 | and refines it through a tool-specific analysis. *) 81 | end 82 | 83 | 84 | module Make (T : ToolType) : S with type tool_options = T.tool_options 85 | (** A functor for building the implementation of an analyzer 86 | that detects missing dependencies using the task graph 87 | of the tool. *) 88 | -------------------------------------------------------------------------------- /src/analysis/stats.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Util 19 | 20 | 21 | type t = 22 | {analysis_time: float; 23 | bug_detection_time: float; 24 | files: int; 25 | tasks: StringSet.t; 26 | conflicts: int; 27 | dfs_traversals: int; 28 | entries: int; 29 | time_counter: float option; 30 | } 31 | 32 | 33 | let begin_counter stats = 34 | { stats with time_counter = Some (Unix.gettimeofday ()); } 35 | 36 | 37 | let add_analysis_time stats = 38 | match stats with 39 | | { time_counter = None; _ } -> stats 40 | | { time_counter = Some v; _ } -> 41 | let t = Unix.gettimeofday () in 42 | { stats with analysis_time = t -. v} 43 | 44 | 45 | let add_bug_detection_time stats = 46 | match stats with 47 | | { time_counter = None; _ } -> stats 48 | | { time_counter = Some v; _ } -> 49 | let t = Unix.gettimeofday () in 50 | { stats with bug_detection_time = t -. v} 51 | 52 | 53 | let add_trace_entry stats = 54 | { stats with entries = 1 + stats.entries } 55 | 56 | 57 | let add_task task stats = 58 | { stats with tasks = task ++ stats.tasks } 59 | 60 | 61 | let add_files files stats = 62 | { stats with files = files } 63 | 64 | 65 | let add_conflict stats = 66 | { stats with conflicts = 1 + stats.conflicts } 67 | 68 | 69 | let add_dfs_taversal stats = 70 | { stats with dfs_traversals = 1 + stats.dfs_traversals } 71 | 72 | 73 | let print_stats stats = 74 | let info_preamble, end_str = "\x1b[0;32m", "\x1b[0m" in 75 | let print_entry x y = 76 | print_endline (x ^ ": " ^ y) 77 | in 78 | begin 79 | print_endline (info_preamble ^ "Statistics"); 80 | print_endline "----------"; 81 | print_entry "Trace entries" (string_of_int stats.entries); 82 | print_entry "Tasks" (stats.tasks |> StringSet.cardinal |> string_of_int); 83 | print_entry "Files" (string_of_int stats.files); 84 | print_entry "Conflicts" (string_of_int stats.conflicts); 85 | print_entry "DFS traversals" (string_of_int stats.dfs_traversals); 86 | print_entry "Analysis time" (string_of_float stats.analysis_time); 87 | print_entry "Bug detection time" (string_of_float stats.bug_detection_time); 88 | print_string end_str; 89 | end 90 | 91 | 92 | let init_stats () = 93 | {analysis_time = 0.0; 94 | bug_detection_time = 0.0; 95 | files = 0; 96 | entries = 0; 97 | dfs_traversals = 0; 98 | conflicts = 0; 99 | tasks = StringSet.empty; 100 | time_counter = None; 101 | } 102 | -------------------------------------------------------------------------------- /src/common/util.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Str 19 | 20 | 21 | (** Implementation of a map using strings as keys *) 22 | module Strings = Map.Make(String) 23 | module Ints = Map.Make(struct type t = int let compare = Core.compare end) 24 | module StringPair = Map.Make( 25 | struct 26 | type t = (string * string) 27 | let compare = Core.compare 28 | end 29 | ) 30 | module StringSet = Set.Make(String) 31 | 32 | 33 | let path_regex = "^\\(/[^/]*\\)+/?$" 34 | 35 | 36 | let check_prefix (prefix : string) (str : string) = 37 | Core.String.is_prefix str ~prefix: prefix 38 | 39 | 40 | let is_absolute pathname = 41 | string_match (regexp path_regex) pathname 0 42 | 43 | 44 | let to_quotes str = 45 | Printf.sprintf "\"%s\"" str 46 | 47 | 48 | let rec has_elem lst elem = 49 | match lst with 50 | | h :: t -> 51 | if h = elem then true 52 | else has_elem t elem 53 | | [] -> false 54 | 55 | 56 | let string_contains s1 s2 = 57 | let re = regexp_string s2 in 58 | try 59 | let _ = search_forward re s1 0 in 60 | true 61 | with Not_found -> false 62 | 63 | 64 | let int_stream i = 65 | Stream.from (fun j -> Some (i + j)) 66 | 67 | 68 | let (~+) x = 69 | StringSet.singleton x 70 | 71 | 72 | let (~@) x = 73 | StringSet.elements x 74 | 75 | 76 | let (++) x y = 77 | StringSet.add x y 78 | 79 | 80 | let (+-) x y = 81 | StringSet.remove x y 82 | 83 | 84 | let is_address x = 85 | check_prefix "0x" x 86 | 87 | 88 | let is_null x = 89 | String.equal "NULL" x 90 | 91 | 92 | let ignore_pathname pathname = 93 | is_null pathname 94 | 95 | 96 | let extract_arg args index = 97 | List.nth (split (regexp ", ") args) index 98 | 99 | 100 | let strip_quotes pathname = 101 | String.sub pathname 1 ((String.length pathname) - 2) 102 | 103 | 104 | let dslash_regex = regexp "//" 105 | 106 | 107 | let extract_pathname index args = 108 | let pathname_str = extract_arg args index in 109 | if ignore_pathname pathname_str 110 | then None (* We don't handle the case when the argument is an address, 111 | e.g. open(0x7f3bbdf504ff, O_RDONLY). *) 112 | else if is_address pathname_str 113 | then Some (Syntax.Unknown "/UNKNOWN") 114 | else Some (Syntax.Path ( 115 | (* Revisit this for any performance issues. *) 116 | pathname_str 117 | |> strip_quotes 118 | |> Str.global_replace dslash_regex "/" 119 | |> Fpath.v 120 | |> Fpath.normalize 121 | |> Fpath.rem_empty_seg 122 | |> Fpath.to_string)) 123 | -------------------------------------------------------------------------------- /src/executor.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type option_status = 19 | | Ok (** Options are OK. *) 20 | | Err of string (** Options are invalid. It comes with an informative message. *) 21 | (** A helper type that is useful for validating user-specified options. *) 22 | 23 | 24 | type mode = 25 | | Online 26 | | Offline 27 | (** Represents the mode of analysis. 28 | It's either online or offline. *) 29 | 30 | 31 | module type ToolType = 32 | sig 33 | type tool_options 34 | (** Type representing tool-specific options specified by user. *) 35 | 36 | val validate_options : mode -> tool_options -> option_status 37 | (** A function used to validate tool-specific options 38 | that are provided by the user. *) 39 | 40 | val construct_command : tool_options -> string array 41 | (** Constructs the command to trace based on the options given by the 42 | user. *) 43 | 44 | module SysParser : Sys_parser.S 45 | (** This is the module responsible for parsing execution trace. *) 46 | 47 | module TraceAnalyzer : Analyzer.S 48 | (** This is the module responsible for analyzing generated trace. *) 49 | 50 | module FaultDetector : Fault_detection.S with type tool_options = tool_options 51 | (** This is the module responsible for detecting faults. *) 52 | 53 | end 54 | 55 | 56 | module type S = 57 | sig 58 | type generic_options = 59 | {mode: mode; (** Mode of analysis. *) 60 | graph_file: string option; (** Output task graph to the specified file. *) 61 | graph_format: Graph.graph_format; (** Format of generated task graph. *) 62 | print_stats: bool; (** Print statistics about analysis. *) 63 | trace_file: string option; (** Path to system call trace file. *) 64 | dump_tool_out: string option; (** Dump tool output to this file. *) 65 | } 66 | 67 | 68 | type tool_options 69 | (** Type representing tool-specific options specified by user. *) 70 | 71 | 72 | val online_analysis : generic_options -> tool_options -> unit 73 | (** This function traces the execution of a script , 74 | collects its system call trace. 75 | 76 | The analysis of traces is online and is done while the 77 | tool script is running. *) 78 | 79 | 80 | val offline_analysis : generic_options -> tool_options -> unit 81 | (** Performs an offline analysis of system call trace. 82 | This function expects a file where the system call trace 83 | stemming from tool execution. *) 84 | end 85 | 86 | 87 | module Make (T : ToolType) : S with type tool_options = T.tool_options 88 | (** A functor for building an implementation that is responsible for 89 | detecting faults regarding the processing of file system resources. 90 | 91 | The module is parameterised by a tool-specific module that customises 92 | analysis in various aspects, such as trace parsing, trace analysis, 93 | fault detection, etc. *) 94 | -------------------------------------------------------------------------------- /src/analysis/syntax.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type eff = 19 | | Cons 20 | | Expunge 21 | | Prod 22 | 23 | 24 | type fd_var = 25 | | CWD 26 | | Fd of string 27 | 28 | 29 | type path = 30 | | Unknown of string 31 | | Path of string 32 | 33 | 34 | type expr = 35 | | P of path 36 | | V of fd_var 37 | | At of (fd_var * path) 38 | 39 | 40 | type statement = 41 | | Let of (fd_var * expr) 42 | | Del of expr 43 | | Consume of expr 44 | | Produce of expr 45 | | Input of (string * string) 46 | | Output of (string * string) 47 | | DependsOn of (string * string) 48 | | Newproc of string 49 | | Begin_task of string 50 | | End_task of string 51 | | Nop 52 | (** The statements of BuildFS used to model all the system calls. *) 53 | 54 | 55 | type syscall_desc = 56 | {syscall: string; (** The name of the system call. *) 57 | args: string; (** The string corresponding to the arguments of the system call. *) 58 | ret: string; (** The return value of the system call. *) 59 | err: string option; (** The error type and message of a failed system call. *) 60 | line: int; (** The line where the system call appears in traces. *) 61 | } 62 | (** A record that stores all the information of a certain system 63 | call trace. *) 64 | 65 | 66 | type trace = (string * (statement * syscall_desc)) 67 | (** The type representing a statement in BuildFS. 68 | Every entry consists of a string value corresponding to PID, 69 | the BuildFS statement and the system call description. *) 70 | 71 | 72 | type 'a stream = 73 | | Stream of 'a * (unit -> 'a stream) 74 | | Empty 75 | (** A polymorphic type representing a stream. *) 76 | 77 | 78 | val main_block : string 79 | (** String representing the main execution block. *) 80 | 81 | 82 | val is_main : string -> bool 83 | (** Checks whether the given block is the main block. *) 84 | 85 | 86 | val dummy_statement : statement -> int -> trace 87 | (** Generates a dummy statement for the given statement*) 88 | 89 | 90 | val string_of_syscall : syscall_desc -> string 91 | (** This function converts a system call description into a string 92 | without including the number of the line where the system call appears. *) 93 | 94 | val string_of_syscall_desc : syscall_desc -> string 95 | (** This function converts a system call description into a string. *) 96 | 97 | 98 | val string_of_trace : (statement * syscall_desc) -> string 99 | (** This function converts an BuildFS statement along with 100 | its system call description into a string. *) 101 | 102 | 103 | val next_trace : trace stream -> trace stream 104 | (** This function expects a stream of traces and returns 105 | the next stream (if any). *) 106 | 107 | 108 | val peek_trace : trace stream -> trace option 109 | (** This function expects a stream of traces and 110 | and returns the current trace (if any). *) 111 | -------------------------------------------------------------------------------- /src/analysis/graph.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type graph 19 | (** Type for task graph. *) 20 | 21 | 22 | type node = string 23 | (** The type of nodes. *) 24 | 25 | 26 | type edge_t 27 | (** The type of edges. *) 28 | 29 | 30 | type edge_label = 31 | | Contain 32 | | Before 33 | | Include 34 | | In 35 | | In_task 36 | | Out 37 | (** This type specifies the edge labels of the graph. *) 38 | 39 | 40 | type graph_format = 41 | | Dot 42 | | Csv 43 | (** A type that represents different formats for storing task graphs. *) 44 | 45 | 46 | type graph_scan = string list list 47 | (** Type that represents the output of the DFS algorithm. 48 | 49 | In particular, this type contains all nodes that are visited by the 50 | given source node. *) 51 | 52 | 53 | val string_of_label : edge_label -> string 54 | (** Converts an edge label to a string. *) 55 | 56 | 57 | val empty_graph : unit -> graph 58 | (** Creates an empty graph. *) 59 | 60 | 61 | val add_node : node -> graph -> graph 62 | (** Adds the specified node to the task graph. *) 63 | 64 | 65 | val add_edge : node -> node -> edge_label -> graph -> graph 66 | (** Adds the specified edge to the task graph. *) 67 | 68 | 69 | val get_edges : graph -> node -> edge_t option 70 | (** Gets the edges of the graph. 71 | Returns None if graph does not contain the given node. *) 72 | 73 | 74 | val exist_edges : (node * edge_label -> bool) -> edge_t -> bool 75 | (** Iterate the given edges and checks whether there is any function 76 | that satisfies the given predicate. *) 77 | 78 | 79 | val fold_edges : ((node * edge_label) -> 'a -> 'a) -> edge_t -> 'a -> 'a 80 | (** Performs folding on the edges of the graph. *) 81 | 82 | 83 | val reachable : 84 | ?labels: edge_label list 85 | -> graph -> string -> Util.StringSet.t 86 | (** Finds the set of nodes that are reachable from the given source. *) 87 | 88 | 89 | val dfs : graph -> string -> string -> bool -> graph_scan option 90 | (** This function implements a DFS algorithm. 91 | 92 | Given a source node on a graph, this function computes 93 | all nodes that are visited by the source node. 94 | 95 | This function returns the all the paths from the source node to 96 | the target. *) 97 | 98 | 99 | val happens_before : graph -> string -> string -> graph_scan option -> bool 100 | (** Check the first build task `happens-before` the second one 101 | with regards to the given task graph. *) 102 | 103 | val is_path : 104 | (string -> edge_label -> string -> bool) 105 | -> graph 106 | -> string list 107 | -> bool 108 | 109 | 110 | val exists : graph -> string -> bool 111 | (** Check whether the given abstraction exists in the provided 112 | task graph. *) 113 | 114 | 115 | val to_dot : graph -> string -> unit 116 | (** Output the given task graph to a .dot file. *) 117 | 118 | 119 | val to_csv : graph -> string -> unit 120 | (** Output the given task graph to a csv file. *) 121 | -------------------------------------------------------------------------------- /src/analysis/analyzer.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Util 19 | 20 | 21 | type file_acc_t = Domains.abstraction_effect * Syntax.syscall_desc 22 | 23 | 24 | type f_accesses = file_acc_t list Util.Strings.t 25 | 26 | 27 | type analysis_out = { 28 | facc: f_accesses; 29 | task_graph: Graph.graph; 30 | dirs: Util.StringSet.t; 31 | } 32 | 33 | 34 | module type ToolType = 35 | sig 36 | val adapt_effect : 37 | string 38 | -> Domains.syscall_effect 39 | -> (string * Domains.abstraction_effect) 40 | end 41 | 42 | 43 | module type S = 44 | sig 45 | val analyze_traces : 46 | Stats.t 47 | -> Syntax.trace Syntax.stream 48 | -> Stats.t * analysis_out 49 | end 50 | 51 | 52 | module Make(T: ToolType) = struct 53 | 54 | let update_graph graph resource effects = 55 | match resource with 56 | | None -> graph 57 | | Some resource -> 58 | List.fold_left (fun acc (effect, sdesc) -> 59 | let key, effect' = T.adapt_effect resource effect in 60 | match Strings.find_opt key acc with 61 | | None -> Strings.add key [effect', sdesc] acc 62 | | Some effects -> 63 | Strings.add key ((effect', sdesc) :: effects) acc 64 | ) graph (Domains.unique_effects effects) 65 | 66 | 67 | let rec _analyze_traces stats traces state acc = 68 | let trace = Syntax.peek_trace traces in 69 | match trace with 70 | | Some (pid, (Syntax.End_task v, sdesc) as trace) 71 | | Some (pid, (Syntax.Begin_task v, sdesc) as trace) -> 72 | let stats = 73 | match v with 74 | | "" -> stats 75 | | v when Syntax.is_main v -> stats 76 | | v -> Stats.add_task v stats 77 | and resource = 78 | match state.Domains.o with 79 | | resource :: _ -> Some resource 80 | | [] -> None 81 | in 82 | let state = Interpreter.interpret trace state in 83 | _analyze_traces 84 | (Stats.add_trace_entry stats) 85 | (Syntax.next_trace traces) 86 | (Domains.reset_effect_store state) 87 | (update_graph acc resource (Domains.get_effects state)) 88 | | Some (pid, trace) -> 89 | _analyze_traces 90 | (Stats.add_trace_entry stats) 91 | (Syntax.next_trace traces) 92 | (Interpreter.interpret (pid, trace) state) 93 | acc 94 | | None -> 95 | stats, 96 | {facc = acc; 97 | task_graph = state.f; 98 | dirs = state.q;} 99 | 100 | let analyze_traces stats traces = 101 | let stats, aout = 102 | _analyze_traces 103 | (Stats.begin_counter stats) 104 | traces 105 | (Domains.init_state ()) 106 | Strings.empty 107 | in 108 | let stats = 109 | stats 110 | |> Stats.add_analysis_time 111 | |> Stats.add_files (Util.Strings.cardinal aout.facc) 112 | in 113 | stats, aout 114 | end 115 | -------------------------------------------------------------------------------- /src/analysis/syntax.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | exception Empty_stream 19 | 20 | 21 | type eff = 22 | | Cons 23 | | Expunge 24 | | Prod 25 | 26 | 27 | type fd_var = 28 | | CWD 29 | | Fd of string 30 | 31 | 32 | type path = 33 | | Unknown of string 34 | | Path of string 35 | 36 | 37 | type expr = 38 | | P of path 39 | | V of fd_var 40 | | At of (fd_var * path) 41 | 42 | 43 | type statement = 44 | | Let of (fd_var * expr) 45 | | Del of expr 46 | | Consume of expr 47 | | Produce of expr 48 | | Input of (string * string) 49 | | Output of (string * string) 50 | | DependsOn of (string * string) 51 | | Newproc of string 52 | | Begin_task of string 53 | | End_task of string 54 | | Nop 55 | 56 | 57 | type 'a stream = 58 | | Stream of 'a * (unit -> 'a stream) 59 | | Empty 60 | 61 | 62 | type syscall_desc = 63 | {syscall: string; 64 | args: string; 65 | ret: string; 66 | err: string option; 67 | line: int; 68 | } 69 | 70 | 71 | type trace = (string * (statement * syscall_desc)) 72 | 73 | 74 | let main_block = "main" 75 | 76 | 77 | let is_main block = 78 | String.equal block main_block 79 | 80 | 81 | let dummy_statement statement line = 82 | "", 83 | (statement, {syscall = "dummy"; 84 | args = "dumargs"; 85 | ret = "0"; 86 | err = None; 87 | line = line;}) 88 | 89 | 90 | let string_of_syscall sdesc = 91 | match sdesc with 92 | | {syscall = v1; args = v2; ret = v3; err = None; _ } -> 93 | v1 ^ "(" ^ v2 ^ ") = " ^ v3 94 | | {syscall = v1; args = v2; ret = v3; err = Some err; _ } -> 95 | v1 ^ "(" ^ v2 ^ ") = " ^ v3 ^ " " ^ err 96 | 97 | 98 | let string_of_syscall_desc sdesc = 99 | match sdesc with 100 | | {syscall = v1; args = v2; ret = v3; err = None; line = v4 } -> 101 | "#" ^ (string_of_int v4) ^ " " ^ v1 ^ "(" ^ v2 ^ ") = " ^ v3 102 | | {syscall = v1; args = v2; ret = v3; err = Some err; line = v5} -> 103 | "#" ^ (string_of_int v5) ^ " " ^ v1 ^ "(" ^ v2 ^ ") = " ^ v3 ^ " " ^ err 104 | 105 | 106 | let string_of_line line = 107 | "(" ^ (string_of_int line) ^ ")" 108 | 109 | 110 | let string_of_path path = 111 | match path with 112 | | Path x | Unknown x -> x 113 | 114 | 115 | let string_of_varfd d = 116 | match d with 117 | | CWD -> "fd0" 118 | | Fd f -> "fd" ^ f 119 | 120 | 121 | let string_of_expr e = 122 | match e with 123 | | P p -> string_of_path p 124 | | V v -> string_of_varfd v 125 | | At (v, p) -> (string_of_path p) ^ " at " ^ (string_of_varfd v) 126 | 127 | 128 | let string_of_trace (trace, sdesc) = 129 | let line_str = string_of_line sdesc.line in 130 | let str_list = ( 131 | match trace with 132 | | Begin_task t -> ["task"; t; "{"; line_str;] 133 | | End_task _ -> ["}"; line_str;] 134 | | Nop -> ["nop"] 135 | | Let (v, e) -> ["let"; string_of_varfd v; "="; string_of_expr e; line_str;] 136 | | Del e -> ["del(fd"; string_of_expr e; line_str; ] 137 | | Newproc f -> ["newproc"; f; line_str;] 138 | | Consume e -> ["consume"; string_of_expr e; line_str;] 139 | | Produce e -> ["produce"; string_of_expr e; line_str;] 140 | | Input (t, p) -> ["input"; t; p; line_str;] 141 | | Output (t, p) -> ["output"; t; p; line_str;] 142 | | DependsOn (t1, t2) -> ["dependsOn"; t1; t2; line_str;] 143 | ) in 144 | String.concat " " str_list 145 | 146 | 147 | let next_trace traces = 148 | match traces with 149 | | Stream (_, thunk) -> thunk () 150 | | Empty -> raise Empty_stream 151 | 152 | 153 | let peek_trace traces = 154 | match traces with 155 | | Stream (v, _) -> Some v 156 | | Empty -> None 157 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | ARG IMAGE_NAME=debian:stretch 2 | FROM ${IMAGE_NAME} 3 | ARG GRADLE 4 | ARG SBUILD 5 | ARG MKCHECK 6 | 7 | 8 | RUN apt-get update && apt-get upgrade -y 9 | RUN apt-get install -y \ 10 | wget \ 11 | strace \ 12 | python3-pip \ 13 | opam \ 14 | sudo \ 15 | m4 \ 16 | vim \ 17 | build-essential \ 18 | curl \ 19 | zip \ 20 | bc \ 21 | make 22 | 23 | ENV HOME /home/buildfs 24 | ENV PROJECT_SRC=${HOME}/buildfs_src \ 25 | MKCHECK_SRC=${HOME}/mkcheck_src \ 26 | SCRIPTS_DIR=/usr/local/bin 27 | 28 | 29 | # Create the buildfs user. 30 | RUN useradd -ms /bin/bash buildfs && \ 31 | echo buildfs:buildfs | chpasswd && \ 32 | cp /etc/sudoers /etc/sudoers.bak && \ 33 | echo 'buildfs ALL=(root) NOPASSWD:ALL' >> /etc/sudoers 34 | USER buildfs 35 | WORKDIR ${HOME} 36 | 37 | 38 | WORKDIR ${HOME} 39 | # Setup OCaml compiler 40 | RUN if [ "$SBUILD" = "yes" ]; then \ 41 | opam init -y --disable-sandboxing && \ 42 | eval `opam config env` && \ 43 | opam switch create 4.07.0 ; \ 44 | else \ 45 | opam init -y && \ 46 | eval `opam config env` && \ 47 | opam switch 4.07.0 \ 48 | ; fi 49 | 50 | 51 | # Install OCaml packages 52 | RUN eval `opam config env` && \ 53 | opam install -y ppx_jane core yojson dune ounit fd-send-recv fpath 54 | 55 | RUN sudo apt install procps -y 56 | 57 | USER root 58 | WORKDIR /root 59 | 60 | # Install Kotlin 61 | RUN echo $GRADLE 62 | RUN if [ "$GRADLE" = "yes" ]; then apt install -y gradle openjdk-8-jdk; fi 63 | RUN if [ "$GRADLE" = "yes" ]; then wget -O sdk.install.sh "https://get.sdkman.io" && bash sdk.install.sh; fi 64 | RUN if [ "$GRADLE" = "yes" ]; then bash -c "source ~/.sdkman/bin/sdkman-init.sh && sdk install kotlin"; fi 65 | 66 | # Install Android SDK. 67 | ENV ANDROID_TOOLS=https://dl.google.com/android/repository/sdk-tools-linux-4333796.zip 68 | RUN if [ "$GRADLE" = "yes" ]; then apt update && apt install -y android-sdk; fi 69 | 70 | # Accept licenses. 71 | WORKDIR /root 72 | RUN if [ "$GRADLE" = "yes" ]; then update-java-alternatives --set java-1.8.0-openjdk-amd64; fi 73 | RUN if [ "$GRADLE" = "yes" ]; then wget $ANDROID_TOOLS -O tools.zip && unzip tools.zip; fi 74 | RUN if [ "$GRADLE" = "yes" ]; then yes | /root/tools/bin/sdkmanager --licenses && \ 75 | cp -r /root/licenses /usr/lib/android-sdk; fi 76 | 77 | # Copy necessary files 78 | USER buildfs 79 | WORKDIR $HOME 80 | 81 | RUN if [ "$GRADLE" = "yes" ]; then mkdir gradle-instrumentation; fi 82 | ENV ANDROID_SDK_ROOT=/usr/lib/android-sdk 83 | ENV ANDROID_HOME=/usr/lib/android-sdk 84 | 85 | # Set the appropriate permissions. 86 | RUN if [ "$GRADLE" = "yes" ]; then sudo chown -R buildfs:buildfs ${ANDROID_SDK_ROOT}; fi 87 | 88 | COPY ./gradle-instrumentation/buildfs-gradle-plugin ${HOME}/gradle-instrumentation 89 | COPY ./gradle-instrumentation/fsgradle-gradle ${SCRIPTS_DIR} 90 | 91 | # Build Gradle plugin 92 | WORKDIR $HOME/gradle-instrumentation 93 | RUN if [ "$GRADLE" = "yes" ]; then gradle build; fi 94 | 95 | # Set the environement variable pointint to the Gradle plugin. 96 | ENV ANDROID_SDK_ROOT=/usr/lib/android-sdk 97 | ENV ANDROID_HOME=/usr/lib/android-sdk 98 | ENV PLUGIN_JAR_DIR=$HOME/gradle-instrumentation/build/libs/ 99 | 100 | # sbuild 101 | USER root 102 | WORKDIR /root 103 | 104 | RUN if [ "$SBUILD" = "yes" ]; then apt install -y sbuild schroot debootstrap; fi 105 | 106 | # INSTALL sbuild 107 | RUN if [ "$SBUILD" = "yes" ]; then sbuild-adduser root; fi 108 | RUN if [ "$SBUILD" = "yes" ]; then sbuild-adduser buildfs; fi 109 | RUN if [ "$SBUILD" = "yes" ]; then sbuild-createchroot --include=eatmydata,ccache,gnupg stable /srv/chroot/stable-amd64-sbuild http://deb.debian.org/debian; fi 110 | RUN if [ "$SBUILD" = "yes" ]; then sbuild-createchroot --include=eatmydata,ccache,gnupg stretch /srv/chroot/stretch-amd64-sbuild http://deb.debian.org/debian; fi 111 | 112 | # DIRECTORY TO SAVE STATS 113 | RUN if [ "$SBUILD" = "yes" ]; then mkdir -p /var/log/sbuild/stats; fi 114 | RUN if [ "$SBUILD" = "yes" ]; then chown -R buildfs /var/log/sbuild; fi 115 | 116 | USER buildfs 117 | WORKDIR ${HOME} 118 | # Add project files 119 | # Setup the environment 120 | ADD ./entrypoint ${SCRIPTS_DIR} 121 | ADD ./make-instrumentation ${SCRIPTS_DIR} 122 | 123 | RUN mkdir ${PROJECT_SRC} 124 | ADD ./src ${PROJECT_SRC}/src 125 | ADD ./dune-project ${PROJECT_SRC}/dune-project 126 | ADD ./buildfs.opam ${PROJECT_SRC}/buildfs.opam 127 | 128 | RUN sudo chown -R buildfs:buildfs ${PROJECT_SRC} 129 | RUN echo "eval `opam config env`" >> ${HOME}/.bashrc 130 | 131 | # Build buildfs 132 | WORKDIR ${PROJECT_SRC} 133 | RUN eval `opam config env` && dune build -p buildfs && dune install 134 | 135 | USER buildfs 136 | WORKDIR ${HOME} 137 | 138 | # mkcheck 139 | ADD ./mkcheck-sbuild/ mkcheck-sbuild/ 140 | RUN if [ "$MKCHECK" = "yes" ]; then sudo cp ./mkcheck-sbuild/fuzz_test /usr/local/bin/ ;fi 141 | RUN if [ "$MKCHECK" = "yes" ]; then sudo cp ./mkcheck-sbuild/run-mkcheck /usr/local/bin/ ;fi 142 | RUN if [ "$MKCHECK" = "yes" ]; then mkdir ${MKCHECK_SRC} ;fi 143 | RUN if [ "$MKCHECK" = "yes" ]; then cd ${MKCHECK_SRC} ;fi 144 | RUN if [ "$MKCHECK" = "yes" ]; then sudo apt-get install -y cmake clang libboost-all-dev bc python-pip python-yaml ;fi 145 | RUN if [ "$MKCHECK" = "yes" ]; then pip install requests beautifulsoup4 ;fi 146 | RUN if [ "$MKCHECK" = "yes" ]; then git clone https://github.com/nandor/mkcheck ;fi 147 | RUN if [ "$MKCHECK" = "yes" ]; then cd mkcheck && git checkout 09f520ce5ceceb42c2371d9df6f83b045223f260 && \ 148 | cp ../mkcheck-sbuild/syscall.cpp mkcheck/syscall.cpp && \ 149 | mkdir Release && cd Release && \ 150 | cmake .. -DCMAKE_BUILD_TYPE=Release -DCMAKE_CXX_COMPILER=clang++ && \ 151 | make && sudo install ./mkcheck /usr/local/bin/ ;fi 152 | 153 | USER buildfs 154 | WORKDIR ${HOME} 155 | 156 | # sbuild configuration files 157 | RUN mkdir buildfs-sbuild 158 | ADD ./buildfs-sbuild buildfs-sbuild 159 | 160 | USER root 161 | RUN if [ "$SBUILD" = "yes" ]; then cp ./buildfs-sbuild/sbuildrc /root/.sbuildrc; fi 162 | RUN if [ "$SBUILD" = "yes" ]; then cp ./buildfs-sbuild/fstab /etc/schroot/sbuild/fstab; fi 163 | RUN if [ "$SBUILD" = "yes" ]; then cp ./buildfs-sbuild/run-buildfs /usr/local/bin/; fi 164 | USER buildfs 165 | RUN if [ "$SBUILD" = "yes" ]; then cp ./buildfs-sbuild/sbuildrc /home/buildfs/.sbuildrc; fi 166 | 167 | 168 | ENTRYPOINT ["process-project.sh"] 169 | -------------------------------------------------------------------------------- /src/executor.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | type option_status = 19 | | Ok 20 | | Err of string 21 | 22 | 23 | type mode = 24 | | Online 25 | | Offline 26 | 27 | 28 | module type ToolType = 29 | sig 30 | type tool_options 31 | 32 | val validate_options : mode -> tool_options -> option_status 33 | 34 | val construct_command : tool_options -> string array 35 | 36 | module SysParser : Sys_parser.S 37 | 38 | module TraceAnalyzer : Analyzer.S 39 | 40 | module FaultDetector : Fault_detection.S with type tool_options = tool_options 41 | 42 | end 43 | 44 | 45 | module type S = 46 | sig 47 | type generic_options = 48 | {mode: mode; 49 | graph_file: string option; 50 | graph_format: Graph.graph_format; 51 | print_stats: bool; 52 | trace_file: string option; 53 | dump_tool_out: string option; 54 | } 55 | 56 | type tool_options 57 | 58 | val online_analysis : generic_options -> tool_options -> unit 59 | 60 | val offline_analysis : generic_options -> tool_options -> unit 61 | end 62 | 63 | 64 | module Make(T: ToolType) = struct 65 | 66 | let syscalls = [ 67 | "access"; 68 | "chdir"; 69 | "chmod"; 70 | "chown"; 71 | "clone"; 72 | "close"; 73 | "dup"; 74 | "dup2"; 75 | "dup3"; 76 | "execve"; 77 | "fchdir"; 78 | "fchmodat"; 79 | "fchownat"; 80 | "fcntl"; 81 | "fork"; 82 | "getxattr"; 83 | "getcwd"; 84 | "lchown"; 85 | "lgetxattr"; 86 | "lremovexattr"; 87 | "lsetxattr"; 88 | "lstat"; 89 | "link"; 90 | "linkat"; 91 | "mkdir"; 92 | "mkdirat"; 93 | "mknod"; 94 | "open"; 95 | "openat"; 96 | "readlink"; 97 | "readlinkat"; 98 | "removexattr"; 99 | "rename"; 100 | "renameat"; 101 | "rmdir"; 102 | "stat"; 103 | "statfs"; 104 | "symlink"; 105 | "symlinkat"; 106 | "unlink"; 107 | "unlinkat"; 108 | "utime"; 109 | "utimensat"; 110 | "utimes"; 111 | "vfork"; 112 | "write"; 113 | "writev"; 114 | ] 115 | 116 | type generic_options = 117 | {mode: mode; 118 | graph_file: string option; 119 | graph_format: Graph.graph_format; 120 | print_stats: bool; 121 | trace_file: string option; 122 | dump_tool_out: string option; 123 | } 124 | 125 | 126 | type tool_options = T.tool_options 127 | 128 | 129 | type read_point = 130 | | File of string 131 | | FileDesc of Unix.file_descr 132 | 133 | 134 | let child_failed_status_code = 255 135 | 136 | 137 | let make_executor_err msg = 138 | raise (Errors.Error (Errors.ExecutorError, Some msg)) 139 | 140 | 141 | let string_of_unix_err err call params = 142 | Printf.sprintf "%s: %s (%s)" (Unix.error_message err) call params 143 | 144 | 145 | let trace_execution generic_options tool_options input = 146 | let tool_cmd = T.construct_command tool_options in 147 | let prog = "/usr/bin/strace" in 148 | let fd_out = input |> Fd_send_recv.int_of_fd |> string_of_int in 149 | let strace_cmd = [| 150 | "strace"; 151 | "-s"; 152 | "300"; 153 | "-e"; 154 | (String.concat "," syscalls); 155 | "-o"; 156 | ("/dev/fd/" ^ fd_out); 157 | "-f"; |] 158 | in 159 | let cmd = Array.append strace_cmd tool_cmd in 160 | try 161 | print_endline ("\x1b[0;32mInfo: Start tracing command: " 162 | ^ (String.concat " " (Array.to_list tool_cmd)) ^ " ...\x1b[0m"); 163 | let out = 164 | match generic_options.dump_tool_out with 165 | | None -> "/dev/null" 166 | | Some tool_out -> tool_out 167 | in 168 | let fd = Unix.openfile out [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o640 in 169 | let _ = Unix.dup2 fd Unix.stdout in 170 | let _ = Unix.dup2 fd Unix.stderr in 171 | let _ = Unix.close fd in 172 | ignore (Unix.execv prog cmd); 173 | exit 254; (* We should never reach here. *) 174 | with Unix.Unix_error (err, call, params) -> 175 | (* Maybe strace is not installed in the system. 176 | So, we pass the exception to err to the pipe 177 | so that it can be read by the parent process. *) 178 | let msg = string_of_unix_err err call params in 179 | begin 180 | ignore (Unix.write input (Bytes.of_string msg) 0 (String.length msg)); 181 | Unix.close input; 182 | exit child_failed_status_code; 183 | end 184 | 185 | 186 | let analyze_trace_internal read_p debug_trace generic_options tool_options = 187 | let stats, aout = 188 | match read_p with 189 | | File p -> 190 | p 191 | |> T.SysParser.parse_trace_file debug_trace 192 | |> T.TraceAnalyzer.analyze_traces (Stats.init_stats ()) 193 | | FileDesc p -> 194 | p 195 | |> T.SysParser.parse_trace_fd debug_trace 196 | |> T.TraceAnalyzer.analyze_traces (Stats.init_stats ()) 197 | in 198 | T.FaultDetector.detect_faults 199 | ~print_stats: generic_options.print_stats 200 | ~graph_format: generic_options.graph_format 201 | stats generic_options.graph_file tool_options aout 202 | 203 | 204 | let online_analysis generic_options tool_options = 205 | let output, input = Unix.pipe () in 206 | (* We create a child process that is responsible for invoking 207 | strace and run the build script in parallel. *) 208 | match Unix.fork () with 209 | | 0 -> 210 | Unix.close output; 211 | trace_execution generic_options tool_options input 212 | | pid -> ( 213 | Unix.close input; 214 | analyze_trace_internal 215 | (FileDesc output) generic_options.trace_file generic_options tool_options; 216 | try 217 | Unix.kill pid Sys.sigkill; 218 | Unix.close output; 219 | with Unix.Unix_error _ -> ()) 220 | | exception Unix.Unix_error (err, call, params) -> 221 | params |> string_of_unix_err err call |> make_executor_err 222 | 223 | 224 | let offline_analysis generic_options tool_options = 225 | match generic_options.trace_file with 226 | | None -> make_executor_err "Offline analysis requires trace file" 227 | | Some trace_file -> 228 | analyze_trace_internal (File trace_file) None generic_options tool_options 229 | end 230 | -------------------------------------------------------------------------------- /src/main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Buildfs 19 | 20 | 21 | let handle_error err msg = 22 | match msg with 23 | | None -> 24 | begin 25 | Printf.eprintf "Error: %s" (Errors.string_of_error err); 26 | exit 1; 27 | end 28 | | Some msg -> 29 | begin 30 | Printf.eprintf "Error: %s: %s" (Errors.string_of_error err) msg; 31 | exit 1; 32 | end 33 | 34 | 35 | let format_of_string = function 36 | | "dot" -> Graph.Dot 37 | | "csv" -> Graph.Csv 38 | | _ -> 39 | begin 40 | Printf.eprintf "Format must be either 'dot' or 'csv'"; 41 | exit 1; 42 | end 43 | 44 | 45 | let mode_of_string = function 46 | | "online" -> Executor.Online 47 | | "offline" -> Executor.Offline 48 | | _ -> 49 | begin 50 | Printf.eprintf "Mode must be either 'online' or 'offline'"; 51 | exit 1; 52 | end 53 | 54 | 55 | let gradle_tool = 56 | let open Core.Command.Let_syntax in 57 | Core.Command.basic 58 | ~summary:"This is the sub-command for analyzing and detecting faults in Gradle scripts" 59 | [%map_open 60 | let build_task = 61 | flag "build-task" (optional string) 62 | ~doc:"Build task to execute" 63 | and build_dir = 64 | flag "build-dir" (optional_with_default (Sys.getcwd ()) string) 65 | ~doc:"Build directory" 66 | and mode = 67 | flag "mode" (required (Arg_type.create mode_of_string)) 68 | ~doc: "Analysis mode; either online or offline" 69 | and trace_file = 70 | flag "trace-file" (optional string) 71 | ~doc:"Path to trace file produced by the 'strace' tool." 72 | and dump_tool_out = 73 | flag "dump-tool-out" (optional string) 74 | ~doc: "File to store output from Gradle execution (for debugging only)" 75 | and graph_format = 76 | flag "graph-format" (optional_with_default Graph.Dot (Arg_type.create format_of_string)) 77 | ~doc: "Format for storing the task graph of the BuildFS program." 78 | and graph_file = 79 | flag "graph-file" (optional string) 80 | ~doc: "File to store the task graph inferred by BuildFS." 81 | and print_stats = 82 | flag "print-stats" (no_arg) 83 | ~doc: "Print stats about execution and analysis" 84 | in 85 | fun () -> 86 | let module GradleExecutor = Executor.Make(Gradle) in 87 | let open GradleExecutor in 88 | let gradle_options = 89 | {Build_options.build_task = build_task; 90 | Build_options.build_dir = build_dir; 91 | Build_options.ignore_mout = false; 92 | Build_options.build_db = None; 93 | } 94 | in 95 | let generic_options = 96 | {GradleExecutor.trace_file = trace_file; 97 | GradleExecutor.dump_tool_out = dump_tool_out; 98 | GradleExecutor.mode = mode; 99 | GradleExecutor.graph_file = graph_file; 100 | GradleExecutor.graph_format = graph_format; 101 | GradleExecutor.print_stats = print_stats;} 102 | in 103 | match Gradle.validate_options generic_options.mode gradle_options with 104 | | Executor.Err err -> 105 | Printf.eprintf "Error: %s. Run command with -help" err; 106 | exit 1 107 | | Executor.Ok -> 108 | try 109 | match generic_options with 110 | | { mode = Online; _; } -> 111 | online_analysis generic_options gradle_options 112 | | { mode = Offline; _; } -> 113 | offline_analysis generic_options gradle_options 114 | with Errors.Error (err, msg) -> handle_error err msg 115 | ] 116 | 117 | 118 | let make_tool = 119 | let open Core.Command.Let_syntax in 120 | Core.Command.basic 121 | ~summary:"This is the sub-command for analyzing and detecting faults in Make scripts" 122 | [%map_open 123 | let build_dir = 124 | flag "build-dir" (optional_with_default (Sys.getcwd ()) string) 125 | ~doc:"Build directory" 126 | and build_db = 127 | flag "build-db" (optional string) 128 | ~doc: "Path to Make database" 129 | and mode = 130 | flag "mode" (required (Arg_type.create mode_of_string)) 131 | ~doc: "Analysis mode; either online or offline" 132 | and trace_file = 133 | flag "trace-file" (optional string) 134 | ~doc:"Path to trace file produced by the 'strace' tool." 135 | and dump_tool_out = 136 | flag "dump-tool-out" (optional string) 137 | ~doc: "File to store output from Make execution (for debugging only)" 138 | and graph_format = 139 | flag "graph-format" (optional_with_default Graph.Dot (Arg_type.create format_of_string)) 140 | ~doc: "Format for storing the task graph of the BuildFS program." 141 | and graph_file = 142 | flag "graph-file" (optional string) 143 | ~doc: "File to store the task graph inferred by BuildFS." 144 | and print_stats = 145 | flag "print-stats" (no_arg) 146 | ~doc: "Print stats about execution and analysis" 147 | in 148 | fun () -> 149 | let module MakeExecutor = Executor.Make(Make) in 150 | let open MakeExecutor in 151 | let make_options = 152 | {Build_options.build_task = None; 153 | Build_options.build_dir = build_dir; 154 | Build_options.ignore_mout = true; 155 | Build_options.build_db = build_db; 156 | } 157 | in 158 | let generic_options = 159 | {MakeExecutor.trace_file = trace_file; 160 | MakeExecutor.dump_tool_out = dump_tool_out; 161 | MakeExecutor.mode = mode; 162 | MakeExecutor.graph_file = graph_file; 163 | MakeExecutor.graph_format = graph_format; 164 | MakeExecutor.print_stats = print_stats;} 165 | in 166 | match Make.validate_options generic_options.mode make_options with 167 | | Executor.Err err -> 168 | Printf.eprintf "Error: %s. Run command with -help" err; 169 | exit 1 170 | | Executor.Ok -> 171 | try 172 | match generic_options with 173 | | { mode = Online; _; } -> 174 | online_analysis generic_options make_options 175 | | { mode = Offline; _; } -> 176 | offline_analysis generic_options make_options 177 | with Errors.Error (err, msg) -> handle_error err msg 178 | ] 179 | 180 | let () = 181 | Core.Command.group 182 | ~summary:"Detecting faults in Parallel and Incremental Builds." 183 | [ 184 | "gradle-build", gradle_tool; 185 | "make-build", make_tool; 186 | 187 | ] |> Core.Command.run 188 | -------------------------------------------------------------------------------- /src/analysis/domains.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | exception DomainError of string 19 | (** Exception that is raised when we perform invalid operations 20 | on the analysis state. *) 21 | 22 | 23 | type syscall_effect = 24 | | Create of string 25 | | Read of string 26 | | Remove of string 27 | | Touch of string 28 | | Write of string 29 | (** Type that holds the effect that a system call might have 30 | on the file system. *) 31 | 32 | 33 | type abstraction_effect = 34 | | Consumed of string 35 | | Modified of string 36 | | Produced of string 37 | | Expunged of string 38 | (** Type that holds the effects that higher-level constructs, such as 39 | build tasks, might have on the file system. *) 40 | 41 | 42 | type effect = (syscall_effect * Syntax.syscall_desc) 43 | (** A type that represents an effect of a system call.*) 44 | 45 | 46 | type process = string 47 | (** Type that represents a process. *) 48 | 49 | 50 | type addr_t 51 | (** Type representing the address used to store file descriptor table 52 | and working directory of a process. *) 53 | 54 | 55 | type fd = string 56 | (** Type that represents a file descriptor. *) 57 | 58 | 59 | type filename = string 60 | (** Type that represents a file name. *) 61 | 62 | 63 | type effect_store 64 | (** A list that contains the effect of a system call on the file system. *) 65 | 66 | 67 | type proc_store 68 | 69 | 70 | type proc_fd_store 71 | (** The type that represents the file descriptor table of a process. *) 72 | 73 | 74 | type fd_store 75 | (** The type for the file descriptor table. *) 76 | 77 | 78 | type cwd_store 79 | (** The type for the current working directory table. *) 80 | 81 | 82 | type symlink_store 83 | (** The type for the symbolic link table. *) 84 | 85 | 86 | type task_block = string list 87 | (** The type that represents the ID of the current execution block. *) 88 | 89 | 90 | type parent_process = string option 91 | (** The type that represents the process of the tool. *) 92 | 93 | 94 | type state = 95 | {k: proc_store; 96 | r: fd_store; 97 | c: effect_store; 98 | d: cwd_store; 99 | s: symlink_store; 100 | g: int Stream.t; 101 | b: task_block; 102 | o: task_block; 103 | z: parent_process; 104 | f: Graph.graph; 105 | q: Util.StringSet.t; 106 | e: string option; 107 | } 108 | (** Abstract type that represents the state in BuildFS. *) 109 | 110 | 111 | val gen_addr : state -> addr_t 112 | (** Generates a fresh address. *) 113 | 114 | 115 | val init_state : unit -> state 116 | (** Initializes the state of the analysis. *) 117 | 118 | 119 | val get_effects : state -> effect list 120 | (** Retrieves the list of the effects of the current execution block. *) 121 | 122 | 123 | val reset_effect_store : state -> state 124 | (** Resets the effect store from the given state. *) 125 | 126 | 127 | val find_from_cwdtable : process -> proc_store -> cwd_store -> filename option 128 | (** This function gets the filename of the working directory 129 | of the given process. *) 130 | 131 | 132 | val find_proc_fdtable : process 133 | -> proc_store 134 | -> fd_store 135 | -> proc_fd_store option 136 | (** This function gets the file descriptor table of a process. *) 137 | 138 | 139 | val find_from_fdtable : process -> fd -> proc_store -> fd_store -> filename option 140 | (** This function finds the filename that corresponds to an open 141 | file descriptor with regards to the table of the provided process. *) 142 | 143 | 144 | val find_from_symtable : filename -> symlink_store -> filename option 145 | (** Gets the path to which the given inode points. *) 146 | 147 | 148 | val find_from_proctable : process -> proc_store -> (addr_t * addr_t) option 149 | (** Finds the pair of addresses of a processes. 150 | 151 | These addresses are used to store the working directory and 152 | the file descriptor table of that process respectively. *) 153 | 154 | 155 | val add_to_cwdtable : process -> filename -> proc_store -> cwd_store -> cwd_store 156 | (** This functions add a new entry to the table of working directories. 157 | Specifically, it associates a process with its current working directory. *) 158 | 159 | 160 | val add_to_fdtable : process 161 | -> fd 162 | -> filename option 163 | -> proc_store 164 | -> fd_store 165 | -> fd_store 166 | (** This function adds a new entry to the file descriptor table. 167 | It creates an entry with the given file descriptor and filename to 168 | the file descriptor table of the current process. *) 169 | 170 | 171 | val add_to_symtable : filename -> filename -> symlink_store -> symlink_store 172 | (** This function adds a new entry to the symbolic link table. *) 173 | 174 | 175 | val remove_from_fdtable : process -> fd -> proc_store -> fd_store -> fd_store 176 | (** This function removes an entry (i.e., pid, fd) from the file 177 | file descriptor table. *) 178 | 179 | 180 | val init_proc_cwdtable : addr_t -> cwd_store -> cwd_store 181 | (** Initializes the working directory of a process 182 | stored in the given address. *) 183 | 184 | 185 | val init_proc_fdtable : addr_t -> fd_store -> fd_store 186 | (** Initializes the file descriptor table of a process 187 | stored in the given address. *) 188 | 189 | 190 | val add_to_proctable : process 191 | -> addr_t 192 | -> addr_t 193 | -> proc_store 194 | -> proc_store 195 | (** Adds the given addresses to the process table of the specified process. *) 196 | 197 | 198 | val copy_cwdtable : process -> addr_t -> proc_store -> cwd_store -> cwd_store 199 | (** It copies the working directory of the first process to the second one. *) 200 | 201 | 202 | val copy_fdtable : process -> addr_t -> proc_store -> fd_store -> fd_store 203 | (** It copies the file descriptor table of the first process to the 204 | second one. *) 205 | 206 | 207 | val copy_fd : process -> fd -> fd -> proc_store -> fd_store -> fd_store 208 | (** This function copies the file descriptor of a given process. *) 209 | 210 | 211 | val add_effect : effect_store -> (syscall_effect * Syntax.syscall_desc) -> effect_store 212 | (** This function adds the effect of a particular system call to the list of effects. *) 213 | 214 | 215 | val unique_effects : effect list -> effect list 216 | (** Gets the unique system calls effects from a given list. *) 217 | 218 | 219 | val get_parent_dir : process -> state -> Syntax.fd_var -> string option 220 | (** Gets the directory corresponding to the given file descriptor variable. *) 221 | 222 | 223 | val get_pathname : process -> state -> Syntax.fd_var -> Syntax.path -> Syntax.path option 224 | (** This function gets a path and a file descriptor and constructs 225 | an absolute path. 226 | 227 | If the given path is not absolute, this function interprets it as 228 | relative to the given file descriptor. *) 229 | 230 | 231 | val extract_task : abstraction_effect * Syntax.syscall_desc -> string 232 | (** Extracts the name of the task from the given effect. *) 233 | -------------------------------------------------------------------------------- /src/build/build_fault.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Build_options 19 | open Domains 20 | open Fault_detection 21 | 22 | 23 | let cache = Hashtbl.create 5000 24 | 25 | 26 | type tool_options = Build_options.tool_options 27 | 28 | 29 | type tool_info = unit 30 | 31 | 32 | let ignore_dirs = true 33 | 34 | 35 | let min = "MIN", "Missing Input" 36 | let mout = "MOUT", "Missing Output" 37 | 38 | 39 | let filter_conflict (x, y) = 40 | 41 | let t1, t2 = extract_task x, extract_task y in 42 | [ 43 | ":lint"; 44 | ":violations"; 45 | ":validatePlugin"; 46 | ":violations"; 47 | ":codenarcMain"; 48 | ":codenarcTest"; 49 | ":kapt"; 50 | ] 51 | |> List.exists (fun x -> Util.string_contains t1 x || Util.string_contains t2 x) || 52 | (Util.string_contains t1 "jar" && Util.string_contains t2 "compile") || 53 | (Util.string_contains t1 "jar" && Util.string_contains t2 "Compile") || 54 | (Util.string_contains t1 "jar" && Util.string_contains t2 "Debug") || 55 | (Util.string_contains t1 "jar" && Util.string_contains t2 "Release") || 56 | (Util.string_contains t1 "Debug" && Util.string_contains t2 "Release") || 57 | (Util.string_contains t1 "Release" && Util.string_contains t2 "Debug") 58 | 59 | 60 | let adapt_tasks x y _ = 61 | x, y 62 | 63 | 64 | let patterns = [ 65 | Str.regexp (".*/\\.transforms/.*$"); 66 | Str.regexp (".*/build/cache.*$"); 67 | Str.regexp (".*/intermediates/.*"); 68 | Str.regexp (".*/docs?$"); 69 | Str.regexp (".*build/generated/res/resValues/debug"); 70 | Str.regexp (".*LICENSE$"); 71 | Str.regexp (".*HEADER$"); 72 | Str.regexp (".*READMΕ\\(.md\\)?$"); 73 | Str.regexp (".*README.md$"); 74 | Str.regexp (".*NOTICE.*$"); 75 | Str.regexp (".*.git[a-z]*$"); 76 | Str.regexp (".*.git/.*$"); 77 | Str.regexp (".*/\\.gradle/.*$"); 78 | Str.regexp (".*/gradlew\\(.bat\\)?$"); 79 | Str.regexp (".*/publish.sh$"); 80 | Str.regexp (".*/Jenkinsfile$"); 81 | Str.regexp (".*\\.travis.yml$"); 82 | Str.regexp (".*plugin/build.gradle$"); 83 | Str.regexp (".*/gradle\\.properties$"); 84 | Str.regexp (".*/gradle/wrapper/.*"); 85 | Str.regexp (".*/build/tmp/.*"); 86 | Str.regexp (".*/settings.gradle$"); 87 | Str.regexp (".*/\\.sandbox/.*$"); 88 | Str.regexp (".*build/pluginDescriptors$"); 89 | Str.regexp (".*.AndroidManifest.xml$"); 90 | Str.regexp (".*/main/res/.*$"); 91 | Str.regexp (".*/generated/res/.*$"); 92 | Str.regexp (".*/main/assets/.*$"); 93 | Str.regexp (".*/\\.gitattributes$"); 94 | Str.regexp (".*/build$"); 95 | Str.regexp (".*/\\.jks$"); 96 | Str.regexp (".*\\.keystore$"); 97 | Str.regexp (".*\\.log$"); 98 | Str.regexp (".*\\.github$"); 99 | Str.regexp (".*\\.dependabot$"); 100 | Str.regexp (".*/subprojects$"); 101 | Str.regexp (".*/images$"); 102 | ] 103 | 104 | 105 | let filter_resource { build_dir = dir; _ } resource = 106 | not (Util.check_prefix dir resource) || 107 | List.exists (fun x -> Str.string_match x resource 0) patterns 108 | 109 | 110 | 111 | let add_fault resource (f_name, f_desc) file_acc faults = 112 | Fault.add_fault f_name f_desc resource file_acc faults 113 | 114 | 115 | let is_output resource faccs graph = 116 | faccs 117 | |> List.filter (fun (x, _) -> 118 | match x with 119 | | Produced _ -> true 120 | | _ -> false) 121 | |> List.map (fun x -> x |> extract_task |> Graph.get_edges graph) 122 | |> List.exists (fun x -> 123 | match x with 124 | | None -> false 125 | | Some edges -> Graph.exist_edges (fun (node, label) -> 126 | Util.check_prefix node resource && (label = Graph.Out)) edges) 127 | 128 | 129 | let detect_build_fault resource task task_graph add_fault f faults = 130 | match Graph.get_edges task_graph task with 131 | | None -> add_fault faults 132 | | Some edges -> 133 | if not ( 134 | Graph.exist_edges (fun (node, label) -> 135 | Util.check_prefix node resource && (f label)) edges) 136 | then add_fault faults 137 | else faults 138 | 139 | 140 | let cache_out = Hashtbl.create 15000 141 | 142 | 143 | (* This function is needed to identify indirect inputs 144 | for a a particular task. *) 145 | let is_indirect_input faccs target graph = 146 | faccs 147 | |> List.filter (fun (x, _) -> 148 | match x with 149 | | Consumed _ -> true 150 | | _ -> false) 151 | |> List.map (fun x -> x |> extract_task) 152 | |> List.exists (fun x -> 153 | if String.equal x target 154 | then false 155 | else 156 | let dfs_out = 157 | match Hashtbl.find_opt cache_out (x, target) with 158 | | Some dfs_out -> dfs_out 159 | | None -> 160 | let dfs_out = Graph.dfs graph x target false in 161 | Hashtbl.add cache_out (x, target) dfs_out; 162 | dfs_out 163 | in 164 | match dfs_out with 165 | | None | Some [] -> false 166 | | _ -> true 167 | ) 168 | 169 | 170 | let is_direct_input task resource graph = 171 | match Graph.get_edges graph task with 172 | | None -> false 173 | | Some edges -> Graph.exist_edges (fun (node, label) -> 174 | Util.check_prefix node resource && (label = Graph.In)) edges 175 | 176 | 177 | let detect_min resource faccs (aout, _) { build_dir = dir; _ } bout = 178 | if not (Util.check_prefix dir resource) 179 | then bout 180 | else 181 | if is_output resource faccs aout.Analyzer.task_graph 182 | then bout 183 | else 184 | faccs 185 | |> List.fold_left (fun bout (facc, sdesc as t) -> 186 | match facc with 187 | | Consumed task when Syntax.is_main task -> bout 188 | | Consumed task when Util.string_contains task "Release" -> bout 189 | | Consumed task when Util.string_contains task "Debug" -> bout 190 | | Consumed task when Util.string_contains task ":lint" -> bout 191 | | Consumed task when is_direct_input task resource aout.task_graph -> bout 192 | | Consumed task when is_indirect_input faccs task aout.task_graph -> bout 193 | | Consumed task -> 194 | { bout with 195 | faults = add_fault resource min t bout.faults } 196 | | _ -> bout 197 | ) bout 198 | 199 | 200 | let process_file_access resource options faccs state bout = 201 | detect_min resource faccs state options bout 202 | 203 | 204 | let process_access_conflict resource { ignore_mout = ignore_mout; _; } 205 | conflict (aout, _) bout = 206 | if ignore_mout 207 | then bout 208 | else 209 | match conflict with 210 | | (Produced x, d), (Consumed y, _) 211 | | (Consumed y, _), (Produced x, d) -> ( 212 | if String.equal x y || 213 | (Util.string_contains x "Release") || (Util.string_contains x "Debug") 214 | then bout 215 | else 216 | let faults = detect_build_fault 217 | resource 218 | x aout.Analyzer.task_graph 219 | (fun y -> 220 | match Hashtbl.find_opt cache (resource, x) with 221 | | None -> 222 | Hashtbl.add cache (resource, x) true; 223 | add_fault resource mout (Produced x, d) y 224 | | Some _ -> y) 225 | (fun y -> y = Graph.Out) 226 | bout.faults 227 | in { bout with faults = faults; }) 228 | | _ -> bout 229 | 230 | 231 | let refine_analysis_out _ analysis_out = 232 | analysis_out, Task_info.empty_task_info (), () 233 | -------------------------------------------------------------------------------- /src/analysis/graph.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Errors 19 | open Util 20 | 21 | 22 | let make_internal_error msg = 23 | raise (Error (InternalError, msg)) 24 | 25 | 26 | type node = string 27 | 28 | 29 | type edge_label = 30 | | Contain 31 | | Before 32 | | Include 33 | | In 34 | | In_task 35 | | Out 36 | 37 | 38 | type graph_format = 39 | | Dot 40 | | Csv 41 | 42 | 43 | module EdgeSet = Set.Make( 44 | struct 45 | type t = (string * edge_label) 46 | let compare = Core.compare 47 | end 48 | ) 49 | 50 | 51 | module LabelSet = Set.Make( 52 | struct 53 | type t = edge_label 54 | let compare = Core.compare 55 | end 56 | ) 57 | 58 | 59 | type edge_t = EdgeSet.t 60 | 61 | 62 | type graph_scan = string list list 63 | 64 | 65 | type graph = EdgeSet.t Strings.t 66 | 67 | 68 | let empty_graph () = 69 | Strings.empty 70 | 71 | 72 | let add_node node graph = 73 | match Strings.find_opt node graph with 74 | | None -> Strings.add node EdgeSet.empty graph 75 | | _ -> graph 76 | 77 | 78 | let add_edge source target label graph = 79 | if String.equal source target 80 | then graph 81 | else 82 | (* Adds target node if it does not exist. *) 83 | let graph = add_node target graph in 84 | match Strings.find_opt source graph, label with 85 | | Some edges, _ -> 86 | Strings.add source (EdgeSet.add (target, label) edges) graph 87 | | None, _ -> 88 | Strings.add source (EdgeSet.singleton (target, label)) graph 89 | 90 | 91 | let get_edges graph node = 92 | match Strings.find_opt node graph with 93 | | None -> None 94 | | Some edges -> 95 | if EdgeSet.is_empty edges 96 | then None 97 | else Some edges 98 | 99 | 100 | let exist_edges f edges = 101 | EdgeSet.exists f edges 102 | 103 | 104 | let fold_edges f edges acc = 105 | EdgeSet.fold f edges acc 106 | 107 | 108 | let string_of_label = function 109 | | Contain -> "contain" 110 | | Before -> "before" 111 | | Include -> "include" 112 | | Out -> "out" 113 | | In | In_task -> "in" 114 | 115 | 116 | let save_to_file file str = 117 | begin 118 | let out = open_out file in 119 | output_string out str; 120 | close_out out; 121 | end 122 | 123 | 124 | let to_dot graph file = 125 | let regex = Str.regexp "\"" in 126 | let add_brace str = 127 | str ^ "}" 128 | in 129 | "digraph {" 130 | |> Strings.fold (fun source edges acc -> 131 | EdgeSet.fold (fun (target, label) acc' -> 132 | String.concat "" [ 133 | acc'; 134 | to_quotes (Str.global_replace regex "\\\"" source); 135 | " -> "; 136 | to_quotes (Str.global_replace regex "\\\"" target); 137 | "[label="; 138 | string_of_label label; 139 | "];\n" 140 | ] 141 | ) edges (acc ^ ((to_quotes (Str.global_replace regex "\\\"" source)) ^ ";\n")) 142 | ) graph 143 | |> add_brace 144 | |> save_to_file file 145 | 146 | 147 | let to_csv graph file = 148 | "" 149 | |> Strings.fold (fun source edges acc -> 150 | EdgeSet.fold (fun (target, label) acc' -> 151 | String.concat "" [ 152 | acc'; 153 | source; 154 | ","; 155 | target; 156 | ","; 157 | string_of_label label; 158 | "\n"; 159 | ] 160 | ) edges acc) graph 161 | |> save_to_file file 162 | 163 | 164 | let reachable ?(labels=[Contain]) graph source = 165 | let rec _dfs visited stack = 166 | match stack with 167 | | [] -> visited 168 | | node :: stack -> 169 | match Strings.find_opt node graph with 170 | | None -> _dfs visited stack 171 | | Some edges -> 172 | match StringSet.find_opt node visited with 173 | | None -> 174 | edges 175 | |> EdgeSet.elements 176 | |> List.filter (fun (_, label) -> List.exists (fun x -> x = label) labels) 177 | |> List.fold_left (fun acc (node, _) -> node :: acc) stack 178 | |> _dfs (node ++ visited) 179 | | Some _ -> _dfs visited stack 180 | in 181 | _dfs StringSet.empty [source] 182 | 183 | 184 | (* A generic function that implements a DFS algorith. 185 | 186 | The output of this function is the list of paths from 187 | 188 | If the parameter `enum_paths` is None, the algorithm becomes `lightweight` 189 | and simply returns a single path. 190 | 191 | The function is tail-recursive. 192 | *) 193 | let dfs_generic graph source target enum_paths = 194 | let rec _dfs paths visited stack = 195 | match stack with 196 | | [] -> paths 197 | | (node, prev) :: stack -> 198 | let path = node :: prev in 199 | if node = target 200 | then 201 | (* If `enum_paths` is true, we need to find all 202 | paths that reach target. *) 203 | if enum_paths 204 | then _dfs (path :: paths) visited stack 205 | else path :: paths 206 | else 207 | let edges = Strings.find node graph in 208 | match StringSet.mem node visited with 209 | | false -> 210 | edges 211 | |> EdgeSet.elements 212 | |> List.fold_left (fun acc (node, _) -> (node, path) :: acc) stack 213 | |> _dfs paths (node ++ visited) 214 | | true -> 215 | if enum_paths 216 | then 217 | (* If `enum_paths` is true, we need to revisit nodes 218 | in order to compute new paths. *) 219 | edges 220 | |> EdgeSet.elements 221 | |> List.filter (fun (_, x) -> not (x = Include) && not (x = Before)) 222 | |> List.fold_left (fun acc (node, _) -> 223 | if Util.has_elem acc (node, path) 224 | then acc 225 | else (node, path) :: acc 226 | ) stack 227 | |> _dfs paths visited 228 | else _dfs paths visited stack 229 | in 230 | _dfs [] StringSet.empty [(source, [])] 231 | 232 | 233 | let dfs graph source target enum_paths = 234 | try 235 | let paths = dfs_generic graph source target enum_paths in 236 | Some paths 237 | with Not_found -> None 238 | 239 | 240 | let exists graph abstraction = 241 | Strings.mem abstraction graph 242 | 243 | 244 | let compute_dfs_out graph dfs_out source target enum_paths = 245 | match dfs_out with 246 | | None -> dfs graph source target enum_paths 247 | | dfs_out -> dfs_out 248 | 249 | 250 | let happens_before graph source target dfs_out = 251 | match compute_dfs_out graph dfs_out source target false with 252 | | None -> true 253 | (* There is not any path from the source to the target*) 254 | | Some [] -> false 255 | | _ -> true 256 | 257 | 258 | let is_contain x = 259 | x = Contain 260 | 261 | 262 | (* A helper function that converts a list to a list of pairs as follows: 263 | 264 | [1, 2, 3, 4] -> [(1, 2), (2, 3), (3, 4)]. *) 265 | let to_pairs path = 266 | let rec _to_pairs acc path = 267 | match path with 268 | | [] 269 | | [_] -> acc 270 | | x :: (y :: t) -> 271 | let acc' = (y, x) :: acc in 272 | _to_pairs acc' (y :: t) 273 | in 274 | _to_pairs [] path 275 | 276 | 277 | let is_path f graph path = 278 | let edges = to_pairs path in 279 | List.for_all (fun (x, y) -> 280 | match Strings.find_opt x graph with 281 | | None -> make_internal_error (Some ("Unreachable case.")) 282 | | Some edges -> 283 | EdgeSet.exists (fun (node, label) -> f node label y) edges 284 | ) edges 285 | -------------------------------------------------------------------------------- /src/analysis/fault.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Domains 19 | open Syntax 20 | 21 | 22 | type fault_kind = 23 | | Facc of Analyzer.file_acc_t 24 | | Conflict of (Analyzer.file_acc_t * Analyzer.file_acc_t) 25 | 26 | 27 | type fault_t = 28 | {name: string; 29 | desc: string; 30 | resource: string; 31 | kind: fault_kind; 32 | } 33 | 34 | 35 | module StrPair = Map.Make( 36 | struct 37 | type t = string * string 38 | let compare = Core.compare 39 | end 40 | ) 41 | 42 | 43 | type fault_collection = 44 | {conflicts: fault_t list StrPair.t; 45 | other: fault_t list Util.Strings.t;} 46 | 47 | 48 | let empty_faults () = 49 | {other = Util.Strings.empty; 50 | conflicts = StrPair.empty; 51 | } 52 | 53 | 54 | let construct_fault name desc resource file_acc = 55 | {name = name; 56 | desc = desc; 57 | resource = resource; 58 | kind = Facc file_acc; 59 | } 60 | 61 | 62 | let construct_conflict_fault name desc resource conflict = 63 | {name = name; 64 | desc = desc; 65 | resource = resource; 66 | kind = Conflict conflict; 67 | } 68 | 69 | 70 | let add_fault fault_name fault_desc resource file_acc faults = 71 | let t = extract_task file_acc in 72 | let fault = construct_fault fault_name fault_desc resource file_acc in 73 | match Util.Strings.find_opt t faults.other with 74 | | None -> 75 | { faults with other = Util.Strings.add t [fault] faults.other } 76 | | Some flist -> 77 | { faults with other = Util.Strings.add t (fault :: flist) faults.other } 78 | 79 | 80 | let add_conflict_fault fault_name fault_desc resource (facc1, facc2) faults = 81 | let t1, t2 = extract_task facc1, extract_task facc2 in 82 | let fault = 83 | (facc1, facc2) 84 | |> construct_conflict_fault fault_name fault_desc resource 85 | in 86 | match 87 | StrPair.find_opt (t1, t2) faults.conflicts, 88 | StrPair.find_opt (t2, t1) faults.conflicts 89 | with 90 | | None, None -> 91 | { faults with conflicts = StrPair.add (t1, t2) [fault] faults.conflicts } 92 | | Some f, None -> 93 | { faults with conflicts = StrPair.add (t1, t2) (fault :: f) faults.conflicts } 94 | | None, Some f -> 95 | { faults with conflicts = StrPair.add (t2, t1) (fault :: f) faults.conflicts } 96 | | _ -> faults 97 | 98 | 99 | let task_print_format task_name = 100 | [ 101 | "[Task: "; 102 | task_name; 103 | "]" 104 | ] 105 | |> String.concat "" 106 | 107 | 108 | let task_print_details tinfo task_name = 109 | match Task_info.get_task_desc task_name tinfo with 110 | | None -> "" 111 | | Some tdesc -> Task_info.string_of_task_desc tdesc ^ "\n" 112 | 113 | 114 | let string_of_file_acc x = 115 | let msg, sdesc = ( 116 | match x with 117 | | Consumed x, d -> "Consumed by " ^ x, d 118 | | Modified x, d -> "Modified by " ^ x, d 119 | | Produced x, d -> "Produced by " ^ x, d 120 | | Expunged x, d -> "Expunged by " ^ x, d 121 | ) in 122 | String.concat " " [ 123 | msg; 124 | "("; 125 | sdesc.syscall; 126 | "at line"; 127 | (string_of_int sdesc.line); 128 | ")"; 129 | ] 130 | 131 | 132 | let string_of_faults faults = 133 | List.fold_left (fun str {kind = kind; resource = resource; _; } -> 134 | match kind with 135 | | Conflict (x, y) -> 136 | String.concat "" [ 137 | str; 138 | " - "; 139 | resource; 140 | ": "; 141 | string_of_file_acc x; 142 | " and "; 143 | string_of_file_acc y; 144 | "\n"; 145 | ] 146 | | Facc x -> 147 | String.concat "" [ 148 | str; 149 | " - "; 150 | resource; 151 | ": "; 152 | string_of_file_acc x; 153 | "\n"; 154 | ] 155 | ) "" faults 156 | 157 | 158 | let group_task_faults task_faults = 159 | (* Groups faults by their kind (aka name). *) 160 | List.fold_left (fun acc fault -> 161 | match Util.Strings.find_opt fault.name acc with 162 | | None -> Util.Strings.add fault.name [fault] acc 163 | | Some faults -> Util.Strings.add fault.name (fault :: faults) acc 164 | ) Util.Strings.empty task_faults 165 | 166 | 167 | let report_fault_2 tinfo faults = 168 | Util.Strings.iter (fun task task_faults -> 169 | [ 170 | " \x1b[0;31m==> "; 171 | (task_print_format task); 172 | "\n"; 173 | " \x1b[0;36m"; 174 | (task_print_details tinfo task); 175 | "\x1b[0m"; 176 | ] 177 | |> String.concat "" 178 | |> print_endline; 179 | let grouped_faults = group_task_faults task_faults in 180 | Util.Strings.iter (fun fault_name task_faults -> 181 | print_endline ( " Fault Type: " ^ fault_name); 182 | print_endline (string_of_faults task_faults) 183 | ) grouped_faults 184 | ) faults.other 185 | 186 | 187 | let report_fault_details tinfo faults = 188 | StrPair.iter (fun (t1, t2) task_faults -> 189 | [ 190 | " \x1b[0;31m==> "; 191 | (task_print_format t1); 192 | " | "; 193 | (task_print_format t2); 194 | "\n"; 195 | " \x1b[0;36m"; 196 | (task_print_details tinfo t1); 197 | " "; 198 | (task_print_details tinfo t2); 199 | "\x1b[0m"; 200 | ] 201 | |> String.concat "" 202 | |> print_endline; 203 | let grouped_faults = group_task_faults task_faults in 204 | Util.Strings.iter (fun fault_name task_faults -> 205 | print_endline ( " Fault Type: " ^ fault_name); 206 | print_endline (string_of_faults task_faults) 207 | ) grouped_faults 208 | ) faults.conflicts 209 | 210 | 211 | let compute_fault_occ acc faults = 212 | List.fold_left (fun occ fault_name -> 213 | match Util.Strings.find_opt fault_name occ with 214 | | None -> Util.Strings.add fault_name 1 occ 215 | | Some i -> Util.Strings.add fault_name (i + 1) occ 216 | ) acc faults 217 | 218 | 219 | let get_occ_conflict_faults faults = 220 | StrPair.fold (fun _ task_faults acc -> 221 | task_faults 222 | |> List.map (fun { name = f; desc = d; _ } -> 223 | [d; "s"; " ("; f; ")"] |> String.concat "") 224 | |> Util.StringSet.of_list 225 | |> Util.StringSet.elements 226 | |> compute_fault_occ acc) faults Util.Strings.empty 227 | 228 | 229 | let get_occ_faults faults = 230 | Util.Strings.fold (fun _ task_faults acc -> 231 | task_faults 232 | |> List.map (fun { name = f; desc = d; _ } -> 233 | [d; "s"; " ("; f; ")"] |> String.concat "") 234 | |> Util.StringSet.of_list 235 | |> Util.StringSet.elements 236 | |> compute_fault_occ acc) faults Util.Strings.empty 237 | 238 | 239 | let print_occ_faults fault_occ = 240 | Util.Strings.iter (fun fault_name occ -> 241 | [ 242 | "Number of "; 243 | fault_name; 244 | ": "; 245 | (string_of_int occ); 246 | ] 247 | |> String.concat "" 248 | |> print_endline 249 | ) fault_occ 250 | 251 | 252 | let report_faults tinf faults = 253 | print_endline "------------------------------------------------------------"; 254 | if StrPair.cardinal faults.conflicts <> 0 || 255 | (Util.Strings.cardinal faults.other <> 0) 256 | then 257 | begin 258 | faults.other 259 | |> get_occ_faults 260 | |> print_occ_faults; 261 | faults.conflicts 262 | |> get_occ_conflict_faults 263 | |> print_occ_faults; 264 | print_endline "\nDetailed Bug Report:"; 265 | report_fault_2 tinf faults; 266 | report_fault_details tinf faults; 267 | end 268 | else print_endline "No faults found..." 269 | -------------------------------------------------------------------------------- /src/analysis/interpreter.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Errors 19 | open Domains 20 | open Util 21 | open Syntax 22 | 23 | 24 | let add_dir_when_mkdir sdesc pathname q = 25 | match sdesc with 26 | | { syscall = "mkdir"; _ } -> pathname ++ q 27 | | _ -> q 28 | 29 | 30 | let get_target_pathname state pathname = 31 | match Domains.find_from_symtable pathname state.s with 32 | | None -> pathname 33 | | Some target -> target 34 | 35 | 36 | let handle_path_effect pathname effect state sdesc = 37 | let state = { state with q = (Core.Filename.dirname pathname) ++ state.q } in 38 | let update_state = 39 | match state.o with 40 | (* The operation is done outside an execution block. *) 41 | | [] -> fun state _ -> state 42 | | _ -> fun state x -> { state with c = Domains.add_effect state.c x } 43 | in 44 | match effect with 45 | | Syntax.Cons -> 46 | let pathname = get_target_pathname state pathname in 47 | update_state state (Touch pathname, sdesc) 48 | | Syntax.Prod -> 49 | let state' = update_state state (Create pathname, sdesc) in 50 | { state' with 51 | (* They system call 'mkdir' operates on a directory. *) 52 | q = add_dir_when_mkdir sdesc pathname state'.q } 53 | | Syntax.Expunge -> 54 | update_state state (Remove pathname, sdesc) 55 | 56 | 57 | let eval_expr pid state e = 58 | match e with 59 | | Syntax.P p -> Some p 60 | | Syntax.At (v, p) -> Domains.get_pathname pid state v p 61 | | Syntax.V v -> 62 | match Domains.get_parent_dir pid state v with 63 | | None -> None 64 | | Some p -> Some (Syntax.Path p) 65 | 66 | 67 | let copy_fd pid state f1 f2 = 68 | try 69 | { state with r = Domains.copy_fd pid f1 f2 state.k state.r } 70 | with Not_found -> state 71 | 72 | 73 | let chcwd pid state p = 74 | match Domains.get_pathname pid state Syntax.CWD p with 75 | | None -> state 76 | | Some (Path cwd) | Some (Unknown cwd) -> 77 | { state with d = Domains.add_to_cwdtable pid cwd state.k state.d; } 78 | 79 | 80 | let interpret_let pid state v e = 81 | match (v, e) with 82 | | (Syntax.Fd f1, Syntax.V (Fd f2)) -> copy_fd pid state f1 f2 83 | | (Syntax.CWD, Syntax.P p) -> chcwd pid state p 84 | | _ -> 85 | match eval_expr pid state e with 86 | | None | Some (Syntax.Unknown _) -> state 87 | | Some (Syntax.Path p) -> 88 | match v with 89 | | Syntax.CWD -> chcwd pid state (Syntax.Path p) 90 | | Syntax.Fd f -> 91 | let dir = Core.Filename.dirname p in 92 | { state with 93 | r = Domains.add_to_fdtable pid f (Some p) state.k state.r; 94 | q = dir ++ state.q; (* This is for tracking directories. *) 95 | } 96 | 97 | 98 | let del_fd pid state fd = 99 | try 100 | { state with r = Domains.remove_from_fdtable pid fd state.k state.r } 101 | with Not_found -> state 102 | 103 | 104 | let interpret_del pid state sdesc e = 105 | match e with 106 | | Syntax.V (Syntax.Fd f) -> del_fd pid state f 107 | | Syntax.V Syntax.CWD -> state 108 | | _ -> 109 | match eval_expr pid state e with 110 | | None | Some (Syntax.Unknown _) -> state 111 | | Some (Syntax.Path p) -> handle_path_effect p Syntax.Expunge state sdesc 112 | 113 | 114 | let interpret_consume pid state sdesc e = 115 | match eval_expr pid state e with 116 | | None | Some (Syntax.Unknown _) -> state 117 | | Some (Syntax.Path p) -> handle_path_effect p Syntax.Cons state sdesc 118 | 119 | 120 | let interpret_produce pid state sdesc e = 121 | match eval_expr pid state e with 122 | | None | Some (Syntax.Unknown _) -> state 123 | | Some (Syntax.Path p) -> 124 | match sdesc.syscall with 125 | | "symlink" | "symlinkat" -> ( 126 | match Util.extract_pathname 0 sdesc.args with 127 | | None | Some (Syntax.Unknown _) -> 128 | handle_path_effect p Syntax.Prod state sdesc 129 | | Some (Syntax.Path link) -> 130 | let state = handle_path_effect p Syntax.Prod state sdesc in 131 | { state with s = Domains.add_to_symtable p link state.s }) 132 | | _ -> handle_path_effect p Syntax.Prod state sdesc 133 | 134 | 135 | let process_clone_none pid new_pid state = 136 | let addr = Domains.gen_addr state in 137 | let k' = Domains.add_to_proctable new_pid addr addr state.k in 138 | (* Get the working directory of the parent process 139 | and use the same for the child process. *) 140 | { state with k = k'; 141 | d = Domains.copy_cwdtable pid addr k' state.d; 142 | r = Domains.copy_fdtable pid addr k' state.r;} 143 | 144 | 145 | let interpret_newproc pid state f = 146 | try 147 | process_clone_none pid f state 148 | with Not_found -> 149 | let addr = Domains.gen_addr state in 150 | { state with k = Domains.add_to_proctable f addr addr state.k } 151 | 152 | 153 | let interpret_input _ state t p = 154 | { state with f = Graph.add_edge t p Graph.In state.f } 155 | 156 | 157 | let interpret_dependson _ state t1 t2 = 158 | { state with f = Graph.add_edge t2 t1 Graph.Before state.f } 159 | 160 | 161 | let interpret_output _ state t p = 162 | { state with f = Graph.add_edge t p Graph.Out state.f } 163 | 164 | 165 | let interpret_begin pid state _ b = 166 | match state.b, state.e with 167 | (* FIXME: Handle it in a better way. *) 168 | | [], _ -> { state with b = b::state.b; z = Some pid; o = [b]; } 169 | | b' :: l, None -> 170 | {state with 171 | b = b :: (b' :: l); 172 | o = b :: state.o; 173 | z = Some pid; 174 | f = state.f 175 | |> Graph.add_edge b b' Graph.Contain 176 | |> Graph.add_edge b' b Graph.Before; 177 | } 178 | | b' :: l, Some e -> 179 | (* Nested blocks are executed in a FIFO order. *) 180 | {state with 181 | b = b :: (b' :: l); 182 | o = b :: state.o; 183 | z = Some pid; 184 | f = state.f 185 | |> Graph.add_edge b b' Graph.Contain 186 | |> Graph.add_edge e b Graph.Before 187 | |> Graph.add_edge b' b Graph.Before; 188 | } 189 | 190 | 191 | let interpret_end _ state _ _ = 192 | match state.b with 193 | | [] -> state 194 | | t :: b -> { state with b = b; o = []; e = Some t; } 195 | 196 | 197 | let interpret (pid, (statement, sdesc)) state = 198 | match sdesc with 199 | (* We do not handle system calls that failed. *) 200 | | {err = Some _; _ } -> state 201 | | _ -> 202 | let state = 203 | match sdesc.line with 204 | | 1 -> 205 | let addr = gen_addr state in 206 | { state with k = Domains.add_to_proctable pid addr addr state.k; 207 | d = Domains.init_proc_cwdtable addr state.d; 208 | r = Domains.init_proc_fdtable addr state.r; 209 | } 210 | | _ -> state 211 | in 212 | try 213 | match statement with 214 | | Let (v, e) -> interpret_let pid state v e 215 | | Del e -> interpret_del pid state sdesc e 216 | | Consume e -> interpret_consume pid state sdesc e 217 | | Produce e -> interpret_produce pid state sdesc e 218 | | Input (t, p) -> interpret_input pid state t p 219 | | Output (t, p) -> interpret_output pid state t p 220 | | DependsOn (t1, t2) -> interpret_dependson pid state t1 t2 221 | | Newproc f -> interpret_newproc pid state f 222 | | Begin_task t -> interpret_begin pid state sdesc t 223 | | End_task t -> interpret_end pid state sdesc t 224 | | Nop -> state (* Nop does not affect the state. *) 225 | with 226 | | DomainError msg -> 227 | let msg = String.concat "" [ 228 | msg; 229 | "on "; 230 | "model: "; 231 | Syntax.string_of_trace (statement, sdesc); 232 | ] in 233 | let err = (InterpretationError sdesc) in 234 | raise (Error (err, Some msg)) 235 | -------------------------------------------------------------------------------- /src/analysis/fault_detection.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Domains 19 | open Util 20 | 21 | 22 | type t = 23 | {faults: Fault.fault_collection; 24 | stats: Stats.t; 25 | } 26 | 27 | 28 | module type ToolType = 29 | sig 30 | type tool_options 31 | 32 | type tool_info 33 | 34 | val ignore_dirs : bool 35 | 36 | val filter_resource : tool_options -> string -> bool 37 | 38 | val filter_conflict : Analyzer.file_acc_t * Analyzer.file_acc_t -> bool 39 | 40 | val adapt_tasks : string -> string -> Graph.graph -> string * string 41 | 42 | val refine_analysis_out : 43 | tool_options 44 | -> Analyzer.analysis_out 45 | -> (Analyzer.analysis_out * Task_info.task_info * tool_info) 46 | 47 | val process_file_access : 48 | string 49 | -> tool_options 50 | -> Analyzer.file_acc_t list 51 | -> (Analyzer.analysis_out * tool_info) 52 | -> t 53 | -> t 54 | 55 | val process_access_conflict : 56 | string 57 | -> tool_options 58 | -> Analyzer.file_acc_t * Analyzer.file_acc_t 59 | -> (Analyzer.analysis_out * tool_info) 60 | -> t 61 | -> t 62 | end 63 | 64 | 65 | module type S = 66 | sig 67 | type tool_options 68 | 69 | val detect_faults : 70 | ?print_stats: bool 71 | -> ?graph_format: Graph.graph_format 72 | -> Stats.t 73 | -> string option 74 | -> tool_options 75 | -> Analyzer.analysis_out 76 | -> unit 77 | end 78 | 79 | 80 | module Make(T: ToolType) = struct 81 | 82 | type tool_options = T.tool_options 83 | 84 | 85 | let cache_size = 5000 86 | (* A cache that store the result of the `Task_graph.dfs` 87 | functions. *) 88 | 89 | 90 | let dfs_cache = Hashtbl.create cache_size 91 | 92 | 93 | let ov = "OV", "Ordering Violation" 94 | 95 | 96 | let non_consumed x = 97 | match x with 98 | | Produced _, _ | Expunged _, _ -> true 99 | | _ -> false 100 | 101 | 102 | let is_consumed x = 103 | match x with 104 | | Consumed _, _ | Modified _, _ -> true 105 | | _ -> false 106 | 107 | 108 | let get_2combinations lst = 109 | let rec _get_2combinations l accum = 110 | match l with 111 | | [] -> accum 112 | | h :: t -> 113 | let accum' = accum @ (List.rev_map (fun x -> (h, x)) t) in 114 | _get_2combinations t accum' 115 | in _get_2combinations lst [] 116 | 117 | 118 | let get_cartesian lst lst' = 119 | List.concat (List.rev_map (fun x -> List.rev_map (fun y -> (x, y)) lst') lst) 120 | 121 | 122 | (** 123 | * Filters the case when a system resource is 124 | * consumed and produced by the same tool's unit. 125 | *) 126 | let get_cartesian_and_filter lst lst' = 127 | List.filter (fun (x, y) -> 128 | (extract_task x) <> (extract_task y) 129 | ) (get_cartesian lst lst') 130 | 131 | 132 | let visit_nodes stats graph task cache = 133 | match Hashtbl.find_opt dfs_cache task with 134 | | Some out -> stats, out 135 | | None -> 136 | (* Find all nodes that are reachable from 'task' with respect 137 | to the given edge labels. *) 138 | let out = Graph.reachable 139 | ~labels: [Graph.Contain; Graph.Before; Graph.Include] 140 | graph task 141 | in 142 | Hashtbl.add dfs_cache task out; 143 | Stats.add_dfs_taversal stats, out 144 | 145 | 146 | let add_fault resource conflict (f_name, f_desc) faults = 147 | Fault.add_conflict_fault f_name f_desc resource conflict faults 148 | 149 | 150 | let create_bout faults stats = 151 | {stats = stats; 152 | faults = faults; 153 | } 154 | 155 | 156 | let process_access_conflict resource options (aout, _ as t) task facc 157 | conflicts bout = 158 | let stats, out = visit_nodes bout.stats 159 | aout.Analyzer.task_graph task dfs_cache in 160 | let bout = { bout with stats = stats; } in 161 | List.fold_left (fun bout facc' -> 162 | let { faults = faults; stats = stats; } = bout in 163 | let conflict = facc, facc' in 164 | match conflict with 165 | | (Produced x, _), (Consumed y, _) 166 | | (Produced x, _), (Modified y, _) 167 | | (Produced x, _), (Produced y, _) 168 | | (Expunged x, _), (Modified y, _) 169 | | (Expunged x, _), (Consumed y, _) -> ( 170 | (* Ignore conflicts involving the main execution block. *) 171 | if Syntax.is_main x || Syntax.is_main y 172 | then bout 173 | else 174 | let bout = { bout with stats = Stats.add_conflict stats } in 175 | if T.filter_conflict conflict 176 | then create_bout faults stats 177 | else 178 | let process_non_consumed { faults = faults; stats = stats; } = 179 | if non_consumed facc' 180 | then 181 | if StringSet.mem y out 182 | then create_bout faults stats 183 | else 184 | let stats, out' = visit_nodes stats aout.task_graph y dfs_cache in 185 | if StringSet.mem x out' 186 | then create_bout faults stats 187 | else 188 | {stats = stats; 189 | faults = add_fault resource conflict ov faults} 190 | else create_bout faults stats 191 | and process_consumed { faults = faults; stats = stats; } = 192 | if is_consumed facc' 193 | then 194 | if StringSet.mem y out 195 | then create_bout faults stats 196 | else 197 | let stats, out' = visit_nodes stats aout.task_graph y dfs_cache in 198 | if StringSet.mem x out' 199 | then create_bout faults stats 200 | else create_bout (add_fault resource conflict ov faults) stats 201 | else create_bout faults stats 202 | in 203 | bout 204 | |> process_non_consumed 205 | |> process_consumed 206 | |> T.process_access_conflict resource options conflict t) 207 | | _ -> bout 208 | ) bout conflicts 209 | 210 | 211 | let ignore_resource resource dirs = 212 | String.equal "/dev/null" resource || 213 | Util.check_prefix "/proc" resource || 214 | (T.ignore_dirs && StringSet.mem resource dirs) 215 | 216 | 217 | let process_conflicts state options resource effects bout = 218 | let conflicts = 219 | match 220 | List.filter non_consumed effects, 221 | List.filter is_consumed effects 222 | with 223 | | [], _ -> Strings.empty 224 | | non_consumed, consumed -> 225 | let tasks = non_consumed @ consumed in 226 | List.fold_left (fun acc x -> 227 | let t1 = extract_task x in 228 | List.fold_left (fun acc y -> 229 | let t2 = extract_task y in 230 | if String.equal t1 t2 231 | then acc 232 | else 233 | match Strings.find_opt t1 acc, Strings.find_opt t2 acc with 234 | | None, None -> Strings.add t1 (x, [y]) acc 235 | | None, Some (y, yv) -> Strings.add t2 (y, (x :: yv)) acc 236 | | Some (x, xv), None 237 | | Some (x, xv), Some _ -> Strings.add t1 (x, (y :: xv)) acc 238 | ) acc tasks 239 | ) Strings.empty non_consumed 240 | in 241 | Strings.fold (fun task (facc, conflicts) bout -> 242 | process_access_conflict resource options state task facc conflicts bout 243 | ) conflicts bout 244 | 245 | 246 | let process_resource (aout, toolinf as t) options resource effects bout = 247 | if ignore_resource resource aout.Analyzer.dirs || 248 | T.filter_resource options resource 249 | then bout 250 | else 251 | bout 252 | |> T.process_file_access resource options effects t 253 | |> process_conflicts t options resource effects 254 | 255 | 256 | let detect_faults ?(print_stats=true) ?(graph_format=Graph.Dot) 257 | stats graph_file options analysis_out = 258 | let stats = Stats.begin_counter stats in 259 | let aout, tinfo, tool_info = T.refine_analysis_out options analysis_out in 260 | let _ = 261 | (* Stores task graph to a file in the specified format. *) 262 | match graph_format, graph_file with 263 | | _, None -> () 264 | | Graph.Dot, Some graph_file -> Graph.to_dot aout.task_graph graph_file 265 | | Graph.Csv, Some graph_file -> Graph.to_csv aout.task_graph graph_file 266 | in 267 | let {stats = stats; faults = faults; } = 268 | { stats = stats; faults = Fault.empty_faults (); } 269 | |> Strings.fold (fun resource effects acc -> 270 | process_resource (aout, tool_info) options resource effects acc 271 | ) analysis_out.facc 272 | in 273 | let _ = 274 | stats 275 | |> Stats.add_bug_detection_time 276 | |> if print_stats then Stats.print_stats else fun _ -> () 277 | in 278 | Fault.report_faults tinfo faults 279 | end 280 | -------------------------------------------------------------------------------- /src/build/make_fault.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Build_options 19 | open Domains 20 | open Fault_detection 21 | open Util 22 | 23 | 24 | type read_point = 25 | | FileDesc of Unix.file_descr 26 | | File of string 27 | 28 | 29 | let make_executor_err msg = 30 | raise (Errors.Error (Errors.ExecutorError, Some msg)) 31 | 32 | 33 | let string_of_unix_err err call params = 34 | Printf.sprintf "%s: %s (%s)" (Unix.error_message err) call params 35 | 36 | 37 | let cache = Hashtbl.create 5000 38 | let min_cache = Hashtbl.create 10000 39 | 40 | 41 | type tool_options = Build_options.tool_options 42 | 43 | 44 | type tool_info = Util.StringSet.t 45 | 46 | 47 | let ignore_dirs = true 48 | 49 | 50 | let min = "MIN", "Missing Input" 51 | let mout = "MOUT", "Missing Output" 52 | 53 | 54 | let patterns = [ 55 | Str.regexp (".*Makefile$"); 56 | Str.regexp (".*Makefile\\.[^/]"); 57 | Str.regexp (".*.git$"); 58 | Str.regexp (".*.git/.*$"); 59 | Str.regexp (".*libtool$"); 60 | Str.regexp (".*/.*\\.d$"); 61 | Str.regexp (".*/\\.gitmodules$"); 62 | ] 63 | 64 | 65 | let dep_target = Str.regexp (".*/deps/.*$") 66 | 67 | 68 | let filter_resource { build_dir = dir; _ } resource = 69 | not (Util.check_prefix dir resource) || 70 | List.exists (fun x -> Str.string_match x resource 0) patterns 71 | 72 | 73 | let filter_conflict (_, _) = 74 | false 75 | 76 | 77 | let adapt_tasks x y _ = 78 | x, y 79 | 80 | 81 | let add_fault resource (f_name, f_desc) file_acc faults = 82 | Fault.add_fault f_name f_desc resource file_acc faults 83 | 84 | 85 | let is_output resource faccs graph = 86 | faccs 87 | |> List.exists (fun (x, _) -> 88 | match x with 89 | | Produced _ -> true 90 | | _ -> false) 91 | 92 | 93 | let detect_build_fault resource task task_graph add_fault f faults = 94 | match Graph.get_edges task_graph task with 95 | | None -> add_fault faults 96 | | Some edges -> 97 | if not ( 98 | Graph.exist_edges (fun (node, label) -> 99 | Util.check_prefix node resource && (f label)) edges) 100 | then add_fault faults 101 | else faults 102 | 103 | 104 | let is_direct_input task resource graph = 105 | match Graph.get_edges graph task with 106 | | None -> false 107 | | Some edges -> Graph.exist_edges (fun (node, label) -> 108 | Util.check_prefix node resource && (label = Graph.In)) edges 109 | 110 | 111 | let detect_min resource faccs (aout, phonys) { build_dir = dir; _ } bout = 112 | if not (Util.check_prefix dir resource) 113 | then bout 114 | else 115 | if is_output resource faccs aout.Analyzer.task_graph 116 | then bout 117 | else 118 | faccs 119 | |> List.fold_left (fun bout (facc, sdesc) -> 120 | let { faults = faults; stats = stats; } = bout in 121 | (* Ignore missing input when one of the following 122 | conditions hold: 123 | 124 | * Task is the main task. 125 | * Task represents a phony target. 126 | * Resource has been declared as direct input of this task.*) 127 | match facc with 128 | | Consumed task when Syntax.is_main task -> bout 129 | | Consumed task when Util.StringSet.mem task phonys -> bout 130 | | Consumed task when is_direct_input resource task aout.task_graph -> bout 131 | | Consumed task when Str.string_match dep_target task 0 -> bout 132 | | Consumed task -> ( 133 | let stats, out = 134 | match Hashtbl.find_opt min_cache (task, resource) with 135 | | None -> 136 | let out = 137 | Graph.reachable 138 | ~labels: [Graph.In_task] 139 | aout.task_graph task 140 | in 141 | Hashtbl.add min_cache (task, resource) out; 142 | Stats.add_dfs_taversal stats, out 143 | | Some out -> stats, out 144 | in 145 | if ( 146 | Util.StringSet.exists (fun task' -> 147 | match Graph.get_edges aout.task_graph task' with 148 | | None -> false 149 | | Some edges -> Graph.exist_edges (fun (node, label) -> 150 | Util.check_prefix node resource && label = Graph.In) 151 | edges) out) 152 | then { bout with stats = stats; } 153 | else 154 | {stats = stats; 155 | faults = add_fault resource min (facc, sdesc) faults }) 156 | | _ -> bout 157 | ) bout 158 | 159 | 160 | let process_file_access resource options faccs state bout = 161 | bout |> detect_min resource faccs state options 162 | 163 | 164 | let process_access_conflict resource { ignore_mout = ignore_mout; _; } 165 | conflict (aout, _) bout = 166 | if ignore_mout 167 | then bout 168 | else 169 | match conflict with 170 | | (Produced x, _), (Consumed y, _) 171 | | (Consumed y, _), (Produced x, _) when String.equal x y -> bout 172 | | (Produced x, d), (Consumed y, _) 173 | | (Consumed y, _), (Produced x, d) -> ( 174 | let faults = detect_build_fault 175 | resource 176 | x aout.Analyzer.task_graph 177 | (fun y -> 178 | match Hashtbl.find_opt cache (resource, x) with 179 | | None -> 180 | Hashtbl.add cache (resource, x) true; 181 | add_fault resource mout (Produced x, d) y 182 | | Some _ -> y) 183 | (fun y -> y = Graph.Out) 184 | bout.faults 185 | in { bout with faults = faults; }) 186 | | _ -> bout 187 | 188 | 189 | let curdir_regex = Str.regexp "CURDIR := \\(.*\\)" 190 | let target_regex = Str.regexp "^\\([^=#%]+\\):[ ]*\\([^=#%]*\\)$" 191 | let object_regex = Str.regexp "\\(.*\\)\\.o$" 192 | let not_target_msg = "# Not a target:" 193 | 194 | 195 | let process_phony target currdir prereqs phonys = 196 | match target with 197 | | ".PHONY" -> ( 198 | match Core.String.split_on_chars ~on: [ ' ' ] prereqs with 199 | | [""] -> phonys 200 | | ptargets -> 201 | List.fold_left (fun acc x -> (currdir ^ ":" ^ x) ++ acc) phonys ptargets) 202 | | _ -> phonys 203 | 204 | 205 | let process_line (prev_target, currdir, targets, phonys) line = 206 | if String.equal line not_target_msg 207 | then false, currdir, targets, phonys 208 | else 209 | match Util.check_prefix "#" line with 210 | | true -> true, currdir, targets, phonys 211 | | false -> 212 | if Str.string_match target_regex line 0 213 | then 214 | let target, prereqs = 215 | Str.matched_group 1 line, 216 | Str.matched_group 2 line 217 | in 218 | let prereqs = 219 | if Str.string_match object_regex target 0 220 | then prereqs ^ " " ^ ((Str.matched_group 1 target) ^ ".c") 221 | else prereqs 222 | in 223 | let phonys = process_phony target currdir prereqs phonys in 224 | let target_name = currdir ^ ":" ^ target in 225 | match Util.Strings.find_opt target_name targets with 226 | | None -> 227 | let spec = (prev_target, currdir, prereqs) in 228 | true, currdir, Util.Strings.add target_name spec targets, phonys 229 | | Some (is_target, _, prereqs') -> 230 | let spec = (prev_target || is_target, currdir, prereqs ^ " " ^ prereqs') in 231 | true, currdir, Util.Strings.add target_name spec targets, phonys 232 | else 233 | if Str.string_match curdir_regex line 0 234 | then true, Str.matched_group 1 line, targets, phonys 235 | else true, currdir, targets, phonys 236 | 237 | 238 | let build_make_graph read_p graph = 239 | let in_channel = 240 | match read_p with 241 | | File file -> open_in file 242 | | FileDesc fd -> Unix.in_channel_of_descr fd 243 | in 244 | let rec _build_graph channel state = 245 | match input_line channel with 246 | | line -> 247 | line 248 | |> process_line state 249 | |> _build_graph channel 250 | | exception End_of_file -> 251 | close_in channel; state 252 | in 253 | let _, _, targets, phonys = 254 | _build_graph in_channel (true, "", Util.Strings.empty, Util.StringSet.empty) 255 | in 256 | Util.Strings.fold (fun name (is_target, curdir, prereqs) graph -> 257 | if not is_target 258 | then graph 259 | else 260 | match Core.String.split_on_chars ~on: [ ' ' ] prereqs with 261 | | [ "" ] -> graph 262 | | prereqs -> 263 | List.fold_left (fun graph x -> 264 | let target = curdir ^ ":" ^ x in 265 | let path = 266 | if Util.check_prefix "/" x 267 | then x 268 | else 269 | (curdir ^ "/" ^ x) 270 | |> Fpath.v 271 | |> Fpath.normalize 272 | |> Fpath.to_string 273 | in 274 | match Util.Strings.find_opt target targets with 275 | | None -> graph 276 | | Some (false, _, _) -> 277 | Graph.add_edge name path Graph.In graph 278 | | Some (true, _, _) -> 279 | graph 280 | (* FIXME: Handle transitive inputs in a better way. *) 281 | |> Graph.add_edge name path Graph.In 282 | |> Graph.add_edge name target Graph.In_task 283 | |> Graph.add_edge target name Graph.Before 284 | ) graph prereqs 285 | ) targets graph, phonys 286 | 287 | 288 | let build_make_graph_online graph = 289 | let output, input = Unix.pipe () in 290 | (* We create a child process that is responsible for invoking 291 | strace and run 'make -pn' in parallel. *) 292 | match Unix.fork () with 293 | | 0 -> 294 | Unix.close output; 295 | let fd = Unix.openfile "/dev/null" [ 296 | Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o640 297 | in 298 | let _ = Unix.dup2 input Unix.stdout in 299 | let _ = Unix.dup2 fd Unix.stderr in 300 | let _ = Unix.close fd in 301 | let args = [| "make"; "-pn"; |] in 302 | ignore (Unix.execv "/usr/bin/make" args); 303 | exit 254 304 | | _ -> 305 | Unix.close input; 306 | build_make_graph (FileDesc output) graph 307 | | exception Unix.Unix_error (err, call, params) -> 308 | params |> string_of_unix_err err call |> make_executor_err 309 | 310 | 311 | let build_make_graph_offline filename graph = 312 | build_make_graph (File filename) graph 313 | 314 | 315 | let refine_analysis_out { build_db = build_db; _ } analysis_out = 316 | let graph, phonys = 317 | match build_db with 318 | | None -> build_make_graph_online analysis_out.Analyzer.task_graph 319 | | Some db -> build_make_graph_offline db analysis_out.task_graph 320 | in 321 | { analysis_out with Analyzer.task_graph = graph; }, 322 | Task_info.empty_task_info (), phonys 323 | -------------------------------------------------------------------------------- /src/analysis/domains.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Util 19 | 20 | 21 | exception DomainError of string 22 | 23 | 24 | module RelSet = Set.Make( 25 | struct 26 | type t = Syntax.eff 27 | let compare = Core.compare 28 | end 29 | ) 30 | 31 | 32 | type syscall_effect = 33 | | Create of string 34 | | Read of string 35 | | Remove of string 36 | | Touch of string 37 | | Write of string 38 | 39 | 40 | type abstraction_effect = 41 | | Consumed of string 42 | | Modified of string 43 | | Produced of string 44 | | Expunged of string 45 | 46 | 47 | type effect = (syscall_effect * Syntax.syscall_desc) 48 | 49 | 50 | type addr_t = int 51 | 52 | 53 | type process = string 54 | 55 | 56 | type fd = string 57 | 58 | 59 | type filename = string 60 | 61 | 62 | type proc_store = (int * int) Strings.t 63 | 64 | 65 | type proc_fd_store = filename option Strings.t 66 | 67 | 68 | type fd_store = proc_fd_store Ints.t 69 | 70 | 71 | type cwd_store = filename Ints.t 72 | 73 | 74 | type symlink_store = filename Strings.t 75 | 76 | 77 | type effect_cache = RelSet.t Strings.t 78 | 79 | 80 | type effect_store = (effect list * effect_cache) 81 | 82 | 83 | type task_block = string list 84 | 85 | 86 | type parent_process = string option 87 | 88 | 89 | type state = 90 | { 91 | k: proc_store; 92 | r: fd_store; 93 | c: effect_store; 94 | d: cwd_store; 95 | s: symlink_store; 96 | g: int Stream.t; 97 | b: task_block; 98 | o: task_block; 99 | z: parent_process; 100 | f: Graph.graph; 101 | q: StringSet.t; 102 | e: string option; 103 | } 104 | 105 | 106 | let cache_size = 1000 107 | 108 | 109 | let gen_addr state = 110 | Stream.next state.g 111 | 112 | 113 | (* Functions that perform queries to the structures of the state. *) 114 | let find_from_cwdtable pid proc_table cwd_table = 115 | match Strings.find_opt pid proc_table with 116 | | None -> None 117 | | Some (addr, _) -> Ints.find_opt addr cwd_table 118 | 119 | 120 | let find_proc_fdtable pid proc_table fd_table = 121 | match Strings.find_opt pid proc_table with 122 | | None -> None 123 | | Some (_, addr) -> Ints.find_opt addr fd_table 124 | 125 | 126 | let find_from_fdtable pid fd proc_table fd_table = 127 | match Strings.find_opt pid proc_table with 128 | | None -> None 129 | | Some (_, addr) -> Strings.find fd (Ints.find addr fd_table) 130 | 131 | 132 | let find_from_symtable path sym_table = 133 | Strings.find_opt path sym_table 134 | 135 | 136 | let find_from_proctable pid proc_table = 137 | Strings.find_opt pid proc_table 138 | 139 | 140 | (* Functions that perform additions to the structures of the state. *) 141 | let add_to_cwdtable pid inode proc_table cwd_table = 142 | match Strings.find_opt pid proc_table with 143 | | None -> cwd_table 144 | | Some (addr, _) -> Ints.add addr inode cwd_table 145 | 146 | 147 | let add_to_fdtable pid fd inode proc_table fd_table = 148 | match Strings.find_opt pid proc_table with 149 | | None -> fd_table 150 | | Some (_, addr) -> 151 | match Ints.find_opt addr fd_table with 152 | | None -> Ints.add addr (Strings.singleton fd inode) fd_table 153 | | Some f -> Ints.add addr (Strings.add fd inode f) fd_table 154 | 155 | 156 | let add_to_symtable source target sym_table = 157 | Strings.add source target sym_table 158 | 159 | 160 | let strip_trailing_slash path = 161 | let len = String.length path in 162 | if len > 0 && path.[len - 1] = '/' 163 | then String.sub path 0 (len - 1) 164 | else path 165 | 166 | 167 | (* Functions that perform deletions to the structures of the state. *) 168 | let remove_from_fdtable pid fd proc_table fd_table = 169 | match Strings.find_opt pid proc_table with 170 | | None -> fd_table 171 | | Some (_, addr) -> Ints.add addr ( 172 | Strings.remove fd (Ints.find addr fd_table)) fd_table 173 | 174 | 175 | (* Removes a path that points to a particular inode. 176 | 177 | That path must be placed inside the directory given as an argument. *) 178 | let remove_from_rev_it inode path rev_inode_table = 179 | match Ints.find_opt inode rev_inode_table with 180 | | None -> rev_inode_table 181 | | Some paths -> 182 | let paths = path +- paths in 183 | if StringSet.is_empty paths 184 | then 185 | (* The inode is not pointed by any file, so we remove it. *) 186 | Ints.remove inode rev_inode_table 187 | else Ints.add inode paths rev_inode_table 188 | 189 | 190 | let init_proc_fdtable addr fd_table = 191 | Ints.add addr Strings.empty fd_table 192 | 193 | 194 | let init_proc_cwdtable addr cwd_table = 195 | Ints.add addr "/" cwd_table 196 | 197 | 198 | let add_to_proctable pid cwd_addr fd_addr proc_table = 199 | Strings.add pid (cwd_addr, fd_addr) proc_table 200 | 201 | 202 | let copy_cwdtable pid addr proc_table cwd_table = 203 | match Strings.find_opt pid proc_table with 204 | | None -> cwd_table 205 | | Some (old_addr, _) -> 206 | Ints.add addr (Ints.find old_addr cwd_table) cwd_table 207 | 208 | 209 | let copy_fdtable pid addr proc_table fd_table = 210 | match Strings.find_opt pid proc_table with 211 | | None -> fd_table 212 | | Some (_, old_addr) -> Ints.add addr (Ints.find old_addr fd_table) fd_table 213 | 214 | 215 | let copy_fd pid f1 f2 proc_table fd_table = 216 | add_to_fdtable pid f2 (find_from_fdtable pid f1 proc_table fd_table) 217 | proc_table fd_table 218 | 219 | 220 | (* Functions that operate on the effect store. *) 221 | let add_effect_to_cache cache x effect = 222 | match Strings.find_opt x cache with 223 | | None -> Strings.add x (RelSet.add effect RelSet.empty) cache 224 | | Some set when effect = Syntax.Expunge -> 225 | let set' = RelSet.empty in 226 | Strings.add x (RelSet.add effect set') cache 227 | | Some set -> Strings.add x (RelSet.add effect set) cache 228 | 229 | 230 | let add_effect (lst, cache) (elem, sdesc) = 231 | match elem with 232 | | Create x -> 233 | (elem, sdesc) :: lst, add_effect_to_cache cache x Syntax.Prod 234 | | Read x | Touch x | Write x -> 235 | (elem, sdesc) :: lst, add_effect_to_cache cache x Syntax.Cons 236 | | Remove x -> 237 | (elem, sdesc) :: lst, add_effect_to_cache cache x Syntax.Expunge 238 | 239 | 240 | let init_proc_store () = Strings.empty 241 | 242 | 243 | let init_fd_store () = Ints.empty 244 | 245 | 246 | let init_cwd_store () = Ints.empty 247 | 248 | 249 | let init_effect_store () = ([], Strings.empty) 250 | 251 | 252 | let init_int_stream () = 253 | (* Initialize a stream of integers to be used as inodes. 254 | We start from 3 because 2 is alreasy reseved by the root 255 | directory. *) 256 | Util.int_stream 3 257 | 258 | 259 | let reset_effect_store state = 260 | { state with c = init_effect_store () } 261 | 262 | 263 | let init_symlink_store () = Strings.empty 264 | 265 | 266 | let init_state () = 267 | { 268 | k = init_proc_store (); 269 | r = init_fd_store (); 270 | c = init_effect_store (); 271 | d = init_cwd_store (); 272 | s = init_symlink_store (); 273 | g = init_int_stream (); 274 | b = []; 275 | o = []; 276 | z = None; 277 | f = Graph.empty_graph (); 278 | q = StringSet.empty; 279 | e = None; 280 | } 281 | 282 | 283 | let get_effects state = 284 | match state.c with 285 | | x, _ -> x 286 | 287 | 288 | let strip_con x = 289 | match x with 290 | | Create v | Read v | Touch v | Remove v | Write v -> v 291 | 292 | 293 | let unique_effects effects = 294 | (* Adds a cache that remembers paths that 295 | have been processed previously. *) 296 | let cache = Hashtbl.create cache_size in 297 | List.fold_left (fun acc (x, d) -> 298 | match x, Hashtbl.find_opt cache (strip_con x) with 299 | | _, None -> 300 | Hashtbl.add cache (strip_con x) (x, d); 301 | (x, d) :: acc 302 | | Create u, Some _ -> 303 | Hashtbl.replace cache u (Create u, d); 304 | (Create u, d) :: acc 305 | | Read _, Some _ 306 | | Touch _, Some _ 307 | | (Write _, Some (Write _, _)) 308 | | (Write _, Some (Create _, _)) -> acc 309 | | Write u, Some _ -> 310 | Hashtbl.replace cache u (Write u, d); 311 | (Write u, d) :: acc 312 | | Remove u, Some _ -> 313 | (* If we expunge the resource, all the previous 314 | effects on that resource have not meaning. 315 | So we remove them. 316 | 317 | Also, we remove all the resources which start with 318 | the name of the removed resource. 319 | 320 | This captures the case when we remove a directory. 321 | 322 | rmdir("/foo/bar") 323 | 324 | Apparently, in this case, we also need to remove all the 325 | resources included in that directory. 326 | *) 327 | Hashtbl.remove cache u; 328 | List.filter (fun (x, _) -> 329 | match x with 330 | | Create v | Read v | Touch v | Write v | Remove v -> 331 | not (Core.String.equal u v)) acc 332 | ) [] (List.rev effects) 333 | 334 | 335 | (* Helper functions used during interpretation. *) 336 | let get_cwd pid state = 337 | match find_from_cwdtable pid state.k state.d with 338 | (* Perphaps, it's the case when early take place 339 | and we don't have the information about the current working 340 | directory of the process. *) 341 | | None -> "/CWD" 342 | | Some cwd -> cwd 343 | 344 | 345 | let get_parent_dir pid state d = 346 | match d with 347 | (* It's not an *at call, so we get the current working directory. *) 348 | | Syntax.CWD -> Some (get_cwd pid state) 349 | | Syntax.Fd "0" | Syntax.Fd "1" | Syntax.Fd "2" -> None 350 | | Syntax.Fd dirfd -> 351 | match find_from_fdtable pid dirfd state.k state.r with 352 | | Some p -> Some p 353 | | None -> None 354 | | exception Not_found -> None 355 | 356 | 357 | (** 358 | * Extract and generate the absolute path name from the arguments 359 | * of system call. 360 | * 361 | * If the given path name is absolute, then this function returns it verbatim. 362 | * Otherwise, it extracts the dirfd argument: 363 | - If it is AT_FDCWD constant, then we interpret the given path name relative 364 | to the current working directory. 365 | - Otherwise, we inspect the directory corresponding to the given dirfd. 366 | *) 367 | let get_pathname pid state d p = 368 | match p with 369 | | Syntax.Unknown _ -> Some p 370 | | Syntax.Path pathname -> 371 | if is_absolute pathname then Some p 372 | else 373 | match ( 374 | pathname, 375 | get_parent_dir pid state d 376 | ) with 377 | | _, None -> None 378 | (* Get the current directory, e.g. /foo/. -> /foo *) 379 | | ".", Some cwd -> Some (Syntax.Path cwd) 380 | (* Get the parent directory, e.g. /foo/bar/.. -> /foo/bar *) 381 | | "..", Some cwd -> Some (Syntax.Path (Core.Filename.dirname cwd)) 382 | (* Join paths, e.g. /foo/bar and /bar/x -> /foo/bar/bar/x *) 383 | | _, Some cwd -> Some (Syntax.Path ( 384 | pathname 385 | |> Core.Filename.concat cwd 386 | |> Fpath.v 387 | |> Fpath.normalize 388 | |> Fpath.to_string)) 389 | 390 | 391 | let extract_task = function 392 | | Consumed v, _ 393 | | Modified v, _ 394 | | Produced v, _ 395 | | Expunged v, _ -> v 396 | -------------------------------------------------------------------------------- /entrypoint/process-project.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # 3 | # This is the entrypoint script for analyzing 4 | # and detecting faults in a Gradle or Make script 5 | # using BuildFS. 6 | 7 | basedir=${HOME}/data 8 | project_url= 9 | project_verion="latest" 10 | project_type= 11 | build_path= 12 | with_strace=0 13 | iterations=1 14 | offline=0 15 | 16 | eval `opam config env` 17 | 18 | 19 | while getopts "p:v:st:k:b:o" opt; do 20 | case "$opt" in 21 | p) project_url=$OPTARG 22 | ;; 23 | v) project_version=$OPTARG 24 | ;; 25 | t) project_type=$OPTARG 26 | ;; 27 | s) with_strace=1 28 | ;; 29 | k) iterations=$OPTARG 30 | ;; 31 | b) build_path=$OPTARG 32 | ;; 33 | o) offline=$OPTARG 34 | ;; 35 | esac 36 | done 37 | shift $(($OPTIND - 1)); 38 | 39 | 40 | if [ -z $project_url ]; then 41 | # Run script in interactive mode for debugging purposes. 42 | bash 43 | exit 0 44 | fi 45 | 46 | 47 | if [ -z "$project_type" ]; then 48 | echo "You must specify the type of the project" 49 | echo "(gradle or make or sbuild or mkcheck or sbuild-mkcheck)" 50 | exit 1 51 | fi 52 | 53 | 54 | if [ "$iterations" -lt 1 ]; then 55 | echo "You must provide a number greater than 1" 56 | exit 1 57 | fi 58 | 59 | sudo chown buildfs:buildfs -R $basedir 60 | 61 | function fetch_project() 62 | { 63 | local project project_out project_repo version 64 | project_repo=$1 65 | project=$2 66 | version=$3 67 | 68 | project_out=$basedir/$project 69 | mkdir -p $project_out 70 | 71 | git clone "$project_repo" $HOME/$project 72 | if [ $? -ne 0 ]; then 73 | echo "Unable to clone" > $project_out/err 74 | return 1 75 | fi 76 | 77 | cd $project 78 | 79 | if [ "$version" != "latest" ]; then 80 | echo "Checking out to version $version..." 81 | # Checkout to the given version. 82 | git checkout $version 83 | if [ $? -ne 0 ]; then 84 | echo "Unable to checkout to given version $version" > $project_out/err 85 | return 1 86 | fi 87 | fi 88 | 89 | cd .. 90 | return 0 91 | } 92 | 93 | 94 | instrument_build_script() 95 | { 96 | plugin="$PLUGIN_JAR_DIR/gradle-instrumentation-1.0.jar" 97 | if [ "$1" = "groovy" ]; then 98 | buildscript="buildscript { dependencies { classpath files('$plugin') } }\n" 99 | applyplug="apply plugin: 'org.buildfs.gradle.buildfs-plugin'" 100 | build_file="build.gradle" 101 | else 102 | buildscript="buildscript { dependencies { classpath(files(\"$plugin\")) } }\n" 103 | applyplug="apply(plugin=\"org.buildfs.gradle.buildfs-plugin\")" 104 | build_file="build.gradle.kts" 105 | fi 106 | # Heuristic: Search for file whose name is build.gradle.[kts] 107 | find . -regex ".*${build_file}" -type f -printf "%d %p\n" | 108 | sort -n | 109 | head -1 | 110 | cut -d' ' -f2 | 111 | xargs -i sed -i -e "1s;^;${buildscript};" -e "\$a${applyplug}" {} 112 | return $? 113 | } 114 | 115 | 116 | function build_gradle_project() 117 | { 118 | local project with_strace iterations 119 | project=$1 120 | with_strace=$2 121 | iterations=$3 122 | 123 | # Enter Gradle project's directory. 124 | cd $HOME/$project 125 | 126 | if [ $with_strace -eq 1 ]; then 127 | instrument_build_script "groovy" 128 | ret_groovy=$? 129 | instrument_build_script "kotlin" 130 | ret_kotlin=$? 131 | 132 | if [[ $ret_groovy -ne 0 && $ret_kotlin -ne 0 ]]; then 133 | echo "Unable to find build.gradle file" > $basedir/$project/err 134 | return 1 135 | fi 136 | fi 137 | 138 | if [ -x $HOME/pre-script.sh ]; then 139 | $HOME/pre-script.sh 140 | fi 141 | 142 | gradlew=$(find . -name 'gradlew' -type f -printf "%d %p\n" | 143 | sort -n | 144 | head -1 | 145 | cut -d' ' -f2) 146 | 147 | if [ $? -ne 0 ]; then 148 | echo "Unable to find gradlew file" > $basedir/$project/err 149 | return 1 150 | fi 151 | 152 | echo $gradlew 153 | 154 | if [[ ! -x $gradlew ]]; then 155 | gradlew="sh $gradlew" 156 | fi 157 | 158 | # Run gradle for the first time to configure project and install all 159 | # necessary dependencies and plugins. 160 | eval "$gradlew tasks" 161 | if [ $? -ne 0 ]; then 162 | return 1 163 | fi 164 | eval "$gradlew --stop" 165 | rm -f build-result.txt 166 | 167 | 168 | echo $(pwd) > $basedir/$project/$project.path 169 | for i in {1..$iterations}; do 170 | if [ $with_strace -eq 1 ]; then 171 | echo "Building the Gradle project $project with BuildFS..." 172 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 173 | buildfs gradle-build \ 174 | -mode online \ 175 | -build-task build \ 176 | -trace-file $basedir/$project/$project.strace \ 177 | -print-stats \ 178 | -build-dir "$(pwd)" > $basedir/$project/$project.faults 2> $basedir/$project/err 179 | if [ ! -s $basedir/$project/err ]; then 180 | rm $basedir/$project/err 181 | # This is the build time using BuildFS... 182 | btime=$(cat $basedir/$project/$project.faults | 183 | grep -oP 'Analysis time: .*' | 184 | sed -r 's/Analysis time: (.*)/\1/g') 185 | echo $btime >> $basedir/$project/build-buildfs.times 186 | fi 187 | else 188 | echo "Building the Gradle project $project without BuildFS..." 189 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 190 | start_time=$(date +%s.%N) 191 | bash -c "./gradlew build --no-build-cache --no-parallel >out 2>&1" 192 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 193 | # Compute the time spent on build. 194 | printf "%.2f\n" $elapsed_time >> $basedir/$project/base-build.time 195 | fi 196 | ./gradlew clean 197 | ./gradlew --stop 198 | done 199 | } 200 | 201 | 202 | function build_make_project() 203 | { 204 | local project with_strace iterations build_path 205 | project=$1 206 | with_strace=$2 207 | iterations=$3 208 | build_path=$4 209 | 210 | 211 | if [ -z "$build_path" ]; then 212 | path=$HOME/$project 213 | else 214 | path=$HOME/$project/$build_path 215 | fi 216 | 217 | cd $path 218 | echo $(pwd) > $basedir/$project/$project.path 219 | 220 | if [ -x $HOME/pre-script.sh ]; then 221 | $HOME/pre-script.sh 222 | fi 223 | 224 | if [ -f configure ]; then 225 | # If the project contains a configure script, we run this set up things. 226 | ./configure 227 | fi 228 | 229 | for i in {1..$iterations}; do 230 | if [ $with_strace -eq 0 ]; then 231 | echo "Building the Make project $project without BuildFS..." 232 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 233 | start_time=$(date +%s.%N) 234 | make 235 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 236 | # Compute the time spent on build. 237 | printf "%.2f\n" $elapsed_time >> $basedir/$project/base-build.time 238 | else 239 | sed -i -r 's/make/\$\(MAKE\)/' Makefile 240 | echo "Building Make project $project with BuildFS..." 241 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 242 | buildfs make-build \ 243 | -mode online \ 244 | -trace-file $basedir/$project/$project.strace \ 245 | -print-stats \ 246 | -build-dir "$(pwd)" > $basedir/$project/$project.faults 2> $basedir/$project/err 247 | if [ ! -s $basedir/$project/err ]; then 248 | rm $basedir/$project/err 249 | # This is the build time using BuildFS... 250 | btime=$(cat $basedir/$project/$project.faults | 251 | grep -oP 'Analysis time: .*' | 252 | sed -r 's/Analysis time: (.*)/\1/g') 253 | echo $btime >> $basedir/$project/build-buildfs.times 254 | make -pn > $basedir/$project/$project.makedb 255 | fi 256 | make clean 257 | fi 258 | done 259 | } 260 | 261 | 262 | function build_sbuild_project() 263 | { 264 | local project with_strace iterations sbuildrc buildfs_bin 265 | project=$1 266 | with_strace=$2 267 | iterations=$3 268 | 269 | sbuildrc=/home/buildfs/.sbuildrc 270 | 271 | # we cannot run which buildfs during the build of image 272 | buildfs_bin=$(which buildfs) && sudo cp $buildfs_bin /usr/local/bin/ 273 | 274 | echo "Building the Make sbuild project $project..." 275 | sed -i "s/{PROJECT}/${project}/g" $sbuildrc 276 | sed -i "s/{STRACE}/${with_strace}/g" $sbuildrc 277 | sed -i "s/{ITERATIONS}/${iterations}/g" $sbuildrc 278 | sbuild --apt-update --no-apt-upgrade --no-apt-distupgrade --batch \ 279 | --stats-dir=/var/log/sbuild/stats --dist=stable $project 280 | sudo chown buildfs:buildfs -R $basedir 281 | } 282 | 283 | 284 | function build_mkcheck_project() 285 | { 286 | local project with_strace iterations build_path 287 | project=$1 288 | with_strace=$2 289 | iterations=$3 290 | build_path=$4 291 | 292 | 293 | if [ -z "$build_path" ]; then 294 | path=$HOME/$project 295 | else 296 | path=$HOME/$project/$build_path 297 | fi 298 | 299 | cd $path 300 | echo $(pwd) > $basedir/$project/$project.path 301 | 302 | if [ -x $HOME/pre-script.sh ]; then 303 | $HOME/pre-script.sh 304 | fi 305 | 306 | if [ -f configure ]; then 307 | # If the project contains a configure script, we run this set up things. 308 | ./configure 309 | fi 310 | 311 | mkdir -p $basedir/$project/mkcheck 312 | 313 | for i in {1..$iterations}; do 314 | if [ $with_strace -eq 0 ]; then 315 | echo "Building the Make project $project without mkcheck..." 316 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 317 | start_time=$(date +%s.%N) 318 | make 319 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 320 | # Compute the time spent on build. 321 | printf "%.2f\n" $elapsed_time >> $basedir/$project/base-build.time 322 | else 323 | echo "Building Make project $project with mkcheck..." 324 | echo "Depending on the build, it may take some time (even hours). Bear with us..." 325 | echo " 326 | filter_in: 327 | - Makefile.* 328 | - /usr/.* 329 | - /etc/.* 330 | - //.* 331 | - /lib/.* 332 | - /bin/.* 333 | - /.*/debian/.* 334 | " > filter.yaml 335 | start_time=$(date +%s.%N) 336 | fuzz_test --graph-path=foo.json build 2> /dev/null 337 | if [ $? -ne 0 ]; then 338 | return 339 | fi 340 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 341 | printf "%.2f\n" $elapsed_time > $basedir/$project/mkcheck/$project.time 342 | 343 | cp foo.json $basedir/$project/mkcheck/$project.json 344 | 345 | echo "Fuzz testing..." 346 | start_time=$(date +%s.%N) 347 | fuzz_test --graph-path=foo.json \ 348 | --rule-path filter.yaml fuzz \ 349 | > $basedir/$project/mkcheck/$project.fuzz 2> /dev/null 350 | if [ $? -ne 0 ]; then 351 | exit 1 352 | fi 353 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 354 | printf "%.2f\n" $elapsed_time >> $basedir/$project/mkcheck/$project.time 355 | 356 | echo "Race testing..." 357 | start_time=$(date +%s.%N) 358 | fuzz_test --graph-path=foo.json \ 359 | --rule-path filter.yaml race \ 360 | > $basedir/$project/mkcheck/$project.race 2> /dev/null 361 | 362 | if [ $? -ne 0 ]; then 363 | exit 1 364 | fi 365 | elapsed_time=$(echo "$(date +%s.%N) - $start_time" | bc) 366 | printf "%.2f\n" $elapsed_time >> $basedir/$project/mkcheck/$project.time 367 | fi 368 | done 369 | } 370 | 371 | 372 | function build_sbuild_mkcheck_project() 373 | { 374 | local project with_strace iterations sbuildrc mkcheck_bin 375 | project=$1 376 | with_strace=$2 377 | iterations=$3 378 | 379 | sbuildrc=/home/buildfs/.sbuildrc 380 | 381 | mkcheck_bin=$(which mkcheck) && sudo cp $mkcheck_bin /usr/local/bin/ 382 | 383 | echo "Building the Make sbuild project $project with mkcheck..." 384 | sed -i "s/'strace',/'strace',\n'libboost-all-dev',\n'python',\n'python-pip',\n'python-yaml',\n/" $sbuildrc 385 | sed -i "s/run-buildfs/run-mkcheck/g" $sbuildrc 386 | sed -i "s/{PROJECT}/${project}/g" $sbuildrc 387 | sed -i "s/{STRACE}/${with_strace}/g" $sbuildrc 388 | sed -i "s/{ITERATIONS}/${iterations}/g" $sbuildrc 389 | sbuild --apt-update --no-apt-upgrade --no-apt-distupgrade --batch \ 390 | --stats-dir=/var/log/sbuild/stats --dist=stable $project 391 | sudo chown buildfs:buildfs -R $basedir 392 | } 393 | 394 | 395 | function buildfs_offline() 396 | { 397 | local project iterations 398 | project=$1 399 | iterations=$2 400 | project_type=$3 401 | 402 | set +e 403 | 404 | echo "Offline analysis with BuildFS..." 405 | if [ ! -f $basedir/$project/$project.times ]; then 406 | for i in {1..$iterations}; do 407 | if [ "$project_type" = "make" ]; then 408 | buildfs make-build \ 409 | -mode offline \ 410 | -print-stats \ 411 | -trace-file $basedir/$project/$project.strace \ 412 | -build-db $basedir/$project/$project.makedb \ 413 | -build-dir "$(cat $basedir/$project/$project.path)" \ 414 | > $basedir/$project/$project.faults 2> $basedir/$project/err 415 | else 416 | buildfs gradle-build \ 417 | -mode offline \ 418 | -print-stats \ 419 | -trace-file $basedir/$project/$project.strace \ 420 | -build-dir "$(cat $basedir/$project/$project.path)" \ 421 | > $basedir/$project/$project.faults 2> $basedir/$project/err 422 | fi 423 | 424 | if [ $? -ne 0 ]; then 425 | return 2 426 | fi 427 | 428 | if [ ! -s $basedir/$project/err ]; then 429 | rm $basedir/$project/err 430 | atime=$(cat $basedir/$project/$project.faults | 431 | grep -oP 'Analysis time: .*' | 432 | sed -r 's/Analysis time: (.*)/\1/g') 433 | fdtime=$(cat $basedir/$project/$project.faults | 434 | grep -oP 'Bug detection time: .*' | 435 | sed -r 's/Bug detection time: (.*)/\1/g') 436 | echo "$atime,$fdtime" >> $basedir/$project/$project.times 437 | fi 438 | done 439 | fi 440 | return 0 441 | } 442 | 443 | 444 | if [ "$project_type" = "sbuild" ] || [ "$project_type" = "sbuild-mkcheck" ]; then 445 | project_name=$project_url 446 | else 447 | project_name=$(echo $project_url | sed -r 's/^https:\/\/.*\.((org)|(com)|(net))\/.*\/(.*)\.git/\5/g') 448 | fi 449 | 450 | if [ ! "$project_type" = "sbuild" ] && [ ! "$project_type" = "sbuild-mkcheck" ]; then 451 | fetch_project "$project_url" "$project_name" "$project_version" 452 | if [ $? -ne 0 ]; then 453 | echo "Couldn't fetch the project $project" 454 | exit 1 455 | fi 456 | fi 457 | 458 | 459 | if [ "$project_type" = "make" ]; then 460 | build_make_project "$project_name" $with_strace "$iterations" "$build_path" 461 | elif [ "$project_type" = "gradle" ]; then 462 | build_gradle_project "$project_name" "$with_strace" $iterations 463 | elif [ "$project_type" = "sbuild" ]; then 464 | build_sbuild_project "$project_name" "$with_strace" $iterations 465 | elif [ "$project_type" = "mkcheck" ]; then 466 | build_mkcheck_project "$project_name" "$with_strace" $iterations "$build_path" 467 | elif [ "$project_type" = "sbuild-mkcheck" ]; then 468 | build_sbuild_mkcheck_project "$project_name" "$with_strace" $iterations 469 | fi 470 | 471 | 472 | if [ $? -ne 0 ]; then 473 | exit 1 474 | fi 475 | 476 | 477 | if [ $offline -eq 1 ]; then 478 | buildfs_offline "$project_name" $iterations "$project_type" 479 | fi 480 | exit $? 481 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # BuildFS 2 | 3 | `BuildFS` is a dynamic approach for detecting faults in parallel 4 | and incremental builds. 5 | Our method is based on a model (`BuildFS`) that treats a build execution 6 | stemming from an arbitrary build system as a sequence of tasks, where each task 7 | receives a set of input files, performs a number of file system operations, 8 | and finally produces a number of output files. 9 | `BuildFS` stakes into account 10 | (1) the specification (as declared in build scripts) 11 | and (2) the definition (as observed during a build through file accesses) 12 | of each build task. 13 | By combining the two elements, 14 | we formally define three different types of faults related to 15 | incremental and parallel builds that 16 | arise when a file access violates the specification of build. 17 | Our testing approach operates as follows. 18 | First, it monitors the execution of an instrumented build script, 19 | and models this execution in `BuildFS`. 20 | Our method then verifies the correctness of the build execution 21 | by ensuring that there is no file access that leads to 22 | any fault concerning incrementality or parallelism. 23 | Note that to uncover faults, our method only requires a single full build. 24 | 25 | 26 | ## Building 27 | 28 | Fetch the repo by running 29 | 30 | ```` 31 | git clone --recursive https://github.com/theosotr/buildfs 32 | ```` 33 | 34 | 35 | ### Build Docker Images 36 | 37 | To build a Docker image that contains 38 | an environment for executing and analyzing build executions 39 | through `BuildFS`, run 40 | 41 | ```bash 42 | docker build -t buildfs --build-arg IMAGE_NAME= --build-arg GRADLE=yes . 43 | ``` 44 | 45 | where `` is the base Docker used to set up 46 | the environment. We have tested our Docker script 47 | on `ubuntu:18.04` and `debian:stable` base images. 48 | 49 | ### Building from source 50 | 51 | To build `BuildFS` from source, you have to 52 | install some necessary packages first 53 | 54 | ```bash 55 | apt install opam m4 56 | ``` 57 | 58 | Then, install OCaml compiler 4.07 by running 59 | 60 | ```bash 61 | opam init -y 62 | eval $(opam env) 63 | opam switch create 4.07.0 64 | ``` 65 | 66 | Next, install some opam packages used by `BuildFS` 67 | 68 | ```bash 69 | eval $(opam env) 70 | opam install -y ppx_jane core yojson dune fd-send-recv fpath 71 | ``` 72 | 73 | Finally, build `BuildFS` by running 74 | 75 | ```bash 76 | make 77 | sudo make install 78 | ``` 79 | 80 | This will (1) build and install the `buildfs` executable 81 | inside your local `~/.opam/4.07.0/bin` directory, 82 | and (2) install the scripts for instrumenting Make and Gradle builds 83 | into your `/usr/local/bin` path. 84 | 85 | ## Use BuildFS as standalone tool 86 | 87 | Here, we describe how you can use `BuildFS` 88 | as a standalone tool (without employing a Docker image). 89 | Currently, `BuildFS` has support for two well-established 90 | and popular build systems (namely, GNU Make and Gradle). 91 | 92 | ### Make Builds 93 | 94 | 95 | You have analyze and test your Make builds by simply running 96 | the following command 97 | from the directory where your `Makefile` is located. 98 | 99 | ``` 100 | buildfs make-build -mode online 101 | ``` 102 | 103 | The command above executes your build, 104 | and analyzes its execution. 105 | It reports any missing inputs or ordering violations, 106 | if your Make script is incorrect. 107 | 108 | ### Gradle Builds 109 | 110 | 111 | For Gradle builds, first you need to put the following three lines 112 | of code inside your main `build.grade` file. 113 | 114 | ```groovy 115 | plugins { 116 | id "org.buildfs.gradle.buildfs-plugin" version "1.0" 117 | } 118 | ``` 119 | 120 | The code above applies our 121 | [org.buildfs.gradle.buildfs-plugin](https://plugins.gradle.org/plugin/org.buildfs.gradle.buildfs-plugin) to your Gradle script 122 | in order to enable our instrumentation. 123 | The `buildfs` tool exploits this instrumentation 124 | during the execution of the build, 125 | to extract the specification of each Gradle task 126 | (as written by the developers). 127 | 128 | After modifying your Gradle script, analyze and test your Gradle script 129 | by simply running the following command from the directory 130 | where your `gradlew` file is stored. 131 | 132 | ``` 133 | buildfs gradle-build -mode online -build-task build 134 | ``` 135 | 136 | ### Usage 137 | 138 | ``` 139 | ❯ buildfs help 140 | Detecting Faults in Parallel and Incremental Builds. 141 | 142 | buildfs SUBCOMMAND 143 | 144 | === subcommands === 145 | 146 | gradle-build This is the sub-command for analyzing and detecting faults in 147 | Gradle scripts 148 | make-build This is the sub-command for analyzing and detecting faults in 149 | Make scripts 150 | version print version information 151 | help explain a given subcommand (perhaps recursively) 152 | ``` 153 | 154 | For analyzing Gradle builds 155 | 156 | ``` 157 | ❯ buildfs gradle-build -help 158 | This is the sub-command for analyzing and detecting faults in Gradle scripts 159 | 160 | buildfs gradle-build 161 | 162 | === flags === 163 | 164 | -build-dir Build directory 165 | -mode Analysis mode; either online or offline 166 | [-build-task Build] task to execute 167 | [-dump-tool-out File] to store output from Gradle execution (for debugging 168 | only) 169 | [-graph-file File] to store the task graph inferred by BuildFS. 170 | [-graph-format Format] for storing the task graph of the BuildFS program. 171 | [-print-stats] Print stats about execution and analysis 172 | [-trace-file Path] to trace file produced by the 'strace' tool. 173 | [-help] print this help text and exit 174 | (alias: -?) 175 | ``` 176 | 177 | For analyzing Make builds 178 | 179 | 180 | ``` 181 | ❯ buildfs make-build -help 182 | This is the sub-command for analyzing and detecting faults in Make scripts 183 | 184 | buildfs make-build 185 | 186 | === flags === 187 | 188 | -build-dir Build directory 189 | -mode Analysis mode; either online or offline 190 | [-build-db Path] to Make database 191 | [-dump-tool-out File] to store output from Make execution (for debugging 192 | only) 193 | [-graph-file File] to store the task graph inferred by BuildFS. 194 | [-graph-format Format] for storing the task graph of the BuildFS program. 195 | [-print-stats] Print stats about execution and analysis 196 | [-trace-file Path] to trace file produced by the 'strace' tool. 197 | [-help] print this help text and exit 198 | (alias: -?) 199 | ``` 200 | 201 | ## Getting Started with Docker Image 202 | 203 | After seeing how we can use `BuildFS` as a standalone tool, 204 | it's time to see how we run and analyze real-world builds 205 | through our Docker image. 206 | Recall that this image contains all necessary dependencies for 207 | running the builds and scripts for producing multiple report files. 208 | The image contains an entrypoint script that expects the following 209 | options: 210 | 211 | * `-p`: A URL pointing to the *git* repository of the project 212 | that we want to run and analyze. 213 | * `-v`: A commit hash, a tag, or a branch that indicates the version of the 214 | project that we want to analyze (default `latest`). 215 | * `-t`: The type of the project (`gradle` or `make`). 216 | * `-b`: This option expects a path (relative to the directory of the project) 217 | where the build is performed. 218 | * `-k`: Number of builds to perform (default 1). 219 | * `-s`: A flag that indicates that the build is ran through `BuildFS`. 220 | If this is flag is not provided, we run the build without `BuildFS`. 221 | * `-o`: A flag that beyond online analysis through `BuildFS`, it also 222 | performs an offline analysis on the trace stemming from the execution 223 | of the build. This option was used in our experiments to estimate 224 | the amount of time spent on the analysis of BuildFS programs. 225 | 226 | 227 | ### Example1: Make Build 228 | 229 | To analyze an example Make build, run the following command: 230 | 231 | ```bash 232 | docker run --rm -ti --privileged \ 233 | -v $(pwd)/out:/home/buildfs/data buildfs \ 234 | -p "https://github.com/dspinellis/cqmetrics.git" \ 235 | -v "5e5495499863921ba3133a66957f98b192004507" \ 236 | -s -t make \ 237 | -b src 238 | ``` 239 | 240 | Some explanations: 241 | 242 | The Docker option `--privileged` is used to enable tracing inside the 243 | Docker container. The option `-v` is used to mount a local volume inside 244 | the Docker container. This is used to store all the files produced 245 | from the analysis of the build script into the given volume `$(pwd)/out`. 246 | Specifically, 247 | for Make builds, 248 | `BuildFS` produces the following files inside this directory. 249 | 250 | * `cqmetrics/build-buildfs.times`: This file contains the time for building 251 | the project using `BuildFS`. This file is generated if we run the container 252 | with the option `-s`. 253 | * `cqmetrics/base-build.times`: This file contains the time spent for building 254 | the project *without* `BuildFS`. This file is generated if the option 255 | `-s` is *not* provided. 256 | * `cqmetrics/cqmetrics.times`: This file is a CSV that includes the time spent 257 | on the analysis of BuildFS programs and fault detection. This file is generated 258 | if the option `-o` (offline analysis) is provided. 259 | * `cqmetrics/cqmetrics.faults`: This file is the report that contains the faults 260 | detected by `BuildFS`. This file is generated if we run the container 261 | with the option `-s`. 262 | * `cqmetrics/cqmetrics.makedb`: This file is the database of the Make build 263 | produced by running `make -pn`. This is used for an offline analysis of a Make 264 | project. This file is generated if we run the container with the option `-s`. 265 | * `cqmetrics/cqmetrics.path`: This file contains the path where we performed 266 | the build. This file is generated if we run the container with the option `-s`. 267 | * `cqmetrics/cqmetrics.strace`: a system call trace corresponding 268 | to the build execution. This file is generated if we run the container with 269 | the option `-s`. 270 | 271 | If we inspect the contains of the resulting `out/cqmetrics/cqmetrics.faults` 272 | file, we will see something that is similar to the following: 273 | 274 | ```bash 275 | 276 | ❯ cat out/cqmetrics/cqmetrics.faults 277 | Info: Start tracing command: fsmake-make ... 278 | Statistics 279 | ---------- 280 | Trace entries: 19759 281 | Tasks: 8 282 | Files: 342 283 | Conflicts: 4 284 | DFS traversals: 41 285 | Analysis time: 2.81151819229 286 | Bug detection time: 0.0152561664581 287 | ------------------------------------------------------------ 288 | Number of Missing Inputs (MIN): 3 289 | 290 | Detailed Bug Report: 291 | ==> [Task: /home/buildfs/cqmetrics/src:header.tab] 292 | 293 | Fault Type: MIN 294 | - /home/buildfs/cqmetrics/src/QualityMetrics.h: Consumed by /home/buildfs/cqmetrics/src:header.tab ( openat at line 21068 ) 295 | 296 | ==> [Task: /home/buildfs/cqmetrics/src:header.txt] 297 | 298 | Fault Type: MIN 299 | - /home/buildfs/cqmetrics/src/QualityMetrics.h: Consumed by /home/buildfs/cqmetrics/src:header.txt ( openat at line 22386 ) 300 | 301 | ==> [Task: /home/buildfs/cqmetrics/src:qmcalc.o] 302 | 303 | Fault Type: MIN 304 | - /home/buildfs/cqmetrics/src/BolState.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18631 ) 305 | - /home/buildfs/cqmetrics/src/CKeyword.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18633 ) 306 | - /home/buildfs/cqmetrics/src/CMetricsCalculator.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18563 ) 307 | - /home/buildfs/cqmetrics/src/CharSource.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18565 ) 308 | - /home/buildfs/cqmetrics/src/Cyclomatic.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18767 ) 309 | - /home/buildfs/cqmetrics/src/Descriptive.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18769 ) 310 | - /home/buildfs/cqmetrics/src/Halstead.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 19361 ) 311 | - /home/buildfs/cqmetrics/src/NestingLevel.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 19365 ) 312 | - /home/buildfs/cqmetrics/src/QualityMetrics.h: Consumed by /home/buildfs/cqmetrics/src:qmcalc.o ( openat at line 18711 ) 313 | ``` 314 | 315 | Specifically, `BuildFS` detected three missing inputs (MIN) related to three 316 | build tasks of the project. For example, the following fragment shows that 317 | the task `/home/buildfs/cqmetrics/src:header.txt` has a missing input on one file 318 | (i.e., `/home/buildfs/cqmetrics/src/QualityMetrics.h`). This means that 319 | whenever the latter is updated, Make does not re-trigger the execution of 320 | the task leading to stale targets. 321 | 322 | ```bash 323 | ==> [Task: /home/buildfs/cqmetrics/src:header.txt] 324 | 325 | Fault Type: MIN 326 | - /home/buildfs/cqmetrics/src/QualityMetrics.h: Consumed by /home/buildfs/cqmetrics/src:header.txt ( openat at line 22386 ) 327 | ``` 328 | 329 | 330 | ### Example2: Gradle Build 331 | 332 | For running and analyzing a Gradle project using our Docker image, 333 | run the following: 334 | 335 | 336 | ```bash 337 | docker run --rm -ti --privileged \ 338 | -v $(pwd)/out:/home/buildfs/data buildfs \ 339 | -p "https://github.com/seqeralabs/nf-tower.git" \ 340 | -v "997985c2f7e603342189effdfea122bab53a6bae" \ 341 | -s \ 342 | -t gradle 343 | ``` 344 | 345 | This will fetch and instrument the specified repository. For Gradle builds, 346 | `BuildFS` will generate the same file inside the `out` except for 347 | the `*.makedb` as it is only relevant for Make builds. 348 | 349 | If you inspect the produced `out/nf-tower/nf-tower.faults` file you will see 350 | the following report: 351 | 352 | ```bash 353 | ❯ cat out/nf-tower/nf-tower.faults 354 | Info: Start tracing command: ./gradlew build --no-parallel ... 355 | Statistics 356 | ---------- 357 | Trace entries: 897251 358 | Tasks: 18 359 | Files: 2877 360 | Conflicts: 2614 361 | DFS traversals: 10 362 | Analysis time: 214.29347682 363 | Bug detection time: 0.146173000336 364 | ------------------------------------------------------------ 365 | Number of Ordering Violations (OV): 3 366 | 367 | Detailed Bug Report: 368 | ==> [Task: tower-backend:shadowJar] | [Task: tower-backend:distTar] 369 | 370 | Fault Type: OV 371 | - /home/buildfs/nf-tower/tower-backend/build/libs/tower-backend-19.08.0.jar: Produced by tower-backend:shadowJar ( openat at line 280041 ) and Consumed by tower-backend:distTar ( lstat at line 151875 ) 372 | 373 | ==> [Task: tower-backend:shadowJar] | [Task: tower-backend:distZip] 374 | 375 | Fault Type: OV 376 | - /home/buildfs/nf-tower/tower-backend/build/libs/tower-backend-19.08.0.jar: Produced by tower-backend:shadowJar ( openat at line 280041 ) and Consumed by tower-backend:distZip ( lstat at line 161551 ) 377 | 378 | ==> [Task: tower-backend:shadowJar] | [Task: tower-backend:jar] 379 | 380 | Fault Type: OV 381 | - /home/buildfs/nf-tower/tower-backend/build/libs/tower-backend-19.08.0.jar: Produced by tower-backend:shadowJar ( openat at line 280041 ) and Produced by tower-backend:jar ( openat at line 139411 ) 382 | - /home/buildfs/nf-tower/tower-backend/build/libs/tower-backend-19.08.0.jar: Produced by tower-backend:shadowJar ( openat at line 280041 ) and Produced by tower-backend:jar ( openat at line 139411 ) 383 | ``` 384 | 385 | `BuildFS` detected three ordering violations (OV). 386 | For example, there is an ordering violations between the tasks 387 | `tower-backend:shadowJar`, 388 | `tower-backend:jar`. 389 | These tasks conflict on two files 390 | (e.g., `/home/buildfs/nf-tower/tower-backend/build/libs/tower-backend-19.08.0.jar`), 391 | and no dependency has been specified between these tasks. 392 | 393 | **NOTE**: In general, 394 | Gradle builds take longer as they involve the download of JAR 395 | dependencies and the setup of the Gradle Daemon. 396 | 397 | ## Publications 398 | 399 | The tool is described in detail in the following paper. 400 | 401 | * Thodoris Sotiropoulos, Stefanos Chaliasos, Dimitris Mitropoulos, and Diomidis Spinellis. 2020. 402 | [A Model for Detecting Faults in Build Specifications](https://doi.org/10.1145/3428212). 403 | In Proceedings of the ACM on Programming Languages (OOPSLA '20), 2020, Virtual, USA, 404 | 30 pages. 405 | ([doi:10.1145/3428212](https://doi.org/10.1145/3428212)) 406 | 407 | The research artifact associated with this tool can be found at https://github.com/theosotr/buildfs-eval. 408 | -------------------------------------------------------------------------------- /src/analysis/sys_parser.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018-2020 Thodoris Sotiropoulos 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, version 3. 7 | * 8 | * This program is distributed in the hope that it will be useful, but 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11 | * General Public License for more details. 12 | * 13 | * You should have received a copy of the GNU General Public License 14 | * along with this program. If not, see . 15 | *) 16 | 17 | 18 | open Str 19 | 20 | open Errors 21 | open Syntax 22 | 23 | 24 | 25 | (* Some helper functions to raise Parser errors. *) 26 | let make_error error_kind msg = 27 | raise (Error (error_kind, msg)) 28 | 29 | 30 | let make_parser_error syscall line msg = 31 | make_error (ParserError (syscall, line)) msg 32 | 33 | 34 | module type ToolParserType = 35 | sig 36 | val is_tool_debug_msg : string -> bool 37 | 38 | val model_syscall : string -> Syntax.statement 39 | 40 | val stop_parser : string -> bool 41 | end 42 | 43 | 44 | module type S = 45 | sig 46 | val parse_trace_fd : 47 | string option 48 | -> Unix.file_descr 49 | -> Syntax.trace Syntax.stream 50 | 51 | val parse_trace_file : string option -> string -> Syntax.trace Syntax.stream 52 | end 53 | 54 | 55 | module Make (T : ToolParserType) = struct 56 | 57 | type syscall_type = 58 | | Completed 59 | | Unfinished 60 | | Resumed 61 | 62 | type syscall_l = 63 | | CoSyscall of (string * string * string option * string option) 64 | | UnSyscall of (string * string) 65 | | ResSyscall of (string * string * string option * string option) 66 | 67 | 68 | let regex_pid = regexp "^[0-9]+[ ]+" 69 | 70 | (* Regex for system calls *) 71 | let ret_value_pattern = "\\([ ]*=[ ]*\\(-?[0-9\\?]+\\)[ ]*\\(.*\\)?\\)?" 72 | let regex_syscall = regexp ("\\([a-z0-9_]+\\)(\\(.*\\))" ^ ret_value_pattern) 73 | let regex_syscall_unfin = regexp "\\([a-z0-9_?]+\\)(\\(.*\\)[ ]+" 74 | let regex_syscall_resum = regexp ("<...[ ]+\\([a-z0-9_?]+\\)[ ]+resumed>[ ]*\\(.*\\))" ^ ret_value_pattern) 75 | 76 | let syscall_group = 1 77 | let args_group = 2 78 | let ret_group = 3 79 | let retv_group = 4 80 | let err_msg_group = 5 81 | 82 | 83 | let has_dupfd args = 84 | Util.string_contains args "F_DUPFD" 85 | 86 | 87 | let has_rdonly args = 88 | Util.string_contains args "O_RDONLY" 89 | 90 | 91 | let has_wronly args = 92 | Util.string_contains args "O_WRONLY" 93 | 94 | 95 | let has_rdwrd args = 96 | Util.string_contains args "O_RDWR" 97 | 98 | 99 | let has_trunc args = 100 | Util.string_contains args "O_TRUNC" 101 | 102 | 103 | let has_creat args = 104 | Util.string_contains args "O_CREAT" 105 | 106 | 107 | let has_clone_fs args = 108 | Util.string_contains args "CLONE_FS" 109 | 110 | 111 | let has_clone_files args = 112 | Util.string_contains args "CLONE_FILES" 113 | 114 | 115 | let to_path_expr p_index args = 116 | match Util.extract_pathname p_index args with 117 | | None -> None 118 | | Some p -> Some (Syntax.P p) 119 | 120 | 121 | let to_fdvar fd = 122 | match fd with 123 | (* When fd is None or AT_FDCWD, then we model the working directory of 124 | the process. *) 125 | | None 126 | | Some "AT_FDCWD" -> Syntax.CWD 127 | | Some f -> Syntax.Fd f 128 | 129 | 130 | let to_fdvar_expr fd = 131 | Syntax.V (to_fdvar fd) 132 | 133 | 134 | let to_at_expr fd p_index args = 135 | match Util.extract_pathname p_index args with 136 | | None -> None 137 | | Some p -> Some (Syntax.At (to_fdvar fd, p)) 138 | 139 | 140 | let is_open_consumed args = 141 | match ( 142 | has_rdonly args, 143 | has_wronly args, 144 | has_rdwrd args, 145 | has_trunc args, 146 | has_creat args) 147 | with 148 | | true, _, _, _, _ -> true (* O_RDONLY *) 149 | | _, true, _, true, _ -> false (* O_WRONLY|O_TRUNC *) 150 | | _, _, true, false, false -> true (* O_RDWRD *) 151 | | _, _, true, _, true -> false (* O_RDWRD|O_CREAT *) 152 | | _, true, _, _, true -> false (* O_WRONLY|O_CREAT *) 153 | | _, true, _, false, false -> true (* O_WRONLY *) 154 | | _ -> true 155 | 156 | 157 | let get_fd index args = 158 | match index with 159 | | None -> None 160 | | Some i -> Some (Util.extract_arg args i) 161 | 162 | 163 | (* Functions to model system calls in BuildFS. *) 164 | let to_nop _ = 165 | Syntax.Nop 166 | 167 | 168 | let to_chdir sdesc = 169 | match to_path_expr 0 sdesc.args with 170 | | None -> Syntax.Nop 171 | | Some e -> Syntax.Let (Syntax.CWD, e) 172 | 173 | 174 | let to_newproc sdesc = 175 | Syntax.Newproc sdesc.ret 176 | 177 | 178 | let to_delfd sdesc = 179 | Syntax.Del (to_fdvar_expr (Some sdesc.args)) 180 | 181 | 182 | let to_dupfd_fcntl sdesc = 183 | if has_dupfd sdesc.args 184 | then 185 | Syntax.Let ( 186 | to_fdvar (Some (Util.extract_arg sdesc.args 0)), 187 | to_fdvar_expr (Some sdesc.ret) 188 | ) 189 | else Syntax.Nop 190 | 191 | 192 | let to_dupfd_dup sdesc = 193 | Syntax.Let( 194 | to_fdvar (Some (Util.extract_arg sdesc.args 0)), 195 | to_fdvar_expr (Some sdesc.ret) 196 | ) 197 | 198 | 199 | let to_dupfd_dup2 sdesc = 200 | Syntax.Let( 201 | to_fdvar (Some (Util.extract_arg sdesc.args 0)), 202 | to_fdvar_expr (Some (Util.extract_arg sdesc.args 1)) 203 | ) 204 | 205 | 206 | let to_fchdir sdesc = 207 | Syntax.Let ( 208 | Syntax.CWD, 209 | to_fdvar_expr (Some (Util.extract_arg sdesc.args 0)) 210 | ) 211 | 212 | 213 | let to_consume d_index p_index sdesc = 214 | let fd = get_fd d_index sdesc.args in 215 | match to_at_expr fd p_index sdesc.args with 216 | | None -> Syntax.Nop 217 | | Some e -> Syntax.Consume e 218 | 219 | 220 | let to_produce d_index p_index sdesc = 221 | let fd = get_fd d_index sdesc.args in 222 | match to_at_expr fd p_index sdesc.args with 223 | | None -> Syntax.Nop 224 | | Some e -> Syntax.Produce e 225 | 226 | 227 | let to_del_path d_index p_index sdesc = 228 | let fd = get_fd d_index sdesc.args in 229 | match to_at_expr fd p_index sdesc.args with 230 | | None -> Syntax.Nop 231 | | Some e -> Syntax.Del e 232 | 233 | 234 | let model_open d_index p_index sdesc = 235 | let fd = get_fd d_index sdesc.args in 236 | match to_at_expr fd p_index sdesc.args with 237 | | None -> Syntax.Nop 238 | | Some e -> 239 | if is_open_consumed sdesc.args 240 | then Syntax.Consume e 241 | else Syntax.Produce e 242 | 243 | 244 | let to_newfd d_index p_index sdesc = 245 | let fd = get_fd d_index sdesc.args in 246 | match to_at_expr fd p_index sdesc.args with 247 | | None -> Syntax.Nop 248 | | Some e -> Syntax.Let (to_fdvar (Some sdesc.ret), e) 249 | 250 | 251 | let parsers = Util.Strings.empty 252 | |> Util.Strings.add "access" [(to_consume None 0)] 253 | |> Util.Strings.add "chdir" [to_chdir] 254 | |> Util.Strings.add "chmod" [(to_consume None 0)] 255 | |> Util.Strings.add "chown" [(to_consume None 0)] 256 | |> Util.Strings.add "clone" [to_newproc] 257 | |> Util.Strings.add "close" [to_delfd] 258 | |> Util.Strings.add "dup" [to_dupfd_dup] 259 | |> Util.Strings.add "dup2" [to_dupfd_dup2] 260 | |> Util.Strings.add "dup3" [to_dupfd_dup2] 261 | |> Util.Strings.add "execve" [(to_consume None 0)] 262 | |> Util.Strings.add "fchdir" [to_fchdir] 263 | |> Util.Strings.add "fchmodat" [(to_consume (Some 0) 1)] 264 | |> Util.Strings.add "fchownat" [(to_consume (Some 0) 1)] 265 | |> Util.Strings.add "fcntl" [to_dupfd_fcntl] 266 | |> Util.Strings.add "fork" [to_newproc] 267 | |> Util.Strings.add "getxattr" [(to_consume None 0)] 268 | |> Util.Strings.add "getcwd" [to_chdir] 269 | |> Util.Strings.add "lchown" [(to_consume None 0)] 270 | |> Util.Strings.add "lgetxattr" [(to_consume None 0)] 271 | |> Util.Strings.add "lremovexattr"[(to_consume None 0)] 272 | |> Util.Strings.add "lsetxattr" [(to_consume None 0)] 273 | |> Util.Strings.add "lstat" [(to_consume None 0)] 274 | |> Util.Strings.add "link" [ 275 | (to_produce None 1); 276 | (to_consume None 0); 277 | ] 278 | |> Util.Strings.add "linkat" [ 279 | (to_produce (Some 2) 3); 280 | (to_consume (Some 0) 1); 281 | ] 282 | |> Util.Strings.add "mkdir" [(to_produce None 0)] 283 | |> Util.Strings.add "mkdirat" [(to_produce (Some 0) 1)] 284 | |> Util.Strings.add "mknod" [(to_produce None 0)] 285 | |> Util.Strings.add "open" [ 286 | (to_newfd None 0); 287 | (model_open None 0); 288 | ] 289 | |> Util.Strings.add "openat" [ 290 | (to_newfd (Some 0) 1); 291 | (model_open (Some 0) 1); 292 | ] 293 | |> Util.Strings.add "pread" [to_nop] 294 | |> Util.Strings.add "pwrite" [to_nop] 295 | |> Util.Strings.add "read" [to_nop] 296 | |> Util.Strings.add "readlink" [(to_consume None 0)] 297 | |> Util.Strings.add "readlinkat" [(to_consume (Some 0) 1)] 298 | |> Util.Strings.add "removexattr" [(to_consume None 0)] 299 | |> Util.Strings.add "rename" [ 300 | (to_del_path None 0); 301 | (to_produce None 1); 302 | ] 303 | |> Util.Strings.add "renameat" [ 304 | (to_del_path (Some 0) 1); 305 | (to_produce (Some 2) 3); 306 | ] 307 | |> Util.Strings.add "rmdir" [(to_del_path None 0)] 308 | |> Util.Strings.add "symlink" [ 309 | (to_produce None 1); 310 | ] 311 | |> Util.Strings.add "symlinkat" [ 312 | (to_produce (Some 1) 2); 313 | ] 314 | |> Util.Strings.add "unlink" [(to_del_path None 0)] 315 | |> Util.Strings.add "unlinkat" [(to_del_path (Some 0) 1)] 316 | |> Util.Strings.add "utime" [(to_consume None 0)] 317 | |> Util.Strings.add "utimensat" [(to_consume (Some 0) 1)] 318 | |> Util.Strings.add "utimes" [(to_consume None 0)] 319 | |> Util.Strings.add "vfork" [to_newproc] 320 | |> Util.Strings.add "write" [to_nop] 321 | |> Util.Strings.add "writev" [to_nop] 322 | 323 | 324 | let should_ignore trace_line = 325 | Util.check_prefix "+++" trace_line 326 | 327 | 328 | let is_signal trace_line = 329 | Util.check_prefix "---" trace_line 330 | 331 | 332 | let is_resumed syscall_line = 333 | Util.check_prefix "<.." syscall_line 334 | 335 | 336 | let is_unfinished syscall_line = 337 | let str_len = String.length syscall_line in 338 | String.equal (String.sub syscall_line (str_len - 1) 1) ">" 339 | 340 | 341 | let get_syscall_type syscall_line = 342 | if is_resumed syscall_line 343 | then Resumed 344 | else if is_unfinished syscall_line 345 | then Unfinished 346 | else Completed 347 | 348 | 349 | let get_regex syscall_type = 350 | match syscall_type with 351 | | Completed -> regex_syscall 352 | | Resumed -> regex_syscall_resum 353 | | Unfinished -> regex_syscall_unfin 354 | 355 | 356 | let extract_syscall_name syscall_line = 357 | matched_group syscall_group syscall_line 358 | 359 | 360 | let extract_args syscall_line = 361 | matched_group args_group syscall_line 362 | 363 | 364 | let extract_ret_value ret = 365 | matched_group retv_group ret 366 | 367 | 368 | let get_err_msg syscall_line = 369 | match matched_group err_msg_group syscall_line with 370 | | "" -> None 371 | | v -> Some v 372 | 373 | 374 | let extract_ret syscall_line = 375 | try 376 | match matched_group ret_group syscall_line with 377 | | "" -> None 378 | | _ -> Some (extract_ret_value syscall_line, get_err_msg syscall_line) 379 | with Not_found -> None 380 | 381 | 382 | let extract_syscall_desc syscall_line = 383 | match extract_ret syscall_line with 384 | | None -> 385 | extract_syscall_name syscall_line, 386 | extract_args syscall_line, 387 | None, 388 | None 389 | | Some (ret, err) -> 390 | extract_syscall_name syscall_line, 391 | extract_args syscall_line, 392 | Some ret, 393 | err 394 | 395 | 396 | let get_syscall_extractor syscall_type = 397 | fun syscall_line -> 398 | match syscall_type with 399 | | Completed -> 400 | Some ( CoSyscall (extract_syscall_desc syscall_line)) 401 | | Unfinished -> 402 | Some ( UnSyscall ( 403 | matched_group syscall_group syscall_line, 404 | matched_group args_group syscall_line)) 405 | | Resumed -> 406 | Some ( ResSyscall (extract_syscall_desc syscall_line)) 407 | 408 | 409 | let _parse_trace regex extract_value trace_line i = 410 | if should_ignore trace_line 411 | then None 412 | else 413 | if string_match regex trace_line 0 414 | then 415 | try extract_value trace_line 416 | with Invalid_argument _ -> 417 | make_parser_error trace_line i None 418 | else 419 | make_parser_error trace_line i None 420 | 421 | 422 | (* This function constructs a syscall given a description of a system call. 423 | Note that we need to identify if a system call stem from debug messages of the tool 424 | because we need to extract the name of the resource. *) 425 | let construct_syscall sdesc = 426 | let syscall_line = string_of_syscall sdesc in 427 | if T.is_tool_debug_msg syscall_line 428 | then [T.model_syscall syscall_line], sdesc 429 | else 430 | match Util.Strings.find_opt sdesc.syscall parsers with 431 | | Some parser_funs -> (List.fold_left (fun traces parser_fun -> (parser_fun sdesc) :: traces) [] parser_funs), sdesc 432 | | None -> [Syntax.Nop], sdesc 433 | 434 | 435 | let parse_syscall syscall_line (pid, map) i = 436 | let syscall_type = get_syscall_type syscall_line in 437 | match _parse_trace 438 | (get_regex syscall_type) 439 | (get_syscall_extractor syscall_type) 440 | syscall_line 441 | i 442 | with 443 | | Some (UnSyscall (v1, v2)) -> 444 | None, Util.StringPair.add (pid, v1) v2 map 445 | | Some (ResSyscall (v1, v2, Some v3, v4)) -> ( 446 | try 447 | let args = Util.StringPair.find (pid, v1) map in 448 | let sdesc = { 449 | syscall = v1; 450 | args = ( 451 | match args, v2 with 452 | | _, "" -> args 453 | | "", v -> v 454 | | arg1, arg2 -> arg1 ^ " " ^ arg2 455 | ); 456 | ret = v3; 457 | err = v4; 458 | line = i; 459 | } in 460 | Some (construct_syscall sdesc), 461 | Util.StringPair.remove (pid, v1) map 462 | with Not_found -> None, map) 463 | | Some (CoSyscall (v1, v2, Some v3, v4)) -> 464 | Some (construct_syscall { 465 | syscall = v1; 466 | args = v2; 467 | ret = v3; 468 | err = v4; 469 | line = i; 470 | }), 471 | map 472 | | None 473 | | Some (ResSyscall (_, _, None, _)) 474 | | Some (CoSyscall (_, _, None, _)) -> None, map 475 | 476 | 477 | let parse_trace trace_line (pid, map) i = 478 | if should_ignore trace_line 479 | then None, map 480 | else 481 | if is_signal trace_line 482 | then None, map (* We do not handle signals. *) 483 | else parse_syscall trace_line (pid, map) i 484 | 485 | 486 | let parse_traces line map i = 487 | try 488 | match full_split regex_pid line with 489 | | Delim pid :: Text trace_line :: [] -> ( 490 | let pid = String.trim pid in 491 | match parse_trace trace_line (pid, map) i with 492 | | None, map -> None, map 493 | | Some (traces, sdesc), map -> 494 | Some (List.map(fun trace -> (pid, (trace, sdesc))) traces), map) 495 | | _ -> make_parser_error line i None 496 | with _ -> make_parser_error line i None 497 | 498 | 499 | let write_trace_line out line = 500 | match out with 501 | | None -> () 502 | | Some out -> Printf.fprintf out "%s\n" line 503 | 504 | let close_trace_out out = 505 | match out with 506 | | None -> () 507 | | Some out -> close_out out 508 | 509 | let parse_lines lines debug_trace_file = 510 | (* i is just a counter of the current stream. 511 | Also it indicates the number of the line 512 | where every trace is located. *) 513 | let trace_out = 514 | match debug_trace_file with 515 | | Some trace_file -> Some (open_out trace_file) 516 | | None -> None 517 | in 518 | let rec _next_trace traces m i () = 519 | match traces with 520 | | [] -> ( 521 | match input_line lines with 522 | | line -> 523 | write_trace_line trace_out line; 524 | if T.stop_parser line 525 | then 526 | begin 527 | (* We don't need to analyze more traces *) 528 | close_in lines; 529 | close_trace_out trace_out; 530 | Stream (dummy_statement (Syntax.End_task "") i, fun () -> Empty) 531 | end 532 | else ( 533 | match parse_traces line m i with 534 | | Some traces, map' -> _next_trace traces map' (i + 1) () 535 | (* If None, we just ignore that trace, 536 | and we recursively search for another. *) 537 | | None, map' -> _next_trace [] map' (i + 1) ()) 538 | | exception End_of_file -> 539 | close_in lines; 540 | close_trace_out trace_out; 541 | Empty 542 | | exception Error v -> 543 | close_in lines; 544 | close_trace_out trace_out; 545 | raise (Error v) 546 | | exception v -> 547 | close_in lines; 548 | close_trace_out trace_out; 549 | let msg = Printexc.to_string v in 550 | raise (Error (InternalError, Some msg))) 551 | | trace :: traces' -> 552 | Stream (trace, _next_trace traces' m i) 553 | in _next_trace [] Util.StringPair.empty 1 () 554 | 555 | 556 | let parse_trace_fd debug_trace_file fd = 557 | match parse_lines (Unix.in_channel_of_descr fd) debug_trace_file with 558 | | traces -> traces 559 | | exception Sys_error msg -> raise (Error (GenericError, Some msg)) 560 | 561 | 562 | let parse_trace_file debug_trace_file filename = 563 | match parse_lines (open_in filename) debug_trace_file with 564 | | traces -> traces 565 | | exception Sys_error msg -> raise (Error (GenericError, Some msg)) 566 | end 567 | --------------------------------------------------------------------------------