New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

connect has no result type anymore #251

Merged
merged 1 commit into from Oct 2, 2016
Jump to file or symbol
Failed to load files and symbols.
+68 −80
Diff settings

Always

Just for now

View
@@ -213,7 +213,7 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.MCLOCK) (Time : V1_LWT.TIME) = st
Lwt.async (tick t);
Log.info (fun f -> f "Connected arpv4 device on %s" (Macaddr.to_string (
Ethif.mac t.ethif)));
Lwt.return (`Ok t)
Lwt.return t
let disconnect t =
Log.info (fun f -> f "Disconnected arpv4 device on %s" (Macaddr.to_string (
View
@@ -21,5 +21,5 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.MCLOCK) (Time : V1_LWT.TIME) : si
type ethif = Ethif.t
(** [connect] creates a value of type [t]. *)
val connect : ethif -> Clock.t -> [> `Ok of t | `Error of error ] Lwt.t
val connect : ethif -> Clock.t -> t Lwt.t
end
View
@@ -70,7 +70,7 @@ module Make(Netif : V1_LWT.NETWORK) = struct
MProf.Trace.label "ethif.connect";
let t = { netif } in
Log.info (fun f -> f "Connected Ethernet interface %s" (Macaddr.to_string (mac t)));
Lwt.return (`Ok t)
Lwt.return t
let disconnect t =
Log.info (fun f -> f "Disconnected Ethernet interface %s" (Macaddr.to_string (mac t)));
View
@@ -17,5 +17,5 @@
module Make ( N:V1_LWT.NETWORK ) : sig
include V1_LWT.ETHIF with type netif = N.t
val connect : netif -> [> `Ok of t | `Error of error ] Lwt.t
val connect : netif -> t Lwt.t
end
View
@@ -15,7 +15,9 @@ module Make(IP : V1_LWT.IPV4) = struct
type id = t
let connect ip = Lwt.return (`Ok { ip; echo_reply = true; })
let connect ip =
let t = { ip; echo_reply = true } in
Lwt.return t
let disconnect _ = Lwt.return_unit
View
@@ -1,5 +1,5 @@
module Make ( I:V1_LWT.IPV4 ) : sig
include V1_LWT.ICMPV4
val connect : I.t -> [ `Ok of t | `Error of error ] io
val connect : I.t -> t io
end
View
@@ -165,7 +165,7 @@ module Make(Ethif: V1_LWT.ETHIF) (Arpv4 : V1_LWT.ARP) = struct
?(netmask=Ipaddr.V4.any)
?(gateways=[]) ethif arp =
let t = { ethif; arp; ip; netmask; gateways } in
Lwt.return (`Ok t)
Lwt.return t
let disconnect _ = Lwt.return_unit
View
@@ -25,7 +25,7 @@ module Make (N:V1_LWT.ETHIF) (A: V1_LWT.ARP) : sig
?ip:Ipaddr.V4.t ->
?netmask:Ipaddr.V4.t ->
?gateways:Ipaddr.V4.t list ->
ethif -> A.t -> [> `Ok of t | `Error of error ] Lwt.t
ethif -> A.t -> t Lwt.t
(** Connect to an ipv4 device.
Default ip is {!Ipaddr.V4.any}
Default netmask is {!Ipaddr.V4.any}
View
@@ -138,6 +138,6 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.MCLOCK) = struct
(netmask, Lwt_list.iter_s (set_ip_netmask t)) >>=? fun () ->
(gateways, set_ip_gateways t) >>=? fun () ->
Lwt.async (fun () -> start_ticking t);
Lwt.return (`Ok t)
Lwt.return t
end
View
@@ -20,5 +20,5 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (Clock : V1.MCLOCK) : sig
?ip:Ipaddr.V6.t ->
?netmask:Ipaddr.V6.Prefix.t list ->
?gateways:Ipaddr.V6.t list ->
ethif -> Clock.t -> [> `Ok of t | `Error of error ] Lwt.t
ethif -> Clock.t -> t Lwt.t
end
View
@@ -54,8 +54,6 @@ module Make(IP:V1_LWT.IP)(TM:V1_LWT.TIME)(C:V1.MCLOCK)(R:V1_LWT.RANDOM) = struct
Ipaddr.pp_hum (IP.to_uipaddr daddr) dport);
Lwt.return (`Error `Refused)
let ok x = Lwt.return (`Ok x)
let error_message = function
| `Unknown msg -> msg
| `Timeout -> "Timeout while attempting to connect"
@@ -83,13 +81,13 @@ module Make(IP:V1_LWT.IP)(TM:V1_LWT.TIME)(C:V1.MCLOCK)(R:V1_LWT.RANDOM) = struct
let writev t views = Pcb.writev t views >|= err_rewrite
let write_nodelay t view = Pcb.write_nodelay t view >>= err_raise
let writev_nodelay t views = Pcb.writev_nodelay t views >>= err_raise
let connect ipv4 clock = ok (Pcb.create ipv4 clock)
let connect ipv4 clock = Lwt.return (Pcb.create ipv4 clock)
let disconnect _ = Lwt.return_unit
let create_connection tcp (daddr, dport) =
Pcb.connect tcp ~dst:daddr ~dst_port:dport >>= function
| `Timeout -> err_timeout daddr dport
| `Rst -> err_refused daddr dport
| `Ok (fl, _) -> ok fl
| `Ok (fl, _) -> Lwt.return (`Ok fl)
end
View
@@ -23,5 +23,5 @@ module Make (IP:V1_LWT.IP)(TM:V1_LWT.TIME)(C:V1.MCLOCK)(R:V1_LWT.RANDOM) : sig
with type ip = IP.t
and type ipaddr = IP.ipaddr
and type ipinput = src:IP.ipaddr -> dst:IP.ipaddr -> Cstruct.t -> unit Lwt.t
val connect : ip -> C.t -> [> `Ok of t | `Error of error ] Lwt.t
val connect : ip -> C.t -> t Lwt.t
end
@@ -175,7 +175,7 @@ struct
application stack that the IP address has changed (perhaps via a control
Lwt_stream that the application can ignore if it doesn't care). *)
Log.info (fun f -> f "Manager: configuration done");
Lwt.return (`Ok t)
Lwt.return t
let disconnect _t =
(* TODO: kill the listening thread *)
@@ -42,5 +42,5 @@ module Make
and module UDPV4 = Udpv4
val connect : (netif, mode) V1_LWT.stackv4_config ->
Ethif.t -> Arpv4.t -> Ipv4.t -> Icmpv4.t -> Udpv4.t -> Tcpv4.t ->
[> `Ok of t | `Error of error ] Lwt.t
t Lwt.t
end
View
@@ -71,7 +71,8 @@ module Make(Ip: V1_LWT.IP) = struct
let connect ip =
let ips = List.map Ip.to_uipaddr @@ Ip.get_ip ip in
Log.info (fun f -> f "UDP interface connected on %a" pp_ips ips);
Lwt.return (`Ok { ip })
let t = { ip } in
Lwt.return t
let disconnect t =
let ips = List.map Ip.to_uipaddr @@ Ip.get_ip t.ip in
View
@@ -20,5 +20,5 @@ module Make ( IP:V1_LWT.IP ) : sig
with type ip = IP.t
and type ipaddr = IP.ipaddr
and type ipinput = src:IP.ipaddr -> dst:IP.ipaddr -> Cstruct.t -> unit Lwt.t
val connect : ip -> [> `Ok of t | `Error of error ] Lwt.t
val connect : ip -> t Lwt.t
end
View
@@ -34,9 +34,8 @@ module Make(E : V1_LWT.ETHIF)(Clock : V1.MCLOCK) (Time : V1_LWT.TIME) = struct
let pp fmt repr =
Format.fprintf fmt "%s" repr
let connect e clock = A.connect e clock >>= function
| `Ok base -> Lwt.return (`Ok { base; table = (Hashtbl.create 7) })
| `Error e -> Lwt.return (`Error e)
let connect e clock = A.connect e clock >>= fun base ->
Lwt.return ({ base; table = (Hashtbl.create 7) })
let disconnect t = A.disconnect t.base
View
@@ -10,7 +10,7 @@ module Fast_clock = struct
let last_read = ref 0L
let connect () = Lwt.return (`Ok ())
let connect () = Lwt.return_unit
let advance_clock ns =
last_read := Int64.add !last_read ns
@@ -66,7 +66,6 @@ let macaddr =
let check_header ~message expected actual =
Alcotest.(check packet) message expected actual
let or_error = Common.or_error
let fail = Alcotest.fail
let timeout ~time t =
@@ -143,10 +142,10 @@ let arp_request ~from_netif ~to_mac ~from_ip ~to_ip =
let get_arp ?(backend = B.create ~use_async_readers:true
~yield:(fun() -> Lwt_main.yield ()) ()) () =
or_error "clock" Fast_clock.connect () >>= fun clock ->
or_error "backend" V.connect backend >>= fun netif ->
or_error "ethif" E.connect netif >>= fun ethif ->
or_error "arp" (A.connect ethif) clock >>= fun arp ->
Fast_clock.connect () >>= fun clock ->
V.connect backend >>= fun netif ->
E.connect netif >>= fun ethif ->
A.connect ethif clock >>= fun arp ->
Lwt.return { backend; netif; ethif; arp }
(* we almost always want two stacks on the same backend *)
View
@@ -42,13 +42,13 @@ let slowly fn =
let get_stack ?(backend = B.create ~use_async_readers:true
~yield:(fun() -> Lwt_main.yield ()) ()) () =
let or_error = Common.or_error in
or_error "clock" Mclock.connect () >>= fun clock ->
or_error "backend" V.connect backend >>= fun netif ->
or_error "ethif" E.connect netif >>= fun ethif ->
or_error "arp" (Static_arp.connect ethif) clock >>= fun arp ->
or_error "ipv4" (Ip.connect ethif) arp >>= fun ip ->
or_error "icmpv4" Icmp.connect ip >>= fun icmp ->
or_error "udp" Udp.connect ip >>= fun udp ->
Mclock.connect () >>= fun clock ->
V.connect backend >>= fun netif ->
E.connect netif >>= fun ethif ->
Static_arp.connect ethif clock >>= fun arp ->
Ip.connect ethif arp >>= fun ip ->
Icmp.connect ip >>= fun icmp ->
Udp.connect ip >>= fun udp ->
Lwt.return { backend; netif; ethif; arp; ip; icmp; udp }
(* assume a class C network with no default gateway *)
View
@@ -79,11 +79,6 @@ module Test_iperf (B : Vnetif_backends.Backend) = struct
let err = V.Stackv4.TCPV4.error_message e in
fail "Error in server while reading: %s" err
let get_clock () =
Mclock.connect () >>= function
| `Error _ -> Lwt.fail (Failure "clock initialization failed")
| `Ok clock -> Lwt.return clock
let write_and_check flow buf =
V.Stackv4.TCPV4.write flow buf >>= function
@@ -191,7 +186,7 @@ module Test_iperf (B : Vnetif_backends.Backend) = struct
(Logs.info (fun f -> f "I am server with IP %s, expecting connections on port %d"
(Ipaddr.V4.to_string server_ip) port);
V.create_stack backend server_ip netmask [gw] >>= fun server_s ->
get_clock () >>= fun clock ->
Mclock.connect () >>= fun clock ->
V.Stackv4.listen_tcpv4 server_s ~port (iperf clock server_s server_done_u);
Lwt.wakeup server_ready_u ();
V.Stackv4.listen server_s) ] >>= fun () ->
View
@@ -47,11 +47,11 @@ let create_sut_stack backend =
VNETIF_STACK.create_stack backend sut_ip netmask [gw]
let create_raw_stack backend =
or_error "clock" Mclock.connect () >>= fun clock ->
or_error "backend" V.connect backend >>= fun netif ->
or_error "ethif" E.connect netif >>= fun ethif ->
or_error "arpv4" (A.connect ethif) clock >>= fun arpv4 ->
or_error "ipv4" (I.connect ethif) arpv4 >>= fun ip ->
Mclock.connect () >>= fun clock ->
V.connect backend >>= fun netif ->
E.connect netif >>= fun ethif ->
A.connect ethif clock >>= fun arpv4 ->
I.connect ethif arpv4 >>= fun ip ->
Lwt.return (netif, ethif, arpv4, ip)
type 'state fsm_result =
View
@@ -10,11 +10,6 @@ type stack_stack = {
tcp : Tcpv4_socket.t;
}
let or_fail f args =
f args >>= function
| `Ok p -> Lwt.return p
| `Error s -> Alcotest.fail s
let or_fail_str ~str f args =
f args >>= function
| `Ok p -> Lwt.return p
@@ -25,16 +20,16 @@ let localhost = Ipaddr.V4.of_string_exn "127.0.0.1"
let make_stack ~name ~ip =
(* define a config record, which should match the type expected of
V1_LWT.stackv4_config *)
or_fail_str ~str:"error initializing TCP socket" Tcpv4_socket.connect (Some ip) >>= fun tcp ->
or_fail Udpv4_socket.connect (Some ip) >>= fun udp ->
Tcpv4_socket.connect (Some ip) >>= fun tcp ->
Udpv4_socket.connect (Some ip) >>= fun udp ->
let open V1_LWT in
let config = {
name;
interface = [ip];
mode = ();
} in
Icmpv4_socket.connect () >>= fun icmp ->
or_fail_str ~str:"stack initialization failed" (Stack.connect config udp) tcp >>= fun stack ->
Stack.connect config udp tcp >>= fun stack ->
Lwt.return { stack; icmp; udp; tcp }
let two_connect_tcp () =
View
@@ -19,13 +19,12 @@ type stack = {
let get_stack ?(backend = B.create ~use_async_readers:true
~yield:(fun() -> Lwt_main.yield ()) ()) () =
let open Lwt.Infix in
let or_error = Common.or_error in
or_error "clock" Mclock.connect () >>= fun clock ->
or_error "backend" V.connect backend >>= fun netif ->
or_error "ethif" E.connect netif >>= fun ethif ->
or_error "arp" (Static_arp.connect ethif) clock >>= fun arp ->
or_error "ipv4" (Ip.connect ethif) arp >>= fun ip ->
or_error "udp" Udp.connect ip >>= fun udp ->
Mclock.connect () >>= fun clock ->
V.connect backend >>= fun netif ->
E.connect netif >>= fun ethif ->
Static_arp.connect ethif clock >>= fun arp ->
Ip.connect ethif arp >>= fun ip ->
Udp.connect ip >>= fun udp ->
Lwt.return { clock; backend; netif; ethif; arp; ip; udp }
(* assume a class C network with no default gateway *)
View
@@ -64,20 +64,20 @@ module VNETIF_STACK ( B : Vnetif_backends.Backend) : (VNETIF_STACK with type bac
B.create ()
let create_stack backend ip netmask gw =
or_error "clock" Clock.connect () >>= fun clock ->
or_error "backend" V.connect backend >>= fun netif ->
or_error "ethif" E.connect netif >>= fun ethif ->
or_error "arpv4" (A.connect ethif) clock >>= fun arpv4 ->
or_error "ipv4" (Ip.connect ethif) arpv4 >>= fun ipv4 ->
or_error "icmpv4" Icmp.connect ipv4 >>= fun icmpv4 ->
or_error "udpv4" U.connect ipv4 >>= fun udpv4 ->
or_error "tcpv4" (T.connect ipv4) clock >>= fun tcpv4 ->
Clock.connect () >>= fun clock ->
V.connect backend >>= fun netif ->
E.connect netif >>= fun ethif ->
A.connect ethif clock >>= fun arpv4 ->
Ip.connect ethif arpv4 >>= fun ipv4 ->
Icmp.connect ipv4 >>= fun icmpv4 ->
U.connect ipv4 >>= fun udpv4 ->
T.connect ipv4 clock >>= fun tcpv4 ->
let config = {
V1_LWT.name = "stack";
interface = netif;
mode = `IPv4 (ip, netmask, gw);
} in
or_error "stack" (Stackv4.connect config ethif arpv4 ipv4 icmpv4 udpv4) tcpv4
Stackv4.connect config ethif arpv4 ipv4 icmpv4 udpv4 tcpv4
let create_backend_listener backend listenf =
match (B.register backend) with
View
@@ -32,7 +32,7 @@ let of_uipaddr = Ipaddr.to_v4
let id _ = ()
let disconnect _ = return_unit
let connect _ = return (`Ok None)
let connect _ = return_unit
let input_arpv4 _ _ = fail (Failure "Not implemented")
let input _ ~tcp:_ ~udp:_ ~default:_ _ = return_unit
View
@@ -33,7 +33,7 @@ let of_uipaddr ip = Some (Ipaddr.to_v6 ip)
let id _ = ()
let disconnect () = return_unit
let connect () = return (`Ok ())
let connect () = return_unit
let input _ ~tcp:_ ~udp:_ ~default:_ _ = return_unit
let allocate_frame _ ~dst:_ ~proto:_ = raise (Failure "Not implemented")
@@ -143,6 +143,6 @@ let connect id udpv4 tcpv4 =
Log.info (fun f -> f "Manager: configuring");
configure t interface
>>= fun () ->
return (`Ok t)
return t
let disconnect _ = return_unit
@@ -24,4 +24,4 @@ include V1_LWT.STACKV4
and module TCPV4 = Tcpv4_socket
and module IPV4 = Ipv4_socket
val connect : (netif, mode) V1_LWT.stackv4_config ->
Udpv4_socket.t -> Tcpv4_socket.t -> [> `Ok of t | `Error of error ] Lwt.t
Udpv4_socket.t -> Tcpv4_socket.t -> t Lwt.t
View
@@ -46,7 +46,7 @@ let connect id =
| None -> { interface=None }
| Some ip -> { interface=Some (Ipaddr_unix.V4.to_inet_addr ip) }
in
return (`Ok t)
return t
let disconnect _ =
return_unit
View
@@ -18,4 +18,4 @@ include V1_LWT.TCP with type ip = Ipaddr.V4.t option
and type ipaddr = Ipaddr.V4.t
and type ipinput = unit Lwt.t
and type flow = Lwt_unix.file_descr
val connect : ip -> [> `Ok of t | `Error of error ] Lwt.t
val connect : ip -> t Lwt.t
View
@@ -47,7 +47,7 @@ let connect addr =
| None -> { interface=None }
| Some ip -> { interface=Some (Ipaddr_unix.V6.to_inet_addr ip) }
in
return (`Ok t)
return t
let disconnect _ =
return_unit
View
@@ -20,4 +20,4 @@ include V1_LWT.TCP with type ip = Ipaddr.V6.t option
and type ipinput = unit Lwt.t
and type flow = Lwt_unix.file_descr
val connect : ip -> [ `Ok of t ] io
val connect : ip -> t io
Oops, something went wrong.
ProTip! Use n and p to navigate between commits in a pull request.