Mercurial > repos > tabletprog

annotate modules/http.tp @ 316:df4b67d8d2bc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Minor improvement to error message about invalid c type expressions
author Michael Pavone <pavone@retrodev.com>
date Thu, 19 Mar 2015 22:39:18 -0700
parents f594e6836c44
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
1 {
159
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
2 parseHex <- :text {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
3 }
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
4 response <- :_headers _status _sock _data {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
5 _open? <- true
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
6 _body <- ""
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
7 _length <- int32: (_headers get: "Content-Length" withDefault: "-1")
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
8 _chunked? <- (_headers get: "Transfer-Encoding" withDefault: "") = "chunked"
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
9 _code <- int32: _status
149
7f442b3e4448 Tiny bit of work on HTTP client and sample usage of it
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
10 #{
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
11 headers <- { _headers }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
12 status <- { _status }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
13 statusCode <- { _code }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
14 body <- {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
15 if: _open? {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
16 if: _chunked? {
159
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
17 chunkSize <- 0
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
18 while: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
19 canReceive <- true
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
20 while: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
21 pos <- _data find: "\r\n" else: { -1 }
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
22 if: pos >= 0 {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
23 chunkSize <- (_data from: 0 withLength: pos) parseHex32
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
24 _data <- _data from: pos + 2
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
25 false
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
26 } else: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
27 canReceive
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
28 }
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
29 } do: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
30 r <- (_sock recv: 4096)
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
31 if: (r length) > 0 {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
32 _data <- _data . r
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
33 } else: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
34 canReceive <- false
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
35 }
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
36 }
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
37 chunkSize > 0
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
38 } do: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
39 while: { (_data length) < chunkSize } do: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
40 r <- _sock recv: 4096
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
41 if: (r length) > 0 {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
42 _data <- _data . r
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
43 } else: {
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
44 chunkSize <- _data length
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
45 }
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
46 }
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
47 _body <- _body . (_data from: 0 withLength: chunkSize)
d81de309a51f Add support for chunked encoding to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 157
diff changeset
48 }
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
49 } else: {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
50 if: _length >= 0 {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
51 _body <- _data . (_sock recvAll: (_length - (_data byte_length)))
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
52 } else: {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
53 chunk <- ""
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
54 while: {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
55 chunk <- _sock recv: 4096
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
56 (chunk length) > 0
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
57 } do: {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
58 _data <- _data . chunk
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
59 }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
60 _body <- _data
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
61 }
153
075b1e71feff A little more work on the HTTP module
Mike Pavone <pavone@retrodev.com>
parents: 149
diff changeset
62 }
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
63 _data <- ""
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
64 close
153
075b1e71feff A little more work on the HTTP module
Mike Pavone <pavone@retrodev.com>
parents: 149
diff changeset
65 }
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
66 _body
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
67 }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
68 close <- {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
69 if: _open? {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
70 _sock close
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
71 _open? <- false
153
075b1e71feff A little more work on the HTTP module
Mike Pavone <pavone@retrodev.com>
parents: 149
diff changeset
72 }
149
7f442b3e4448 Tiny bit of work on HTTP client and sample usage of it
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
73 }
7f442b3e4448 Tiny bit of work on HTTP client and sample usage of it
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
74 }
7f442b3e4448 Tiny bit of work on HTTP client and sample usage of it
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
75 }
160
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
76 _handleResponse <- :sock {
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
77 resp <- ""
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
78 waiting <- true
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
79 headerText <- ""
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
80 rest <- ""
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
81 status <- ""
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
82 while: { waiting } do: {
163
f594e6836c44 Fix silly typo in http module
Mike Pavone <pavone@retrodev.com>
parents: 160
diff changeset
83 data <- sock recv: 4096
160
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
84 resp <- resp . data
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
85 pos <- resp find: "\r\n\r\n" else: { -1 }
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
86 if: pos >= 0 {
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
87 waiting <- false
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
88 statusEnd <- resp find: "\r\n" else: { 0 }
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
89 statusStart <- (resp find: " " else: { 0 }) + 1
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
90 status <- resp from: statusStart withLength: (statusEnd - statusStart)
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
91 headerText <- resp from: statusEnd + 2 withLength: pos - (statusEnd + 2)
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
92 rest <- resp from: pos + 4
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
93 }
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
94 }
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
95 headers <- (headerText splitOn: "\r\n") fold: (dict linear) with: :acc curLine{
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
96 //TODO: support multiple headers with the same name
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
97 part <- curLine partitionOn: ":"
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
98 acc set: (trim: (part before)) (trim: (part after))
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
99 }
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
100
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
101 response: headers status sock rest
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
102 }
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
103 #{
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
104 client:usingPort <- :address :port{
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
105 #{
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
106 get <- :path {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
107 sock <- socket connectTo: address onPort: port
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
108 sock send: "GET " . path . " HTTP/1.1\r\nHost: " . address . "\r\n\r\n"
160
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
109 _handleResponse: sock
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
110 }
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
111 post:toPath:withType <- :body :path :type {
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
112 sock <- socket connectTo: address onPort: port
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
113 sock send: "POST " . path . " HTTP/1.1\r\nHost: " . address . "\r\nContent-Type: " . type . "\r\nContent-Length: " . (string: (body byte_length)) . "\r\n\r\n"
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
114 sock send: body
729dc894e61c Add post support to HTTP client
Mike Pavone <pavone@retrodev.com>
parents: 159
diff changeset
115 _handleResponse: sock
157
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
116 }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
117 }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
118 }
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
119
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
120 client <- :address {
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
121 client: address usingPort: 80
55e0dca7d3d7 Partial implementation of HTTP get requests
Mike Pavone <pavone@retrodev.com>
parents: 153
diff changeset
122 }
149
7f442b3e4448 Tiny bit of work on HTTP client and sample usage of it
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
123 }
7f442b3e4448 Tiny bit of work on HTTP client and sample usage of it
Mike Pavone <pavone@retrodev.com>
parents:
diff changeset
124 }