~cypheon/ocaml-apfs

ref: 61b44ed33d0b50533d003402e5de4e07aa8bafc6 ocaml-apfs/lib/structs/types.ml -rw-r--r-- 37.5 KiB
61b44ed3 — Johann Rudloff Do simple (ASCII-only) case folding when calculating file name hashes. 1 year, 9 months ago
                                                                                
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
let magic_string_int32 s = let open String in
  (int_of_char (get s 0) lsl 0) +
  (int_of_char (get s 1) lsl 8) +
  (int_of_char (get s 2) lsl 16) +
  (int_of_char (get s 3) lsl 24)

let uint32_highest_bit = 0x80000000l;

type virt_oid_t = int64
[@@deriving show]

type phys_oid_t = int64
[@@deriving show]

let oid_invalid = 0L

type eph_oid_t = int64
[@@deriving show]

type xid_t = int64
[@@deriving show]

type paddr = int64
[@@deriving show]

[%%cstruct
type obj_phys = {
  o_cksum: uint64_t;
  o_oid: uint64_t;
  o_xid: uint64_t;
  o_type: uint32_t;
  o_subtype: uint32_t;
} [@@little_endian]]
let () = assert (sizeof_obj_phys = 32)

[%%cstruct
type nx_superblock = {
  nx_o: uint8_t [@len 32]; (* obj_phys *)
  nx_magic: uint32_t;

  nx_block_size: uint32_t;
  nx_block_count: uint64_t;

  nx_features: uint64_t;
  nx_readonly_compatible_features: uint64_t;
  nx_incompatible_features: uint64_t;

  nx_uuid: uint8_t [@len 16]; (* uuid_t *)

  nx_next_oid: uint64_t;
  nx_next_xid: uint64_t;

  nx_xp_desc_blocks: uint32_t;
  nx_xp_data_blocks: uint32_t;
  nx_xp_desc_base: uint64_t;
  nx_xp_data_base: uint64_t;
  nx_xp_desc_next: uint32_t;
  nx_xp_data_next: uint32_t;
  nx_xp_desc_index: uint32_t;
  nx_xp_desc_len: uint32_t;
  nx_xp_data_index: uint32_t;
  nx_xp_data_len: uint32_t;

  nx_spaceman_oid: uint64_t;
  nx_omap_oid: uint64_t;

  nx_reaper_oid: uint64_t;
  nx_test_type: uint32_t;

  nx_max_file_systems: uint32_t;
  nx_fs_oid: uint8_t [@len 800]; (* oid_t[NX_MAX_FILE_SYSTEMS = 100] = 800 *)
  nx_counters: uint8_t [@len 256]; (* uint64_t[NX_NUM_COUNTERS = 32] = 256 *)
  nx_blocked_out_prange: uint8_t [@len 16]; (* prange_t *)
  nx_evict_mapping_tree_oid: uint64_t;
  nx_flags: uint64_t;
  nx_efi_jumpstart: uint64_t;
  nx_fusion_uuid: uint8_t [@len 16]; (* uuid_t *)
  nx_keylocker: uint8_t [@len 16]; (* prange_t *)
  nx_ephemeral_info: uint8_t [@len 32]; (* uint64_t[NX_EPH_INFO_COUNT = 4] = 32 *)
  nx_test_oid: uint64_t;
  nx_fusion_mt_oid: uint64_t;
  nx_fusion_wbc_oid: uint64_t;
  nx_fusion_wbc: uint8_t [@len 16]; (* prange_t *)

} [@@little_endian]]

[%%cstruct
type btree_node_phys = {
  btn_o: uint8_t [@len 32]; (* obj_phys *)
  btn_flags: uint16_t;
  btn_level: uint16_t;
  btn_nkeys: uint32_t;
  btn_table_space: uint32_t; (* nloc *)
  btn_free_space: uint32_t; (* nloc *)
  btn_key_free_list: uint32_t;
  btn_val_free_list: uint32_t;
} [@@little_endian]]
let () = assert (sizeof_btree_node_phys = 56)

(* Apple's docs describe btree_info_fixed_t and btree_info_t separately,
 * we merge them both into one struct. *)
[%%cstruct
type btree_info = {
  (* start btree_info_fixed_t *)
  bt_flags: uint32_t;
  bt_node_size: uint32_t;
  bt_key_size: uint32_t;
  bt_val_size: uint32_t;
  (* end btree_info_fixed_t *)

  (* start btree_info_t *)
  bt_longest_key: uint32_t;
  bt_longest_val: uint32_t;
  bt_key_count: uint64_t;
  bt_node_count: uint64_t;
  (* end btree_info_t *)
} [@@little_endian]]
let () = assert (sizeof_btree_info = 40)

[%%cstruct
type omap_phys = {
  om_o: uint8_t [@len 32]; (* obj_phys *)
  om_flags: uint32_t;
  om_snap_count: uint32_t;
  om_tree_type: uint32_t;
  om_snapshot_tree_type: uint32_t;
  om_tree_oid: uint64_t;
  om_snapshot_tree_oid: uint64_t;
  om_most_recent_snap: uint64_t;
  om_pending_revert_min: uint64_t;
  om_pending_revert_max: uint64_t;
} [@@little_endian]]
let () = assert (sizeof_omap_phys = 88)

[%%cstruct
type checkpoint_mapping = {
  cpm_type: uint32_t;
  cpm_subtype: uint32_t;
  cpm_size: uint32_t;
  cpm_pad: uint32_t;
  cpm_fs_oid: uint64_t;
  cpm_oid: uint64_t;
  cpm_paddr: uint64_t;
} [@@little_endian]]
let () = assert (sizeof_checkpoint_mapping = 40)

[%%cstruct
type checkpoint_map_phys = {
  cpm_o: uint8_t [@len 32]; (* obj_phys *)
  cpm_flags: uint32_t;
  cpm_count: uint32_t;
} [@@little_endian]]
let () = assert (sizeof_checkpoint_map_phys = 40)

[%%cstruct
type apfs_superblock = {
  apfs_o: uint8_t [@len 32]; (* obj_phys *)

  apfs_magic: uint32_t;
  apfs_fs_index: uint32_t;

  apfs_features: uint64_t;
  apfs_readonly_compatible_features: uint64_t;
  apfs_incompatible_features: uint64_t;

  apfs_unmount_time: uint64_t;

  apfs_fs_reserve_block_count: uint64_t;
  apfs_fs_quota_block_count: uint64_t;
  apfs_fs_alloc_count: uint64_t;

  apfs_meta_crypto: uint8_t [@len 20]; (* wrapped_meta_crypto_state *)

  apfs_root_tree_type: uint32_t;
  apfs_extentref_tree_type: uint32_t;
  apfs_snap_meta_tree_type: uint32_t;

  apfs_omap_oid: uint64_t;
  apfs_root_tree_oid: uint64_t;
  apfs_extentref_tree_oid: uint64_t;
  apfs_snap_meta_tree_oid: uint64_t;

  apfs_revert_to_xid: uint64_t;
  apfs_revert_to_block_oid: uint64_t;

  apfs_next_obj_id: uint64_t;

  apfs_num_files: uint64_t;
  apfs_num_directories: uint64_t;
  apfs_num_symlinks: uint64_t;
  apfs_num_other_fsobjects: uint64_t;
  apfs_num_snapshots: uint64_t;

  apfs_total_blocks_alloced: uint64_t;
  apfs_total_blocks_freed: uint64_t;

  apfs_vol_uuid: uint8_t [@len 16]; (* uuid_t *)
  apfs_last_mod_time: uint64_t;

  apfs_fs_flags: uint64_t;

  (* sizeof_apfs_modified_by = 32 + 8 + 8 = 48 *)

  apfs_formatted_by: uint8_t [@len 48]; (* apfs_modified_by *)
  apfs_modified_by: uint8_t [@len 384]; (* apfs_modified_by[APFS_MAX_HIST = 8] -> 48*8=384 *)

  apfs_volname: uint8_t [@len 256]; (* string *)
  apfs_next_doc_id: uint32_t;

  apfs_role: uint16_t;
  apfs_reserved: uint16_t;

  apfs_root_to_xid: uint64_t;
  apfs_er_state_oid: uint64_t;
} [@@little_endian]]

[%%cstruct
type j_inode_val_t = {
  parent_id: uint64_t;
  private_id: uint64_t;

  create_time: uint64_t;
  mod_time: uint64_t;
  change_time: uint64_t;
  access_time: uint64_t;

  internal_flags: uint64_t;

  union_nchildren_nlink: int32_t;

  default_protection_class: uint32_t; (* cp_key_class_t *)

  write_generation_counter: uint32_t;
  bsd_flags: uint32_t;
  owner: uint32_t;
  group: uint32_t;
  mode: uint16_t;
  pad1: uint16_t;
  pad2: uint64_t;
  (* xfields *)
} [@@little_endian]]
let () = assert (sizeof_j_inode_val_t = 92)

let flags_set flags value = (flags land value) <> 0
let flags_set32 flags value = Int32.(logand flags value) <> 0l

let pp_cstruct fmt buf =
  Format.fprintf fmt "<%s>" (Cstruct.to_string buf)

module ObjectType = struct
  type typ =
    | NX_SUPERBLOCK

    | BTREE
    | BTREE_NODE

    | SPACEMAN
    | SPACEMAN_FREE_QUEUE

    | OMAP
    | CHECKPOINT_MAP

    | FS
    | FSTREE

    | NX_REAPER
  [@@deriving show]

  module Flags = struct
    type t = {
      storagetype: [ `Virtual | `Ephemeral | `Physical ];
      noheader: bool;
      encrypted: bool;
      nonpersistent: bool;
    }
    [@@deriving show]

    let obj_virtual   = 0x00000000l
    let obj_ephemeral = 0x80000000l
    let obj_physical  = 0x40000000l

    let obj_storagetype_mask = 0xc0000000l

    let obj_noheader  = 0x20000000l
    let obj_encrypted = 0x10000000l
    let obj_nonpersistent  = 0x08000000l

    let storagetype_of_int32 i =
      if i = obj_virtual then `Virtual
      else if i = obj_ephemeral then `Ephemeral
      else if i = obj_physical then `Physical
      else failwith "invalid storage type"

    let of_int32 i = {
      storagetype = Int32.(logand i obj_storagetype_mask) |> storagetype_of_int32;
      noheader = flags_set32 i obj_noheader;
      encrypted = flags_set32 i obj_encrypted;
      nonpersistent = flags_set32 i obj_nonpersistent;
    }
  end

  type t = {
    ot_type: typ;
    ot_flags: Flags.t;
  }
  [@@deriving show]

  let ot_mask_typ =   0x0000ffffl
  let ot_mask_flags = 0xffff0000l

  let typ_of_int = function
    | 0x0001l -> Some NX_SUPERBLOCK

    | 0x0002l -> Some BTREE
    | 0x0003l -> Some BTREE_NODE

    | 0x0005l -> Some SPACEMAN
    | 0x0009l -> Some SPACEMAN_FREE_QUEUE

    | 0x000bl -> Some OMAP
    | 0x000cl -> Some CHECKPOINT_MAP

    | 0x000dl -> Some FS
    | 0x000el -> Some FSTREE

    | 0x0011l -> Some NX_REAPER
    | i -> Printf.printf "unknown object type: <0x%08lx>\n" i;None

  let of_int i =
    let obj_typ = typ_of_int Int32.(logand i ot_mask_typ) in
    Option.map (fun ot -> {
    ot_type = ot;
    ot_flags = Int32.logand i ot_mask_flags |> Flags.of_int32;
  }) obj_typ

  let show_typ_opt = function
    | Some t -> show_typ t
    | None -> "(None)"
end

module Option = struct
  include  Stdlib.Option

  let get_exn e = function
    | Some v -> v
    | None -> raise e
end

module Obj_phys = struct

  type t = {
    o_cksum: int64 [@printer fun fmt -> fprintf fmt "0x%Lx"];
    o_oid: int64;
    o_xid: int64;
    o_type: ObjectType.t;
    o_subtype: ObjectType.t option;
  }
  [@@deriving show]

  let of_buffer buf =
    {
      o_cksum = get_obj_phys_o_cksum buf;
      o_oid = get_obj_phys_o_oid buf;
      o_xid = get_obj_phys_o_xid buf;
      o_type = get_obj_phys_o_type buf |> ObjectType.of_int |> Option.get_exn (Invalid_argument "unknown object primary type");
      o_subtype = get_obj_phys_o_subtype buf |> ObjectType.of_int;
    }

  let type_subtype o =
    o.o_type.ot_type,
    (o.o_subtype |> Option.map (fun x -> x.ObjectType.ot_type))

end

module Nx_superblock = struct
  type t = {
    nx_magic: int32;
    nx_block_size: int;
    nx_uuid: Uuidm.t;

    nx_next_oid: int64;
    nx_next_xid: int64;

    nx_xp_desc_blocks: int32;
    nx_xp_data_blocks: int32;
    nx_xp_desc_base: paddr;

    nx_omap_oid: phys_oid_t;

    nx_fs_oid: virt_oid_t list;
  }
  [@@deriving show]

  let nx_max_file_systems = 100

  let read_fs_oids buf =
    let rec read_fs_oids_at_index i = if i >= nx_max_file_systems then [] else
      let fs_oid = Cstruct.LE.get_uint64 buf (i * 8) in
      let rest = read_fs_oids_at_index (i+1) in
      if fs_oid = oid_invalid then rest else fs_oid::rest
      in
    read_fs_oids_at_index 0

  let of_buffer buf =
    {
      nx_magic = get_nx_superblock_nx_magic buf;
      nx_block_size = Int32.to_int @@ get_nx_superblock_nx_block_size buf;

      nx_uuid = Uuidm.of_bytes (Cstruct.to_string (get_nx_superblock_nx_uuid buf)) |> Option.get;

      nx_next_oid = get_nx_superblock_nx_next_oid buf;
      nx_next_xid = get_nx_superblock_nx_next_xid buf;

      nx_xp_desc_blocks = get_nx_superblock_nx_xp_desc_blocks buf;
      nx_xp_data_blocks = get_nx_superblock_nx_xp_data_blocks buf;

      nx_xp_desc_base = get_nx_superblock_nx_xp_desc_base buf;

      nx_omap_oid = get_nx_superblock_nx_omap_oid buf;

      nx_fs_oid = read_fs_oids (get_nx_superblock_nx_fs_oid buf);
    }

  let checkpoint_desc_area_contiguous sb =
    0l = Int32.logand uint32_highest_bit sb.nx_xp_desc_blocks
end

module type BtreeKey = sig
  type t

  val compare : t -> t -> int
  val of_buffer : Cstruct.t -> t
  val show : t -> string
  val pp : Format.formatter -> t -> unit
end

module type BtreeVal = sig
  type t
  type key

  val of_buffer : key -> Cstruct.t -> t
  val show : t -> string
  val pp : Format.formatter -> t -> unit
end

module Omap_key = struct
  type t = (virt_oid_t * xid_t)
  [@@deriving show]

  let compare (a_oid, a_xid) (b_oid, b_xid) =
    match compare a_oid b_oid with
    | 0 -> compare a_xid b_xid
    | x -> x

  let of_buffer buf =
    (Cstruct.LE.get_uint64 buf 0
    ,Cstruct.LE.get_uint64 buf 8
    )
end

module Omap_val = struct
  type key = Omap_key.t
  type flags = {
    ov_is_deleted: bool;
    ov_is_saved: bool;
    ov_is_encrypted: bool;
    ov_is_noheader: bool;
    ov_is_crypto_generation: bool;
  }
  [@@deriving show]

  module Flags = struct
    let deleted = 0x00000001l
    let saved = 0x00000002l
    let encrypted = 0x00000004l
    let noheader = 0x00000008l
    let crypto_generation = 0x00000010l

    let of_int32 i = {
      ov_is_deleted = flags_set32 i deleted;
      ov_is_saved = flags_set32 i saved;
      ov_is_encrypted = flags_set32 i encrypted;
      ov_is_noheader = flags_set32 i noheader;
      ov_is_crypto_generation = flags_set32 i crypto_generation;
    }
  end

  type t = {
    ov_flags: flags;
    ov_size: int;
    ov_paddr: paddr;
  }
  [@@deriving show]

  let of_buffer _key buf =
    {
      ov_flags = Flags.of_int32 (Cstruct.LE.get_uint32 buf 0);
      ov_size = Cstruct.LE.get_uint32 buf 4 |> Int32.to_int;
      ov_paddr = Cstruct.LE.get_uint64 buf 8;
    }
end

type any_oid =
  | Ephemeral of eph_oid_t
  | Physical of phys_oid_t
  | Virtual of virt_oid_t
[@@deriving show]

type 'a btree_val =
  | ChildNode of any_oid
  | Value of 'a
  [@@deriving show]

let mk_oid typ addr = match typ with
  | `Ephemeral -> Ephemeral addr
  | `Physical -> Physical addr
  | `Virtual -> Virtual addr

module BtreeMeta = struct
  type flags = {
    bt_oid_type: [ `Ephemeral | `Physical | `Virtual ];
  }
  [@@deriving show]

  type info = {
    bt_flags: flags;
    bt_node_size: int;
    bt_key_size: int;
    bt_val_size: int;
  }
  [@@deriving show]
end

module type Btree_node_S = sig
  type flags = {
    btn_is_root: bool;
    btn_is_leaf: bool;
    btn_is_fixed_kv_size: bool;
    btn_is_check_koff_invalid: bool;
  }

  type k
  type v

  type kv_pair

  type t = {
    btn_flags: flags;

    btn_level: int;
    btn_nkeys: int;

    btn_kvs: kv_pair array;
  }

  (** Returns the (k,v) entry for the greatest key that is less or equal to given key *)
  val floor_entry : t -> k -> (k * (v btree_val)) option

  (** Look up a specific entry. If this is a leaf node, return the matching
   * entry. Otherwise, return the corresponding child node.
   *)
  (*val find : t -> k -> (k * (v btree_val)) option*)

  val compare_key : k -> k -> int

  val iter : (k -> v btree_val -> unit) -> t -> unit
  val stream : t -> (unit -> (k * v btree_val) option)
  val stream_from : k -> t -> (unit -> (k * v btree_val) option)

  val pp : Format.formatter -> t -> unit

  val pp_k : Format.formatter -> k -> unit
  val pp_v : Format.formatter -> v -> unit

  val of_block : BtreeMeta.info -> Cstruct.t -> (Obj_phys.t * t)

  (* private *)
  val of_buffer : BtreeMeta.info -> Cstruct.t -> t
end

module Btree_node (K : BtreeKey) (V : BtreeVal with type key = K.t) = struct
  type flags = {
    btn_is_root: bool;
    btn_is_leaf: bool;
    btn_is_fixed_kv_size: bool;
    btn_is_check_koff_invalid: bool;
  }
  [@@deriving show]

  let btnode_root = 0x0001
  let btnode_leaf = 0x0002
  let btnode_fixed_kv_size = 0x0004
  let btnode_check_koff_invalid = 0x8000

  type k = K.t
  [@@deriving show]

  type v = V.t
  [@@deriving show]

  type kv_pair = (k * (v btree_val))

  type nloc = (int * int) (* off, len *)
  [@@deriving show]

  let pp_array pp fmt a =
    Format.pp_print_string fmt "[A: ";
    Format.pp_open_vbox fmt 1;
    Array.iter (fun x ->
      Format.fprintf fmt "%a@;" pp x) a;
    Format.pp_close_box fmt ();
    Format.pp_print_string fmt " ]"
  let pp_kv_pair fmt (k, v) = Format.fprintf fmt "%a => %a," K.pp k (pp_btree_val pp_v) v

  type t = {
    btn_flags: flags;

    btn_level: int;
    btn_nkeys: int;

    btn_kvs: kv_pair array [@printer (pp_array pp_kv_pair)];
  }
  [@@deriving show]

  let parse_nloc i =
    Int32.((logand 0xffffl i) |> to_int, shift_right_logical (logand 0xffff0000l i) 16 |> to_int)

  let flags_of_int i = {
    btn_is_root = flags_set btnode_root i;
    btn_is_leaf = flags_set btnode_leaf i;
    btn_is_fixed_kv_size = flags_set btnode_fixed_kv_size i;
    btn_is_check_koff_invalid = flags_set btnode_check_koff_invalid i;
  }

  let read_keys_fixed_size_leaf keysize valsize nkeys buf (toc_start, toc_len) = Array.init nkeys (fun i ->
    let key_off = Cstruct.LE.get_uint16 buf (toc_start + 0 + i * 4) in
    let val_off = Cstruct.LE.get_uint16 buf (toc_start + 2 + i * 4) in
    let key_buf = Cstruct.(sub buf (toc_start + toc_len + key_off) keysize) in
    let val_buf = Cstruct.(sub buf (len buf - val_off) valsize) in
    let key = K.of_buffer key_buf in
    let value = (V.of_buffer key val_buf) in
    (key, Value value)
  )

  let read_keys_fixed_size_nonleaf oid_type keysize nkeys buf (toc_start, toc_len) = Array.init nkeys (fun i ->
    let addr = mk_oid oid_type in
    let valsize = 8 in
    let key_off = Cstruct.LE.get_uint16 buf (toc_start + 0 + i * 4) in
    let val_off = Cstruct.LE.get_uint16 buf (toc_start + 2 + i * 4) in
    let key_buf = Cstruct.(sub buf (toc_start + toc_len + key_off) keysize) in
    let val_buf = Cstruct.(sub buf (len buf - val_off) valsize) in
    (K.of_buffer key_buf, ChildNode (addr (Cstruct.LE.get_uint64 val_buf 0)))
  )

  let read_keys_variable_size_leaf nkeys buf (toc_start, toc_len) = Array.init nkeys (fun i ->
    let key_off = Cstruct.LE.get_uint16 buf (toc_start + 0 + i * 8) in
    let key_len = Cstruct.LE.get_uint16 buf (toc_start + 2 + i * 8) in
    let val_off = Cstruct.LE.get_uint16 buf (toc_start + 4 + i * 8) in
    let val_len = Cstruct.LE.get_uint16 buf (toc_start + 6 + i * 8) in
    let key_buf = Cstruct.(sub buf (toc_start + toc_len + key_off) key_len) in
    let val_buf = Cstruct.(sub buf (len buf - val_off) val_len) in
    let key = K.of_buffer key_buf in
    let value = (V.of_buffer key val_buf) in
    (key, Value value)
  )

  let read_keys_variable_size_nonleaf oid_type nkeys buf (toc_start, toc_len) = Array.init nkeys (fun i ->
    let addr = mk_oid oid_type in
    let key_off = Cstruct.LE.get_uint16 buf (toc_start + 0 + i * 8) in
    let key_len = Cstruct.LE.get_uint16 buf (toc_start + 2 + i * 8) in
    let val_off = Cstruct.LE.get_uint16 buf (toc_start + 4 + i * 8) in
    let val_len = Cstruct.LE.get_uint16 buf (toc_start + 6 + i * 8) in
    assert (val_len = 8);
    let key_buf = Cstruct.(sub buf (toc_start + toc_len + key_off) key_len) in
    let val_buf = Cstruct.(sub buf (len buf - val_off) val_len) in
    (*Format.printf "DEBUG: key %d -> k=%d+%d  // v=%d+%d  ==> %a // %a\n" i key_off key_len val_off val_len Cstruct.hexdump_pp key_buf Cstruct.hexdump_pp val_buf;*)
    (K.of_buffer key_buf, ChildNode (addr (Cstruct.LE.get_uint64 val_buf 0)))
  )

  let read_keys (info:BtreeMeta.info) flags nkeys buf table_space=
    let keysize = info.bt_key_size in
    let valsize = info.bt_val_size in
    if flags.btn_is_fixed_kv_size then
      (if flags.btn_is_leaf then
        read_keys_fixed_size_leaf keysize valsize nkeys buf table_space
      else
        (*failwith "can not read non-leaf nodes"*)
        read_keys_fixed_size_nonleaf (info.bt_flags.bt_oid_type) keysize nkeys buf table_space
      )
    else
      (if flags.btn_is_leaf then
        read_keys_variable_size_leaf nkeys buf table_space
      else
        read_keys_variable_size_nonleaf (info.bt_flags.bt_oid_type) nkeys buf table_space
      )

  let of_buffer (info:BtreeMeta.info) buf =
    (*Format.printf "deserializing btree_node: %a\n---\n%a\n" BtreeMeta.pp_info info Cstruct.hexdump_pp buf;*)
    let btn_flags = flags_of_int (get_btree_node_phys_btn_flags buf) in
    let btn_nkeys = get_btree_node_phys_btn_nkeys buf |> Int32.to_int in
    let btn_table_space = get_btree_node_phys_btn_table_space buf |> parse_nloc in
    (*Format.printf "btn.of_buffer (table_space: %d+%d):\n%a\n" (fst btn_table_space) (snd btn_table_space) Cstruct.hexdump_pp buf;*)
    let data_area_size = if btn_flags.btn_is_root
      then Cstruct.(len buf - sizeof_btree_node_phys - sizeof_btree_info)
      else Cstruct.(len buf - sizeof_btree_node_phys)
    in
    let data_buf = Cstruct.(sub buf (sizeof_btree_node_phys) data_area_size) in
    (*let toc_buf = Cstruct.(sub buf (sizeof_btree_node_phys + btn_table_space) (len buf - sizeof_btree_node_phys - sizeof_btree_info - btn_table_space)) in*)
    {
      btn_flags;
      btn_level = get_btree_node_phys_btn_level buf;
      btn_nkeys;
      btn_kvs = read_keys info btn_flags btn_nkeys data_buf btn_table_space;
    }

  let max_comp c a b = if c a b < 0 then b else a
  let compare_entry (k1, _) k2 = K.compare k1 k2
  let compare_key = K.compare

  (** Return (Some index) of the greatest key which is less than or equal to
   * the given key, or None otherwise. *)
  let internal_floor_index (kvs: kv_pair array) (key:k) =
    (* For now, this is an inefficient linear search, it can (and should) be
     * optimized to a more efficient bisect search. *)
    let rec go acc i = if i >= Array.length kvs then acc
    else let entry = kvs.(i) in
      (if compare_entry entry key > 0 then acc
      else go (Some i) (i+1)
      )
    in go None 0

  (** Return (Some index) of the least key which is greater than or equal to
   * the given key, or None otherwise. *)
  let internal_ceil_index (kvs: kv_pair array) (key:k) =
    (* For now, this is an inefficient linear search, it can (and should) be
     * optimized to a more efficient bisect search. *)
    let rec go i = if i >= Array.length kvs then None
    else let entry = kvs.(i) in
      (if compare_entry entry key >= 0 then Some i
      else go (i+1)
      )
    in go 0

  let internal_floor_entry (kvs: kv_pair array) (key:k) =
    Option.map (Array.get kvs) (internal_floor_index kvs key)

  (** Returns the (k,v) entry for the greatest key that is less or equal to given key *)
  let floor_entry btn key = internal_floor_entry btn.btn_kvs key

  let iter f btn =
    let f_uncurried (a,b) = f a b in
    Array.iter f_uncurried btn.btn_kvs

  let stream_from_index btn start_index =
    let i = ref start_index in
    let f = fun () ->
        if !i < Array.length btn.btn_kvs then
        (incr i; Some (Array.get btn.btn_kvs (!i - 1)))
        else None
    in f

  let stream btn = stream_from_index btn 0

  let stream_from key btn = match internal_floor_index btn.btn_kvs key with
  | None   -> stream btn
  | Some i -> stream_from_index btn i

  let of_block info buf =
    let obj_phys = Obj_phys.of_buffer buf in
    match Obj_phys.type_subtype obj_phys with
    (* TODO: compare object type with expected type from NodeType *)
    | ObjectType.BTREE_NODE, Some ObjectType.OMAP ->
        (obj_phys, of_buffer info buf)
    | ObjectType.BTREE_NODE, Some ObjectType.FSTREE ->
        (obj_phys, of_buffer info buf)
    | typ, subtyp ->
        failwith ("unknown btree type: " ^ (ObjectType.show_typ typ) ^ " / " ^ (ObjectType.show_typ_opt subtyp))
end

module OmapBtree_node = Btree_node(Omap_key)(Omap_val)

module InodeXfield = struct
  module Pervasives = Stdlib (* ugly hack required for ppx_cstruct to work *)
  [%%cenum
  type xf_type =
    | XFTypeName        [@id   4]
    | XFTypeDstream     [@id   8]
    | XFTypeSparseBytes [@id 0xd]
    [@@uint8_t]
  ]

  type j_dstream = {
    size: int64;
    allocated_size: int64;
    default_crypto_id: int64;
    total_bytes_written: int64;
    total_bytes_read: int64;
  }
  [@@deriving show]

  type t =
    | XFName    of string
    | XFDstream of j_dstream
    | XFSparseBytes of int64
    | XFUnknown of int
  [@@deriving show]

  let sizeof_xblob_t = 4
  let sizeof_xfield_t = 4

  let j_dstream_of_buffer buf = {
    size = Cstruct.LE.get_uint64 buf 0;
    allocated_size = Cstruct.LE.get_uint64 buf 8;
    default_crypto_id = Cstruct.LE.get_uint64 buf 16;
    total_bytes_written = Cstruct.LE.get_uint64 buf 24;
    total_bytes_read = Cstruct.LE.get_uint64 buf 32;
  }

  let of_buffer buf data_buf =
    let xf_type = Cstruct.get_uint8 buf 0 |> int_to_xf_type in
    let _xf_flags = Cstruct.get_uint8 buf 1 in
    let xf_size = Cstruct.LE.get_uint16 buf 2 in
    match xf_type with
      | Some XFTypeName -> (XFName (Cstruct.copy data_buf 0 xf_size), xf_size)
      | Some XFTypeDstream -> (XFDstream (j_dstream_of_buffer data_buf), xf_size)
      | Some XFTypeSparseBytes -> (XFSparseBytes (Cstruct.LE.get_uint64 data_buf 0), xf_size)
      | _ -> Printf.printf "hi\n"; (XFUnknown (Cstruct.get_uint8 buf 0), xf_size)

  let align8 x =
    (x + 7) land (lnot 7)

  let rec read_xfields buf data_area =
      let (xfield, consumed_data) = of_buffer buf data_area in
      let buf_rest = Cstruct.shift buf sizeof_xfield_t in
      let rest_xfields = if (Cstruct.len buf_rest) = 0 then []
        else
          let data_area_rest = Cstruct.shift data_area (align8 consumed_data) in
          read_xfields buf_rest data_area_rest
        in
      xfield::rest_xfields

      (*let xf_size = Cstruct.LE.get_uint16 buf 2 in*)
      (*let xf_buf = Cstruct.sub buf 0 (4 + xf_size) in*)
      (*let data_buf = Cstruct.shift buf (4 + xf_size) in*)
      (*(of_buffer xf_buf)::(read_xfields (remaining - 1) rest_buf)*)

  let many_of_buffer buf =
    if Cstruct.len buf = 0 then []
    else
      let xfields_count = Cstruct.LE.get_uint16 buf 0 in
      (*let xfields_size = Cstruct.LE.get_uint16 buf 2 in*)
      let xfields_buf = Cstruct.sub buf 4 (sizeof_xfield_t * xfields_count) in
      let data_area = Cstruct.shift buf (sizeof_xblob_t + (sizeof_xfield_t * xfields_count)) in
      read_xfields xfields_buf data_area

end

module FsObject = struct
  type drec_key = {
    name: string;
    name_len_and_hash: int32 [@printer fun fmt -> fprintf fmt "0x%08lxl"];
  }
  [@@deriving show]

  type t =
    | Invalid
    | Inode of int64
    | Xattr of string
    | DataStreamId
    | FileExtent of int64
    | DirRec of drec_key
    | InvalidMax
  [@@deriving show]

  let obj_id_mask   = 0x0fffffffffffffffL
  let obj_type_mask = 0xf000000000000000L
  let obj_type_shift = 60

  let type_inode = 0x3
  let type_xattr = 0x4
  let type_dstream_id = 0x6
  let type_extent  = 0x8
  let type_dir_rec = 0x9

  let drec_len_mask   = 0x000003ffl
  let drec_hash_mask  = 0xfffffc00l
  let drec_hash_shift = 10

  let read_drec_key buf =
    let name_and_hash = Cstruct.LE.get_uint32 buf 8 in
    let name_len = Int32.(logand drec_len_mask name_and_hash |> to_int) in
    {
      (*subtract 1, because name_len includes the final NUL byte*)
      name = Cstruct.copy buf 12 (name_len - 1);
      (*hash = Int32.(shift_right_logical (logand drec_hash_mask name_and_hash) drec_hash_shift |> to_int);*)
      name_len_and_hash = name_and_hash;
    }

  let read_xattr_key buf =
    let name_len = Cstruct.LE.get_uint16 buf 8 in
    (*subtract 1, because name_len includes the final NUL byte*)
    Cstruct.copy buf 10 (name_len - 1)

  let read_file_extent buf =
    Cstruct.LE.get_uint64 buf 8

  let compare a b = match (a,b) with
  | (DirRec dra, DirRec drb) -> (match compare dra.name_len_and_hash drb.name_len_and_hash with
    | 0 -> compare dra.name drb.name
    | x -> x
  )
  | (Xattr a, Xattr b) -> compare a b
  | (FileExtent a, FileExtent b) -> compare a b
  | (Invalid, Invalid) -> 0
  | (Invalid, _) -> -1
  | (_, Invalid) -> 1
  | (InvalidMax, InvalidMax) -> 0
  | (_, InvalidMax) -> -1
  | (InvalidMax, _) -> 1
  | _ -> 0

  let of_buffer buf =
    let obj_id_and_type = Cstruct.LE.get_uint64 buf 0 in
    let obj_id = Int64.(logand obj_id_mask obj_id_and_type) in
    let obj_type = Int64.(shift_right_logical (logand obj_id_and_type obj_type_mask) obj_type_shift |> to_int) in
    ((obj_id, obj_type),
    if obj_type = type_inode then Inode obj_id
    else if obj_type = type_xattr then Xattr (read_xattr_key buf)
    else if obj_type = type_dstream_id then DataStreamId
    else if obj_type = type_extent then FileExtent (read_file_extent buf)
    else if obj_type = type_dir_rec then DirRec (read_drec_key buf)
    else (failwith (Printf.sprintf "unknown fs object type: %d" obj_type))
    )
end

module FsBtree_key = struct
  type t = (int64 * int) * FsObject.t
  [@@deriving show]

  let of_buffer buf = FsObject.of_buffer buf

  let compare ((aid, atyp), a) ((bid, btyp), b) =
    match compare aid bid with
    | 0 -> (match compare atyp btyp with
      | 0 -> FsObject.compare a b
      | x -> x
    )
    | x -> x
end

module FsBtree_val = struct
  type key = FsBtree_key.t

  module InodeVal = struct
    type t = {
      parent_id: int64;
      private_id: int64;

      create_time: int64;
      mod_time: int64;
      change_time: int64;
      access_time: int64;

      internal_flags: int64 [@printer fun fmt -> fprintf fmt "0x%Lx"];

      xfields: InodeXfield.t list;
    }
    [@@deriving show]

    let of_buffer buf =
      let xfields_buf = Cstruct.shift buf sizeof_j_inode_val_t in
    {
      parent_id = get_j_inode_val_t_parent_id buf;
      private_id = get_j_inode_val_t_private_id buf;

      create_time = get_j_inode_val_t_create_time buf;
      mod_time = get_j_inode_val_t_mod_time buf;
      change_time = get_j_inode_val_t_change_time buf;
      access_time = get_j_inode_val_t_access_time buf;

      internal_flags = get_j_inode_val_t_internal_flags buf;
      xfields = InodeXfield.many_of_buffer xfields_buf;
    }
  end

  module XattrVal = struct
    module Flags = struct
      module Pervasives = Stdlib (* ugly hack required for ppx_cstruct to work *)
      [%%cenum
      type xattr_storage_type =
        | STDataStream   [@id 0x0001]
        | STDataEmbedded [@id 0x0002]
        [@@uint16_t]
      ]
      let pp_xattr_storage_type fmt v =
        Format.fprintf fmt "%s(0x%x)" (xattr_storage_type_to_string v) (xattr_storage_type_to_int v)

      let xattr_storage_type_mask = 0x03
      let xattr_file_system_owned = 0x04
      let xattr_reserverd_8       = 0x08

      type t = {
        file_system_owned: bool;
        reserved_8: bool;
        storage_type: xattr_storage_type;
      }
      [@@deriving show]

      let storage_type_of_int i = (xattr_storage_type_mask land i) |> int_to_xattr_storage_type

      let of_int i = {
        file_system_owned = flags_set xattr_file_system_owned i;
        reserved_8 = flags_set xattr_reserverd_8 i;
        storage_type = storage_type_of_int i |> Option.get;
      }
    end

    type xdata_t =
    | XDataEmbedded of Cstruct.t [@printer pp_cstruct]
    | XDataStream of int64
    [@@deriving show]

    type t = {
      flags: Flags.t;
      xdata: xdata_t;
    }
    [@@deriving show]

    let of_buffer buf =
      let flags = Flags.of_int (Cstruct.LE.get_uint16 buf 0) in
      let xdata = (
      match flags.storage_type with
      | STDataEmbedded ->
          let data_len = Cstruct.LE.get_uint16 buf 2 in
          XDataEmbedded (Cstruct.sub buf 4 data_len)
      | STDataStream ->
          XDataStream (Cstruct.LE.get_uint64 buf 4)
      ) in
      {flags;xdata;}
  end

  module DirRecVal = struct
    module Pervasives = Stdlib (* ugly hack required for ppx_cstruct to work *)

    [%%cenum
    type dirrec_type =
      | DtUnknown   [@id 0x0000]
      | DtFifo      [@id 0x0001]
      | DtCharacter [@id 0x0002]
      | DtDirectory [@id 0x0004]
      | DtBlock     [@id 0x0006]
      | DtRegular   [@id 0x0008]
      | DtSymLink   [@id 0x000a]
      | DtSocket    [@id 0x000c]
      | DtWhiteout  [@id 0x000e]
      [@@uint16_t]
    ]

    let pp_dirrec_type fmt v =
      Format.fprintf fmt "%s(0x%x)" (dirrec_type_to_string v) (dirrec_type_to_int v)

    type t = {
      file_id: int64;
      date_added: int64;
      typ: dirrec_type;
      (*xfields: XField.t list;*)
    }
    [@@deriving show]

    let dirrec_type_mask = 0x000f

    let of_buffer buf = {
      file_id = Cstruct.LE.get_uint64 buf 0;
      date_added = Cstruct.LE.get_uint64 buf 8;
      typ = int_to_dirrec_type (Cstruct.LE.get_uint16 buf 16) |> Option.get;
    }
  end

  module PhysExtentVal = struct
    type t = {
      length: int64;
      owning_obj_oid: int64;
      refcnt: int32;
    }
    [@@deriving show]
  end

  module DataStreamIdVal = struct
    type t = {
      refcnt: int32;
    }
    [@@deriving show]

    let of_buffer buf = assert (Cstruct.len buf = 4); {
       refcnt = Cstruct.LE.get_uint32 buf 0;
    }
  end

  module FileExtentVal = struct
    type t = {
      length: int64;
      flags: unit; (* currently no flags defined *)
      phys_block_num: int64;
      crypto_id: int64;
    }
    [@@deriving show]

    let file_extent_len_mask = 0x00ffffff_ffffffffL

    let of_buffer buf = {
      length = Int64.logand file_extent_len_mask (Cstruct.LE.get_uint64 buf 0);
      flags = ();
      phys_block_num = Cstruct.LE.get_uint64 buf 8;
      crypto_id = Cstruct.LE.get_uint64 buf 16;
    }
  end

  type t =
    | Inode of InodeVal.t
    | Xattr of XattrVal.t
    | DirRec of DirRecVal.t
    | DataStreamId of DataStreamIdVal.t
    | FileExtent of FileExtentVal.t
    | PhysExtent of PhysExtentVal.t
    | NotImplemented
  [@@deriving show]

  let of_buffer key buf = match key with
    | (_, FsObject.Inode _) -> Inode (InodeVal.of_buffer buf)
    | (_, FsObject.DirRec _) -> DirRec (DirRecVal.of_buffer buf)
    | (_, FsObject.DataStreamId) -> DataStreamId (DataStreamIdVal.of_buffer buf)
    | (_, FsObject.FileExtent _) -> FileExtent (FileExtentVal.of_buffer buf)
    | (_, FsObject.Xattr _) -> Xattr (XattrVal.of_buffer buf)
    | (_, typ) -> Printf.printf "unable to deserialize: %s\n" (FsObject.show typ);
      NotImplemented
    (*Cstruct.LE.get_uint64 buf 0;*)
end

module FsBtree_node = Btree_node(FsBtree_key)(FsBtree_val)

(*module Btree (K : BtreeKey) (V : BtreeVal) = struct*)
module Btree (NodeType : Btree_node_S) = struct
  include BtreeMeta

  let bt_oid_type_ephemeral = 0x00000008l
  let bt_oid_type_physical = 0x00000010l
  let bt_oid_type_mask = Int32.(logor bt_oid_type_ephemeral bt_oid_type_physical)

  type t = info * NodeType.t
  [@@deriving show]

  exception Inconsistent_data of string

  let flags_of_int32 i =
    {
      bt_oid_type = (match Int32.(logand bt_oid_type_mask i) with
      | 0x00000000l -> `Virtual
      | 0x00000008l -> `Ephemeral
      | 0x00000010l -> `Physical
      | _ -> failwith "invalid oid type in btree" );
    }

  let validate (info, root) =
    if root.NodeType.btn_flags.btn_is_fixed_kv_size then (
      if info.bt_key_size = 0 || info.bt_val_size = 0 then raise (Inconsistent_data "inconsistent BTree flags")
    );
    (info, root)

  let of_buffer buf =
    let buf_info = Cstruct.(sub buf (len buf - sizeof_btree_info) (sizeof_btree_info)) in
    let bt_flags = flags_of_int32 (get_btree_info_bt_flags buf_info) in
    let bt_key_size = get_btree_info_bt_key_size buf_info |> Int32.to_int in
    let bt_val_size = get_btree_info_bt_val_size buf_info |> Int32.to_int in
    let info = {
      bt_flags;
      bt_node_size = get_btree_info_bt_node_size buf_info |> Int32.to_int;
      bt_key_size;
      bt_val_size;
    } in
    validate (info, NodeType.of_buffer info buf)
end

module OmapBtree = Btree(OmapBtree_node)
module FsBtree = Btree(FsBtree_node)

module Omap_phys = struct
  type t = {
    om_tree_oid: virt_oid_t;
  }
  [@@deriving show]

  let of_buffer buf = {
    om_tree_oid = get_omap_phys_om_tree_oid buf;
  }
end

module Checkpoint_mapping = struct
  type t = {
    cpm_type: ObjectType.t;
    cpm_subtype: ObjectType.t option;
    cpm_size: int32;
    cpm_pad: int32;
    cpm_paddr: int64;
  }
  [@@deriving show]

  let empty = {
    cpm_type =  ObjectType.of_int 0x00000001l |> Option.get;
    cpm_subtype =  ObjectType.of_int 0x0l;
    cpm_size = 0l;
    cpm_pad = 0l;
    cpm_paddr = 0L;
  }

  let of_buffer buf = {
    cpm_type = ObjectType.of_int (get_checkpoint_mapping_cpm_type buf) |> Option.get;
    cpm_subtype = ObjectType.of_int (get_checkpoint_mapping_cpm_subtype buf);
    cpm_size = get_checkpoint_mapping_cpm_size buf;
    cpm_pad = get_checkpoint_mapping_cpm_pad buf;
    cpm_paddr = get_checkpoint_mapping_cpm_paddr buf;
    }
end

module Checkpoint_map_phys = struct
  type flags = {
    cpm_is_last: bool;
  }
  [@@deriving show]

  let checkpoint_map_last = 0x00000001l

  let flags_of_int32 flags = {
    cpm_is_last = 0l <> (Int32.logand checkpoint_map_last flags)
  }

  type t = {
    cpm_flags: flags;
    cpm_map: Checkpoint_mapping.t array;
  }
  [@@deriving show]

  let of_buffer buf =
    let count = get_checkpoint_map_phys_cpm_count buf in
    let cpm_map = Array.init (Int32.to_int count) (fun i ->
      let offset = sizeof_checkpoint_map_phys + (i * sizeof_checkpoint_mapping) in
      Checkpoint_mapping.of_buffer Cstruct.(shift buf offset)
      ) in
    {
      cpm_flags = flags_of_int32 (get_checkpoint_map_phys_cpm_flags buf);
      cpm_map;
    }
end

let nul_terminated_string_of_buffer buf =
  let s = Cstruct.to_string buf in
  match String.index_opt s '\000' with
  | Some idx -> String.sub s 0 idx
  | None -> s

module Apfs_superblock = struct
  type t = {
    apfs_root_tree_type: ObjectType.t;
    apfs_omap_oid: phys_oid_t;
    apfs_root_tree_oid: virt_oid_t;
    apfs_volname: string;
  }
  [@@deriving show]

  let of_buffer buf =
    {
      apfs_root_tree_type = get_apfs_superblock_apfs_root_tree_type buf |> ObjectType.of_int |> Option.get;
      apfs_omap_oid = get_apfs_superblock_apfs_omap_oid buf;
      apfs_root_tree_oid = get_apfs_superblock_apfs_root_tree_oid buf;
      apfs_volname = get_apfs_superblock_apfs_volname buf |> nul_terminated_string_of_buffer;
    }
end

module Object = struct
  type t = Obj_phys.t * [
    | `NX_SUPERBLOCK of Nx_superblock.t
    | `CHECKPOINT_MAP of Checkpoint_map_phys.t
    | `FS of Apfs_superblock.t
    | `FS_BTREE of FsBtree.t
    | `OMAP of Omap_phys.t
    | `OMAP_BTREE of OmapBtree.t
    | `OMAP_BTREE_NODE of OmapBtree_node.t
    (*| `BTREE_NODE of Btree_node.t*)
  ]
  [@@deriving show]

  exception UnexpectedObjectType of t * string

  let to_omap_phys msg = function
    | (_, `OMAP x) -> x
    | x -> raise (UnexpectedObjectType (x, msg))
  let to_omap_btree msg = function
    | (_, `OMAP_BTREE x) -> x
    | x -> raise (UnexpectedObjectType (x, msg))
  let to_omap_btree_node msg = function
    | (_, `OMAP_BTREE_NODE x) -> x
    | x -> raise (UnexpectedObjectType (x, msg))
  let to_fs msg = function
    | (hdr, `FS x) -> hdr, x
    | x -> raise (UnexpectedObjectType (x, msg))
  let to_fs_btree msg = function
    | (_, `FS_BTREE x) -> x
    | x -> raise (UnexpectedObjectType (x, msg))
end

let obj_of_buffer obj_phys csbuf =
  let open Obj_phys in
  match type_subtype obj_phys with
  | ObjectType.NX_SUPERBLOCK, None ->
      (obj_phys, `NX_SUPERBLOCK (Nx_superblock.of_buffer csbuf))
  | ObjectType.CHECKPOINT_MAP, None ->
      (obj_phys, `CHECKPOINT_MAP (Checkpoint_map_phys.of_buffer csbuf))
  | ObjectType.OMAP, None ->
      (obj_phys, `OMAP (Omap_phys.of_buffer csbuf))
  | ObjectType.FS, None ->
      (obj_phys, `FS (Apfs_superblock.of_buffer csbuf))
  | ObjectType.BTREE, Some ObjectType.FSTREE ->
      (obj_phys, `FS_BTREE (FsBtree.of_buffer csbuf))
  | ObjectType.BTREE, Some ObjectType.OMAP ->
      (obj_phys, `OMAP_BTREE (OmapBtree.of_buffer csbuf))
  | ObjectType.BTREE_NODE, Some ObjectType.OMAP ->
      failwith "to be continued"
      (*(obj_phys, `OMAP_BTREE_NODE (OmapBtree_node.of_buffer csbuf))*)
  | typ, subtyp ->
      failwith ("unknown obj type: " ^ (ObjectType.show_typ typ) ^ " / " ^ (ObjectType.show_typ_opt subtyp))