package dream-httpaf

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file client_connection.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
module Headers = Httpaf.Headers

type state =
  | Handshake of Client_handshake.t
  | Websocket of Websocket_connection.t

type t = { mutable state: state }

type error =
  [ Httpaf.Client_connection.error
  | `Handshake_failure of Httpaf.Response.t * Httpaf.Body.Reader.t ]

type input_handlers = Websocket_connection.input_handlers =
  { frame : opcode:Websocket.Opcode.t -> is_fin:bool -> len:int -> Payload.t -> unit
  ; eof   : unit -> unit }

let passes_scrutiny ~status ~accept headers =
 (*
  * The client MUST validate the server's response as follows:
  *
  *   1. If the status code received from the server is not 101, the client
  *      handles the response per HTTP [RFC2616] procedures [...].
  *
  *   2. If the response lacks an |Upgrade| header field or the |Upgrade|
  *      header field contains a value that is not an ASCII case- insensitive
  *      match for the value "websocket", the client MUST _Fail the WebSocket
  *      Connection_.
  *
  *   3. If the response lacks a |Connection| header field or the |Connection|
  *      header field doesn't contain a token that is an ASCII case-insensitive
  *      match for the value "Upgrade", the client MUST _Fail the WebSocket
  *      Connection_.

  *   4. If the response lacks a |Sec-WebSocket-Accept| header field or
  *      the |Sec-WebSocket-Accept| contains a value other than the
  *      base64-encoded SHA-1 of the concatenation of the |Sec-WebSocket-
  *      Key| (as a string, not base64-decoded) with the string "258EAFA5-
  *      E914-47DA-95CA-C5AB0DC85B11" but ignoring any leading and
  *      trailing whitespace, the client MUST _Fail the WebSocket
  *      Connection_.

  * 5.  If the response includes a |Sec-WebSocket-Extensions| header
  *     field and this header field indicates the use of an extension
  *     that was not present in the client's handshake (the server has
  *     indicated an extension not requested by the client), the client
  *     MUST _Fail the WebSocket Connection_.  (The parsing of this
  *     header field to determine which extensions are requested is
  *     discussed in Section 9.1.)
  * *)
 match
   status,
   Headers.get_exn headers "upgrade",
   Headers.get_exn headers "connection",
   Headers.get_exn headers "sec-websocket-accept"
   with
   (* 1 *)
 | `Switching_protocols, upgrade, connection, sec_websocket_accept ->
   (* 2 *)
   Handshake.CI.equal upgrade "websocket" &&
   (* 3 *)
   (List.exists
     (fun v -> Handshake.CI.equal (String.trim v) "upgrade")
     (String.split_on_char ',' connection)) &&
   (* 4 *)
   String.equal sec_websocket_accept accept
   (* TODO(anmonteiro): 5 *)
  | _ -> false
  | exception _ -> false
;;

let handshake_exn t =
  match t.state with
  | Handshake handshake -> handshake
  | Websocket _ -> assert false

let connect
    ~nonce
    ?(headers = Httpaf.Headers.empty)
    ~sha1
    ~error_handler
    ~websocket_handler
    target
  =
  let rec response_handler response response_body =
    let { Httpaf.Response.status; headers; _  } = response in
    let t = Lazy.force t in
    let nonce = Base64.encode_exn nonce in
    let accept = Handshake.sec_websocket_key_proof ~sha1 nonce in
    if passes_scrutiny ~status ~accept headers then begin
      Httpaf.Body.Reader.close response_body;
      let handshake = handshake_exn t in
      t.state <-
        Websocket
         (Websocket_connection.create
          ~mode:(`Client Websocket_connection.random_int32)
          websocket_handler);
      Client_handshake.close handshake
    end else
      error_handler (`Handshake_failure(response, response_body))

  and t = lazy
    { state = Handshake (Client_handshake.create
        ~nonce
        ~headers
        ~error_handler:(error_handler :> Httpaf.Client_connection.error_handler)
        ~response_handler
        target) }
  in
  Lazy.force t

let create ?error_handler websocket_handler =
  { state =
      Websocket
        (Websocket_connection.create
          ~mode:(`Client Websocket_connection.random_int32)
          ?error_handler
          websocket_handler) }

let next_read_operation t =
  match t.state with
  | Handshake handshake -> Client_handshake.next_read_operation handshake
  | Websocket websocket ->
    match Websocket_connection.next_read_operation websocket with
    | `Error (`Parse (_, _message)) ->
        (* TODO(anmonteiro): handle this *)
        assert false
        (* set_error_and_handle t (`Exn (Failure message)); `Close *)
    | (`Read | `Close) as operation -> operation

let read t bs ~off ~len =
  match t.state with
  | Handshake handshake -> Client_handshake.read handshake bs ~off ~len
  | Websocket websocket -> Websocket_connection.read websocket bs ~off ~len

let read_eof t bs ~off ~len =
  match t.state with
  | Handshake handshake -> Client_handshake.read handshake bs ~off ~len
  | Websocket websocket -> Websocket_connection.read_eof websocket bs ~off ~len

let next_write_operation t =
  match t.state with
  | Handshake handshake -> Client_handshake.next_write_operation handshake
  | Websocket websocket -> Websocket_connection.next_write_operation websocket

let report_write_result t result =
  match t.state with
  | Handshake handshake -> Client_handshake.report_write_result handshake result
  | Websocket websocket -> Websocket_connection.report_write_result websocket result

let report_exn t exn =
  begin match t.state with
  | Handshake handshake -> Client_handshake.report_exn handshake exn
  | Websocket websocket -> Websocket_connection.report_exn websocket exn
  end

let yield_reader t f =
  match t.state with
  | Handshake handshake -> Client_handshake.yield_reader handshake f
  | Websocket _websocket -> assert false

let yield_writer t f =
  match t.state with
  | Handshake handshake -> Client_handshake.yield_writer handshake f
  | Websocket websocket -> Websocket_connection.yield_writer websocket f


let is_closed t =
  match t.state with
  | Handshake handshake -> Client_handshake.is_closed handshake
  | Websocket websocket -> Websocket_connection.is_closed websocket

let shutdown t =
  match t.state with
  | Handshake handshake -> Client_handshake.close handshake
  | Websocket websocket -> Websocket_connection.shutdown websocket
;;
OCaml

Innovation. Community. Security.