view modules/http.tp @ 160:729dc894e61c

Add post support to HTTP client
author Mike Pavone <pavone@retrodev.com>
date Sat, 10 Aug 2013 18:26:14 -0700
parents d81de309a51f
children f594e6836c44
line wrap: on
line source

{
	parseHex <- :text {
	}
	response <- :_headers _status _sock _data {
		_open? <- true
		_body <- ""
		_length <- int32: (_headers get: "Content-Length" withDefault: "-1")
		_chunked? <- (_headers get: "Transfer-Encoding" withDefault: "") = "chunked"
		_code <- int32: _status
		#{
			headers <- { _headers }
			status <- { _status }
			statusCode <- { _code }
			body <- {
				if: _open? {
					if: _chunked? {
						chunkSize <- 0
						while: {
							canReceive <- true
							while: {
								pos <- _data find: "\r\n" else: { -1 }
								if: pos >= 0 {
									chunkSize <- (_data from: 0 withLength: pos) parseHex32
									_data <- _data from: pos + 2
									false
								} else: {
									canReceive
								}
							} do: {
								r <- (_sock recv: 4096)
								if: (r length) > 0 {
									_data <- _data . r
								} else: {
									canReceive <- false
								}
							}
							chunkSize > 0
						} do: {
							while: { (_data length) < chunkSize } do: {
								r <- _sock recv: 4096
								if: (r length) > 0 {
									_data <- _data . r
								} else: {
									chunkSize <- _data length
								}
							}
							_body <- _body . (_data from: 0 withLength: chunkSize)
						}
					} else: {
						if: _length >= 0 {
							_body <- _data . (_sock recvAll: (_length - (_data byte_length)))
						} else: {
							chunk <- ""
							while: {
								chunk <- _sock recv: 4096
								(chunk length) > 0
							} do: {
								_data <- _data . chunk
							}
							_body <- _data
						}
					}
					_data <- ""
					close
				}
				_body
			}
			close <- {
				if: _open? {
					_sock close
					_open? <- false
				}
			}
		}
	}
	_handleResponse <- :sock {
		resp <- ""
		waiting <- true
		headerText <- ""
		rest <- ""
		status <- ""
		while: { waiting } do: {
			data <- sock recv 4096
			resp <- resp . data
			pos <- resp find: "\r\n\r\n" else: { -1 }
			if: pos >= 0 {
				waiting <- false
				statusEnd <- resp find: "\r\n" else: { 0 }
				statusStart <- (resp find: " " else: { 0 }) + 1
				status <- resp from: statusStart withLength: (statusEnd - statusStart)
				headerText <- resp from: statusEnd + 2 withLength: pos - (statusEnd + 2)
				rest <- resp from: pos + 4
			}
		}
		headers <- (headerText splitOn: "\r\n") fold: (dict linear) with: :acc curLine{
			//TODO: support multiple headers with the same name
			part <- curLine partitionOn: ":"
			acc set: (trim: (part before)) (trim: (part after))
		}

		response: headers status sock rest
	}
	#{
		client:usingPort <- :address :port{
			#{
				get <- :path {
					sock <- socket connectTo: address onPort: port
					sock send: "GET " . path . " HTTP/1.1\r\nHost: " . address . "\r\n\r\n"
					_handleResponse: sock
				}
				post:toPath:withType <- :body :path :type {
					sock <- socket connectTo: address onPort: port
					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"
					sock send: body
					_handleResponse: sock
				}
			}
		}

		client <- :address {
			client: address usingPort: 80
		}
	}
}