Source file tcp_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
type t = {
  urg : bool;
  ack : bool;
  psh : bool;
  rst : bool;
  syn : bool;
  fin : bool;
  window : Cstruct.uint16;
  options : Options.t list;
  sequence : Sequence.t;
  ack_number : Sequence.t;
  src_port : Cstruct.uint16;
  dst_port : Cstruct.uint16;
}

let equal {urg; ack; psh; rst; syn; fin; window; options; sequence; ack_number;
           src_port; dst_port} q =
  src_port = q.src_port &&
  dst_port = q.dst_port &&
  window = q.window &&
  urg = q.urg && ack = q.ack && psh = q.psh && rst = q.rst && syn = q.syn && fin = q.fin &&
  Sequence.compare sequence q.sequence = 0 &&
  Sequence.compare ack_number q.ack_number = 0 &&
  List.for_all2 Options.equal options q.options

let pp fmt t =
  Format.fprintf fmt
    "TCP packet seq=%a acknum=%a ack=%b rst=%b syn=%b fin=%b win=%d options=%a"
    Sequence.pp t.sequence Sequence.pp t.ack_number
    t.ack t.rst t.syn t.fin t.window Options.pps t.options

let ( let* ) = Result.bind

module Unmarshal = struct
  type error = string

  let of_cstruct pkt =
    let open Tcp_wire in
    let check_len pkt =
      if Cstruct.length pkt < sizeof_tcp then
        Error "packet too short to contain a TCP packet of any size"
      else
        Ok (get_data_offset pkt)
    in
    let long_enough data_offset = if Cstruct.length pkt < data_offset then
        Error "packet too short to contain a TCP packet of the size claimed"
      else
        Ok ()
    in
    let options data_offset pkt =
      if data_offset > 20 then
        Options.unmarshal (Cstruct.sub pkt sizeof_tcp (data_offset - sizeof_tcp))
      else if data_offset < 20 then
        Error "data offset was unreasonably short; TCP header can't be valid"
      else (Ok [])
    in
    let* data_offset = check_len pkt in
    let* () = long_enough data_offset in
    let* options = options data_offset pkt in
    let sequence = get_sequence pkt |> Sequence.of_int32 in
    let ack_number = get_ack_number pkt |> Sequence.of_int32 in
    let urg = get_urg pkt in
    let ack = get_ack pkt in
    let psh = get_psh pkt in
    let rst = get_rst pkt in
    let syn = get_syn pkt in
    let fin = get_fin pkt in
    let window = get_window pkt in
    let src_port = get_src_port pkt in
    let dst_port = get_dst_port pkt in
    let data = Cstruct.shift pkt data_offset in
    Ok ({ urg; ack; psh; rst; syn; fin; window; options;
          sequence; ack_number; src_port; dst_port }, data)
end
module Marshal = struct
  open Tcp_wire

  type error = string

  let unsafe_fill ~pseudoheader ~payload t buf options_len =
    let data_off = sizeof_tcp + options_len in
    let buf = Cstruct.sub buf 0 data_off in
    set_src_port buf t.src_port;
    set_dst_port buf t.dst_port;
    set_sequence buf (Sequence.to_int32 t.sequence);
    set_ack_number buf (Sequence.to_int32 t.ack_number);
    set_data_offset buf (data_off / 4);
    set_flags buf 0;
    if t.urg then set_urg buf;
    if t.ack then set_ack buf;
    if t.rst then set_rst buf;
    if t.syn then set_syn buf;
    if t.fin then set_fin buf;
    if t.psh then set_psh buf;
    set_window buf t.window;
    set_checksum buf 0;
    set_urg_ptr buf 0;
    (* it's possible we've been passed a buffer larger than the size of the header,
     * which contains some data after the end of the header we'll write;
     * in this case, make sure we compute the checksum properly *)
    let checksum = Tcpip_checksum.ones_complement_list [pseudoheader ; buf ;
                                                        payload] in
    set_checksum buf checksum;
    ()

  let into_cstruct ~pseudoheader ~payload t buf =
    let check_header_len () =
      if (Cstruct.length buf) < sizeof_tcp then Error "Not enough space for a TCP header"
      else Ok ()
    in
    let check_overall_len header_length =
      if (Cstruct.length buf) < header_length then
        Error (Printf.sprintf "Not enough space for TCP header: %d < %d"
                 (Cstruct.length buf) header_length)
      else Ok ()
    in
    let insert_options options_frame =
      match t.options with
      |[] -> Ok 0
      |options ->
        try
          Ok (Options.marshal options_frame options)
        with
        (* handle the case where we ran out of room in the buffer while attempting
           to write the options *)
        | Invalid_argument s -> Error s
    in
    let options_frame = Cstruct.shift buf sizeof_tcp in
    let* () = check_header_len () in
    let* options_len = insert_options options_frame in
    let* () = check_overall_len (sizeof_tcp + options_len) in
    let buf = Cstruct.sub buf 0 (sizeof_tcp + options_len) in
    unsafe_fill ~pseudoheader ~payload t buf options_len;
    Ok (sizeof_tcp + options_len)

  let make_cstruct ~pseudoheader ~payload t =
    let buf = Cstruct.create (sizeof_tcp + 40) in (* more than 40 bytes of options can't
                                                     be signalled in the length field of
                                                     the tcp header *)
    let options_buf = Cstruct.shift buf sizeof_tcp in
    let options_len = Options.marshal options_buf t.options in
    let buf = Cstruct.sub buf 0 (sizeof_tcp + options_len) in
    unsafe_fill ~pseudoheader ~payload t buf options_len;
    buf
end