From 2fc50a5f7a8ee1d3ac78a9859632aa0d41cf8782 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 5 Dec 2018 19:24:16 +0100 Subject: [PATCH 1/2] fixes of Logs usage - use Log.yyy when there's a Log source defined in the module - tcp/flow: refactor log_with_stats (now always on debug level, all callers used Debug) --- src/arpv4/arpv4.ml | 4 ++-- src/ipv4/fragments.ml | 6 +++--- src/stack-direct/tcpip_stack_direct.ml | 2 +- src/stack-unix/icmpv4_socket.ml | 3 +-- src/tcp/flow.ml | 16 ++++++++-------- test/test_arp.ml | 8 ++++---- test/test_connect.ml | 10 +++++----- 7 files changed, 24 insertions(+), 25 deletions(-) diff --git a/src/arpv4/arpv4.ml b/src/arpv4/arpv4.ml index 17103bec3..f6fd882b4 100644 --- a/src/arpv4/arpv4.ml +++ b/src/arpv4/arpv4.ml @@ -44,7 +44,7 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF) } let report_ethif_error s e = - Logs.debug (fun f -> + Log.err (fun f -> f "error on underlying ethernet interface when attempting to %s : %a" s Ethif.pp_error e) @@ -159,7 +159,7 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF) let spa = match t.bound_ips with | hd::_ -> hd | [] -> Ipaddr.V4.any in let arp = Arpv4_packet.({ op=Arpv4_wire.Request; tha; sha; tpa; spa }) in - Logs.debug (fun f -> f "ARP: transmitting probe: %a" Arpv4_packet.pp arp); + Log.debug (fun f -> f "ARP: transmitting probe: %a" Arpv4_packet.pp arp); output t ~source:sha ~destination:tha arp let get_ips t = t.bound_ips diff --git a/src/ipv4/fragments.ml b/src/ipv4/fragments.ml index dcd29dfbe..7f5f3bd2f 100644 --- a/src/ipv4/fragments.ml +++ b/src/ipv4/fragments.ml @@ -168,9 +168,9 @@ let process cache ts (packet : Ipv4_packet.t) payload = Ipv4_packet.pp packet Fmt.(list ~sep:(unit "; ") (pair ~sep:(unit ", ") int int)) (List.map (fun (s, d) -> (s, Cstruct.len d)) all_frags)) ; - Logs.debug (fun m -> m "full fragments: %a" - Fmt.(list ~sep:(unit "@.") Cstruct.hexdump_pp) - (List.map snd all_frags)) ; + Log.debug (fun m -> m "full fragments: %a" + Fmt.(list ~sep:(unit "@.") Cstruct.hexdump_pp) + (List.map snd all_frags)) ; Cache.remove key cache', None | Error Hole -> maybe_add_to_cache cache', None diff --git a/src/stack-direct/tcpip_stack_direct.ml b/src/stack-direct/tcpip_stack_direct.ml index e936413f6..401dc16c6 100644 --- a/src/stack-direct/tcpip_stack_direct.ml +++ b/src/stack-direct/tcpip_stack_direct.ml @@ -89,7 +89,7 @@ module Make with Not_found -> None let listen t = - Logs.debug (fun f -> f "Establishing or updating listener for stack %a" pp t); + Log.debug (fun f -> f "Establishing or updating listener for stack %a" pp t); let ethif_listener = Ethif.input ~arpv4:(Arpv4.input t.arpv4) ~ipv4:( diff --git a/src/stack-unix/icmpv4_socket.ml b/src/stack-unix/icmpv4_socket.ml index c7aa298eb..cd4e3f04f 100644 --- a/src/stack-unix/icmpv4_socket.ml +++ b/src/stack-unix/icmpv4_socket.ml @@ -68,8 +68,7 @@ let input t ~src ~dst:_ buf = (* some default logic -- respond to echo requests with echo replies *) match Icmpv4_packet.Unmarshal.of_cstruct buf with | Error s -> - let s = "Error decomposing an ICMP packet: " ^ s in - Logs.debug (fun f -> f "%s" s); + Log.debug (fun f -> f "Error decomposing an ICMP packet: %s" s); Lwt.return_unit | Ok (icmp, payload) -> let open Icmpv4_packet in diff --git a/src/tcp/flow.ml b/src/tcp/flow.ml index c9324ad8f..994151844 100644 --- a/src/tcp/flow.ml +++ b/src/tcp/flow.ml @@ -91,7 +91,7 @@ struct (Hashtbl.length t.listens) (Hashtbl.length t.connects) - let log_with_stats level name t = Log.msg level (fun fmt -> fmt "%s: %a" name pp_stats t) + let log_with_stats name t = Log.debug (fun fmt -> fmt "%s: %a" name pp_stats t) let wscale_default = 2 @@ -240,7 +240,7 @@ struct try Some (Hashtbl.find h k) with Not_found -> None let clearpcb t id tx_isn = - Logs.(log_with_stats Debug "removing pcb from connection tables" t); + log_with_stats "removing pcb from connection tables" t; match hashtbl_find t.channels id with | Some _ -> Hashtbl.remove t.channels id; @@ -399,7 +399,7 @@ struct Lwt.return (pcb, th, opts) let new_server_connection t params id pushf keepalive = - Logs.(log_with_stats Debug "new-server-connection" t); + log_with_stats "new-server-connection" t; new_pcb t params id keepalive >>= fun (pcb, th, opts) -> STATE.tick pcb.state State.Passive_open; STATE.tick pcb.state (State.Send_synack params.tx_isn); @@ -418,7 +418,7 @@ struct Lwt.return (pcb, th) let new_client_connection t params id ack_number keepalive = - Logs.(log_with_stats Debug "new-client-connection" t); + log_with_stats "new-client-connection" t; let tx_isn = params.tx_isn in let params = { params with tx_isn = Sequence.succ tx_isn } in new_pcb t params id keepalive >>= fun (pcb, th, _) -> @@ -436,7 +436,7 @@ struct (Sequence.compare (Sequence.succ tx_isn) ack_number) = 0 let process_reset t id ~ack ~ack_number = - Logs.(log_with_stats Debug "process-reset" t); + log_with_stats "process-reset" t; if ack then match hashtbl_find t.connects id with | Some (wakener, tx_isn, _) -> @@ -464,7 +464,7 @@ struct Lwt.return_unit let process_synack t id ~tx_wnd ~ack_number ~sequence ~options ~syn ~fin = - Logs.(log_with_stats Debug "process-synack" t); + log_with_stats "process-synack" t; match hashtbl_find t.connects id with | Some (wakener, tx_isn, keepalive) -> if is_correct_ack ~tx_isn ~ack_number then ( @@ -492,7 +492,7 @@ struct >>= fun _ -> Lwt.return_unit (* discard errors; we won't retry *) let process_syn t id ~listeners ~tx_wnd ~ack_number ~sequence ~options ~syn ~fin = - Logs.(log_with_stats Debug "process-syn" t); + log_with_stats "process-syn" t; match listeners @@ WIRE.src_port id with | Some { process; keepalive } -> let tx_isn = Sequence.of_int32 (Randomconv.int32 Random.generate) in @@ -510,7 +510,7 @@ struct let process_ack t id ~pkt = let open RXS in - Logs.(log_with_stats Debug "process-ack" t); + log_with_stats "process-ack" t; match hashtbl_find t.listens id with | Some (tx_isn, (pushf, newconn)) -> if Tcp_packet.(is_correct_ack ~tx_isn ~ack_number:pkt.header.ack_number) then begin diff --git a/test/test_arp.ml b/test/test_arp.ml index a48a74899..18f1f8a76 100644 --- a/test/test_arp.ml +++ b/test/test_arp.ml @@ -167,7 +167,7 @@ let query_or_die arp ip expected_mac = | Error `Timeout -> let pp_ip = Ipaddr.V4.pp_hum in A.to_repr arp >>= fun repr -> - Logs.warn (fun f -> f "Timeout querying %a. Table contents: %a" pp_ip ip A.pp repr); + Log.warn (fun f -> f "Timeout querying %a. Table contents: %a" pp_ip ip A.pp repr); fail "ARP query failed when success was mandatory"; | Ok mac -> Alcotest.(check macaddr) "mismatch for expected query value" expected_mac mac; @@ -183,8 +183,8 @@ let set_and_check ~listener ~claimant ip = let start_arp_listener stack () = let noop = (fun _ -> Lwt.return_unit) in - Logs.debug (fun f -> f "starting arp listener for %s" (Macaddr.to_string (V.mac stack.netif))); - E.input ~arpv4:(fun frame -> Logs.debug (fun f -> f "frame received for arpv4"); A.input stack.arp frame) ~ipv4:noop ~ipv6:noop stack.ethif + Log.debug (fun f -> f "starting arp listener for %s" (Macaddr.to_string (V.mac stack.netif))); + E.input ~arpv4:(fun frame -> Log.debug (fun f -> f "frame received for arpv4"); A.input stack.arp frame) ~ipv4:noop ~ipv6:noop stack.ethif let output_then_disconnect ~speak:speak_netif ~disconnect:listen_netif bufs = Lwt.join (List.map (fun b -> V.write speak_netif b >|= fun _ -> ()) bufs) >>= fun () -> @@ -312,7 +312,7 @@ let unreachable_times_out () = let input_replaces_old () = three_arp () >>= fun (listen, claimant_1, claimant_2) -> let listener = start_arp_listener listen () in - Lwt.async ( fun () -> Logs.debug (fun f -> f "arp listener started"); V.listen listen.netif (fun buf -> Logs.debug (fun f -> f "packet received: %a" Cstruct.hexdump_pp buf); listener buf)); + Lwt.async ( fun () -> Log.debug (fun f -> f "arp listener started"); V.listen listen.netif (fun buf -> Log.debug (fun f -> f "packet received: %a" Cstruct.hexdump_pp buf); listener buf)); timeout ~time:2000 ( Time.sleep_ns (Duration.of_ms 100) >>= fun () -> set_and_check ~listener:listen.arp ~claimant:claimant_1 first_ip >>= fun () -> diff --git a/test/test_connect.ml b/test/test_connect.ml index 46ad73b41..3085f4dc3 100644 --- a/test/test_connect.ml +++ b/test/test_connect.ml @@ -45,7 +45,7 @@ module Test_connect (B : Vnetif_backends.Backend) = struct let accept flow expected = let ip, port = V.Stackv4.TCPV4.dst flow in - Logs.debug (fun f -> f "Accepted connection from %s:%d" (Ipaddr.V4.to_string ip) port); + Log.debug (fun f -> f "Accepted connection from %s:%d" (Ipaddr.V4.to_string ip) port); V.Stackv4.TCPV4.read flow >>= function | Error e -> err_read e | Ok `Eof -> err_read_eof () @@ -53,7 +53,7 @@ module Test_connect (B : Vnetif_backends.Backend) = struct Lwt_unix.sleep 0.1 >>= fun () -> (* sleep first to capture data in pcap *) Alcotest.(check string) "accept" expected (Cstruct.to_string b); - Logs.debug (fun f -> f "Connection closed"); + Log.debug (fun f -> f "Connection closed"); Lwt.return_unit let test_tcp_connect_two_stacks () = @@ -72,12 +72,12 @@ module Test_connect (B : Vnetif_backends.Backend) = struct V.Stackv4.listen s2; (let conn = V.Stackv4.TCPV4.create_connection (V.Stackv4.tcpv4 s2) in or_error "connect" conn (server_ip, 80) >>= fun flow -> - Logs.debug (fun f -> f "Connected to other end..."); + Log.debug (fun f -> f "Connected to other end..."); V.Stackv4.TCPV4.write flow (Cstruct.of_string test_string) >>= function | Error `Closed -> err_write_eof () | Error e -> err_write e | Ok () -> - Logs.debug (fun f -> f "wrote hello world"); + Log.debug (fun f -> f "wrote hello world"); V.Stackv4.TCPV4.close flow >>= fun () -> Lwt_unix.sleep 1.0 >>= fun () -> (* record some traffic after close *) Lwt.return_unit)]) ] >>= fun () -> @@ -98,7 +98,7 @@ let test_tcp_connect_two_stacks_basic () = let test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss () = let rec loop = function | 0 -> Lwt.return_unit - | n -> Logs.info (fun f -> f "%d/100" (101-n)); + | n -> Log.info (fun f -> f "%d/100" (101-n)); let module Test = Test_connect(Vnetif_backends.Uniform_no_payload_packet_loss) in Test.record_pcap (Printf.sprintf From 3054d0ee51e87ac0617af86f5f0708b978f67cbc Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 5 Dec 2018 19:32:38 +0100 Subject: [PATCH 2/2] stack-unix: remove unneeded empty hashtables udpv4_listeners and tcpv4_listeners --- src/stack-unix/tcpip_stack_socket.ml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/stack-unix/tcpip_stack_socket.ml b/src/stack-unix/tcpip_stack_socket.ml index 4e9351159..73c9f4b30 100644 --- a/src/stack-unix/tcpip_stack_socket.ml +++ b/src/stack-unix/tcpip_stack_socket.ml @@ -45,8 +45,6 @@ type ipv4 = Ipaddr.V4.t option type t = { udpv4 : Udpv4.t; tcpv4 : Tcpv4.t; - udpv4_listeners: (int, Udpv4.callback) Hashtbl.t; - tcpv4_listeners: (int, (Tcpv4.flow -> unit Lwt.t)) Hashtbl.t; } let udpv4 { udpv4; _ } = udpv4 @@ -132,9 +130,7 @@ let listen _t = let connect ips udpv4 tcpv4 = Log.info (fun f -> f "Manager: connect"); - let udpv4_listeners = Hashtbl.create 7 in - let tcpv4_listeners = Hashtbl.create 7 in - let t = { tcpv4; udpv4; udpv4_listeners; tcpv4_listeners } in + let t = { tcpv4; udpv4 } in Log.info (fun f -> f "Manager: configuring"); configure t ips >|= fun () -> t