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

New clock api #232

Merged
merged 5 commits into from Aug 22, 2016
View
@@ -20,16 +20,17 @@ open Lwt.Infix
let src = Logs.Src.create "arpv4" ~doc:"Mirage ARP module"
module Log = (val Logs.src_log src : Logs.LOG)
module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = struct
module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.MCLOCK) (Time : V1_LWT.TIME) = struct
type result = [ `Ok of Macaddr.t | `Timeout ]
type entry =
| Pending of result Lwt.t * result Lwt.u
| Confirmed of float * Macaddr.t
| Confirmed of int64 * Macaddr.t
type t = {
ethif : Ethif.t;
clock : Clock.t;
cache: (Ipaddr.V4.t, entry) Hashtbl.t;
mutable bound_ips: Ipaddr.V4.t list;
}
@@ -48,23 +49,27 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
let probe_num = 3 (* how many probes to send before giving up *)
let rec tick t () =
let now = Clock.time () in
let expired = Hashtbl.fold (fun ip entry expired ->
let now = Clock.elapsed_ns t.clock in
let remove_expired ip entry =
match entry with
| Pending _ -> expired
| Confirmed (t, _) -> if t >= now then ip :: expired else expired) t.cache []
| Pending _ -> Some entry
| Confirmed (expiry, _) ->
if Int64.compare expiry now > -1
then Some entry
else begin
Log.info (fun f -> f "ARP: timeout %a" Ipaddr.V4.pp_hum ip);
None
end
in
List.iter (fun ip ->
Log.info (fun f -> f "ARP: timeout %a" Ipaddr.V4.pp_hum ip); Hashtbl.remove t.cache ip
) expired;
Hashtbl.filter_map_inplace remove_expired t.cache;
Time.sleep_ns arp_timeout >>= tick t
let to_repr t =
let print ip entry acc =
let key = Ipaddr.V4.to_string ip in
match entry with
| Pending _ -> acc ^ "\n" ^ key ^ " -> " ^ "Pending"
| Confirmed (time, mac) -> Printf.sprintf "%s\n%s -> Confirmed (%s) (expires %f)\n%!"
| Confirmed (time, mac) -> Printf.sprintf "%s\n%s -> Confirmed (%s) (expires %Lu)\n%!"
acc key (Macaddr.to_string mac) time
in
Lwt.return (Hashtbl.fold print t.cache "")
@@ -77,8 +82,8 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
match Ipaddr.V4.is_multicast ip || (Ipaddr.V4.compare ip Ipaddr.V4.any = 0) with
| true -> Log.debug (fun f -> f "Ignoring ARP notification request for IP %a" Ipaddr.V4.pp_hum ip)
| false ->
let now = Clock.time () in
let expire = now +. Duration.to_f arp_timeout in
let now = Clock.elapsed_ns t.clock in
let expire = Int64.add now arp_timeout in
try
match Hashtbl.find t.cache ip with
| Pending (_, w) ->
@@ -197,10 +202,10 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
Lwt.async (retry 0);
response
let connect ethif =
let connect ethif clock =
let cache = Hashtbl.create 7 in
let bound_ips = [] in
let t = { ethif; cache; bound_ips } in
let t = { clock; ethif; cache; bound_ips } in
Lwt.async (tick t);
Log.info (fun f -> f "Connected arpv4 device on %s" (Macaddr.to_string (
Ethif.mac t.ethif)));
View
@@ -15,11 +15,11 @@
*
*)
module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) : sig
module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.MCLOCK) (Time : V1_LWT.TIME) : sig
include V1_LWT.ARP
type ethif = Ethif.t
(** [connect] creates a value of type [t]. *)
val connect : ethif -> [> `Ok of t | `Error of error ] Lwt.t
val connect : ethif -> Clock.t -> [> `Ok of t | `Error of error ] Lwt.t
end
View
@@ -102,7 +102,10 @@ module Marshal = struct
set_ipv4_src buf (Ipaddr.V4.to_int32 t.src);
set_ipv4_dst buf (Ipaddr.V4.to_int32 t.dst);
Cstruct.blit t.options 0 buf sizeof_ipv4 (Cstruct.len t.options);
set_ipv4_len buf (sizeof_ipv4 + (options_len / 4) + (Cstruct.len payload))
set_ipv4_len buf (sizeof_ipv4 + (options_len / 4) + (Cstruct.len payload));
let checksum = Tcpip_checksum.ones_complement @@ Cstruct.sub buf 0 (20 + options_len) in
set_ipv4_csum buf checksum
let into_cstruct ~payload t buf =
if Cstruct.len buf < (sizeof_ipv4 + Cstruct.len t.options) then
View
@@ -21,7 +21,7 @@ module I = Ipaddr
open Lwt.Infix
module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.MCLOCK) = struct
type ethif = E.t
type 'a io = 'a Lwt.t
type buffer = Cstruct.t
@@ -31,6 +31,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
type t =
{ ethif : E.t;
clock : C.t;
mutable ctx : Ndpv6.context }
type error =
@@ -39,7 +40,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
let start_ticking t =
let rec loop () =
let now = C.time () in
let now = C.elapsed_ns t.clock in
let ctx, bufs = Ndpv6.tick ~now t.ctx in
t.ctx <- ctx;
Lwt_list.iter_s (E.writev t.ethif) bufs >>= fun () ->
@@ -51,7 +52,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
Ndpv6.allocate_frame t.ctx dst proto
let writev t frame bufs =
let now = C.time () in
let now = C.elapsed_ns t.clock in
let dst =
Ndpv6.ipaddr_of_cstruct
(Ipv6_wire.get_ipv6_dst (Cstruct.shift frame Ethif_wire.sizeof_ethernet))
@@ -64,7 +65,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
writev t frame [buf]
let input t ~tcp ~udp ~default buf =
let now = C.time () in
let now = C.elapsed_ns t.clock in
let _, bufs, actions = Ndpv6.handle ~now t.ctx buf in
Lwt_list.iter_s (function
| `Tcp (src, dst, buf) -> tcp ~src ~dst buf
@@ -81,7 +82,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
let src t ~dst = Ndpv6.select_source t.ctx dst
let set_ip t ip =
let now = C.time () in
let now = C.elapsed_ns t.clock in
let ctx, bufs = Ndpv6.add_ip ~now t.ctx ip in
t.ctx <- ctx;
Lwt_list.iter_s (E.writev t.ethif) bufs
@@ -90,7 +91,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
Ndpv6.get_ip t.ctx
let set_ip_gateways t ips =
let now = C.time () in
let now = C.elapsed_ns t.clock in
let ctx = Ndpv6.add_routers ~now t.ctx ips in
t.ctx <- ctx;
Lwt.return_unit
@@ -102,7 +103,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
Ndpv6.get_prefix t.ctx
let set_ip_netmask t pfx =
let now = C.time () in
let now = C.elapsed_ns t.clock in
let ctx = Ndpv6.add_prefix ~now t.ctx pfx in
t.ctx <- ctx;
Lwt.return_unit
@@ -127,11 +128,11 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct
| Some x -> f x >>= g
| None -> g ()
let connect ?ip ?netmask ?gateways ethif =
let connect ?ip ?netmask ?gateways ethif clock =
Log.info (fun f -> f "IP6: Starting");
let now = C.time () in
let now = C.elapsed_ns clock in
let ctx, bufs = Ndpv6.local ~now (E.mac ethif) in
let t = {ctx; ethif} in
let t = {ctx; clock; ethif} in
Lwt_list.iter_s (E.writev t.ethif) bufs >>= fun () ->
(ip, set_ip t) >>=? fun () ->
(netmask, Lwt_list.iter_s (set_ip_netmask t)) >>=? fun () ->
View
@@ -14,11 +14,11 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) : sig
module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (Clock : V1.MCLOCK) : sig
include V1_LWT.IPV6 with type ethif = E.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
ethif -> Clock.t -> [> `Ok of t | `Error of error ] Lwt.t
end
Oops, something went wrong.