Source file `ethernet_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
type proto = [ `ARP | `IPv4 | `IPv6 ]

let pp_proto ppf = function
  | `ARP -> Fmt.string ppf "ARP"
  | `IPv4 -> Fmt.string ppf "IPv4"
  | `IPv6 -> Fmt.string ppf "IPv6"

type t = {
  source : Macaddr.t;
  destination : Macaddr.t;
  ethertype : proto;
}

let sizeof_ethernet = 14

let ethertype_to_int = function
  | `ARP -> 0x0806
  | `IPv4 -> 0x0800
  | `IPv6 -> 0x86dd

let int_to_ethertype = function
  | 0x0806 -> Some `ARP
  | 0x0800 -> Some `IPv4
  | 0x86dd -> Some `IPv6
  | _ -> None

type error = string

let pp fmt t =
  Format.fprintf fmt "%a -> %a: %a" Macaddr.pp t.source
    Macaddr.pp t.destination pp_proto t.ethertype

let equal {source; destination; ethertype} q =
  (Macaddr.compare source q.source) = 0 &&
  (Macaddr.compare destination q.destination) = 0 &&
  compare (ethertype_to_int ethertype) (ethertype_to_int q.ethertype) = 0

module Unmarshal = struct

  let of_cstruct frame =
    if Cstruct.length frame >= sizeof_ethernet then
      let raw_typ = Cstruct.BE.get_uint16 frame 12 in
      match raw_typ |> int_to_ethertype with
      | None -> Error (Printf.sprintf "unknown ethertype 0x%x in frame" raw_typ)
      | Some ethertype ->
        let payload = Cstruct.shift frame sizeof_ethernet
        and source = Macaddr.of_octets_exn (Cstruct.to_string ~off:6 ~len:6 frame)
        and destination = Macaddr.of_octets_exn (Cstruct.to_string ~off:0 ~len:6 frame)
        in
        Ok ({ destination; source; ethertype;}, payload)
    else
      Error "frame too small to contain a valid ethernet header"
end

module Marshal = struct
  let check_len buf =
    if sizeof_ethernet > Cstruct.length buf then
      Error "Not enough space for an Ethernet header"
    else Ok ()

  let unsafe_fill t buf =
    Cstruct.blit_from_string (Macaddr.to_octets t.destination) 0 buf 0 6;
    Cstruct.blit_from_string (Macaddr.to_octets t.source) 0 buf 6 6;
    Cstruct.BE.set_uint16 buf 12 (ethertype_to_int t.ethertype)

  let into_cstruct t buf =
    Result.map (fun () -> unsafe_fill t buf) (check_len buf)

  let make_cstruct t =
    let buf = Cstruct.create sizeof_ethernet in
    unsafe_fill t buf;
    buf
end