Skip to content

Commit 497dfae

Browse files
psafontpsafont
committed
Maintenance: format code with ocamlformat
Signed-off-by: Pau Ruiz Safont <[email protected]>
1 parent cf86276 commit 497dfae

18 files changed

+3110
-1990
lines changed

‎.ocamlformat‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
profile=ocamlformat
2+
version=0.14.1
3+
indicate-multiline-delimiters=closing-on-separate-line
4+
if-then-else=fit-or-vertical
5+
dock-collection-brackets=true
6+
break-struct=natural
7+
break-separators=before
8+
break-infix=fit-or-vertical
9+
break-infix-before-func=false

‎Makefile‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,7 @@ SBINDIR ?= /usr/sbin
33
MANDIR ?= /usr/share/man/man1
44
PROFILE=release
55

6-
7-
.PHONY: release build install uninstall clean test doc reindent
6+
.PHONY: release build install uninstall clean test doc format
87

98
release:
109
dune build @install @networkd/man --profile=$(PROFILE)
@@ -40,5 +39,6 @@ gprof:
4039
doc:
4140
dune build @doc --profile=$(PROFILE)
4241

43-
reindent:
44-
ocp-indent --inplace **/*.ml*
42+
# requires ocamlformat
43+
format:
44+
dune build @fmt --auto-promote

‎dune-project‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1,2 @@
1-
(lang dune 1.4)
1+
(lang dune 1.11)
2+
(using fmt 1.2 (enabled_for ocaml))

‎lib/jsonrpc_client.ml‎

Lines changed: 77 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -14,61 +14,73 @@
1414

1515
(* JSON-RPC Client *)
1616

17-
module D = Debug.Make(struct let name = "jsonrpc_client" end)
17+
module D = Debug.Make (struct let name = "jsonrpc_client" end)
18+
1819
open D
1920

2021
exception Timeout
22+
2123
exception Read_error
2224

2325
let json_rpc_max_len = ref 65536 (* Arbitrary maximum length of RPC response *)
24-
let json_rpc_read_timeout = ref 60000000000L (* timeout value in ns when reading RPC response *)
25-
let json_rpc_write_timeout = ref 60000000000L (* timeout value in ns when writing RPC request *)
2626

27-
let to_s s = (Int64.to_float s) *. 1e-9
27+
let json_rpc_read_timeout = ref 60000000000L
28+
29+
(* timeout value in ns when reading RPC response *)
30+
31+
let json_rpc_write_timeout = ref 60000000000L
32+
33+
(* timeout value in ns when writing RPC request *)
34+
35+
let to_s s = Int64.to_float s *. 1e-9
2836

2937
(* Read the entire contents of the fd, of unknown length *)
3038
let timeout_read fd timeout =
3139
let buf = Buffer.create !json_rpc_max_len in
3240
let read_start = Mtime_clock.counter () in
33-
let get_total_used_time () = Mtime.Span.to_uint64_ns (Mtime_clock.count read_start) in
41+
let get_total_used_time () =
42+
Mtime.Span.to_uint64_ns (Mtime_clock.count read_start)
43+
in
3444
let rec inner max_time max_bytes =
35-
let (ready_to_read, _, _) = try Unix.select [fd] [] [] (to_s max_time) with
45+
let ready_to_read, _, _ =
46+
try Unix.select [fd] [] [] (to_s max_time)
47+
with
3648
(* in case the unix.select call fails in situation like interrupt *)
37-
| Unix.Unix_error(Unix.EINTR,_,_) -> [], [], []
49+
| Unix.Unix_error (Unix.EINTR, _, _) ->
50+
([], [], [])
3851
in
3952
(* This is not accurate the calculate time just for the select part. However, we
4053
* think the read time will be minor comparing to the scale of tens of seconds.
4154
* the current style will be much concise in code. *)
42-
let remain_time =
55+
let remain_time =
4356
let used_time = get_total_used_time () in
4457
Int64.sub timeout used_time
4558
in
46-
if remain_time < 0L then
47-
begin
48-
debug "Timeout after read %d" (Buffer.length buf);
49-
raise Timeout
50-
end;
59+
if remain_time < 0L then (
60+
debug "Timeout after read %d" (Buffer.length buf) ;
61+
raise Timeout
62+
) ;
5163
if List.mem fd ready_to_read then
52-
begin
53-
let bytes = Bytes.make 4096 '\000' in
54-
match Unix.read fd bytes 0 4096 with
55-
| 0 -> Buffer.contents buf (* EOF *)
56-
| n ->
57-
if n > max_bytes then
58-
begin
59-
debug "exceeding maximum read limit %d, clear buffer" !json_rpc_max_len;
60-
Buffer.clear buf;
61-
raise Read_error
62-
end
63-
else
64-
begin
65-
Buffer.add_subbytes buf bytes 0 n;
66-
inner remain_time (max_bytes - n)
67-
end
68-
| exception Unix.Unix_error((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR),_,_) ->
64+
let bytes = Bytes.make 4096 '\000' in
65+
match Unix.read fd bytes 0 4096 with
66+
| 0 ->
67+
Buffer.contents buf (* EOF *)
68+
| n ->
69+
if n > max_bytes then (
70+
debug "exceeding maximum read limit %d, clear buffer"
71+
!json_rpc_max_len ;
72+
Buffer.clear buf ;
73+
raise Read_error
74+
) else (
75+
Buffer.add_subbytes buf bytes 0 n ;
76+
inner remain_time (max_bytes - n)
77+
)
78+
| exception
79+
Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _)
80+
->
6981
inner remain_time max_bytes
70-
end
71-
else inner remain_time max_bytes
82+
else
83+
inner remain_time max_bytes
7284
in
7385
inner timeout !json_rpc_max_len
7486

@@ -77,42 +89,50 @@ let timeout_read fd timeout =
7789
(* Writes into the file descriptor at the current cursor position. *)
7890
let timeout_write filedesc total_length data response_time =
7991
let write_start = Mtime_clock.counter () in
80-
let get_total_used_time () = Mtime.Span.to_uint64_ns (Mtime_clock.count write_start) in
92+
let get_total_used_time () =
93+
Mtime.Span.to_uint64_ns (Mtime_clock.count write_start)
94+
in
8195
let rec inner_write offset max_time =
82-
let (_, ready_to_write, _) = try Unix.select [] [filedesc] [] (to_s max_time) with
96+
let _, ready_to_write, _ =
97+
try Unix.select [] [filedesc] [] (to_s max_time)
98+
with
8399
(* in case the unix.select call fails in situation like interrupt *)
84-
| Unix.Unix_error(Unix.EINTR,_,_) -> [], [], []
100+
| Unix.Unix_error (Unix.EINTR, _, _) ->
101+
([], [], [])
85102
in
86-
let remain_time =
103+
let remain_time =
87104
let used_time = get_total_used_time () in
88105
Int64.sub response_time used_time
89106
in
90-
if remain_time < 0L then
91-
begin
92-
debug "Timeout to write %d at offset %d" total_length offset;
93-
raise Timeout
94-
end;
95-
if List.mem filedesc ready_to_write then
96-
begin
97-
let length = total_length - offset in
98-
let bytes_written =
99-
(try Unix.single_write filedesc data offset length with
100-
| Unix.Unix_error((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR),_,_) -> 0)
101-
in
102-
let new_offset = offset + bytes_written in
103-
if length = bytes_written then ()
104-
else inner_write new_offset remain_time
105-
end
106-
else inner_write offset remain_time
107+
if remain_time < 0L then (
108+
debug "Timeout to write %d at offset %d" total_length offset ;
109+
raise Timeout
110+
) ;
111+
if List.mem filedesc ready_to_write then
112+
let length = total_length - offset in
113+
let bytes_written =
114+
try Unix.single_write filedesc data offset length
115+
with
116+
| Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _)
117+
->
118+
0
119+
in
120+
let new_offset = offset + bytes_written in
121+
if length = bytes_written then
122+
()
123+
else
124+
inner_write new_offset remain_time
125+
else
126+
inner_write offset remain_time
107127
in
108128
inner_write 0 response_time
109129

110-
let with_rpc ?(version=Jsonrpc.V2) ~path ~call () =
130+
let with_rpc ?(version = Jsonrpc.V2) ~path ~call () =
111131
let uri = Uri.of_string (Printf.sprintf "file://%s" path) in
112132
Open_uri.with_open_uri uri (fun s ->
113-
Unix.set_nonblock s;
133+
Unix.set_nonblock s ;
114134
let req = Bytes.of_string (Jsonrpc.string_of_call ~version call) in
115-
timeout_write s (Bytes.length req) req !json_rpc_write_timeout;
135+
timeout_write s (Bytes.length req) req !json_rpc_write_timeout ;
116136
let res = timeout_read s !json_rpc_read_timeout in
117-
debug "Response: %s" res;
137+
debug "Response: %s" res ;
118138
Jsonrpc.response_of_string ~strict:false res)

‎lib/jsonrpc_client.mli‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,15 +13,22 @@
1313
*)
1414

1515
exception Timeout
16+
1617
exception Read_error
1718

1819
val json_rpc_max_len : int ref
20+
1921
val json_rpc_read_timeout : int64 ref
22+
2023
val json_rpc_write_timeout : int64 ref
2124

2225
val timeout_read : Unix.file_descr -> int64 -> string
2326

27+
val with_rpc :
28+
?version:Jsonrpc.version
29+
-> path:string
30+
-> call:Rpc.call
31+
-> unit
32+
-> Rpc.response
2433
(** Do an JSON-RPC call to a server that is listening on a Unix domain
2534
* socket at the given path. *)
26-
val with_rpc : ?version:Jsonrpc.version -> path:string -> call:Rpc.call -> unit -> Rpc.response
27-

0 commit comments

Comments
 (0)