Fault detection and integrity monitoring for kernel isolation structures
feat(fdir): integrity monitoring library for kernel isolation structures
Periodic checker that snapshots /proc state (memory maps, seccomp,
cgroups) at boot and detects radiation-induced corruption by comparing
SHA-256 hashes on a timer. Integrated into pid1 as a daemon fiber.
65 tests covering corruption patterns (bit flips, truncation, null
injection), anomaly validation, realistic procfs tampering scenarios,
hash properties, config, and pretty-printers.
+1346
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version = 0.28.1
+28
dune-project
+28
dune-project
···
1
+
(lang dune 3.21)
2
+
3
+
(name fdir)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(package
12
+
(name fdir)
13
+
(synopsis "Integrity monitoring for kernel isolation structures")
14
+
(description
15
+
"Periodic integrity checker that takes known-good snapshots of kernel
16
+
isolation structures (page tables, seccomp filters, cgroup configs,
17
+
memory mappings) at boot and detects radiation-induced corruption
18
+
by comparing against them on a timer.")
19
+
(depends
20
+
(ocaml (>= 5.1))
21
+
(dune (>= 3.0))
22
+
(eio (>= 1.0))
23
+
(digestif (>= 1.0))
24
+
(fmt (>= 0.9))
25
+
(logs (>= 0.7))
26
+
(alcotest :with-test)
27
+
(eio_main :with-test)
28
+
(odoc :with-doc)))
+37
fdir.opam
+37
fdir.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Integrity monitoring for kernel isolation structures"
4
+
description: """
5
+
Periodic integrity checker that takes known-good snapshots of kernel
6
+
isolation structures (page tables, seccomp filters, cgroup configs,
7
+
memory mappings) at boot and detects radiation-induced corruption
8
+
by comparing against them on a timer."""
9
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
11
+
license: "ISC"
12
+
depends: [
13
+
"ocaml" {>= "5.1"}
14
+
"dune" {>= "3.21" & >= "3.0"}
15
+
"eio" {>= "1.0"}
16
+
"digestif" {>= "1.0"}
17
+
"fmt" {>= "0.9"}
18
+
"logs" {>= "0.7"}
19
+
"alcotest" {with-test}
20
+
"eio_main" {with-test}
21
+
"odoc" {with-doc}
22
+
]
23
+
build: [
24
+
["dune" "subst"] {dev}
25
+
[
26
+
"dune"
27
+
"build"
28
+
"-p"
29
+
name
30
+
"-j"
31
+
jobs
32
+
"@install"
33
+
"@runtest" {with-test}
34
+
"@doc" {with-doc}
35
+
]
36
+
]
37
+
x-maintenance-intent: ["(latest)"]
+4
lib/dune
+4
lib/dune
+183
lib/fdir.ml
+183
lib/fdir.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type severity = Log | Isolate | Restart | Degrade | Safe_mode
7
+
type subsystem = Memory_maps | Seccomp | Cgroups
8
+
type hash = string
9
+
type subsystem_snapshot = { subsystem : subsystem; hash : hash; raw_size : int }
10
+
type snapshot = { timestamp : float; entries : subsystem_snapshot list }
11
+
12
+
type anomaly = {
13
+
subsystem : subsystem;
14
+
expected : hash;
15
+
actual : hash;
16
+
expected_size : int;
17
+
actual_size : int;
18
+
}
19
+
20
+
type check_result =
21
+
| Ok of { elapsed_ns : int64 }
22
+
| Anomaly of { anomalies : anomaly list; elapsed_ns : int64 }
23
+
24
+
let pp_severity fmt = function
25
+
| Log -> Fmt.string fmt "Log"
26
+
| Isolate -> Fmt.string fmt "Isolate"
27
+
| Restart -> Fmt.string fmt "Restart"
28
+
| Degrade -> Fmt.string fmt "Degrade"
29
+
| Safe_mode -> Fmt.string fmt "Safe_mode"
30
+
31
+
let pp_subsystem fmt = function
32
+
| Memory_maps -> Fmt.string fmt "Memory_maps"
33
+
| Seccomp -> Fmt.string fmt "Seccomp"
34
+
| Cgroups -> Fmt.string fmt "Cgroups"
35
+
36
+
module Procfs = struct
37
+
type t = {
38
+
maps : unit -> string;
39
+
status : unit -> string;
40
+
cgroups : unit -> string;
41
+
}
42
+
43
+
let read_file path =
44
+
try In_channel.with_open_text path In_channel.input_all with _ -> ""
45
+
46
+
let live () =
47
+
{
48
+
maps = (fun () -> read_file "/proc/self/maps");
49
+
status = (fun () -> read_file "/proc/self/status");
50
+
cgroups = (fun () -> read_file "/proc/self/cgroup");
51
+
}
52
+
53
+
let mock ~maps ~status ~cgroups =
54
+
{
55
+
maps = (fun () -> maps);
56
+
status = (fun () -> status);
57
+
cgroups = (fun () -> cgroups);
58
+
}
59
+
60
+
let read t = function
61
+
| Memory_maps -> t.maps ()
62
+
| Seccomp -> t.status ()
63
+
| Cgroups -> t.cgroups ()
64
+
end
65
+
66
+
let all_subsystems = [ Memory_maps; Seccomp; Cgroups ]
67
+
68
+
let hash_subsystem fs subsystem =
69
+
let data = Procfs.read fs subsystem in
70
+
let hash = Digestif.SHA256.(digest_string data |> to_raw_string) in
71
+
{ subsystem; hash; raw_size = String.length data }
72
+
73
+
let snapshot ~clock fs =
74
+
let timestamp = Eio.Time.now clock in
75
+
let entries = List.map (hash_subsystem fs) all_subsystems in
76
+
{ timestamp; entries }
77
+
78
+
let check ~baseline ~clock fs =
79
+
let t0 = Eio.Time.now clock in
80
+
let current_entries = List.map (hash_subsystem fs) all_subsystems in
81
+
let t1 = Eio.Time.now clock in
82
+
let elapsed_ns = Int64.of_float ((t1 -. t0) *. 1e9) in
83
+
let anomalies =
84
+
List.filter_map
85
+
(fun (base : subsystem_snapshot) ->
86
+
match
87
+
List.find_opt
88
+
(fun (e : subsystem_snapshot) -> e.subsystem = base.subsystem)
89
+
current_entries
90
+
with
91
+
| None -> None
92
+
| Some curr ->
93
+
if base.hash = curr.hash then None
94
+
else
95
+
Some
96
+
{
97
+
subsystem = base.subsystem;
98
+
expected = base.hash;
99
+
actual = curr.hash;
100
+
expected_size = base.raw_size;
101
+
actual_size = curr.raw_size;
102
+
})
103
+
baseline.entries
104
+
in
105
+
match anomalies with
106
+
| [] -> Ok { elapsed_ns }
107
+
| _ -> Anomaly { anomalies; elapsed_ns }
108
+
109
+
type handler = anomaly list -> severity
110
+
111
+
let default_handler anomalies =
112
+
match List.length anomalies with
113
+
| n when n <= 1 -> Log
114
+
| 2 -> Degrade
115
+
| _ -> Safe_mode
116
+
117
+
module Config = struct
118
+
type t = { interval : float; subsystems : subsystem list }
119
+
120
+
let v ?(interval = 30.0) ?(subsystems = all_subsystems) () =
121
+
{ interval; subsystems }
122
+
123
+
let interval t = t.interval
124
+
let subsystems t = t.subsystems
125
+
end
126
+
127
+
let severity_to_int = function
128
+
| Log -> 0
129
+
| Isolate -> 1
130
+
| Restart -> 2
131
+
| Degrade -> 3
132
+
| Safe_mode -> 4
133
+
134
+
let max_severity a b = if severity_to_int a >= severity_to_int b then a else b
135
+
136
+
type stats = {
137
+
checks_total : int;
138
+
anomalies_total : int;
139
+
last_check : float option;
140
+
max_severity_seen : severity option;
141
+
}
142
+
143
+
let start_daemon ~sw ~clock ~config ~baseline ~fs ~on_anomaly () =
144
+
let _stats =
145
+
ref
146
+
{
147
+
checks_total = 0;
148
+
anomalies_total = 0;
149
+
last_check = None;
150
+
max_severity_seen = None;
151
+
}
152
+
in
153
+
Eio.Fiber.fork_daemon ~sw (fun () ->
154
+
while true do
155
+
Eio.Time.sleep clock (Config.interval config);
156
+
let result = check ~baseline ~clock fs in
157
+
let now = Eio.Time.now clock in
158
+
_stats :=
159
+
{
160
+
!_stats with
161
+
checks_total = !_stats.checks_total + 1;
162
+
last_check = Some now;
163
+
};
164
+
match result with
165
+
| Ok _ -> ()
166
+
| Anomaly { anomalies; _ } ->
167
+
let severity = on_anomaly anomalies in
168
+
_stats :=
169
+
{
170
+
!_stats with
171
+
anomalies_total =
172
+
!_stats.anomalies_total + List.length anomalies;
173
+
max_severity_seen =
174
+
Some
175
+
(match !_stats.max_severity_seen with
176
+
| None -> severity
177
+
| Some prev -> max_severity prev severity);
178
+
};
179
+
Logs.warn (fun m ->
180
+
m "FDIR: %d anomalies detected (severity=%a)"
181
+
(List.length anomalies) pp_severity severity)
182
+
done;
183
+
`Stop_daemon)
+81
lib/fdir.mli
+81
lib/fdir.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Fault Detection, Isolation and Recovery (FDIR).
7
+
8
+
Periodic integrity checker for kernel isolation structures. Takes known-good
9
+
snapshots at boot and compares against them on a timer to detect
10
+
radiation-induced corruption. *)
11
+
12
+
type severity = Log | Isolate | Restart | Degrade | Safe_mode
13
+
type subsystem = Memory_maps | Seccomp | Cgroups
14
+
type hash = string
15
+
type subsystem_snapshot = { subsystem : subsystem; hash : hash; raw_size : int }
16
+
type snapshot = { timestamp : float; entries : subsystem_snapshot list }
17
+
18
+
type anomaly = {
19
+
subsystem : subsystem;
20
+
expected : hash;
21
+
actual : hash;
22
+
expected_size : int;
23
+
actual_size : int;
24
+
}
25
+
26
+
type check_result =
27
+
| Ok of { elapsed_ns : int64 }
28
+
| Anomaly of { anomalies : anomaly list; elapsed_ns : int64 }
29
+
30
+
module Procfs : sig
31
+
type t
32
+
33
+
val live : unit -> t
34
+
(** Read from real [/proc]. *)
35
+
36
+
val mock : maps:string -> status:string -> cgroups:string -> t
37
+
(** Canned data for testing. *)
38
+
end
39
+
40
+
val snapshot : clock:_ Eio.Time.clock -> Procfs.t -> snapshot
41
+
(** Take a snapshot of all subsystems. *)
42
+
43
+
val check :
44
+
baseline:snapshot -> clock:_ Eio.Time.clock -> Procfs.t -> check_result
45
+
(** Compare current state against [baseline]. *)
46
+
47
+
type handler = anomaly list -> severity
48
+
49
+
val default_handler : handler
50
+
(** 1 subsystem changed -> [Log], 2 -> [Degrade], 3+ -> [Safe_mode]. *)
51
+
52
+
val pp_severity : Format.formatter -> severity -> unit
53
+
val pp_subsystem : Format.formatter -> subsystem -> unit
54
+
55
+
module Config : sig
56
+
type t
57
+
58
+
val v : ?interval:float -> ?subsystems:subsystem list -> unit -> t
59
+
(** Default: interval=30.0s, subsystems=all three. *)
60
+
61
+
val interval : t -> float
62
+
val subsystems : t -> subsystem list
63
+
end
64
+
65
+
type stats = {
66
+
checks_total : int;
67
+
anomalies_total : int;
68
+
last_check : float option;
69
+
max_severity_seen : severity option;
70
+
}
71
+
72
+
val start_daemon :
73
+
sw:Eio.Switch.t ->
74
+
clock:_ Eio.Time.clock ->
75
+
config:Config.t ->
76
+
baseline:snapshot ->
77
+
fs:Procfs.t ->
78
+
on_anomaly:handler ->
79
+
unit ->
80
+
unit
81
+
(** Fork a daemon fiber that periodically checks integrity. *)
+5
test/dune
+5
test/dune
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "fdir" [ Test_fdir.suite ]
+1005
test/test_fdir.ml
+1005
test/test_fdir.ml
···
1
+
let mock_maps = "7f9a1000-7f9a2000 r-xp 00000000 08:01 123456 /usr/lib/libc.so"
2
+
let mock_status = "Seccomp:\t2\nSeccomp_filters:\t1"
3
+
let mock_cgroups = "0::/system.slice/init.scope"
4
+
let with_eio f () = Eio_main.run @@ fun env -> f (Eio.Stdenv.clock env)
5
+
6
+
let mock_fs ?(maps = mock_maps) ?(status = mock_status)
7
+
?(cgroups = mock_cgroups) () =
8
+
Fdir.Procfs.mock ~maps ~status ~cgroups
9
+
10
+
let make_anomaly ?(expected = "x") ?(actual = "y") ?(expected_size = 1)
11
+
?(actual_size = 1) sub =
12
+
{ Fdir.subsystem = sub; expected; actual; expected_size; actual_size }
13
+
14
+
(* ── Snapshot creation ──────────────────────────────────────────────── *)
15
+
16
+
let test_snapshot_creation =
17
+
Alcotest.test_case "snapshot creation" `Quick
18
+
( with_eio @@ fun clock ->
19
+
let snap = Fdir.snapshot ~clock (mock_fs ()) in
20
+
Alcotest.(check int) "3 entries" 3 (List.length snap.entries);
21
+
List.iter
22
+
(fun (e : Fdir.subsystem_snapshot) ->
23
+
Alcotest.(check int) "32-byte hash" 32 (String.length e.hash))
24
+
snap.entries )
25
+
26
+
let test_snapshot_sizes =
27
+
Alcotest.test_case "snapshot sizes" `Quick
28
+
( with_eio @@ fun clock ->
29
+
let snap = Fdir.snapshot ~clock (mock_fs ()) in
30
+
let find sub =
31
+
List.find
32
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = sub)
33
+
snap.entries
34
+
in
35
+
Alcotest.(check int)
36
+
"maps size" (String.length mock_maps) (find Memory_maps).raw_size;
37
+
Alcotest.(check int)
38
+
"status size"
39
+
(String.length mock_status)
40
+
(find Seccomp).raw_size;
41
+
Alcotest.(check int)
42
+
"cgroups size"
43
+
(String.length mock_cgroups)
44
+
(find Cgroups).raw_size )
45
+
46
+
let test_snapshot_timestamp_positive =
47
+
Alcotest.test_case "snapshot timestamp > 0" `Quick
48
+
( with_eio @@ fun clock ->
49
+
let snap = Fdir.snapshot ~clock (mock_fs ()) in
50
+
Alcotest.(check bool) "timestamp > 0" true (snap.timestamp > 0.0) )
51
+
52
+
let test_snapshot_entry_order =
53
+
Alcotest.test_case "snapshot entry order is consistent" `Quick
54
+
( with_eio @@ fun clock ->
55
+
let snap1 = Fdir.snapshot ~clock (mock_fs ()) in
56
+
let snap2 = Fdir.snapshot ~clock (mock_fs ()) in
57
+
List.iter2
58
+
(fun (a : Fdir.subsystem_snapshot) (b : Fdir.subsystem_snapshot) ->
59
+
Alcotest.(check bool)
60
+
"same subsystem order" true
61
+
(a.subsystem = b.subsystem))
62
+
snap1.entries snap2.entries )
63
+
64
+
let test_snapshot_subsystem_coverage =
65
+
Alcotest.test_case "snapshot covers all subsystems" `Quick
66
+
( with_eio @@ fun clock ->
67
+
let snap = Fdir.snapshot ~clock (mock_fs ()) in
68
+
let subs =
69
+
List.map (fun (e : Fdir.subsystem_snapshot) -> e.subsystem) snap.entries
70
+
in
71
+
Alcotest.(check bool)
72
+
"has Memory_maps" true
73
+
(List.mem Fdir.Memory_maps subs);
74
+
Alcotest.(check bool) "has Seccomp" true (List.mem Fdir.Seccomp subs);
75
+
Alcotest.(check bool) "has Cgroups" true (List.mem Fdir.Cgroups subs) )
76
+
77
+
(* ── Check OK ───────────────────────────────────────────────────────── *)
78
+
79
+
let test_check_ok =
80
+
Alcotest.test_case "check OK" `Quick
81
+
( with_eio @@ fun clock ->
82
+
let fs = mock_fs () in
83
+
let baseline = Fdir.snapshot ~clock fs in
84
+
match Fdir.check ~baseline ~clock fs with
85
+
| Fdir.Ok _ -> ()
86
+
| Fdir.Anomaly _ -> Alcotest.fail "expected Ok, got Anomaly" )
87
+
88
+
let test_check_ok_elapsed_non_negative =
89
+
Alcotest.test_case "check OK elapsed_ns >= 0" `Quick
90
+
( with_eio @@ fun clock ->
91
+
let fs = mock_fs () in
92
+
let baseline = Fdir.snapshot ~clock fs in
93
+
match Fdir.check ~baseline ~clock fs with
94
+
| Fdir.Ok { elapsed_ns } ->
95
+
Alcotest.(check bool) ">= 0" true (elapsed_ns >= 0L)
96
+
| Fdir.Anomaly _ -> Alcotest.fail "expected Ok" )
97
+
98
+
let test_check_ok_repeated =
99
+
Alcotest.test_case "check OK repeated 10 times" `Quick
100
+
( with_eio @@ fun clock ->
101
+
let fs = mock_fs () in
102
+
let baseline = Fdir.snapshot ~clock fs in
103
+
for _ = 1 to 10 do
104
+
match Fdir.check ~baseline ~clock fs with
105
+
| Fdir.Ok _ -> ()
106
+
| Fdir.Anomaly _ -> Alcotest.fail "expected Ok on repeated check"
107
+
done )
108
+
109
+
(* ── Single subsystem corruption ────────────────────────────────────── *)
110
+
111
+
let test_detect_maps_change =
112
+
Alcotest.test_case "detect maps change" `Quick
113
+
( with_eio @@ fun clock ->
114
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
115
+
let fs2 = mock_fs ~maps:"corrupted" () in
116
+
match Fdir.check ~baseline ~clock fs2 with
117
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
118
+
| Fdir.Anomaly { anomalies; _ } ->
119
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies);
120
+
Alcotest.(check bool)
121
+
"Memory_maps" true
122
+
((List.hd anomalies).subsystem = Memory_maps) )
123
+
124
+
let test_detect_seccomp_change =
125
+
Alcotest.test_case "detect seccomp change" `Quick
126
+
( with_eio @@ fun clock ->
127
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
128
+
let fs2 = mock_fs ~status:"corrupted" () in
129
+
match Fdir.check ~baseline ~clock fs2 with
130
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
131
+
| Fdir.Anomaly { anomalies; _ } ->
132
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies);
133
+
Alcotest.(check bool)
134
+
"Seccomp" true
135
+
((List.hd anomalies).subsystem = Seccomp) )
136
+
137
+
let test_detect_cgroup_change =
138
+
Alcotest.test_case "detect cgroup change" `Quick
139
+
( with_eio @@ fun clock ->
140
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
141
+
let fs2 = mock_fs ~cgroups:"corrupted" () in
142
+
match Fdir.check ~baseline ~clock fs2 with
143
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
144
+
| Fdir.Anomaly { anomalies; _ } ->
145
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies);
146
+
Alcotest.(check bool)
147
+
"Cgroups" true
148
+
((List.hd anomalies).subsystem = Cgroups) )
149
+
150
+
let test_multiple_anomalies =
151
+
Alcotest.test_case "multiple anomalies" `Quick
152
+
( with_eio @@ fun clock ->
153
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
154
+
let fs2 = mock_fs ~maps:"bad" ~status:"bad" ~cgroups:"bad" () in
155
+
match Fdir.check ~baseline ~clock fs2 with
156
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
157
+
| Fdir.Anomaly { anomalies; _ } ->
158
+
Alcotest.(check int) "3 anomalies" 3 (List.length anomalies) )
159
+
160
+
(* ── Corruption patterns (mocking realistic errors) ─────────────────── *)
161
+
162
+
let test_single_bit_flip =
163
+
Alcotest.test_case "single bit flip detected" `Quick
164
+
( with_eio @@ fun clock ->
165
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
166
+
(* Flip one bit in the first byte of maps *)
167
+
let corrupted =
168
+
let b = Bytes.of_string mock_maps in
169
+
let c = Bytes.get b 0 in
170
+
Bytes.set b 0 (Char.chr (Char.code c lxor 1));
171
+
Bytes.to_string b
172
+
in
173
+
let fs2 = mock_fs ~maps:corrupted () in
174
+
match Fdir.check ~baseline ~clock fs2 with
175
+
| Fdir.Ok _ -> Alcotest.fail "single bit flip not detected"
176
+
| Fdir.Anomaly { anomalies; _ } ->
177
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies) )
178
+
179
+
let test_single_byte_appended =
180
+
Alcotest.test_case "single byte appended detected" `Quick
181
+
( with_eio @@ fun clock ->
182
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
183
+
let fs2 = mock_fs ~maps:(mock_maps ^ "\x00") () in
184
+
match Fdir.check ~baseline ~clock fs2 with
185
+
| Fdir.Ok _ -> Alcotest.fail "appended byte not detected"
186
+
| Fdir.Anomaly _ -> () )
187
+
188
+
let test_single_byte_prepended =
189
+
Alcotest.test_case "single byte prepended detected" `Quick
190
+
( with_eio @@ fun clock ->
191
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
192
+
let fs2 = mock_fs ~maps:("\x00" ^ mock_maps) () in
193
+
match Fdir.check ~baseline ~clock fs2 with
194
+
| Fdir.Ok _ -> Alcotest.fail "prepended byte not detected"
195
+
| Fdir.Anomaly _ -> () )
196
+
197
+
let test_truncation_detected =
198
+
Alcotest.test_case "truncation detected" `Quick
199
+
( with_eio @@ fun clock ->
200
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
201
+
let truncated = String.sub mock_maps 0 (String.length mock_maps / 2) in
202
+
let fs2 = mock_fs ~maps:truncated () in
203
+
match Fdir.check ~baseline ~clock fs2 with
204
+
| Fdir.Ok _ -> Alcotest.fail "truncation not detected"
205
+
| Fdir.Anomaly _ -> () )
206
+
207
+
let test_null_byte_injection =
208
+
Alcotest.test_case "null byte injection detected" `Quick
209
+
( with_eio @@ fun clock ->
210
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
211
+
(* Inject null byte in the middle *)
212
+
let mid = String.length mock_status / 2 in
213
+
let corrupted =
214
+
String.sub mock_status 0 mid
215
+
^ "\x00"
216
+
^ String.sub mock_status (mid + 1) (String.length mock_status - mid - 1)
217
+
in
218
+
let fs2 = mock_fs ~status:corrupted () in
219
+
match Fdir.check ~baseline ~clock fs2 with
220
+
| Fdir.Ok _ -> Alcotest.fail "null injection not detected"
221
+
| Fdir.Anomaly _ -> () )
222
+
223
+
let test_whitespace_only_change =
224
+
Alcotest.test_case "whitespace change detected" `Quick
225
+
( with_eio @@ fun clock ->
226
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
227
+
let fs2 = mock_fs ~cgroups:(mock_cgroups ^ " ") () in
228
+
match Fdir.check ~baseline ~clock fs2 with
229
+
| Fdir.Ok _ -> Alcotest.fail "whitespace change not detected"
230
+
| Fdir.Anomaly _ -> () )
231
+
232
+
let test_case_change_detected =
233
+
Alcotest.test_case "case change detected" `Quick
234
+
( with_eio @@ fun clock ->
235
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
236
+
let fs2 = mock_fs ~maps:(String.uppercase_ascii mock_maps) () in
237
+
match Fdir.check ~baseline ~clock fs2 with
238
+
| Fdir.Ok _ -> Alcotest.fail "case change not detected"
239
+
| Fdir.Anomaly _ -> () )
240
+
241
+
let test_data_to_empty_detected =
242
+
Alcotest.test_case "data to empty detected" `Quick
243
+
( with_eio @@ fun clock ->
244
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
245
+
let fs2 = mock_fs ~maps:"" () in
246
+
match Fdir.check ~baseline ~clock fs2 with
247
+
| Fdir.Ok _ -> Alcotest.fail "data→empty not detected"
248
+
| Fdir.Anomaly _ -> () )
249
+
250
+
let test_empty_to_data_detected =
251
+
Alcotest.test_case "empty to data detected" `Quick
252
+
( with_eio @@ fun clock ->
253
+
let baseline = Fdir.snapshot ~clock (mock_fs ~maps:"" ()) in
254
+
let fs2 = mock_fs () in
255
+
match Fdir.check ~baseline ~clock fs2 with
256
+
| Fdir.Ok _ -> Alcotest.fail "empty→data not detected"
257
+
| Fdir.Anomaly _ -> () )
258
+
259
+
let test_binary_data_corruption =
260
+
Alcotest.test_case "binary data corruption detected" `Quick
261
+
( with_eio @@ fun clock ->
262
+
let binary = String.init 256 Char.chr in
263
+
let baseline = Fdir.snapshot ~clock (mock_fs ~maps:binary ()) in
264
+
let corrupted =
265
+
let b = Bytes.of_string binary in
266
+
Bytes.set b 128 '\xff';
267
+
Bytes.to_string b
268
+
in
269
+
let fs2 = mock_fs ~maps:corrupted () in
270
+
match Fdir.check ~baseline ~clock fs2 with
271
+
| Fdir.Ok _ -> Alcotest.fail "binary corruption not detected"
272
+
| Fdir.Anomaly _ -> () )
273
+
274
+
let test_large_data_corruption =
275
+
Alcotest.test_case "large data single-byte corruption" `Quick
276
+
( with_eio @@ fun clock ->
277
+
let large = String.make 100_000 'A' in
278
+
let baseline = Fdir.snapshot ~clock (mock_fs ~maps:large ()) in
279
+
let corrupted =
280
+
let b = Bytes.of_string large in
281
+
Bytes.set b 50_000 'B';
282
+
Bytes.to_string b
283
+
in
284
+
let fs2 = mock_fs ~maps:corrupted () in
285
+
match Fdir.check ~baseline ~clock fs2 with
286
+
| Fdir.Ok _ -> Alcotest.fail "large data corruption not detected"
287
+
| Fdir.Anomaly _ -> () )
288
+
289
+
(* ── Anomaly record validation ──────────────────────────────────────── *)
290
+
291
+
let test_anomaly_expected_hash_matches_baseline =
292
+
Alcotest.test_case "anomaly expected hash = baseline hash" `Quick
293
+
( with_eio @@ fun clock ->
294
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
295
+
let baseline_maps_hash =
296
+
(List.find
297
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
298
+
baseline.entries)
299
+
.hash
300
+
in
301
+
let fs2 = mock_fs ~maps:"corrupted" () in
302
+
match Fdir.check ~baseline ~clock fs2 with
303
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
304
+
| Fdir.Anomaly { anomalies; _ } ->
305
+
let a = List.hd anomalies in
306
+
Alcotest.(check string) "expected hash" baseline_maps_hash a.expected
307
+
)
308
+
309
+
let test_anomaly_actual_hash_matches_current =
310
+
Alcotest.test_case "anomaly actual hash = current hash" `Quick
311
+
( with_eio @@ fun clock ->
312
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
313
+
let corrupted_fs = mock_fs ~maps:"corrupted" () in
314
+
let current_snap = Fdir.snapshot ~clock corrupted_fs in
315
+
let current_maps_hash =
316
+
(List.find
317
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
318
+
current_snap.entries)
319
+
.hash
320
+
in
321
+
match Fdir.check ~baseline ~clock corrupted_fs with
322
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
323
+
| Fdir.Anomaly { anomalies; _ } ->
324
+
let a = List.hd anomalies in
325
+
Alcotest.(check string) "actual hash" current_maps_hash a.actual )
326
+
327
+
let test_anomaly_expected_size =
328
+
Alcotest.test_case "anomaly expected_size = baseline size" `Quick
329
+
( with_eio @@ fun clock ->
330
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
331
+
let fs2 = mock_fs ~maps:"x" () in
332
+
match Fdir.check ~baseline ~clock fs2 with
333
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
334
+
| Fdir.Anomaly { anomalies; _ } ->
335
+
let a = List.hd anomalies in
336
+
Alcotest.(check int)
337
+
"expected_size" (String.length mock_maps) a.expected_size )
338
+
339
+
let test_anomaly_actual_size =
340
+
Alcotest.test_case "anomaly actual_size = current size" `Quick
341
+
( with_eio @@ fun clock ->
342
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
343
+
let corrupted = "short" in
344
+
let fs2 = mock_fs ~maps:corrupted () in
345
+
match Fdir.check ~baseline ~clock fs2 with
346
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
347
+
| Fdir.Anomaly { anomalies; _ } ->
348
+
let a = List.hd anomalies in
349
+
Alcotest.(check int)
350
+
"actual_size" (String.length corrupted) a.actual_size )
351
+
352
+
let test_anomaly_elapsed_non_negative =
353
+
Alcotest.test_case "anomaly elapsed_ns >= 0" `Quick
354
+
( with_eio @@ fun clock ->
355
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
356
+
let fs2 = mock_fs ~maps:"bad" () in
357
+
match Fdir.check ~baseline ~clock fs2 with
358
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
359
+
| Fdir.Anomaly { elapsed_ns; _ } ->
360
+
Alcotest.(check bool) ">= 0" true (elapsed_ns >= 0L) )
361
+
362
+
let test_anomaly_hashes_differ =
363
+
Alcotest.test_case "anomaly expected != actual" `Quick
364
+
( with_eio @@ fun clock ->
365
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
366
+
let fs2 = mock_fs ~status:"tampered" () in
367
+
match Fdir.check ~baseline ~clock fs2 with
368
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
369
+
| Fdir.Anomaly { anomalies; _ } ->
370
+
let a = List.hd anomalies in
371
+
Alcotest.(check bool) "hashes differ" true (a.expected <> a.actual) )
372
+
373
+
let test_multiple_anomaly_subsystems_distinct =
374
+
Alcotest.test_case "multiple anomaly subsystems are distinct" `Quick
375
+
( with_eio @@ fun clock ->
376
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
377
+
let fs2 = mock_fs ~maps:"a" ~status:"b" ~cgroups:"c" () in
378
+
match Fdir.check ~baseline ~clock fs2 with
379
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
380
+
| Fdir.Anomaly { anomalies; _ } ->
381
+
let subs =
382
+
List.map (fun (a : Fdir.anomaly) -> a.subsystem) anomalies
383
+
in
384
+
let unique = List.sort_uniq compare subs in
385
+
Alcotest.(check int) "3 distinct subsystems" 3 (List.length unique) )
386
+
387
+
(* ── Pairwise subsystem combinations ────────────────────────────────── *)
388
+
389
+
let test_two_anomalies_maps_seccomp =
390
+
Alcotest.test_case "two anomalies: maps + seccomp" `Quick
391
+
( with_eio @@ fun clock ->
392
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
393
+
let fs2 = mock_fs ~maps:"bad" ~status:"bad" () in
394
+
match Fdir.check ~baseline ~clock fs2 with
395
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
396
+
| Fdir.Anomaly { anomalies; _ } ->
397
+
Alcotest.(check int) "2 anomalies" 2 (List.length anomalies);
398
+
let subs =
399
+
List.map (fun (a : Fdir.anomaly) -> a.subsystem) anomalies
400
+
in
401
+
Alcotest.(check bool) "has maps" true (List.mem Fdir.Memory_maps subs);
402
+
Alcotest.(check bool) "has seccomp" true (List.mem Fdir.Seccomp subs)
403
+
)
404
+
405
+
let test_two_anomalies_maps_cgroups =
406
+
Alcotest.test_case "two anomalies: maps + cgroups" `Quick
407
+
( with_eio @@ fun clock ->
408
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
409
+
let fs2 = mock_fs ~maps:"bad" ~cgroups:"bad" () in
410
+
match Fdir.check ~baseline ~clock fs2 with
411
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
412
+
| Fdir.Anomaly { anomalies; _ } ->
413
+
Alcotest.(check int) "2 anomalies" 2 (List.length anomalies);
414
+
let subs =
415
+
List.map (fun (a : Fdir.anomaly) -> a.subsystem) anomalies
416
+
in
417
+
Alcotest.(check bool) "has maps" true (List.mem Fdir.Memory_maps subs);
418
+
Alcotest.(check bool) "has cgroups" true (List.mem Fdir.Cgroups subs)
419
+
)
420
+
421
+
let test_two_anomalies_seccomp_cgroups =
422
+
Alcotest.test_case "two anomalies: seccomp + cgroups" `Quick
423
+
( with_eio @@ fun clock ->
424
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
425
+
let fs2 = mock_fs ~status:"bad" ~cgroups:"bad" () in
426
+
match Fdir.check ~baseline ~clock fs2 with
427
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
428
+
| Fdir.Anomaly { anomalies; _ } ->
429
+
Alcotest.(check int) "2 anomalies" 2 (List.length anomalies);
430
+
let subs =
431
+
List.map (fun (a : Fdir.anomaly) -> a.subsystem) anomalies
432
+
in
433
+
Alcotest.(check bool) "has seccomp" true (List.mem Fdir.Seccomp subs);
434
+
Alcotest.(check bool) "has cgroups" true (List.mem Fdir.Cgroups subs)
435
+
)
436
+
437
+
(* ── Default handler severity ───────────────────────────────────────── *)
438
+
439
+
let test_default_handler_severity =
440
+
Alcotest.test_case "default handler 1→Log 2→Degrade 3→Safe_mode" `Quick
441
+
(fun () ->
442
+
let one = [ make_anomaly Memory_maps ] in
443
+
let two = [ make_anomaly Memory_maps; make_anomaly Seccomp ] in
444
+
let three =
445
+
[ make_anomaly Memory_maps; make_anomaly Seccomp; make_anomaly Cgroups ]
446
+
in
447
+
Alcotest.(check bool) "1 -> Log" true (Fdir.default_handler one = Log);
448
+
Alcotest.(check bool)
449
+
"2 -> Degrade" true
450
+
(Fdir.default_handler two = Degrade);
451
+
Alcotest.(check bool)
452
+
"3 -> Safe_mode" true
453
+
(Fdir.default_handler three = Safe_mode))
454
+
455
+
let test_default_handler_empty =
456
+
Alcotest.test_case "default handler empty → Log" `Quick (fun () ->
457
+
Alcotest.(check bool) "0 -> Log" true (Fdir.default_handler [] = Log))
458
+
459
+
let test_default_handler_four_anomalies =
460
+
Alcotest.test_case "default handler 4+ → Safe_mode" `Quick (fun () ->
461
+
let four =
462
+
[
463
+
make_anomaly Memory_maps;
464
+
make_anomaly Seccomp;
465
+
make_anomaly Cgroups;
466
+
make_anomaly Memory_maps;
467
+
]
468
+
in
469
+
Alcotest.(check bool)
470
+
"4 -> Safe_mode" true
471
+
(Fdir.default_handler four = Safe_mode))
472
+
473
+
let test_default_handler_all_same_subsystem =
474
+
Alcotest.test_case "default handler: 3 anomalies same subsystem" `Quick
475
+
(fun () ->
476
+
let three =
477
+
[
478
+
make_anomaly Memory_maps;
479
+
make_anomaly Memory_maps;
480
+
make_anomaly Memory_maps;
481
+
]
482
+
in
483
+
Alcotest.(check bool)
484
+
"3 same -> Safe_mode" true
485
+
(Fdir.default_handler three = Safe_mode))
486
+
487
+
(* ── Hash properties ────────────────────────────────────────────────── *)
488
+
489
+
let test_hash_determinism =
490
+
Alcotest.test_case "hash determinism" `Quick
491
+
( with_eio @@ fun clock ->
492
+
let fs = mock_fs () in
493
+
let snap1 = Fdir.snapshot ~clock fs in
494
+
let snap2 = Fdir.snapshot ~clock fs in
495
+
List.iter2
496
+
(fun (a : Fdir.subsystem_snapshot) (b : Fdir.subsystem_snapshot) ->
497
+
Alcotest.(check string) "same hash" a.hash b.hash)
498
+
snap1.entries snap2.entries )
499
+
500
+
let test_hash_different_data_different_hash =
501
+
Alcotest.test_case "different data → different hash" `Quick
502
+
( with_eio @@ fun clock ->
503
+
let snap1 = Fdir.snapshot ~clock (mock_fs ~maps:"aaa" ()) in
504
+
let snap2 = Fdir.snapshot ~clock (mock_fs ~maps:"bbb" ()) in
505
+
let h1 =
506
+
(List.find
507
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
508
+
snap1.entries)
509
+
.hash
510
+
in
511
+
let h2 =
512
+
(List.find
513
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
514
+
snap2.entries)
515
+
.hash
516
+
in
517
+
Alcotest.(check bool) "hashes differ" true (h1 <> h2) )
518
+
519
+
let test_hash_same_data_different_mock_same_hash =
520
+
Alcotest.test_case "same data from different mocks → same hash" `Quick
521
+
( with_eio @@ fun clock ->
522
+
let fs1 = mock_fs ~maps:"hello" () in
523
+
let fs2 = mock_fs ~maps:"hello" () in
524
+
let snap1 = Fdir.snapshot ~clock fs1 in
525
+
let snap2 = Fdir.snapshot ~clock fs2 in
526
+
let h1 =
527
+
(List.find
528
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
529
+
snap1.entries)
530
+
.hash
531
+
in
532
+
let h2 =
533
+
(List.find
534
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
535
+
snap2.entries)
536
+
.hash
537
+
in
538
+
Alcotest.(check string) "same hash" h1 h2 )
539
+
540
+
let test_hash_avalanche =
541
+
Alcotest.test_case "hash avalanche: similar inputs differ significantly"
542
+
`Quick
543
+
( with_eio @@ fun clock ->
544
+
let snap1 = Fdir.snapshot ~clock (mock_fs ~maps:"test0" ()) in
545
+
let snap2 = Fdir.snapshot ~clock (mock_fs ~maps:"test1" ()) in
546
+
let h1 =
547
+
(List.find
548
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
549
+
snap1.entries)
550
+
.hash
551
+
in
552
+
let h2 =
553
+
(List.find
554
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = Memory_maps)
555
+
snap2.entries)
556
+
.hash
557
+
in
558
+
(* Count differing bytes — should be many for SHA-256 avalanche *)
559
+
let diffs = ref 0 in
560
+
for i = 0 to 31 do
561
+
if h1.[i] <> h2.[i] then incr diffs
562
+
done;
563
+
Alcotest.(check bool) "at least 8 bytes differ" true (!diffs >= 8) )
564
+
565
+
let test_empty_input_valid_hash =
566
+
Alcotest.test_case "empty input produces valid SHA-256" `Quick
567
+
( with_eio @@ fun clock ->
568
+
let fs = mock_fs ~maps:"" ~status:"" ~cgroups:"" () in
569
+
let snap = Fdir.snapshot ~clock fs in
570
+
Alcotest.(check int) "3 entries" 3 (List.length snap.entries);
571
+
List.iter
572
+
(fun (e : Fdir.subsystem_snapshot) ->
573
+
Alcotest.(check int) "32-byte hash" 32 (String.length e.hash);
574
+
Alcotest.(check int) "0 size" 0 e.raw_size)
575
+
snap.entries )
576
+
577
+
let test_empty_strings_same_hash =
578
+
Alcotest.test_case "all-empty subsystems produce same hash" `Quick
579
+
( with_eio @@ fun clock ->
580
+
let snap =
581
+
Fdir.snapshot ~clock (mock_fs ~maps:"" ~status:"" ~cgroups:"" ())
582
+
in
583
+
let hashes =
584
+
List.map (fun (e : Fdir.subsystem_snapshot) -> e.hash) snap.entries
585
+
in
586
+
(* All empty strings → same SHA-256 *)
587
+
match hashes with
588
+
| [ a; b; c ] ->
589
+
Alcotest.(check string) "a = b" a b;
590
+
Alcotest.(check string) "b = c" b c
591
+
| _ -> Alcotest.fail "expected 3 entries" )
592
+
593
+
let test_empty_check_ok =
594
+
Alcotest.test_case "empty data baseline check OK" `Quick
595
+
( with_eio @@ fun clock ->
596
+
let fs = mock_fs ~maps:"" ~status:"" ~cgroups:"" () in
597
+
let baseline = Fdir.snapshot ~clock fs in
598
+
match Fdir.check ~baseline ~clock fs with
599
+
| Fdir.Ok _ -> ()
600
+
| Fdir.Anomaly _ -> Alcotest.fail "expected Ok for empty data" )
601
+
602
+
(* ── Config ─────────────────────────────────────────────────────────── *)
603
+
604
+
let test_config_defaults =
605
+
Alcotest.test_case "config defaults" `Quick (fun () ->
606
+
let config = Fdir.Config.v () in
607
+
Alcotest.(check (float 0.01))
608
+
"interval" 30.0
609
+
(Fdir.Config.interval config);
610
+
Alcotest.(check int)
611
+
"subsystems" 3
612
+
(List.length (Fdir.Config.subsystems config)))
613
+
614
+
let test_config_custom_interval =
615
+
Alcotest.test_case "config custom interval" `Quick (fun () ->
616
+
let config = Fdir.Config.v ~interval:5.0 () in
617
+
Alcotest.(check (float 0.01)) "interval" 5.0 (Fdir.Config.interval config))
618
+
619
+
let test_config_custom_subsystems =
620
+
Alcotest.test_case "config custom subsystems" `Quick (fun () ->
621
+
let config =
622
+
Fdir.Config.v ~subsystems:[ Fdir.Memory_maps; Fdir.Seccomp ] ()
623
+
in
624
+
Alcotest.(check int)
625
+
"subsystems" 2
626
+
(List.length (Fdir.Config.subsystems config)))
627
+
628
+
let test_config_single_subsystem =
629
+
Alcotest.test_case "config single subsystem" `Quick (fun () ->
630
+
let config = Fdir.Config.v ~subsystems:[ Fdir.Cgroups ] () in
631
+
Alcotest.(check int)
632
+
"subsystems" 1
633
+
(List.length (Fdir.Config.subsystems config));
634
+
Alcotest.(check bool)
635
+
"is Cgroups" true
636
+
(List.hd (Fdir.Config.subsystems config) = Cgroups))
637
+
638
+
let test_config_empty_subsystems =
639
+
Alcotest.test_case "config empty subsystems" `Quick (fun () ->
640
+
let config = Fdir.Config.v ~subsystems:[] () in
641
+
Alcotest.(check int)
642
+
"subsystems" 0
643
+
(List.length (Fdir.Config.subsystems config)))
644
+
645
+
let test_config_small_interval =
646
+
Alcotest.test_case "config small interval" `Quick (fun () ->
647
+
let config = Fdir.Config.v ~interval:0.001 () in
648
+
Alcotest.(check (float 0.0001))
649
+
"interval" 0.001
650
+
(Fdir.Config.interval config))
651
+
652
+
let test_config_large_interval =
653
+
Alcotest.test_case "config large interval" `Quick (fun () ->
654
+
let config = Fdir.Config.v ~interval:3600.0 () in
655
+
Alcotest.(check (float 0.01))
656
+
"interval" 3600.0
657
+
(Fdir.Config.interval config))
658
+
659
+
(* ── Pretty-printers ────────────────────────────────────────────────── *)
660
+
661
+
let test_pp_functions =
662
+
Alcotest.test_case "pretty-printers don't crash" `Quick (fun () ->
663
+
let buf = Buffer.create 16 in
664
+
let fmt = Format.formatter_of_buffer buf in
665
+
List.iter
666
+
(fun sev ->
667
+
Fdir.pp_severity fmt sev;
668
+
Format.pp_print_flush fmt ())
669
+
[ Fdir.Log; Fdir.Isolate; Fdir.Restart; Fdir.Degrade; Fdir.Safe_mode ];
670
+
List.iter
671
+
(fun sub ->
672
+
Fdir.pp_subsystem fmt sub;
673
+
Format.pp_print_flush fmt ())
674
+
[ Fdir.Memory_maps; Fdir.Seccomp; Fdir.Cgroups ];
675
+
Alcotest.(check bool) "pp didn't crash" true (Buffer.length buf > 0))
676
+
677
+
let test_pp_severity_values =
678
+
Alcotest.test_case "pp_severity output values" `Quick (fun () ->
679
+
let pp s = Fmt.str "%a" Fdir.pp_severity s in
680
+
Alcotest.(check string) "Log" "Log" (pp Log);
681
+
Alcotest.(check string) "Isolate" "Isolate" (pp Isolate);
682
+
Alcotest.(check string) "Restart" "Restart" (pp Restart);
683
+
Alcotest.(check string) "Degrade" "Degrade" (pp Degrade);
684
+
Alcotest.(check string) "Safe_mode" "Safe_mode" (pp Safe_mode))
685
+
686
+
let test_pp_subsystem_values =
687
+
Alcotest.test_case "pp_subsystem output values" `Quick (fun () ->
688
+
let pp s = Fmt.str "%a" Fdir.pp_subsystem s in
689
+
Alcotest.(check string) "Memory_maps" "Memory_maps" (pp Memory_maps);
690
+
Alcotest.(check string) "Seccomp" "Seccomp" (pp Seccomp);
691
+
Alcotest.(check string) "Cgroups" "Cgroups" (pp Cgroups))
692
+
693
+
let test_pp_severity_with_fmt_str =
694
+
Alcotest.test_case "pp_severity works with Fmt.str" `Quick (fun () ->
695
+
let s = Fmt.str "severity=%a" Fdir.pp_severity Fdir.Safe_mode in
696
+
Alcotest.(check string) "formatted" "severity=Safe_mode" s)
697
+
698
+
let test_pp_subsystem_with_fmt_str =
699
+
Alcotest.test_case "pp_subsystem works with Fmt.str" `Quick (fun () ->
700
+
let s = Fmt.str "sub=%a" Fdir.pp_subsystem Fdir.Memory_maps in
701
+
Alcotest.(check string) "formatted" "sub=Memory_maps" s)
702
+
703
+
(* ── Cross-mock consistency ─────────────────────────────────────────── *)
704
+
705
+
let test_independent_subsystem_hashes =
706
+
Alcotest.test_case "subsystem hashes are independent" `Quick
707
+
( with_eio @@ fun clock ->
708
+
let snap1 = Fdir.snapshot ~clock (mock_fs ~maps:"A" ()) in
709
+
let snap2 = Fdir.snapshot ~clock (mock_fs ~maps:"B" ()) in
710
+
let get sub entries =
711
+
(List.find
712
+
(fun (e : Fdir.subsystem_snapshot) -> e.subsystem = sub)
713
+
entries)
714
+
.hash
715
+
in
716
+
(* Maps hash should differ *)
717
+
Alcotest.(check bool)
718
+
"maps differs" true
719
+
(get Memory_maps snap1.entries <> get Memory_maps snap2.entries);
720
+
(* Status and cgroups hashes should be the same *)
721
+
Alcotest.(check string)
722
+
"seccomp same"
723
+
(get Seccomp snap1.entries)
724
+
(get Seccomp snap2.entries);
725
+
Alcotest.(check string)
726
+
"cgroups same"
727
+
(get Cgroups snap1.entries)
728
+
(get Cgroups snap2.entries) )
729
+
730
+
let test_check_after_revert_ok =
731
+
Alcotest.test_case "check OK after corruption reverts" `Quick
732
+
( with_eio @@ fun clock ->
733
+
let fs = mock_fs () in
734
+
let baseline = Fdir.snapshot ~clock fs in
735
+
(* First check with corruption *)
736
+
let fs_bad = mock_fs ~maps:"corrupted" () in
737
+
(match Fdir.check ~baseline ~clock fs_bad with
738
+
| Fdir.Ok _ -> Alcotest.fail "should have detected corruption"
739
+
| Fdir.Anomaly _ -> ());
740
+
(* Second check with original data — should be OK again *)
741
+
match Fdir.check ~baseline ~clock fs with
742
+
| Fdir.Ok _ -> ()
743
+
| Fdir.Anomaly _ -> Alcotest.fail "should be OK after revert" )
744
+
745
+
let test_check_with_different_corruption_each_time =
746
+
Alcotest.test_case "different corruptions produce different anomalies" `Quick
747
+
( with_eio @@ fun clock ->
748
+
let baseline = Fdir.snapshot ~clock (mock_fs ()) in
749
+
let get_hash result =
750
+
match result with
751
+
| Fdir.Ok _ -> Alcotest.fail "expected Anomaly"
752
+
| Fdir.Anomaly { anomalies; _ } -> (List.hd anomalies).actual
753
+
in
754
+
let h1 =
755
+
get_hash (Fdir.check ~baseline ~clock (mock_fs ~maps:"corrupt_A" ()))
756
+
in
757
+
let h2 =
758
+
get_hash (Fdir.check ~baseline ~clock (mock_fs ~maps:"corrupt_B" ()))
759
+
in
760
+
Alcotest.(check bool)
761
+
"different corruptions → different hashes" true (h1 <> h2) )
762
+
763
+
(* ── Realistic procfs content ───────────────────────────────────────── *)
764
+
765
+
let realistic_maps =
766
+
{|55a1b2c3d000-55a1b2c3e000 r--p 00000000 08:01 1234567 /usr/bin/init
767
+
55a1b2c3e000-55a1b2c3f000 r-xp 00001000 08:01 1234567 /usr/bin/init
768
+
7f8a12300000-7f8a12500000 r--p 00000000 08:01 2345678 /usr/lib/libc.so.6
769
+
7f8a12500000-7f8a12680000 r-xp 00200000 08:01 2345678 /usr/lib/libc.so.6
770
+
7ffd9e100000-7ffd9e121000 rw-p 00000000 00:00 0 [stack]
771
+
ffffffffff600000-ffffffffff601000 --xp 00000000 00:00 0 [vsyscall]|}
772
+
773
+
let realistic_status =
774
+
{|Name: init
775
+
Umask: 0022
776
+
State: S (sleeping)
777
+
Tgid: 1
778
+
Ngid: 0
779
+
Pid: 1
780
+
PPid: 0
781
+
Seccomp: 2
782
+
Seccomp_filters: 1
783
+
Cpus_allowed: f
784
+
Mems_allowed: 1|}
785
+
786
+
let realistic_cgroups =
787
+
{|0::/init.scope
788
+
1:name=systemd:/init.scope
789
+
2:cpuset:/
790
+
3:memory:/init.scope|}
791
+
792
+
let test_realistic_snapshot =
793
+
Alcotest.test_case "realistic procfs snapshot" `Quick
794
+
( with_eio @@ fun clock ->
795
+
let fs =
796
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
797
+
~cgroups:realistic_cgroups
798
+
in
799
+
let snap = Fdir.snapshot ~clock fs in
800
+
Alcotest.(check int) "3 entries" 3 (List.length snap.entries);
801
+
List.iter
802
+
(fun (e : Fdir.subsystem_snapshot) ->
803
+
Alcotest.(check int) "32-byte hash" 32 (String.length e.hash);
804
+
Alcotest.(check bool) "size > 0" true (e.raw_size > 0))
805
+
snap.entries )
806
+
807
+
let test_realistic_check_ok =
808
+
Alcotest.test_case "realistic procfs check OK" `Quick
809
+
( with_eio @@ fun clock ->
810
+
let fs =
811
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
812
+
~cgroups:realistic_cgroups
813
+
in
814
+
let baseline = Fdir.snapshot ~clock fs in
815
+
match Fdir.check ~baseline ~clock fs with
816
+
| Fdir.Ok _ -> ()
817
+
| Fdir.Anomaly _ -> Alcotest.fail "expected Ok" )
818
+
819
+
let test_realistic_seccomp_tampering =
820
+
Alcotest.test_case "realistic seccomp tampering" `Quick
821
+
( with_eio @@ fun clock ->
822
+
let fs =
823
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
824
+
~cgroups:realistic_cgroups
825
+
in
826
+
let baseline = Fdir.snapshot ~clock fs in
827
+
(* Simulate seccomp filter being disabled *)
828
+
let tampered_status =
829
+
{|Name: init
830
+
Umask: 0022
831
+
State: S (sleeping)
832
+
Tgid: 1
833
+
Ngid: 0
834
+
Pid: 1
835
+
PPid: 0
836
+
Seccomp: 0
837
+
Seccomp_filters: 0
838
+
Cpus_allowed: f
839
+
Mems_allowed: 1|}
840
+
in
841
+
let fs2 =
842
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:tampered_status
843
+
~cgroups:realistic_cgroups
844
+
in
845
+
match Fdir.check ~baseline ~clock fs2 with
846
+
| Fdir.Ok _ -> Alcotest.fail "seccomp tampering not detected"
847
+
| Fdir.Anomaly { anomalies; _ } ->
848
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies);
849
+
Alcotest.(check bool)
850
+
"Seccomp" true
851
+
((List.hd anomalies).subsystem = Seccomp) )
852
+
853
+
let test_realistic_cgroup_escape =
854
+
Alcotest.test_case "realistic cgroup escape" `Quick
855
+
( with_eio @@ fun clock ->
856
+
let fs =
857
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
858
+
~cgroups:realistic_cgroups
859
+
in
860
+
let baseline = Fdir.snapshot ~clock fs in
861
+
(* Simulate cgroup escape — moved to root *)
862
+
let tampered_cgroups = {|0::/
863
+
1:name=systemd:/
864
+
2:cpuset:/
865
+
3:memory:/|} in
866
+
let fs2 =
867
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
868
+
~cgroups:tampered_cgroups
869
+
in
870
+
match Fdir.check ~baseline ~clock fs2 with
871
+
| Fdir.Ok _ -> Alcotest.fail "cgroup escape not detected"
872
+
| Fdir.Anomaly { anomalies; _ } ->
873
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies);
874
+
Alcotest.(check bool)
875
+
"Cgroups" true
876
+
((List.hd anomalies).subsystem = Cgroups) )
877
+
878
+
let test_realistic_memory_map_injection =
879
+
Alcotest.test_case "realistic memory map injection" `Quick
880
+
( with_eio @@ fun clock ->
881
+
let fs =
882
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
883
+
~cgroups:realistic_cgroups
884
+
in
885
+
let baseline = Fdir.snapshot ~clock fs in
886
+
(* Simulate new executable mapping appearing *)
887
+
let tampered_maps =
888
+
realistic_maps
889
+
^ "\n\
890
+
7f0000000000-7f0000001000 r-xp 00000000 08:01 9999999 \
891
+
/tmp/malicious.so"
892
+
in
893
+
let fs2 =
894
+
Fdir.Procfs.mock ~maps:tampered_maps ~status:realistic_status
895
+
~cgroups:realistic_cgroups
896
+
in
897
+
match Fdir.check ~baseline ~clock fs2 with
898
+
| Fdir.Ok _ -> Alcotest.fail "map injection not detected"
899
+
| Fdir.Anomaly { anomalies; _ } ->
900
+
Alcotest.(check int) "1 anomaly" 1 (List.length anomalies);
901
+
Alcotest.(check bool)
902
+
"Memory_maps" true
903
+
((List.hd anomalies).subsystem = Memory_maps) )
904
+
905
+
let test_realistic_full_compromise =
906
+
Alcotest.test_case "realistic full compromise: all 3 tampered" `Quick
907
+
( with_eio @@ fun clock ->
908
+
let fs =
909
+
Fdir.Procfs.mock ~maps:realistic_maps ~status:realistic_status
910
+
~cgroups:realistic_cgroups
911
+
in
912
+
let baseline = Fdir.snapshot ~clock fs in
913
+
let fs2 =
914
+
Fdir.Procfs.mock ~maps:"hijacked" ~status:"Seccomp:\t0" ~cgroups:"0::/"
915
+
in
916
+
match Fdir.check ~baseline ~clock fs2 with
917
+
| Fdir.Ok _ -> Alcotest.fail "full compromise not detected"
918
+
| Fdir.Anomaly { anomalies; _ } ->
919
+
Alcotest.(check int) "3 anomalies" 3 (List.length anomalies);
920
+
let severity = Fdir.default_handler anomalies in
921
+
Alcotest.(check bool) "Safe_mode" true (severity = Safe_mode) )
922
+
923
+
(* ── Suite ──────────────────────────────────────────────────────────── *)
924
+
925
+
let suite =
926
+
( "fdir",
927
+
[
928
+
(* Snapshot creation *)
929
+
test_snapshot_creation;
930
+
test_snapshot_sizes;
931
+
test_snapshot_timestamp_positive;
932
+
test_snapshot_entry_order;
933
+
test_snapshot_subsystem_coverage;
934
+
(* Check OK *)
935
+
test_check_ok;
936
+
test_check_ok_elapsed_non_negative;
937
+
test_check_ok_repeated;
938
+
(* Single subsystem corruption *)
939
+
test_detect_maps_change;
940
+
test_detect_seccomp_change;
941
+
test_detect_cgroup_change;
942
+
test_multiple_anomalies;
943
+
(* Corruption patterns *)
944
+
test_single_bit_flip;
945
+
test_single_byte_appended;
946
+
test_single_byte_prepended;
947
+
test_truncation_detected;
948
+
test_null_byte_injection;
949
+
test_whitespace_only_change;
950
+
test_case_change_detected;
951
+
test_data_to_empty_detected;
952
+
test_empty_to_data_detected;
953
+
test_binary_data_corruption;
954
+
test_large_data_corruption;
955
+
(* Anomaly record validation *)
956
+
test_anomaly_expected_hash_matches_baseline;
957
+
test_anomaly_actual_hash_matches_current;
958
+
test_anomaly_expected_size;
959
+
test_anomaly_actual_size;
960
+
test_anomaly_elapsed_non_negative;
961
+
test_anomaly_hashes_differ;
962
+
test_multiple_anomaly_subsystems_distinct;
963
+
(* Pairwise subsystem combinations *)
964
+
test_two_anomalies_maps_seccomp;
965
+
test_two_anomalies_maps_cgroups;
966
+
test_two_anomalies_seccomp_cgroups;
967
+
(* Default handler *)
968
+
test_default_handler_severity;
969
+
test_default_handler_empty;
970
+
test_default_handler_four_anomalies;
971
+
test_default_handler_all_same_subsystem;
972
+
(* Hash properties *)
973
+
test_hash_determinism;
974
+
test_hash_different_data_different_hash;
975
+
test_hash_same_data_different_mock_same_hash;
976
+
test_hash_avalanche;
977
+
test_empty_input_valid_hash;
978
+
test_empty_strings_same_hash;
979
+
test_empty_check_ok;
980
+
(* Config *)
981
+
test_config_defaults;
982
+
test_config_custom_interval;
983
+
test_config_custom_subsystems;
984
+
test_config_single_subsystem;
985
+
test_config_empty_subsystems;
986
+
test_config_small_interval;
987
+
test_config_large_interval;
988
+
(* Pretty-printers *)
989
+
test_pp_functions;
990
+
test_pp_severity_values;
991
+
test_pp_subsystem_values;
992
+
test_pp_severity_with_fmt_str;
993
+
test_pp_subsystem_with_fmt_str;
994
+
(* Cross-mock consistency *)
995
+
test_independent_subsystem_hashes;
996
+
test_check_after_revert_ok;
997
+
test_check_with_different_corruption_each_time;
998
+
(* Realistic procfs *)
999
+
test_realistic_snapshot;
1000
+
test_realistic_check_ok;
1001
+
test_realistic_seccomp_tampering;
1002
+
test_realistic_cgroup_escape;
1003
+
test_realistic_memory_map_injection;
1004
+
test_realistic_full_compromise;
1005
+
] )
+1
test/test_fdir.mli
+1
test/test_fdir.mli
···
1
+
val suite : string * unit Alcotest.test_case list