1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(***********************************************************************)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
open My_std
module type TRACER = sig
(** Call the given command using the tracer, it returns the exit status. *)
val call : string -> string list -> StringSet.t * Unix.process_status
end
module Ktrace = struct
let process_line line (wait_a_string, set) =
let strings = Lexers.space_sep_strings (Lexing.from_string line) in
if wait_a_string then
match strings with
| [_; _; "NAMI"; file] -> false, StringSet.add file set
| _ -> failwith (Printf.sprintf "unexpected ktrace output line (%S)" line)
else
match strings with
| [_; _; "CALL"; fct] ->
(String.length fct > 5 && String.sub fct 0 5 = "open("), set
| _ -> false, set
let call cmd args =
let tmp = Filename.temp_file "ktrace" "out" in
match Unix.fork () with
| 0 -> Unix.execvp "ktrace" (Array.of_list("-d"::"-i"::"-t"::"nc"::"-f"::tmp::cmd::args))
| pid ->
let _, st = Unix.waitpid [] pid in
let ic = Unix.open_process_in (Printf.sprintf "kdump -f %s" (Filename.quote tmp)) in
let close () = ignore (Unix.close_process_in ic); Sys.remove tmp in
let set =
try
let rec loop acc =
match try Some (input_line ic) with End_of_file -> None with
| Some line -> loop (process_line line acc)
| None -> acc in
let _, set = loop (false, StringSet.empty) in
close ();
set
with e -> (close (); raise e)
in set, st
end
module Driver (T : TRACER) = struct
let usage () =
Printf.eprintf "Usage: %s [-a <authorized_file>]* <cmd> <args>*\n%!" Sys.argv.(0);
exit 2
let main () =
let log = "opentracer.log" in
let oc =
if sys_file_exists log then
open_out_gen [Open_wronly;Open_append;Open_text] 0 log
else
let oc = open_out log in
let () = output_string oc "---\n" in
oc in
let rec loop acc =
function
| "-a" :: file :: rest -> loop (StringSet.add file acc) rest
| "-a" :: _ -> usage ()
| "--" :: cmd :: args -> acc, cmd, args
| cmd :: args -> acc, cmd, args
| [] -> usage () in
let authorized_files, cmd, args =
loop StringSet.empty (List.tl (Array.to_list Sys.argv)) in
let opened_files, st = T.call cmd args in
let forbidden_files = StringSet.diff opened_files authorized_files in
if not (StringSet.is_empty forbidden_files) then begin
Printf.fprintf oc "- cmd: %s\n args:\n%!" cmd;
let pp = Printf.fprintf oc " - %s\n%!" in
List.iter pp args;
Printf.fprintf oc " forbidden_files:\n%!";
StringSet.iter pp forbidden_files;
end;
close_out oc;
match st with
| Unix.WEXITED st -> exit st
| Unix.WSIGNALED s | Unix.WSTOPPED s -> Unix.kill (Unix.getpid ()) s
end
let main =
(* match os with *)
(* | "macos" -> *)
let module M = Driver(Ktrace) in M.main
(* | "linux" -> *)
(* let module M = Driver(Strace) in M.main *)
let () = main ()
|
