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

Minor cleanups #112

Merged
merged 5 commits into from
Mar 4, 2015
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.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion _oasis
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
3 changes: 1 addition & 2 deletions _tags
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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)
Expand Down
72 changes: 35 additions & 37 deletions lib/ipv4.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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"
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -223,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)
Expand Down
2 changes: 1 addition & 1 deletion lib/ipv6.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
66 changes: 45 additions & 21 deletions lib/wire_structs.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4,34 +4,47 @@ 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;
uint16_t length;
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;
Expand Down Expand Up @@ -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;
Expand Down
6 changes: 3 additions & 3 deletions setup.ml
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -7012,7 +7012,6 @@ let setup_t =
"State";
"Tcptimer";
"Sequence";
"Sliding_window";
"Ack";
"Window";
"Segment";
Expand Down Expand Up @@ -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
Expand Down
Loading