lib/io.ml at main · desertthunder.dev/lithos

desertthunder.dev / lithos
An embedded, single-file key-value store for OCaml, inspired by BoltDB and LMDB.
lithos / lib / io.ml
at main 2.3 kB view raw
 1(** Low-level I/O operations for database files *)
 2
 3let magic = "LITHOS\x00\x00"
 4let version = 1
 5
 6let create_database path page_size =
 7  try
 8    let fd = Unix.openfile path [ Unix.O_RDWR; Unix.O_CREAT; Unix.O_EXCL ] 0o644 in
 9    let buf = Bytes.create page_size in
10    Bytes.blit_string magic 0 buf 0 (String.length magic);
11
12    Bytes.set_int32_le buf 8 (Int32.of_int version);
13    Bytes.set_int32_le buf 12 (Int32.of_int page_size);
14    Bytes.set_int64_le buf 16 Int64.zero;
15
16    let written = Unix.write fd buf 0 page_size in
17    Unix.close fd;
18
19    if written = page_size then Ok () else Error (Error.IO_error "Failed to write complete header")
20  with
21  | Unix.Unix_error (err, _, _) -> Error (Error.of_unix_error err path)
22;;
23
24let read_header path =
25  try
26    let fd = Unix.openfile path [ Unix.O_RDONLY ] 0o644 in
27    let buf = Bytes.create 256 in
28    let read_bytes = Unix.read fd buf 0 256 in
29    Unix.close fd;
30
31    if read_bytes < 24
32    then Error (Error.Invalid_database "File too small")
33    else (
34      let magic_read = Bytes.sub_string buf 0 8 in
35      if magic_read <> magic
36      then Error (Error.Invalid_database "Invalid magic number")
37      else (
38        let ver = Int32.to_int (Bytes.get_int32_le buf 8) in
39        let page_size = Int32.to_int (Bytes.get_int32_le buf 12) in
40        let root = Bytes.get_int64_le buf 16 in
41        let root_bucket = if root = Int64.zero then None else Some root in
42        Ok { Types.version = ver; page_size; root_bucket }))
43  with
44  | Unix.Unix_error (err, _, _) -> Error (Error.of_unix_error err path)
45;;
46
47let write_header path metadata =
48  try
49    let fd = Unix.openfile path [ Unix.O_RDWR ] 0o644 in
50    let buf = Bytes.create 256 in
51
52    Bytes.blit_string magic 0 buf 0 (String.length magic);
53    Bytes.set_int32_le buf 8 (Int32.of_int metadata.Types.version);
54    Bytes.set_int32_le buf 12 (Int32.of_int metadata.Types.page_size);
55
56    let root =
57      match metadata.Types.root_bucket with
58      | None -> Int64.zero
59      | Some id -> id
60    in
61    Bytes.set_int64_le buf 16 root;
62
63    let written = Unix.write fd buf 0 256 in
64    Unix.close fd;
65
66    if written = 256 then Ok () else Error (Error.IO_error "Failed to write header")
67  with
68  | Unix.Unix_error (err, _, _) -> Error (Error.of_unix_error err path)
69;;