(define (lay:http:write-header h) (display (conc (car h) ": " (cdr h) "\r\n"))) (define (lay:http:make-request host path headers) (with-output-to-string (lambda () (display (string-append "GET " path " HTTP/1.1\r\n")) (map lay:http:write-header `((Host . ,host) (User-Agent . chicken-lay) (Connection . close) (Accept . *))) (map lay:http:write-header headers) (display "\r\n")))) (define (lay:http:split-head-line s) (let ((n (string-length s))) (let loop ((i 0)) (if (> i n) (values "" "") (if (char=? #\: (string-ref s i)) (values (substring s 0 i) (substring s (add1 i))) (loop (add1 i))))))) (define (lay:http:parse-head port) (let loop ((head '())) (let ((line (read-line port))) (if (eq? 0 (string-length line)) (reverse head) (let-values (((k v) (lay:http:split-head-line line))) (let ((k (string->symbol (lay:string:downcase (lay:string:trim k)))) (v (lay:string:trim v))) (loop (cons (cons k v) head)))) )))) (define (lay:http:parse-body head port) (and-let* ((content-length (alist-ref 'content-length head))) (read-bytevector (string->number content-length) port))) (define (lay:http:get host path headers) (let ((request (lay:http:make-request host path headers))) (let-values (((i o) (tcp-connect host 80))) (display request o) (flush-output o) (close-output-port o) (let ((first-line (string-split (read-line i)))) (unless (string-ci=? (car first-line) "HTTP/1.1") (error "Invalid response type: " (string-append (map ->string first-line)))) (let* ((code (string->number (cadr first-line))) (head (lay:http:parse-head i)) (body (lay:http:parse-body head i))) (close-input-port i) (values code head body))))))