Skip to content

Commit 24caf7a

Browse files
committed
Update Mirage packages
This also allows VPNkit to be build with OCaml 5+ Signed-off-by: Patrick Ferris <[email protected]>
1 parent 604ab7f commit 24caf7a

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

46 files changed

+357
-309
lines changed

dune

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@
2323

2424
(rule
2525
(target vpnkit.tgz)
26+
(enabled_if (= %{os_type} "macOS"))
2627
(deps vpnkit.exe (:gen ./scripts/mac_package.exe))
2728
(action (run %{gen} -out %{target} -in %{deps})))
2829

src/bin/config/discover.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ let os_type () =
1111
let flags () =
1212
match os_type () with
1313
| "Linux" ->
14-
[ "-ccopt"; "-static" ]
14+
[ "-ccopt"; "-static" ]
1515
| _ ->
1616
[]
1717

src/bin/config/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
11
(executable
22
(name discover)
3-
(libraries sexplib))
3+
(libraries unix sexplib))

src/bin/connect.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -83,8 +83,7 @@ module Hvsock = struct
8383
let read t = F.read t.flow
8484
let write t = F.write t.flow
8585
let writev t = F.writev t.flow
86-
let shutdown_read t = F.shutdown_read t.flow
87-
let shutdown_write t = F.shutdown_write t.flow
86+
let shutdown t = F.shutdown t.flow
8887
let pp_error = F.pp_error
8988
let pp_write_error = F.pp_write_error
9089
type error = F.error

src/bin/main.ml

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -863,21 +863,21 @@ let gc_compact =
863863
in
864864
Arg.(value & opt (some int) None doc)
865865

866-
let command =
866+
let term, info =
867867
let doc = "proxy TCP/IP connections from an ethernet link via sockets" in
868868
let man =
869869
[`S "DESCRIPTION";
870870
`P "Terminates TCP/IP and UDP/IP connections from a client and proxy the\
871871
flows via userspace sockets"]
872872
in
873-
Term.(pure main
873+
Term.(const main
874874
$ socket $ port_control_urls $ introspection_urls $ diagnostics_urls $ pcap_urls $ pcap_snaplen
875875
$ max_connections $ port_forwards $ dns $ http $ http_intercept_api_path $ hosts
876876
$ host_names $ gateway_names $ vm_names $ listen_backlog $ port_max_idle_time $ debug
877877
$ server_macaddr $ domain $ allowed_bind_addresses $ gateway_ip $ host_ip
878878
$ lowest_ip $ highest_ip $ dhcp_json_path $ mtu $ udpv4_forwards $ tcpv4_forwards
879879
$ gateway_forwards_path $ forwards_path $ gc_compact),
880-
Term.info (Filename.basename Sys.argv.(0)) ~version:Version.git ~doc ~man
880+
Cmd.info (Filename.basename Sys.argv.(0)) ~version:Version.git ~doc ~man
881881

882882
let () =
883883
Printexc.record_backtrace true;
@@ -886,4 +886,5 @@ let () =
886886
Log.err (fun f ->
887887
f "Lwt.async failure %a: %s" Fmt.exn exn (Printexc.get_backtrace ()))
888888
);
889-
Term.exit @@ Term.eval command
889+
let command = Cmd.v info term in
890+
exit (Cmd.eval command)

src/dns_forward/dns_forward.mli

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ module Flow: sig
3737
on a well-known address (see Server) *)
3838

3939
module type Client = sig
40-
include Mirage_flow_combinators.SHUTDOWNABLE
40+
include Mirage_flow.S
4141

4242
type address
4343
(** Identifies an endpoint for [connect] *)
@@ -64,7 +64,7 @@ module Flow: sig
6464
(** Accept connections forever, calling the callback with each one.
6565
Connections are closed automatically when the callback finishes. *)
6666

67-
val shutdown: server -> unit Lwt.t
67+
val stop: server -> unit Lwt.t
6868
(** Stop accepting connections on the given server *)
6969
end
7070
end
@@ -253,7 +253,7 @@ module Rpc: sig
253253
(** Listen and accept incoming connections, use the provided callback to
254254
answer requests. *)
255255

256-
val shutdown: server -> unit Lwt.t
256+
val stop: server -> unit Lwt.t
257257
(** Shutdown the server and free any allocated resources. *)
258258
end
259259

src/dns_forward/dns_forward_rpc.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -370,8 +370,8 @@ module Server = struct
370370
);
371371
Lwt_result.return ()
372372
373-
let shutdown server =
374-
Sockets.shutdown server.server
373+
let stop server =
374+
Sockets.stop server.server
375375
376376
end
377377
end

src/dns_forward/dns_forward_s.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ module type Comparable = sig
2222
end
2323

2424
module type FLOW_CLIENT = sig
25-
include Mirage_flow_combinators.SHUTDOWNABLE
25+
include Mirage_flow.S
2626
type address
2727
val connect: ?read_buffer_size:int -> address
2828
-> (flow, [ `Msg of string ]) Lwt_result.t
@@ -35,7 +35,7 @@ module type FLOW_SERVER = sig
3535
val getsockname: server -> address
3636
type flow
3737
val listen: server -> (flow -> unit Lwt.t) -> unit
38-
val shutdown: server -> unit Lwt.t
38+
val stop: server -> unit Lwt.t
3939
end
4040

4141
module type RPC_CLIENT = sig
@@ -57,7 +57,7 @@ module type RPC_SERVER = sig
5757
type server
5858
val bind: address -> (server, [ `Msg of string ]) Lwt_result.t
5959
val listen: server -> (request -> (response, [ `Msg of string ]) Lwt_result.t) -> (unit, [ `Msg of string ]) Lwt_result.t
60-
val shutdown: server -> unit Lwt.t
60+
val stop: server -> unit Lwt.t
6161
end
6262

6363
module type RESOLVER = sig

src/dns_forward/dns_forward_server.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,5 +52,5 @@ module Make(Server: Dns_forward_s.RPC_SERVER)(Resolver: Dns_forward_s.RESOLVER)
5252
>>= fun () ->
5353
match server with
5454
| None -> Lwt.return_unit
55-
| Some server -> Server.shutdown server
55+
| Some server -> Server.stop server
5656
end

src/dns_forward_lwt_unix/dns_forward_lwt_unix.ml

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -193,6 +193,13 @@ module Tcp = struct
193193
Lwt.return_unit
194194
)
195195

196+
let shutdown t = function
197+
| `read -> shutdown_read t
198+
| `write -> shutdown_write t
199+
| `read_write ->
200+
shutdown_read t >>= fun () ->
201+
shutdown_write t
202+
196203
type server = {
197204
mutable server_fd: Lwt_unix.file_descr option;
198205
read_buffer_size: int;
@@ -221,7 +228,7 @@ module Tcp = struct
221228

222229
let getsockname server = getsockname "Tcp.getsockname" server.server_fd
223230

224-
let shutdown server = match server.server_fd with
231+
let stop server = match server.server_fd with
225232
| None -> Lwt.return_unit
226233
| Some fd ->
227234
server.server_fd <- None;
@@ -279,7 +286,7 @@ module Tcp = struct
279286
Lwt_unix.listen fd 32;
280287
loop fd
281288
) (fun () ->
282-
shutdown server
289+
stop server
283290
)
284291
) (fun e ->
285292
Log.info (fun f -> f "%s: caught %s so shutting down server"
@@ -373,8 +380,7 @@ module Udp = struct
373380
Log.debug (fun f -> f "%s: close" (string_of_flow t));
374381
Lwt_unix.close fd
375382

376-
let shutdown_read _t = Lwt.return_unit
377-
let shutdown_write _t = Lwt.return_unit
383+
let shutdown _t _ = Lwt.return_unit
378384

379385
type server = {
380386
mutable server_fd: Lwt_unix.file_descr option;
@@ -396,7 +402,7 @@ module Udp = struct
396402
| e -> errorf "udp:%s: bind caught %s"
397403
(string_of_address address) (Printexc.to_string e)
398404

399-
let shutdown t = match t.server_fd with
405+
let stop t = match t.server_fd with
400406
| None -> Lwt.return_unit
401407
| Some fd ->
402408
t.server_fd <- None;

0 commit comments

Comments
 (0)