Source file entry.ml

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
type t = Tag.t * Cstruct.t
type link = | Metadata of (int64 * int64)
            | Data of (int32 * int32)

let sizeof t =
  Cstruct.length (snd t) + Tag.size

let info_of_entry (tag, data) =
  match tag.Tag.type3 with
  | (LFS_TYPE_NAME, 0x01) ->
    Some (Cstruct.to_string data, `Value)
  | (LFS_TYPE_NAME, 0x02) ->
    Some (Cstruct.to_string data, `Dictionary)
  | _ -> None

let ctime id (d, ps) =
  let cs = Cstruct.create @@ 4 + 8 in
  Cstruct.LE.set_uint32 cs 0 (Int32.of_int d);
  Cstruct.LE.set_uint64 cs 4 ps;
  Tag.({
      valid = true;
      type3 = (LFS_TYPE_USERATTR, 0x74);
      length = 4 + 8;
      id;
    }), cs

let ctime_of_cstruct cs =
  if Cstruct.length cs < 4 + 8 then None
  else begin
    let d = Cstruct.LE.get_uint32 cs 0 |> Int32.to_int in
    let ps = Cstruct.LE.get_uint64 cs 4 in
    Some (d, ps)
  end

let into_cstruct ~xor_tag_with cs t =
  Tag.into_cstruct ~xor_tag_with cs @@ fst t;
  Cstruct.blit (snd t) 0 cs Tag.size (Cstruct.length @@ snd t)

let links (tag, data) =
  if Tag.is_file_struct tag then begin
    match (snd tag.Tag.type3) with
    | 0x00 -> begin
      match Dir.dirstruct_of_cstruct data with
      | None -> None 
      | Some s -> Some (Metadata s)
    end
    | 0x02 -> begin
        match File.ctz_of_cstruct data with
        | None -> None
        | Some s -> Some (Data s)
      end
    | _ -> None
  end else if Tag.is_hardtail tag then begin
    match Dir.hard_tail_links (tag, data) with
    | None -> None
    | Some (next_metadata) -> Some (Metadata next_metadata)
  end else None

let compact entries =
  let remove_entries_matching id l =
    List.filter_map (fun e ->
        if 0 = (Int.compare Tag.((fst e).id) id) then None
        else Some e
      ) l
  in
  List.fold_left (fun new_list e ->
      match Tag.((fst e).type3) with
      | Tag.LFS_TYPE_SPLICE, 0xff -> remove_entries_matching Tag.((fst e).id) new_list
      | _ -> e :: new_list
    ) [] entries |> List.rev

let lenv_with_hardtail l =
  List.fold_left (fun sum t ->
      sum + sizeof t
      ) 0 l

let lenv_less_hardtail l =
  List.fold_left (fun sum t ->
      if (not @@ Tag.is_hardtail @@ fst t) then
      sum + sizeof t
      else sum) 0 l

let into_cstructv ~starting_xor_tag cs l =
  (* currently this takes a `t list`, and therefore is pretty straightforward.
   * This function exists so we can do better once `t list` is replaced with more complicated *)
  List.fold_left (fun (pointer, prev_tag) t ->
      into_cstruct ~xor_tag_with:prev_tag (Cstruct.shift cs pointer) t;
      let tag = Tag.to_cstruct_raw (fst t) in
      (pointer + (sizeof t), tag)
    ) (0, starting_xor_tag) l

let to_cstructv ~starting_xor_tag l =
  (* TODO: this is also not quite right; in cases where we filter out a
   * hardtail, we'll have a gap at the end of the cstruct *)
  let cs = Cstruct.create @@ lenv_with_hardtail l in
  let (_, last_tag) = into_cstructv ~starting_xor_tag cs l in
  last_tag, cs

(** [of_cstructv cs] returns [(l, t, s)] where [l] is the list of (tag, entry) pairs discovered
 * preceding the next CRC entry.
 * [t] the last tag (un-xor'd) for use in seeding future reads or writes,
 * [s] the number of bytes read from [cs], including (if present and read) the CRC tag,
 * data, and any padding. *)
let of_cstructv ~starting_xor_tag cs =
  let tag ~xor_tag_with cs =
    if Cstruct.length cs < Tag.size then None
    else begin
      match Tag.of_cstruct ~xor_tag_with (Cstruct.sub cs 0 Tag.size) with
      | Error _ -> None
      | Ok tag ->
        let total_length = Tag.size + tag.length in
        if total_length <= Cstruct.length cs
        then Some (tag, Cstruct.sub cs Tag.size tag.length)
        else None
    end
  in
  let rec gather (l, last_tag, s) cs =
    match tag ~xor_tag_with:last_tag cs with
    | None -> (List.rev l, last_tag, s)
    | Some (tag, data) ->
      match tag.Tag.type3 with
      | Tag.LFS_TYPE_CRC, _chunk ->
        (* omit the CRC tag from the results, but make sure to return the amount
         * of data we read including it *)
        (List.rev l, Cstruct.sub cs 0 Tag.size,
         (s + Tag.size + (Cstruct.length data)))
      | _ ->

        gather ((tag, data) :: l,
                Cstruct.sub cs 0 Tag.size,
                s + Tag.size + Cstruct.length data
               )
          (Cstruct.shift cs (Tag.size + tag.Tag.length ))
  in
  gather ([], starting_xor_tag, 0) cs