From 00ca58327682dd1363459ee570964aade0704b7c Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sun, 1 Mar 2015 13:10:00 +0000 Subject: [PATCH 1/5] move ipv4 and icmpv4 to its own module ; provide int_to_protocol / protocol_to_int --- lib/ipv4.ml | 70 ++++++++++++++++++++++----------------------- lib/wire_structs.ml | 66 ++++++++++++++++++++++++++++-------------- 2 files changed, 79 insertions(+), 57 deletions(-) diff --git a/lib/ipv4.ml b/lib/ipv4.ml index 7db21d4cc..2d15acd52 100644 --- a/lib/ipv4.ml +++ b/lib/ipv4.ml @@ -87,13 +87,13 @@ module Make(Ethif : V1_LWT.ETHIF) = struct let adjust_output_header ~dmac ~tlen frame = Wire_structs.set_ethernet_dst dmac 0 frame; - let buf = Cstruct.sub frame Wire_structs.sizeof_ethernet Wire_structs.sizeof_ipv4 in + let buf = Cstruct.sub frame Wire_structs.sizeof_ethernet Wire_structs.Ipv4_wire.sizeof_ipv4 in (* Set the mutable values in the ipv4 header *) - Wire_structs.set_ipv4_len buf tlen; - Wire_structs.set_ipv4_id buf (Random.int 65535); (* TODO *) - Wire_structs.set_ipv4_csum buf 0; + Wire_structs.Ipv4_wire.set_ipv4_len buf tlen; + Wire_structs.Ipv4_wire.set_ipv4_id buf (Random.int 65535); (* TODO *) + Wire_structs.Ipv4_wire.set_ipv4_csum buf 0; let checksum = Tcpip_checksum.ones_complement buf in - Wire_structs.set_ipv4_csum buf checksum + Wire_structs.Ipv4_wire.set_ipv4_csum buf checksum let allocate_frame t ~dst ~proto = let ethernet_frame = Io_page.to_cstruct (Io_page.get 1) in @@ -102,19 +102,20 @@ module Make(Ethif : V1_LWT.ETHIF) = struct Wire_structs.set_ethernet_ethertype ethernet_frame 0x0800; let buf = Cstruct.shift ethernet_frame Wire_structs.sizeof_ethernet in (* Write the constant IPv4 header fields *) - Wire_structs.set_ipv4_hlen_version buf ((4 lsl 4) + (5)); (* TODO options *) - Wire_structs.set_ipv4_tos buf 0; - Wire_structs.set_ipv4_off buf 0; (* TODO fragmentation *) - Wire_structs.set_ipv4_ttl buf 38; (* TODO *) - let proto = match proto with |`ICMP -> 1 |`TCP -> 6 |`UDP -> 17 in - Wire_structs.set_ipv4_proto buf proto; - Wire_structs.set_ipv4_src buf (Ipaddr.V4.to_int32 t.ip); - Wire_structs.set_ipv4_dst buf (Ipaddr.V4.to_int32 dst); - let len = Wire_structs.sizeof_ethernet + Wire_structs.sizeof_ipv4 in + Wire_structs.Ipv4_wire.set_ipv4_hlen_version buf ((4 lsl 4) + (5)); (* TODO options *) + Wire_structs.Ipv4_wire.set_ipv4_tos buf 0; + Wire_structs.Ipv4_wire.set_ipv4_off buf 0; (* TODO fragmentation *) + Wire_structs.Ipv4_wire.set_ipv4_ttl buf 38; (* TODO *) + let proto = Wire_structs.Ipv4_wire.protocol_to_int proto in + Wire_structs.Ipv4_wire.set_ipv4_proto buf proto; + Wire_structs.Ipv4_wire.set_ipv4_src buf (Ipaddr.V4.to_int32 t.ip); + Wire_structs.Ipv4_wire.set_ipv4_dst buf (Ipaddr.V4.to_int32 dst); + let len = Wire_structs.sizeof_ethernet + Wire_structs.Ipv4_wire.sizeof_ipv4 in (ethernet_frame, len) let writev t frame bufs = - let dst = Ipaddr.V4.of_int32 (Wire_structs.get_ipv4_dst (Cstruct.shift frame Wire_structs.sizeof_ethernet)) in + let v4_frame = Cstruct.shift frame Wire_structs.sizeof_ethernet in + let dst = Ipaddr.V4.of_int32 (Wire_structs.Ipv4_wire.get_ipv4_dst v4_frame) in (* Something of a layer violation here, but ARP is awkward *) Routing.destination_mac t dst >|= Macaddr.to_bytes >>= fun dmac -> let tlen = Cstruct.len frame + Cstruct.lenv bufs - Wire_structs.sizeof_ethernet in @@ -126,7 +127,7 @@ module Make(Ethif : V1_LWT.ETHIF) = struct let icmp_dst_unreachable buf = let descr = - match Wire_structs.get_icmpv4_code buf with + match Wire_structs.Ipv4_wire.get_icmpv4_code buf with | 0 -> "Destination network unreachable" | 1 -> "Destination host unreachable" | 2 -> "Destination protocol unreachable" @@ -149,18 +150,18 @@ module Make(Ethif : V1_LWT.ETHIF) = struct let icmp_input t src _hdr buf = MProf.Trace.label "icmp_input"; - match Wire_structs.get_icmpv4_ty buf with + match Wire_structs.Ipv4_wire.get_icmpv4_ty buf with |0 -> (* echo reply *) return (printf "ICMP: discarding echo reply\n%!") |3 -> icmp_dst_unreachable buf |8 -> (* echo request *) (* convert the echo request into an echo reply *) let csum = - let orig_csum = Wire_structs.get_icmpv4_csum buf in + let orig_csum = Wire_structs.Ipv4_wire.get_icmpv4_csum buf in let shift = if orig_csum > 0xffff -0x0800 then 0x0801 else 0x0800 in (orig_csum + shift) land 0xffff in - Wire_structs.set_icmpv4_ty buf 0; - Wire_structs.set_icmpv4_csum buf csum; + Wire_structs.Ipv4_wire.set_icmpv4_ty buf 0; + Wire_structs.Ipv4_wire.set_icmpv4_csum buf csum; (* stick an IPv4 header on the front and transmit *) let frame, header_len = allocate_frame t ~dst:src ~proto:`ICMP in let frame = Cstruct.set_len frame header_len in @@ -170,23 +171,20 @@ module Make(Ethif : V1_LWT.ETHIF) = struct return_unit let input t ~tcp ~udp ~default buf = - (* buf pointers to to start of IPv4 header here *) - let ihl = (Wire_structs.get_ipv4_hlen_version buf land 0xf) * 4 in - let src = Ipaddr.V4.of_int32 (Wire_structs.get_ipv4_src buf) in - let dst = Ipaddr.V4.of_int32 (Wire_structs.get_ipv4_dst buf) in - let payload_len = Wire_structs.get_ipv4_len buf - ihl in + (* buf pointers to start of IPv4 header here *) + let ihl = (Wire_structs.Ipv4_wire.get_ipv4_hlen_version buf land 0xf) * 4 in + let src = Ipaddr.V4.of_int32 (Wire_structs.Ipv4_wire.get_ipv4_src buf) in + let dst = Ipaddr.V4.of_int32 (Wire_structs.Ipv4_wire.get_ipv4_dst buf) in + let payload_len = Wire_structs.Ipv4_wire.get_ipv4_len buf - ihl in (* XXX this will raise exception for 0-length payload *) - let hdr = Cstruct.sub buf 0 ihl in - let data = Cstruct.sub buf ihl payload_len in - match Wire_structs.get_ipv4_proto buf with - | 1 -> (* ICMP *) - icmp_input t src hdr data - | 6 -> (* TCP *) - tcp ~src ~dst data - | 17 -> (* UDP *) - udp ~src ~dst data - | proto -> - default ~proto ~src ~dst data + let hdr, data = Cstruct.split buf ihl in + assert (Cstruct.len data = payload_len); + let proto = Wire_structs.Ipv4_wire.get_ipv4_proto buf in + match Wire_structs.Ipv4_wire.int_to_protocol proto with + | Some `ICMP -> icmp_input t src hdr data + | Some `TCP -> tcp ~src ~dst data + | Some `UDP -> udp ~src ~dst data + | None -> default ~proto ~src ~dst data let connect ethif = let ip = Ipaddr.V4.any in diff --git a/lib/wire_structs.ml b/lib/wire_structs.ml index e508fa379..f594e2164 100644 --- a/lib/wire_structs.ml +++ b/lib/wire_structs.ml @@ -4,27 +4,6 @@ cstruct ethernet { uint16_t ethertype } as big_endian -cstruct ipv4 { - uint8_t hlen_version; - uint8_t tos; - uint16_t len; - uint16_t id; - uint16_t off; - uint8_t ttl; - uint8_t proto; - uint16_t csum; - uint32_t src; - uint32_t dst - } as big_endian - -cstruct icmpv4 { - uint8_t ty; - uint8_t code; - uint16_t csum; - uint16_t id; - uint16_t seq - } as big_endian - cstruct udp { uint16_t source_port; uint16_t dest_port; @@ -32,6 +11,40 @@ cstruct udp { uint16_t checksum } as big_endian +module Ipv4_wire = struct + cstruct ipv4 { + uint8_t hlen_version; + uint8_t tos; + uint16_t len; + uint16_t id; + uint16_t off; + uint8_t ttl; + uint8_t proto; + uint16_t csum; + uint32_t src; + uint32_t dst + } as big_endian + + cstruct icmpv4 { + uint8_t ty; + uint8_t code; + uint16_t csum; + uint16_t id; + uint16_t seq + } as big_endian + + let int_to_protocol = function + | 1 -> Some `ICMP + | 6 -> Some `TCP + | 17 -> Some `UDP + | _ -> None + + let protocol_to_int = function + | `ICMP -> 1 + | `TCP -> 6 + | `UDP -> 17 +end + module Tcp_wire = struct cstruct tcp { uint16_t src_port; @@ -96,6 +109,17 @@ module Ipv6_wire = struct uint8_t dst[16] } as big_endian + let int_to_protocol = function + | 58 -> Some `ICMP + | 6 -> Some `TCP + | 17 -> Some `UDP + | _ -> None + + let protocol_to_int = function + | `ICMP -> 58 + | `TCP -> 6 + | `UDP -> 17 + cstruct icmpv6 { uint8_t ty; uint8_t code; From 739ca94cab9d96e4d676be3ef6bfac547425a0a5 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 2 Mar 2015 17:19:55 +0000 Subject: [PATCH 2/5] fix --- lib/ipv4.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ipv4.ml b/lib/ipv4.ml index 2d15acd52..026b548ac 100644 --- a/lib/ipv4.ml +++ b/lib/ipv4.ml @@ -221,7 +221,7 @@ module Make(Ethif : V1_LWT.ETHIF) = struct Cstruct.set_uint8 pbuf 0 0; fun frame bufs -> let frame = Cstruct.shift frame Wire_structs.sizeof_ethernet in - Cstruct.set_uint8 pbuf 1 (Wire_structs.get_ipv4_proto frame); + Cstruct.set_uint8 pbuf 1 (Wire_structs.Ipv4_wire.get_ipv4_proto frame); Cstruct.BE.set_uint16 pbuf 2 (Cstruct.lenv bufs); let src_dst = Cstruct.sub frame 12 (2 * 4) in Tcpip_checksum.ones_complement_list (src_dst :: pbuf :: bufs) From 9172a5c905452ab95e4349c641e0f459e9202ac6 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 2 Mar 2015 17:23:13 +0000 Subject: [PATCH 3/5] cleanup: move (still disabled) verify_checksum to input --- tcp/pcb.ml | 130 +++++++++++++++++++++-------------------------------- 1 file changed, 52 insertions(+), 78 deletions(-) diff --git a/tcp/pcb.ml b/tcp/pcb.ml index ff9667b3e..d34b0243c 100644 --- a/tcp/pcb.ml +++ b/tcp/pcb.ml @@ -69,30 +69,7 @@ struct let ip { ip; _ } = ip - (* - let pbuf = - Cstruct.sub (Cstruct.of_bigarray (Io_page.get 1)) 0 sizeof_pseudo_header - - let checksum ~src ~dst = - fun data -> - set_pseudo_header_src pbuf (Ipaddr.V4.to_int32 src); - set_pseudo_header_dst pbuf (Ipaddr.V4.to_int32 dst); - set_pseudo_header_res pbuf 0; - set_pseudo_header_proto pbuf 6; - set_pseudo_header_len pbuf (Cstruct.lenv data); - Tcpip_checksum.ones_complement_list (pbuf::data) - - let verify_checksum id pkt = - let csum = checksum ~src:id.dest_ip ~dst:id.local_ip [pkt] in - match csum with - | 0 -> true - | _ -> - printf "0x%X 0x%X %s " csum (get_tcpv4_checksum pkt) - (Ipaddr.V4.to_string id.dest_ip); - false - *) - - let verify_checksum _ _ = true + let verify_checksum _ _ _ = true let wscale_default = 2 @@ -160,25 +137,22 @@ struct (* Process an incoming TCP packet that has an active PCB *) let input _t pkt (pcb,_) = - match verify_checksum pcb.id pkt with - | false -> printf "RX.input: checksum error\n%!"; return_unit - | true -> - (* URG_TODO: Deal correctly with incomming RST segment *) - let sequence = Sequence.of_int32 (Tcp_wire.get_tcp_sequence pkt) in - let ack_number = - Sequence.of_int32 (Tcp_wire.get_tcp_ack_number pkt) - in - let fin = Tcp_wire.get_fin pkt in - let syn = Tcp_wire.get_syn pkt in - let ack = Tcp_wire.get_ack pkt in - let window = Tcp_wire.get_tcp_window pkt in - let data = Wire.get_payload pkt in - let seg = - RXS.segment ~sequence ~fin ~syn ~ack ~ack_number ~window ~data - in - let { rxq; _ } = pcb in - (* Coalesce any outstanding segments and retrieve ready segments *) - RXS.input rxq seg + (* URG_TODO: Deal correctly with incomming RST segment *) + let sequence = Sequence.of_int32 (Tcp_wire.get_tcp_sequence pkt) in + let ack_number = + Sequence.of_int32 (Tcp_wire.get_tcp_ack_number pkt) + in + let fin = Tcp_wire.get_fin pkt in + let syn = Tcp_wire.get_syn pkt in + let ack = Tcp_wire.get_ack pkt in + let window = Tcp_wire.get_tcp_window pkt in + let data = Wire.get_payload pkt in + let seg = + RXS.segment ~sequence ~fin ~syn ~ack ~ack_number ~window ~data + in + let { rxq; _ } = pcb in + (* Coalesce any outstanding segments and retrieve ready segments *) + RXS.input rxq seg (* Thread that spools the data into an application receive buffer, and notifies the ACK subsystem that new data is here *) @@ -447,44 +421,44 @@ struct Tx.send_rst t id ~sequence ~ack_number ~syn ~fin let input_no_pcb t listeners pkt id = - match verify_checksum id pkt with - | false -> printf "RX.input: checksum error\n%!"; return_unit - | true -> - match Tcp_wire.get_rst pkt with - | true -> process_reset t id - | false -> - let sequence = Tcp_wire.get_tcp_sequence pkt in - let options = Wire.get_options pkt in - let ack_number = Tcp_wire.get_tcp_ack_number pkt in - let syn = Tcp_wire.get_syn pkt in - let ack = Tcp_wire.get_ack pkt in - let fin = Tcp_wire.get_fin pkt in - match syn, ack with - | true , true -> process_synack t id ~pkt ~ack_number ~sequence - ~options ~syn ~fin - | true , false -> process_syn t id ~listeners ~pkt ~ack_number ~sequence - ~options ~syn ~fin - | false, true -> process_ack t id ~pkt ~ack_number ~sequence ~syn ~fin - | false, false -> - (* What the hell is this packet? No SYN,ACK,RST *) - return_unit + match Tcp_wire.get_rst pkt with + | true -> process_reset t id + | false -> + let sequence = Tcp_wire.get_tcp_sequence pkt in + let options = Wire.get_options pkt in + let ack_number = Tcp_wire.get_tcp_ack_number pkt in + let syn = Tcp_wire.get_syn pkt in + let ack = Tcp_wire.get_ack pkt in + let fin = Tcp_wire.get_fin pkt in + match syn, ack with + | true , true -> process_synack t id ~pkt ~ack_number ~sequence + ~options ~syn ~fin + | true , false -> process_syn t id ~listeners ~pkt ~ack_number ~sequence + ~options ~syn ~fin + | false, true -> process_ack t id ~pkt ~ack_number ~sequence ~syn ~fin + | false, false -> + (* What the hell is this packet? No SYN,ACK,RST *) + return_unit (* Main input function for TCP packets *) let input t ~listeners ~src ~dst data = - let source_port = Tcp_wire.get_tcp_src_port data in - let dest_port = Tcp_wire.get_tcp_dst_port data in - let id = - { WIRE.local_port = dest_port; - dest_ip = src; - local_ip = dst; - dest_port = source_port } - in - (* Lookup connection from the active PCB hash *) - with_hashtbl t.channels id - (* PCB exists, so continue the connection state machine in tcp_input *) - (Rx.input t data) - (* No existing PCB, so check if it is a SYN for a listening function *) - (input_no_pcb t listeners data) + match verify_checksum src dst data with + | false -> printf "RX.input: checksum error\n%!"; return_unit + | true -> + let source_port = Tcp_wire.get_tcp_src_port data in + let dest_port = Tcp_wire.get_tcp_dst_port data in + let id = + { WIRE.local_port = dest_port; + dest_ip = src; + local_ip = dst; + dest_port = source_port } + in + (* Lookup connection from the active PCB hash *) + with_hashtbl t.channels id + (* PCB exists, so continue the connection state machine in tcp_input *) + (Rx.input t data) + (* No existing PCB, so check if it is a SYN for a listening function *) + (input_no_pcb t listeners data) (* Blocking read on a PCB *) let read pcb = From 52d21bad06b9bf56f7043f3c371bb941cb22778f Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 2 Mar 2015 17:28:39 +0000 Subject: [PATCH 4/5] actually use protocol_to_int! --- lib/ipv6.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ipv6.ml b/lib/ipv6.ml index 15caff498..ba4f1180d 100644 --- a/lib/ipv6.ml +++ b/lib/ipv6.ml @@ -924,7 +924,7 @@ module Make (E : V1_LWT.ETHIF) (T : V1_LWT.TIME) (C : V1.CLOCK) = struct end acts let allocate_frame t ~dst ~proto = - let proto = match proto with `ICMP -> 58 | `UDP -> 17 | `TCP -> 6 in + let proto = Ipv6_wire.protocol_to_int proto in let src = AddressList.select_source t.state.address_list dst in Allocate.frame ~mac:t.state.mac ~src ~hlim:t.state.cur_hop_limit ~dst ~proto From 38cf1807cb4f1206c78f0968da7e87cd83151cb9 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 2 Mar 2015 21:00:39 +0000 Subject: [PATCH 5/5] remove unused Sliding_window from build --- _oasis | 2 +- _tags | 3 +-- setup.ml | 6 +++--- tcp/tcp.mlpack | 3 +-- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/_oasis b/_oasis index b7f010b0c..6dafbaffa 100644 --- a/_oasis +++ b/_oasis @@ -69,7 +69,7 @@ Library tcp Path: tcp Findlibparent: tcpip Findlibname: tcp - Modules: Options,Wire,State,Tcptimer,Sequence,Sliding_window,Ack, + Modules: Options,Wire,State,Tcptimer,Sequence,Ack, Window,Segment,User_buffer,Pcb,Flow BuildDepends: io-page, mirage-types, diff --git a/_tags b/_tags index d64e53389..7c6a31185 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 67ffe3d1ae0f586991f8c38ab831f735) +# DO NOT EDIT (digest: f9fff6055d6ed99bbe8e141b101ae9f5) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -45,7 +45,6 @@ true: annot, bin_annot "tcp/state.cmx": for-pack(Tcp) "tcp/tcptimer.cmx": for-pack(Tcp) "tcp/sequence.cmx": for-pack(Tcp) -"tcp/sliding_window.cmx": for-pack(Tcp) "tcp/ack.cmx": for-pack(Tcp) "tcp/window.cmx": for-pack(Tcp) "tcp/segment.cmx": for-pack(Tcp) diff --git a/setup.ml b/setup.ml index 9968eb1c2..06def7f5a 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.5 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 75b4d316c87acd82b1ffa79c5e474a61) *) +(* DO NOT EDIT (digest: e19c1551baf2d1bbee3584bdd4b93b94) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -7012,7 +7012,6 @@ let setup_t = "State"; "Tcptimer"; "Sequence"; - "Sliding_window"; "Ack"; "Window"; "Segment"; @@ -7658,7 +7657,8 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "õ+¬<\143Öõv \004\151së\031{ý"; + oasis_digest = + Some "rM\151\245\231\138\162t\127\006\016\215\238\188\199\128"; oasis_exec = None; oasis_setup_args = []; setup_update = false diff --git a/tcp/tcp.mlpack b/tcp/tcp.mlpack index 953e27063..7a605cd00 100644 --- a/tcp/tcp.mlpack +++ b/tcp/tcp.mlpack @@ -1,11 +1,10 @@ # OASIS_START -# DO NOT EDIT (digest: 930522b050ab87350477f790a86dd9d6) +# DO NOT EDIT (digest: a1d3c8591e91c674b25051803a310a2d) Options Wire State Tcptimer Sequence -Sliding_window Ack Window Segment