gazagnaire.org
Block device abstraction for OCaml 5 with Eio direct-style I/O and Bytesrw integration
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Block device abstraction for Eio.
7
8 This library provides a minimal block device interface inspired by MirageOS
9 but using Eio direct-style I/O instead of Lwt.
10
11 {1 Overview}
12
13 Block devices provide fixed-size sector access to storage. Unlike streaming
14 I/O, block devices support random access reads and writes at sector
15 granularity.
16
17 {[
18 Eio_main.run @@ fun env ->
19 Eio.Switch.run @@ fun sw ->
20 let blk = Block.of_file ~sw env#fs "disk.img" ~sector_size:512 in
21 let info = Block.info blk in
22 Printf.printf "Sectors: %Ld, Size: %d\n" info.sectors info.sector_size;
23 let data = Block.read blk 0L in
24 (* ... *)
25 ]}
26
27 {1 Types} *)
28
29type info = {
30 read_write : bool; (** [true] if writes are permitted *)
31 sector_size : int; (** Bytes per sector (typically 512 or 4096) *)
32 sectors : int64; (** Total number of sectors *)
33}
34(** Device information. *)
35
36type t
37(** A block device handle. *)
38
39val pp : t Fmt.t
40(** [pp] pretty-prints the block device, showing sector size, sector count, and
41 read/write mode. *)
42
43type error =
44 [ `Disconnected (** Device has been disconnected *)
45 | `Read_error of string (** Read operation failed *)
46 | `Invalid_sector of int64 (** Sector number out of bounds *) ]
47(** Read errors. *)
48
49type write_error =
50 [ error
51 | `Write_error of string (** Write operation failed *)
52 | `Read_only (** Device is read-only *) ]
53(** Write errors. *)
54
55val pp_error : error Fmt.t
56(** Pretty-print a read error. *)
57
58val pp_write_error : write_error Fmt.t
59(** Pretty-print a write error. *)
60
61(** {1 Device Operations} *)
62
63val info : t -> info
64(** [info t] returns device information. *)
65
66val read : t -> int64 -> (string, error) result
67(** [read t sector] reads a single sector. Returns sector data or error. *)
68
69val read_many : t -> int64 -> int -> (string, error) result
70(** [read_many t start count] reads [count] consecutive sectors starting at
71 [start]. Returns concatenated data or error on first failure. *)
72
73val write : t -> int64 -> string -> (unit, write_error) result
74(** [write t sector data] writes [data] to [sector]. The length of [data] must
75 equal the sector size. *)
76
77val write_many : t -> int64 -> string list -> (unit, write_error) result
78(** [write_many t start sectors] writes multiple sectors starting at [start].
79 Each string must have length equal to sector size. *)
80
81val sync : t -> unit
82(** [sync t] flushes all pending writes to the underlying storage. *)
83
84val close : t -> unit
85(** [close t] releases resources. Further operations will return
86 [`Disconnected]. *)
87
88(** {1 Bytesrw Integration} *)
89
90val to_reader : t -> offset:int64 -> length:int64 -> Bytesrw.Bytes.Reader.t
91(** [to_reader t ~offset ~length] creates a sequential reader starting at byte
92 [offset] for [length] bytes. Offset must be sector-aligned. *)
93
94val to_writer : t -> offset:int64 -> Bytesrw.Bytes.Writer.t
95(** [to_writer t ~offset] creates a sequential writer starting at byte [offset].
96 Offset must be sector-aligned. Writes are buffered to sector boundaries. *)
97
98(** {1 Implementations} *)
99
100val of_memory : sector_size:int -> sectors:int64 -> t
101(** [of_memory ~sector_size ~sectors] creates an in-memory block device. Useful
102 for testing. *)
103
104val of_bigarray :
105 sector_size:int ->
106 (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t ->
107 t
108(** [of_bigarray ~sector_size ba] wraps an existing bigarray as a block device.
109 The bigarray size must be a multiple of [sector_size]. *)
110
111val of_string : sector_size:int -> string -> t
112(** [of_string ~sector_size data] creates a read-only block device from a
113 string. Useful for testing with known data. *)
114
115val of_file :
116 sw:Eio.Switch.t ->
117 _ Eio.Path.t ->
118 sector_size:int ->
119 ?sectors:int64 ->
120 ?create:int64 ->
121 unit ->
122 t
123(** [of_file ~sw path ~sector_size ?sectors ?create ()] opens a file as a block
124 device.
125
126 @param sectors
127 Override the sector count instead of deriving it from file size. Required
128 for Linux block devices which report [st_size = 0].
129 @param create
130 If provided, creates the file with this many sectors if it doesn't exist.
131 @param sector_size Sector size in bytes (must be power of 2, >= 512). *)
132
133(** {1 Combinators} *)
134
135val read_only : t -> t
136(** [read_only t] returns a read-only view of [t]. *)
137
138val sub : t -> start:int64 -> sectors:int64 -> t
139(** [sub t ~start ~sectors] returns a view of a subset of sectors. Useful for
140 partitioning. *)
141
142val with_crc32c : t -> t
143(** [with_crc32c t] wraps [t] with CRC32C checksums. Each sector reserves 4
144 bytes for the checksum, reducing usable space per sector by 4 bytes. Reads
145 verify checksums and return [`Read_error] on mismatch. *)
146
147(** {1 Generic Operations}
148
149 Operations inspired by MirageOS mirage-block. *)
150
151val fold :
152 f:(int64 -> string -> 'a -> ('a, error) result) ->
153 t ->
154 'a ->
155 ('a, error) result
156(** [fold ~f t init] folds [f] over every sector in the device.
157 [f sector data acc] is called for each sector in order. Stops on first
158 error. *)
159
160val iter :
161 f:(int64 -> string -> (unit, error) result) -> t -> (unit, error) result
162(** [iter ~f t] iterates [f] over every sector. *)
163
164type compare_error =
165 [ error
166 | `Different_sizes (** Devices have different sector counts *)
167 | `Different_sector_sizes (** Devices have different sector sizes *)
168 | `Contents_differ of int64 (** Contents differ at this sector *) ]
169(** Comparison errors. *)
170
171val pp_compare_error : compare_error Fmt.t
172
173val compare : t -> t -> (unit, compare_error) result
174(** [compare a b] compares two block devices sector by sector. Returns [Ok ()]
175 if they are identical, or an error describing the first difference. *)
176
177type copy_error =
178 [ write_error
179 | `Different_sizes (** Source larger than destination *)
180 | `Different_sector_sizes (** Devices have different sector sizes *) ]
181(** Copy errors. *)
182
183val pp_copy_error : copy_error Fmt.t
184
185val copy : src:t -> dst:t -> (unit, copy_error) result
186(** [copy ~src ~dst] copies all sectors from [src] to [dst]. The destination
187 must be at least as large as the source. *)
188
189val sparse_copy : src:t -> dst:t -> (unit, copy_error) result
190(** [sparse_copy ~src ~dst] copies non-zero sectors from [src] to [dst]. Sectors
191 that are all zeros are skipped, preserving sparseness. *)
192
193val fill : t -> char -> (unit, write_error) result
194(** [fill t c] fills every sector with byte [c]. Useful for wiping a device. *)
195
196val zero : t -> (unit, write_error) result
197(** [zero t] fills every sector with zeros. Equivalent to [fill t '\x00']. *)
198
199val is_zero : string -> bool
200(** [is_zero data] returns [true] if [data] contains only zero bytes. *)