Source file protocol_store.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
type t = {
protocol_store_dir : [`Protocol_dir] Naming.directory;
mutable protocols : Protocol_hash.Set.t;
}
let mem t protocol_hash = Protocol_hash.Set.mem protocol_hash t.protocols
let all {protocols; _} = protocols
let raw_store store protocol_hash bytes =
let open Lwt_syntax in
if mem store protocol_hash then Lwt.return_none
else
let protocol_file =
Naming.protocol_file store.protocol_store_dir protocol_hash
in
let* fd =
Lwt_unix.openfile
(Naming.file_path protocol_file)
[Unix.O_CREAT; O_WRONLY; O_CLOEXEC]
0o644
in
let* () = Lwt_utils_unix.write_bytes fd bytes in
let* _ = Lwt_utils_unix.safe_close fd in
store.protocols <- Protocol_hash.Set.add protocol_hash store.protocols ;
Lwt.return_some protocol_hash
let store store protocol_hash protocol =
raw_store store protocol_hash (Protocol.to_bytes protocol)
let read store protocol_hash =
let open Lwt_syntax in
Option.catch_os (fun () ->
let protocol_file =
Naming.protocol_file store.protocol_store_dir protocol_hash
in
let* content =
Lwt_utils_unix.read_file (Naming.file_path protocol_file)
in
Lwt.return (Protocol.of_string content))
let init store_dir =
let open Lwt_syntax in
let protocol_store_dir = Naming.protocol_store_dir store_dir in
let protocol_store_dir_path = Naming.dir_path protocol_store_dir in
let* file_exists = Lwt_unix.file_exists protocol_store_dir_path in
let* () =
if not file_exists then Lwt_utils_unix.create_dir protocol_store_dir_path
else Lwt.return_unit
in
let* dir = Lwt_unix.opendir protocol_store_dir_path in
let rec loop set =
Lwt.try_bind
(fun () -> Lwt_unix.readdir dir)
(fun file ->
match Protocol_hash.of_b58check_opt file with
| Some protocol_hash -> loop (Protocol_hash.Set.add protocol_hash set)
| None -> loop set)
(function End_of_file -> Lwt.return set | _ -> loop set)
in
let* protocols = loop Protocol_hash.Set.empty in
let* () = Lwt_unix.closedir dir in
Lwt.return {protocol_store_dir; protocols}