initial

2016-02-21 19:06:39 +01:00
commit 6a4b845639
3 changed files with 446 additions and 0 deletions
--- a/request.zp
+++ b/request.zp
@@ -0,0 +1,80 @@
+(module "request"
+  (export
+    (list "set-buffer-size!" set-buffer-size)
+    (list "set-default-headers!" set-default-headers)
+    (list "set-follow-redirects!" set-follow-redirects)
+    (list "request" request)
+    (list "get" get)
+    (list "put" put)
+    (list "post" post)
+    (list "delete" delete))
+
+  (BSIZE (make-small 1024))
+  (DFLT-HEADERS (make-hash "User-Agent" (++ "zepto-" (zepto:version-str))))
+  (FOLLOW-REDIRECTS #f)
+
+  (set-buffer-size (lambda (nsize)
+    (set! BSIZE nsize)))
+
+  (set-default-headers (lambda (headers)
+    (set! DFLT-HEADERS headers)))
+
+  (set-follow-redirects (lambda (flag)
+    (set! FOLLOW-REDIRECTS flag)))
+
+  (parse-request (lambda (req scheme path req-headers)
+    (let* ((split (string:split req "\r\n\r\n"))
+           (headers (if (> (length split) 1) (string:split (car split) "\r\n") []))
+           (body (if (truthy? headers) (string:join (cdr split) #\newline) (car split)))
+           (status-ln (string:split (get-from headers 0) #\space))
+           (http-version (car status-ln))
+           (status (cadr status-ln))
+           (message (caddr status-ln))
+           (split-headers (lambda (acc v) (make-hash acc (string:split v ": "))))
+           (headers (reduce split-headers #{} (if (> (length headers) 1) (cdr headers) [])))
+           (res (make-hash :headers headers
+                           :body body
+                           :status (string->integer status)
+                           :http http-version
+                           :path path
+                           :status-message message)))
+      (if (and (eq? (res :status) 302) FOLLOW-REDIRECTS)
+        (request scheme ((res :headers) "Location") req-headers)
+        res))))
+
+  (request (lambda (scheme path  . req-headers)
+    (let* ((path (if (string:starts-with path "http://") (substring path 7 (length path)) path))
+           (path (if (string:starts-with path "https://") (substring path 8 (length path)) path))
+           (split (string:split path #\/))
+           (location (string:join (cdr split) #\/))
+           (host+port (car split))
+           (split (string:split host+port #\:))
+           (host (car split))
+           (port (get-from split 1 "80"))
+           (req-headers (get-from req-headers 0 DFLT-HEADERS))
+           (headers (hash:kv-reduce
+                      (lambda (acc kv) (++ acc (->string (car kv)) ": " (->string (cadr kv)) "\r\n"))
+                      ""
+                      req-headers))
+           (text (++ scheme " /" location " HTTP/1.1\r\nHost: " host+port "\r\n" headers "\r\n\r\n"))
+           (sock (net:socket "stream")))
+      (begin
+        (net:connect sock (net:get-addr-info host port))
+        (net:send sock (string->byte-vector text))
+        (let loop ((recvd (net:recv sock BSIZE))
+                   (bytes b{}))
+          (if (or (falsy? (length recvd)) (string:ends-with (byte-vector->string recvd) "\r\n"))
+            (parse-request (byte-vector->string (++ bytes recvd)) scheme path req-headers)
+            (loop (net:recv sock BSIZE) (++ bytes recvd))))))))
+
+  (get (lambda (path . headers)
+    (request "GET" path (get-from headers 0 DFLT-HEADERS))))
+
+  (post (lambda (path . headers)
+    (request "POST" path) (get-from headers 0 DFLT-HEADERS)))
+
+  (put (lambda (path . headers)
+    (request "PUT" path) (get-from headers 0 DFLT-HEADERS)))
+
+  (delete (lambda (path . headers)
+    (request "DELETE" path) (get-from headers 0 DFLT-HEADERS))))