Merge pull request mirage#170 from Drup/ip_setting

Add optional arguments for settings in ip v6 and v4 connects
samoht · Sep 15, 2015 · 82ae204 · 82ae204
2 parents 6105db1 + db6f3de
commit 82ae204
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 13 deletions.
diff --git a/lib/ipv4.ml b/lib/ipv4.ml
@@ -196,10 +196,10 @@ module Make(Ethif: V1_LWT.ETHIF) (Arpv4 : V1_LWT.ARP) = struct
       | None       -> default ~proto ~src ~dst data
     end else Lwt.return_unit
 
-  let connect ethif arp =
-    let ip = Ipaddr.V4.any in
-    let netmask = Ipaddr.V4.any in
-    let gateways = [] in
+  let connect
+      ?(ip=Ipaddr.V4.any)
+      ?(netmask=Ipaddr.V4.any)
+      ?(gateways=[]) ethif arp =
     let t = { ethif; arp; ip; netmask; gateways } in
     Lwt.return (`Ok t)
 

diff --git a/lib/ipv4.mli b/lib/ipv4.mli
@@ -21,5 +21,14 @@ module Make (N:V1_LWT.ETHIF) (A: V1_LWT.ARP) : sig
     exception No_route_to_destination_address of Ipaddr.V4.t
   end
   include V1_LWT.IPV4 with type ethif = N.t
-  val connect : ethif -> A.t -> [> `Ok of t | `Error of error ] Lwt.t
+  val connect :
+    ?ip:Ipaddr.V4.t ->
+    ?netmask:Ipaddr.V4.t ->
+    ?gateways:Ipaddr.V4.t list ->
+    ethif -> A.t -> [> `Ok of t | `Error of error ] Lwt.t
+    (** Connect to an ipv4 device.
+        Default ip is {!Ipaddr.V4.any}
+        Default netmask is {!Ipaddr.V4.any}
+        Default gateways are [[]]. *)
+
 end
diff --git a/lib/ipv6.ml b/lib/ipv6.ml
@@ -946,13 +946,6 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
     | `Udp (src, dst, pkt)            -> udp ~src ~dst pkt
     | `Default (proto, src, dst, pkt) -> default ~proto ~src ~dst pkt
 
-  let connect ethif =
-    Printf.printf "IP6: Starting\n%!";
-    let now = C.time () in
-    let state, acts = create ~now (E.mac ethif) in
-    let t = {state; ethif} in
-    run t acts >>= fun () ->
-    Lwt.return (`Ok t)
 
   let disconnect _ = (* TODO *)
     Lwt.return_unit
@@ -993,4 +986,19 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
   let to_uipaddr ip = I.V6 ip
   let of_uipaddr ip = Some (I.to_v6 ip)
 
+  let (>>=?) (x,f) g = match x with
+    | Some x -> f x >>= g
+    | None -> g ()
+
+  let connect ?ip ?netmask ?gateways ethif =
+    Printf.printf "IP6: Starting\n%!";
+    let now = C.time () in
+    let state, acts = create ~now (E.mac ethif) in
+    let t = {state; ethif} in
+    run t acts >>= fun () ->
+    (ip, set_ip t) >>=? fun () ->
+    (netmask, Lwt_list.iter_s (set_ip_netmask t)) >>=? fun () ->
+    (gateways, set_ip_gateways t) >>=? fun () ->
+    Lwt.return (`Ok t)
+
 end
diff --git a/lib/ipv6.mli b/lib/ipv6.mli
@@ -16,5 +16,9 @@
 
 module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) : sig
   include V1_LWT.IPV6 with type ethif = E.t
-  val connect : ethif -> [> `Ok of t | `Error of error ] Lwt.t
+  val connect :
+    ?ip:Ipaddr.V6.t ->
+    ?netmask:Ipaddr.V6.Prefix.t list ->
+    ?gateways:Ipaddr.V6.t list ->
+    ethif -> [> `Ok of t | `Error of error ] Lwt.t
 end