src/net/http.slate

   1
   2 "
   3
   4         Request       = Request-Line              ; Section 5.1
   5                         *(( general-header        ; Section 4.5
   6                          | request-header         ; Section 5.3
   7                          | entity-header ) CRLF)  ; Section 7.1
   8                         CRLF
   9                         [ message-body ]          ; Section 4.3
  10
  11        general-header = Cache-Control            ; Section 14.9
  12                       | Connection               ; Section 14.10
  13                       | Date                     ; Section 14.18
  14                       | Pragma                   ; Section 14.32
  15                       | Trailer                  ; Section 14.40
  16                       | Transfer-Encoding        ; Section 14.41
  17                       | Upgrade                  ; Section 14.42
  18                       | Via                      ; Section 14.45
  19                       | Warning                  ; Section 14.46
  20
  21       request-header = Accept                   ; Section 14.1
  22                       | Accept-Charset           ; Section 14.2
  23                       | Accept-Encoding          ; Section 14.3
  24                       | Accept-Language          ; Section 14.4
  25                       | Authorization            ; Section 14.8
  26                       | Expect                   ; Section 14.20
  27                       | From                     ; Section 14.22
  28                       | Host                     ; Section 14.23
  29                       | If-Match                 ; Section 14.24
  30                       | If-Modified-Since        ; Section 14.25
  31                       | If-None-Match            ; Section 14.26
  32                       | If-Range                 ; Section 14.27
  33                       | If-Unmodified-Since      ; Section 14.28
  34                       | Max-Forwards             ; Section 14.31
  35                       | Proxy-Authorization      ; Section 14.34
  36                       | Range                    ; Section 14.35
  37                       | Referer                  ; Section 14.36
  38                       | TE                       ; Section 14.39
  39                       | User-Agent               ; Section 14.43
  40
  41        Response      = Status-Line               ; Section 6.1
  42                        *(( general-header        ; Section 4.5
  43                         | response-header        ; Section 6.2
  44                         | entity-header ) CRLF)  ; Section 7.1
  45                        CRLF
  46                        [ message-body ]          ; Section 7.2
  47
  48 Request-Line   = Method SP Request-URI SP HTTP-Version CRLF
  49
  50      Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF
  51
  52
  53        response-header = Accept-Ranges           ; Section 14.5
  54                        | Age                     ; Section 14.6
  55                        | ETag                    ; Section 14.19
  56                        | Location                ; Section 14.30
  57                        | Proxy-Authenticate      ; Section 14.33
  58                        | Retry-After             ; Section 14.37
  59                        | Server                  ; Section 14.38
  60                        | Vary                    ; Section 14.44
  61                        | WWW-Authenticate        ; Section 14.47
  62
  63        entity-header  = Allow                    ; Section 14.7
  64                       | Content-Encoding         ; Section 14.11
  65                       | Content-Language         ; Section 14.12
  66                       | Content-Length           ; Section 14.13
  67                       | Content-Location         ; Section 14.14
  68                       | Content-MD5              ; Section 14.15
  69                       | Content-Range            ; Section 14.16
  70                       | Content-Type             ; Section 14.17
  71                       | Expires                  ; Section 14.21
  72                       | Last-Modified            ; Section 14.29
  73                       | extension-header
  74
  75        extension-header = message-header
  76
  77        length := 0
  78        read chunk-size, chunk-extension (if any) and CRLF
  79        while (chunk-size > 0) {
  80           read chunk-data and CRLF
  81           append chunk-data to entity-body
  82           length += chunk-size
  83           read chunk-size and CRLF
  84        }
  85        read entity-header
  86        while (entity-header not empty) {
  87           append entity-header to existing header fields
  88           read entity-header
  89        }
  90        Content-Length := length
  91        Remove chunked from Transfer-Encoding
  92
  93
  94 "
  95
  96 Net define: #HttpClient &parents: {Cloneable}
  97 &slots: {#userAgent -> 'slateweb/1.0'.
  98          #statusResponseRegex -> (Regex Matcher newOn: '^(HTTP/\\d+\\.\\d+) (\\d+) ([ \\w]+)$').
  99          #headerResponseRegex -> (Regex Matcher newOn: '^([^:]+)\\:\\s*(.*)$').
 100          #chunkHeaderRegex -> (Regex Matcher newOn: '^([0-9a-fA-F]+)\\s*$').
 101 }.
 102
 103 Net define: #HttpMessage &parents: {Cloneable} &slots: {#version. #headers}.
 104 Net define: #HttpRequest &parents: {Net HttpMessage} &slots: {#uri. #method.}.
 105
 106 Net define: #HttpResponse &parents: {Net HttpMessage} &slots: {#status. #reason. #body}.
 107 Net define: #SimpleHttpResponse &parents: {Net HttpResponse} &slots: {}.
 108 Net define: #ChunkedHttpResponse &parents: {Net HttpResponse} &slots: {}.
 109
 110 Net define: #HttpAcceptableDictionary &parents: {Dictionary}.
 111
 112
 113 m@(Net HttpMessage traits) new
 114 [
 115   resend `>> [version := 'HTTP/1.1'. headers := Dictionary new. ]
 116 ].
 117
 118 d@(Net HttpAcceptableDictionary traits) as: s@(String traits)
 119 [
 120   ([| :result |
 121     d keysAndValuesDo: [| :key :val |
 122       val ifNil: [result ; ', ' ; key printString]
 123           ifNotNil: [result ; ', ' ; key printString ; ';q=' ; val printString]].
 124    ] streamingAs: s) allButFirst: 2
 125 ].
 126
 127 hc@(Net HttpClient traits) simpleQuery: s@(String traits) &on: stream &method: method
 128 [| str url closeStream |
 129   closeStream := False.
 130   url := (Net URL newFrom: s).
 131   stream ifNil: [closeStream := True.
 132                  stream := hc newConnectionFor: url].
 133   [str := ((hc request: url &method: method) as: String).
 134    "inform: 'sending request'."
 135    stream nextPutAll: (str as: ByteArray). "fixme unicode"
 136    stream flush.
 137    "inform: 'reading reply'."
 138    hc readResponse: stream
 139    ] ensure: [closeStream ifTrue: [stream close]]
 140 ].
 141
 142 Net define: #AsyncSimpleHttpRequest &parents: {Net AsyncBlockOperation}
 143   &slots: {#url. #request}.
 144
 145 _@(Net AsyncSimpleHttpRequest traits) new
 146 [| o con discon resolv send recv retval hostname portIp port |
 147   o := resend.
 148
 149   discon := Net AsyncCloseOperation new.
 150   recv := Net AsyncHttpReader new.
 151   "con/send bound later because request unknown at time of #new"
 152
 153   recv completionBlock := [| :me | o workBlock := [discon workOn]. retval := me result].
 154   discon completionBlock := [| :me | o complete &result: retval].
 155
 156   o workBlock :=
 157     [hostname := o url authority.
 158      portIp := (Net SocketAddress separatePort: hostname).
 159      portIp second ifNil: [hostname := hostname ; ':80'. port := '80'] ifNotNil: [port := portIp second].
 160      resolv := (Net AsyncResolveOperation newOn: portIp first &service: port).
 161      resolv completionBlock :=
 162        [| :me |
 163         con := (Net AsyncConnectOperation newOn: (me result: 0 as: Net SocketAddress)).
 164         con completionBlock :=
 165           [| :me |
 166            {discon. send. recv. } do: [| :x | x handle := me result].
 167            o workBlock := [send workOn]].
 168         o workBlock := [con workOn]].
 169
 170      send := ((o request as: String) as: Net AsyncSendOperation).
 171      send completionBlock := [|:me| o workBlock := [recv workOn]].
 172      o workBlock := [resolv workOn].
 173      o workOn].
 174   o
 175 ].
 176
 177 hc@(Net HttpClient traits) simpleAsyncQuery: s@(String traits) &method: method
 178 [| url request |
 179   url := (Net URL newFrom: s).
 180   request := (hc request: url &method: method).
 181   Net AsyncSimpleHttpRequest new `>> [url := url. request := request. ]
 182 ].
 183
 184 hc@(Net HttpClient traits) request: s@(String traits) &method: method
 185 [
 186   hc request: (Net URL newFrom: s) &method: method
 187 ].
 188
 189 hc@(Net HttpClient traits) request: url@(Net URL traits) &method: method
 190 [| req |
 191   method `defaultsTo: 'GET'.
 192   req := Net HttpRequest new `>> [uri := url. method := method. ].
 193   req headers at: 'Host' put: url authority.
 194   hc userAgent ifNotNil: [req headers at: 'User-Agent' put: hc userAgent].
 195   req
 196 ].
 197
 198 r@(Net HttpRequest traits) as: s@(String traits)
 199 [
 200   r method isNil \/ [r uri path isNil] \/ [r version isNil] ifTrue: [error: 'Nil request'].
 201   [| :result |
 202    result ; r method ; ' ' ; r uri path ; ' ' ; r version ; '\r\n'.
 203    r headers keysAndValuesDo: [|:key :val| result ; key ; ': ' ; (val as: String) ; '\r\n'].
 204    result ; '\r\n'.
 205  ] writingAs: s
 206 ].
 207
 208 "this needs to be resolved.. fixme"
 209 hc@(Net HttpClient traits) newConnectionFor: url@(Net URL traits)
 210 [| addr socket hostname portIp |
 211   hostname := url authority.
 212   portIp := (Net SocketAddress separatePort: hostname).
 213   portIp second ifNil: [hostname := hostname ; ':80'].
 214   addr := (Net SocketAddress newOn: hostname).
 215   socket := (Net Socket newFor: addr domain type: Net Socket Types Stream protocol: Net Socket Protocols Default).
 216   socket connectTo: addr.
 217   Net SocketStream newOn: socket
 218 ].
 219
 220 hc@(Net HttpClient traits) readLineFrom: stream@(ReadStream traits)
 221 [| str |
 222   "inform: 'reading line...'."
 223   str := (stream upTo: $\r code).
 224   stream next ~= $\n code ifTrue: [error: 'invalid newline separator in http response'].
 225   str := (str as: ASCIIString).
 226   "inform: 'read: ' ; str escaped."
 227   str
 228 ].
 229
 230 hc@(Net HttpClient traits) readHeaders: stream@(ReadStream traits)
 231 [| headers line re |
 232   headers := Dictionary new.
 233   "inform: 'reading headers'."
 234   [
 235     line := (hc readLineFrom: stream).
 236     line isEmpty ifTrue: [^ headers].
 237     re := hc headerResponseRegex clone.
 238     (re match: line) = -1 ifTrue: [error: 'malformed header line'].
 239     headers at: (re subexpression: 0) toLowercase put: (re subexpression: 1).
 240   ] loop.
 241 ].
 242
 243 hc@(Net HttpClient traits) newResponseFromHeaders: headers
 244 [| tc |
 245 "fixme... checked for transfer-encoding/TE to see if we need chunked"
 246   (headers at: 'content-length' ifAbsent: [Nil])
 247     ifNotNil: [^ (Net SimpleHttpResponse new `>> [headers := headers. ])].
 248
 249   tc := (headers at: 'transfer-coding' ifAbsent: [Nil]).
 250   tc ifNotNil: [(tc first: 7) toLowercase = 'chunked'
 251                   ifTrue: [^ (Net ChunkedHttpResponse new `>> [headers := headers. ])]].
 252
 253   Net SimpleHttpResponse new `>> [headers := headers. ]
 254   error: 'not sure how to read response body...missing transfer encoding'
 255 ].
 256
 257 hc@(Net HttpClient traits) readBodyInto: response@(Net SimpleHttpResponse traits) from: stream@(ReadStream traits)
 258 [| length |
 259   length := ((response headers at: 'content-length' ifAbsent: [error: 'Content-Length field required'])
 260     as: Integer).
 261   inform: 'reading body len: ' ; length printString.
 262   response body := (stream next: length).
 263 ].
 264
 265 hc@(Net HttpClient traits) readBodyInto: response@(Net ChunkedHttpResponse traits) from: stream@(ReadStream traits)
 266 [| chunkHeader chunkMatch length trailers |
 267   response body := ExtensibleByteArray new.
 268   [
 269     chunkHeader := (hc readLineFrom: stream).
 270     chunkMatch := hc chunkHeaderRegex clone.
 271     (chunkMatch match: chunkHeader) = -1 ifTrue: [error: 'error reading chunk header: ' ; chunkHeader].
 272     length := ((chunkMatch subexpression: 0) as: Integer &radix: 16)
 273     inform: 'reading chunk len: ' ; length printString.
 274     len = 0 ifTrue: [trailers := (hc readHeaders: stream).
 275                      response headers addAll: trailers.
 276                      ^ Nil
 277                      ].
 278     response body addAllLast: (stream next: length).
 279     stream next = $\r code /\ [stream next = $\n code] ifFalse: [error: 'expected CRLF after chunk'].
 280   ] loop.
 281 ].
 282
 283
 284 hc@(Net HttpClient traits) readResponse: stream@(ReadStream traits)
 285 [| status re httpVersion statusCode statusReason headers response |
 286   status := (hc readLineFrom: stream).
 287   re := hc statusResponseRegex clone.
 288   (re match: status) = -1
 289     ifTrue: [error: 'Invalid status line in http response']
 290     ifFalse: [httpVersion := (re subexpression: 0).
 291               statusCode := (re subexpression: 1).
 292               statusReason := (re subexpression: 2)].
 293
 294   httpVersion ~= 'HTTP/1.1' ifTrue: [error: 'Only supporting http version 1.1.'].
 295   headers := (hc readHeaders: stream).
 296   response := (hc newResponseFromHeaders: headers) `>> [version := httpVersion.
 297                                                       status := statusCode.
 298                                                       reason := statusReason. ].
 299   hc readBodyInto: response from: stream.
 300   response
 301
 302 ].
 303
 304 Net define: #AsyncHttpLineReader &parents: {Net AsyncReceiveUntilOperation}.
 305
 306 _@(Net AsyncHttpLineReader traits) new
 307 [
 308   (Net AsyncReceiveUntilOperation newOn: Nil &until: $\n code
 309           &resultModifier: [|:res| ((res last: 2) as: String) = '\r\n' ifFalse: [error: 'malformed line in http response.'].
 310                                        (res allButLast: 2) as: String])
 311 ].
 312
 313 Net define: #AsyncHttpReader &parents: {Net AsyncBlockOperation}
 314   &slots: {#handle}.
 315
 316 _@(Net AsyncHttpReader traits) new
 317 [| o statusReader headerReader bodyReader re httpVersion statusCode statusReason headers |
 318   o := resend.
 319   re := Net HttpClient statusResponseRegex clone.
 320   statusReader := Net AsyncHttpLineReader new.
 321   headerReader := (Net AsyncHttpHeaderReader new).
 322   statusReader completionBlock :=
 323     [| :me |
 324      headerReader handle := me handle.
 325      (re match: me result) = -1
 326        ifTrue: [error: 'Invalid status line in http response']
 327        ifFalse: [httpVersion := (re subexpression: 0).
 328                  statusCode := (re subexpression: 1).
 329                  statusReason := (re subexpression: 2)].
 330      httpVersion ~= 'HTTP/1.1' ifTrue: [error: 'Only supporting http version 1.1.'].
 331      o workBlock := [headerReader workOn]].
 332
 333   bodyReader := (Net AsyncHttpBodyReader new).
 334
 335   headerReader completionBlock :=
 336     [| :me |
 337      bodyReader handle := me handle.
 338      headers := me result.
 339      bodyReader headers := headers.
 340      o workBlock := [bodyReader workOn]].
 341
 342   bodyReader completionBlock :=
 343     [| :me |
 344      headers addAll: me trailers.
 345      o complete &result:
 346        (Net SimpleHttpResponse new `>>
 347           [version := httpVersion.
 348            status := statusCode.
 349            reason := statusReason.
 350            headers := headers.
 351            body := me result. ]).
 352      o workBlock := []].
 353
 354   o workBlock :=
 355     [statusReader handle := o handle.
 356      o workBlock := [statusReader workOn].
 357      o workOn].
 358   o
 359 ].
 360
 361 Net define: #AsyncHttpHeaderReader &parents: {Net AsyncBlockOperation}
 362   &slots: {#handle}.
 363
 364 _@(Net AsyncHttpHeaderReader traits) new
 365 [| o re headers lineReader |
 366   o := resend.
 367   re := Net HttpClient headerResponseRegex clone.
 368   headers := Dictionary new.
 369   lineReader := Net AsyncHttpLineReader new.
 370
 371   lineReader completionBlock :=
 372     [| :me |
 373      me result isEmpty
 374        ifTrue: [o workBlock := [].
 375                 o complete &result: headers]
 376        ifFalse: [(re match: me result) = -1
 377                       ifTrue: [error: 'Invalid header line in http response']
 378                       ifFalse: [headers at: (re subexpression: 0) toLowercase put: (re subexpression: 1).
 379                                 lineReader reset]]
 380
 381          ].
 382
 383   o workBlock := [lineReader handle := o handle.
 384                   o workBlock := [lineReader workOn].
 385                   o workOn].
 386   o
 387 ].
 388
 389 Net define: #AsyncHttpBodyReader &parents: {Net AsyncBlockOperation}
 390   &slots: {#handle. #headers. #trailers}.
 391
 392 _@(Net AsyncHttpBodyReader traits) new
 393 [| o re lineReader chunkReader headerReader body tc |
 394   o := resend.
 395   re := Net HttpClient chunkHeaderRegex clone.
 396   lineReader := Net AsyncHttpLineReader new.
 397   chunkReader := Net AsyncReceiveUntilOperation new.
 398   headerReader := (Net AsyncHttpHeaderReader new). "chunked encoding has trailers"
 399   body := ExtensibleByteArray new.
 400   o trailers := Dictionary new.
 401   o workBlock :=
 402   [lineReader handle := o handle.
 403    chunkReader handle := o handle.
 404    headerReader handle := o handle.
 405    (o headers at: 'content-length' ifAbsent: [Nil])
 406      ifNil: [tc := (o headers at: 'transfer-coding'). "error if not there"
 407              tc ifNotNil: [(tc first: 7) toLowercase = 'chunked'
 408                              ifFalse: [error: 'unknown http transfer encoding']].
 409              "we know it's chunked transfer"
 410              headerReader completionBlock :=
 411                [| :me |
 412                 o trailers := me result.
 413                 o workBlock := [].
 414                 o complete &result: body].
 415
 416              lineReader completionBlock :=
 417                [| :me length |
 418                 (re match: me result) = -1 ifTrue: [error: 'error reading chunk header: ' ; me result].
 419                 length := ((chunkMatch subexpression: 0) as: Integer &radix: 16).
 420                 inform: 'reading chunk len: ' ; length printString.
 421                 chunkReader reset.
 422                 chunkReader amount := length + 2. "plus CRLF"
 423                 o workBlock := [chunkReader workOn]].
 424              chunkReader completionBlock :=
 425                [| :me |
 426                 amount = 2
 427                   ifTrue: [o workBlock := [headerReader workOn]]
 428                   ifFalse: [((me result last: 2) as: String) = '\r\n' ifFalse: [error: 'bad http chunk'].
 429                             body addAllLast: (me result allButLast: 2).
 430                             lineReader reset.
 431                             o workBlock := [lineReader workOn]]].
 432              o workBlock := [lineReader workOn]]
 433
 434      ifNotNil: [chunkReader amount := ((o headers at: 'content-length'
 435                                           ifAbsent: [error: 'Content-Length field required'])
 436                                          as: Integer).
 437                 o workBlock := [chunkReader workOn].
 438                 chunkReader completionBlock := [| :me | o complete &result: me result]].
 439    o workOn].
 440   o
 441 ].