feat(analysis): compare mapping intervals and detect writable executable aliases
1 files changed, +105 −0
- lib/analysis.ml added +105 −0
lib/analysis.ml added
| @@ -0,0 +1,105 @@ | ||
| 1 | +open Model | |
| 2 | +open Paging | |
| 3 | + | |
| 4 | +type change = { start : int64; length : int64; before : state option; after : state option; kinds : string list } | |
| 5 | + | |
| 6 | +let offset_mapping (region : region) address mapping = | |
| 7 | + let offset = Int64.sub address region.start in | |
| 8 | + { mapping with virtual_address = Address.Virtual.of_int64 address; | |
| 9 | + physical_address = Address.Physical.of_int64 (Int64.add (Address.Physical.to_int64 mapping.physical_address) offset) } | |
| 10 | + | |
| 11 | +let state_at (region : region) address = match region.state with | |
| 12 | + | Present mapping -> Present (offset_mapping region address mapping) | |
| 13 | + | state -> state | |
| 14 | + | |
| 15 | +let attributes mapping = | |
| 16 | + let huge = mapping.size <> 4096L in | |
| 17 | + let pat = Address.bit mapping.leaf (if huge then 12 else 7) in | |
| 18 | + Int64.logor (Int64.logand mapping.leaf 0x118L) (if pat then 0x80L else 0L) | |
| 19 | + | |
| 20 | +let history (mapping : mapping) = | |
| 21 | + let leaf = List.length mapping.trace - 1 in | |
| 22 | + List.mapi (fun index (s : step) -> Int64.logand s.raw (if index = leaf then 0x60L else 0x20L)) mapping.trace | |
| 23 | + | |
| 24 | +let differences ~include_ad before after = | |
| 25 | + match before, after with | |
| 26 | + | Some (Unknown _), _ | _, Some (Unknown _) -> ["incomplete"] | |
| 27 | + | Some (Broken a), Some (Broken b) when a = b -> [] | |
| 28 | + | Some (Broken _), _ | _, Some (Broken _) -> ["invalid"] | |
| 29 | + | None, None -> [] | |
| 30 | + | None, Some _ -> ["added"] | |
| 31 | + | Some _, None -> ["removed"] | |
| 32 | + | Some (Present a), Some (Present b) -> | |
| 33 | + List.filter_map (fun (changed, kind) -> if changed then Some kind else None) [ | |
| 34 | + (a.physical_address <> b.physical_address, "backing"); | |
| 35 | + (a.permissions <> b.permissions, "permissions"); | |
| 36 | + (a.size <> b.size, "page_size"); | |
| 37 | + (attributes a <> attributes b, "attributes"); | |
| 38 | + (include_ad && history a <> history b, "accessed_dirty") ] | |
| 39 | + | |
| 40 | +let diff ?(include_ad = false) before after = | |
| 41 | + let boundaries regions = List.fold_left (fun acc (region : region) -> | |
| 42 | + let finish = Int64.add region.start region.length in | |
| 43 | + region.start :: if finish = 0L then acc else finish :: acc) [] regions | |
| 44 | + in | |
| 45 | + let points = List.sort_uniq Address.compare (boundaries before @ boundaries after) in | |
| 46 | + let before = ref before and after = ref after in | |
| 47 | + let lookup regions address = | |
| 48 | + let rec advance () = match !regions with | |
| 49 | + | region :: rest when Address.compare (last region) address < 0 -> regions := rest; advance () | |
| 50 | + | _ -> () | |
| 51 | + in | |
| 52 | + advance (); | |
| 53 | + match !regions with | |
| 54 | + | region :: _ when Address.compare region.start address <= 0 -> Some (state_at region address) | |
| 55 | + | _ -> None | |
| 56 | + in | |
| 57 | + let rec go acc = function | |
| 58 | + | [] -> List.rev acc | |
| 59 | + | start :: rest -> | |
| 60 | + let finish = match rest with next :: _ -> Int64.pred next | [] -> -1L in | |
| 61 | + let a = lookup before start and b = lookup after start in | |
| 62 | + let kinds = differences ~include_ad a b in | |
| 63 | + let acc = if kinds = [] then acc else { | |
| 64 | + start; length = Int64.succ (Int64.sub finish start); before = a; after = b; kinds } :: acc in | |
| 65 | + go acc rest | |
| 66 | + in | |
| 67 | + go [] points | |
| 68 | + | |
| 69 | +type alias = { physical : int64; length : int64; writable : mapping; executable : mapping } | |
| 70 | + | |
| 71 | +let aliases ?(max_pairs = 100_000) regions = | |
| 72 | + let module Active = Map.Make (Int) in | |
| 73 | + let mappings = List.filter_map (fun r -> match r.state with Present m -> Some m | _ -> None) regions in | |
| 74 | + let physical m = Address.Physical.to_int64 m.physical_address in | |
| 75 | + let finish m = Int64.add (physical m) m.size in | |
| 76 | + let events = List.mapi (fun id mapping -> | |
| 77 | + [physical mapping, 1, id, mapping; finish mapping, 0, id, mapping]) mappings |> List.concat | |
| 78 | + |> List.sort (fun (a, ak, ai, _) (b, bk, bi, _) -> | |
| 79 | + let compared = Address.compare a b in | |
| 80 | + if compared <> 0 then compared else let compared = Int.compare ak bk in | |
| 81 | + if compared <> 0 then compared else Int.compare ai bi) | |
| 82 | + in | |
| 83 | + let writable = ref Active.empty and executable = ref Active.empty in | |
| 84 | + let acc = ref [] and count = ref 0 in | |
| 85 | + let emit writable executable = | |
| 86 | + incr count; | |
| 87 | + if !count > max_pairs then raise (Limit "alias pair budget exceeded"); | |
| 88 | + let start = if physical writable > physical executable then physical writable else physical executable in | |
| 89 | + let stop = min (finish writable) (finish executable) in | |
| 90 | + acc := { physical = start; length = Int64.sub stop start; writable; executable } :: !acc | |
| 91 | + in | |
| 92 | + List.iter (fun (_, kind, id, mapping) -> | |
| 93 | + if kind = 0 then begin | |
| 94 | + writable := Active.remove id !writable; | |
| 95 | + executable := Active.remove id !executable | |
| 96 | + end else begin | |
| 97 | + (* end -> start at equal addresses keeps adjacent frames out of the overlap set *) | |
| 98 | + if mapping.permissions.writable then | |
| 99 | + Active.iter (fun _ other -> emit mapping other) !executable; | |
| 100 | + if mapping.permissions.executable then | |
| 101 | + Active.iter (fun _ other -> emit other mapping) !writable; | |
| 102 | + if mapping.permissions.writable then writable := Active.add id mapping !writable; | |
| 103 | + if mapping.permissions.executable then executable := Active.add id mapping !executable | |
| 104 | + end) events; | |
| 105 | + List.rev !acc | |