Skip to content
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
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
33 changes: 19 additions & 14 deletions lib/arpv4/arpv4.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
Expand All @@ -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 "")
Expand All @@ -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) ->
Expand Down Expand Up @@ -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)));
Expand Down
4 changes: 2 additions & 2 deletions lib/arpv4/arpv4.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
5 changes: 4 additions & 1 deletion lib/ipv4/ipv4_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
21 changes: 11 additions & 10 deletions lib/ipv6/ipv6.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 =
Expand All @@ -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 () ->
Expand All @@ -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))
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 () ->
Expand Down
4 changes: 2 additions & 2 deletions lib/ipv6/ipv6.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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