package tcpip
OCaml TCP/IP networking stack, used in MirageOS
Install
Dune Dependency
Authors
Maintainers
Sources
tcpip-v6.4.0.tbz
sha256=6e32bf540d291e9b7325cb3dd00df2f695533e009c46ea534d5518b9492c7348
sha512=2e9f9ca2eeac637599eb48e087b4632598539f1c76f9251758995c7eedeb723f8b951d557a2a53b85a58d50a04e68e15598581f88fca8997733e800fcfca422b
doc/src/tcpip.ipv4/ipv4_packet.ml.html
Source file ipv4_packet.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
type t = { src : Ipaddr.V4.t; dst : Ipaddr.V4.t; id : Cstruct.uint16; off : Cstruct.uint16; ttl : Cstruct.uint8; proto : Cstruct.uint8; options : Cstruct.t; } type protocol = [ | `ICMP | `TCP | `UDP ] let pp fmt t = Format.fprintf fmt "IPv4 packet %a -> %a: id %04x, off %d proto %d, ttl %d, options %a" Ipaddr.V4.pp t.src Ipaddr.V4.pp t.dst t.id t.off t.proto t.ttl Cstruct.hexdump_pp t.options let equal {src; dst; id; off; ttl; proto; options} q = src = q.src && dst = q.dst && id = q.id && off = q.off && ttl = q.ttl && proto = q.proto && Cstruct.equal options q.options module Marshal = struct open Ipv4_wire type error = string let protocol_to_int = function | `ICMP -> 1 | `TCP -> 6 | `UDP -> 17 let pseudoheader ~src ~dst ~proto len = (* should we do sth about id or off (assert false?) *) let proto = protocol_to_int proto in let ph = Cstruct.create 12 in let numify = Ipaddr.V4.to_int32 in Cstruct.BE.set_uint32 ph 0 (numify src); Cstruct.BE.set_uint32 ph 4 (numify dst); Cstruct.set_uint8 ph 8 0; Cstruct.set_uint8 ph 9 proto; Cstruct.BE.set_uint16 ph 10 len; ph let unsafe_fill ~payload_len t buf = let nearest_4 n = match n mod 4 with | 0 -> n | k -> (4 - k) + n in let options_len = nearest_4 @@ Cstruct.length t.options in set_ipv4_hlen_version buf ((4 lsl 4) + 5 + (options_len / 4)); set_ipv4_id buf t.id; set_ipv4_off buf t.off; set_ipv4_ttl buf t.ttl; set_ipv4_proto buf t.proto; 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.length t.options); set_ipv4_len buf (sizeof_ipv4 + options_len + payload_len); let checksum = Tcpip_checksum.ones_complement @@ Cstruct.sub buf 0 (20 + options_len) in set_ipv4_csum buf checksum let into_cstruct ~payload_len t buf = if Cstruct.length buf < (sizeof_ipv4 + Cstruct.length t.options) then Error "Not enough space for IPv4 header" else Ok (unsafe_fill ~payload_len t buf) let make_cstruct ~payload_len t = let nearest_4 n = match n mod 4 with | 0 -> n | k -> (4 - k) + n in let options_len = nearest_4 @@ Cstruct.length t.options in let buf = Cstruct.create (sizeof_ipv4 + options_len) in Cstruct.memset buf 0x00; (* should be removable in the future *) unsafe_fill ~payload_len t buf; buf end module Unmarshal = struct type error = string let int_to_protocol = function | 1 -> Some `ICMP | 6 -> Some `TCP | 17 -> Some `UDP | _ -> None let ( let* ) = Result.bind let header_of_cstruct buf = let open Ipv4_wire in let check_version buf = let version n = (n land 0xf0) in match get_ipv4_hlen_version buf |> version with | 0x40 -> Ok () | n -> Error (Printf.sprintf "IPv4 presented with a packet that claims a different IP version: %x" n) in let size_check buf = if (Cstruct.length buf < sizeof_ipv4) then Error "buffer sent to IPv4 parser had size < 20" else Ok () in let get_header_length buf = let length_of_hlen_version n = (n land 0x0f) * 4 in let hlen = get_ipv4_hlen_version buf |> length_of_hlen_version in if (get_ipv4_len buf) < sizeof_ipv4 then Error (Printf.sprintf "total length %d is smaller than minimum header length" (get_ipv4_len buf)) else if get_ipv4_len buf < hlen then Error (Printf.sprintf "total length %d is smaller than stated header length %d" (get_ipv4_len buf) hlen) else if hlen < sizeof_ipv4 then Error (Printf.sprintf "IPv4 header claimed to have size < 20: %d" hlen) else if Cstruct.length buf < hlen then Error (Printf.sprintf "IPv4 packet w/length %d claimed to have header of size %d" (Cstruct.length buf) hlen) else Ok hlen in let parse buf options_end = let src = Ipaddr.V4.of_int32 (get_ipv4_src buf) in let dst = Ipaddr.V4.of_int32 (get_ipv4_dst buf) in let id = get_ipv4_id buf in let off = get_ipv4_off buf in let ttl = get_ipv4_ttl buf in let proto = get_ipv4_proto buf in let options = if options_end > sizeof_ipv4 then (Cstruct.sub buf sizeof_ipv4 (options_end - sizeof_ipv4)) else (Cstruct.create 0) in Ok ({src; dst; id; off; ttl; proto; options;}, options_end) in let* () = size_check buf in let* () = check_version buf in let* hl = get_header_length buf in parse buf hl let of_cstruct buf = let open Ipv4_wire in let parse buf options_end = let payload_len = (get_ipv4_len buf) - options_end in let payload_available = Cstruct.length buf - options_end in if payload_available < payload_len then ( Error (Printf.sprintf "Payload buffer (%d bytes) too small to contain payload (of size %d from header)" payload_available payload_len) ) else ( let payload = Cstruct.sub buf options_end payload_len in Ok payload ) in let* header, options_end = header_of_cstruct buf in let* payload = parse buf options_end in Ok (header, payload) let verify_transport_checksum ~proto ~ipv4_header ~transport_packet = (* note: it's not necessary to ensure padding to integral number of 16-bit fields here; ones_complement_list does this for us *) let check ~proto ipv4_header len = try let ph = Marshal.pseudoheader ~src:ipv4_header.src ~dst:ipv4_header.dst ~proto len in let calculated_checksum = Tcpip_checksum.ones_complement_list [ph ; transport_packet] in 0 = compare 0x0000 calculated_checksum with | Invalid_argument _ -> false in match proto with | `TCP -> (* checksum isn't optional in tcp, but pkt must be long enough *) check ipv4_header ~proto (Cstruct.length transport_packet) | `UDP -> match Udp_wire.get_udp_checksum transport_packet with | n when (=) 0 @@ compare n 0x0000 -> true (* no checksum supplied, so the check trivially passes *) | _ -> check ipv4_header ~proto (Cstruct.length transport_packet) end
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>