Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 108 lines (101 sloc) 5.02 kb
e9950d9 first commit
Kanen Flowers authored
1 ;; @module Http
e2bb587 Ego commit
Kanen Flowers authored
2 ;; @author Jeff Ober <jeffober@gmail.com>, Kanen Flowers <kanendosei@gmail.com>
e9950d9 first commit
Kanen Flowers authored
3 ;; @version 1.1
4 ;; @location http://static.artfulcode.net/newlisp/http.lsp
5 ;; @package http://static.artfulcode.net/newlisp/http.qwerty
6 ;; @description A bare-bones HTTP 1.0 library (updated for newlisp 10).
7 ;; Http is an extremely bare-bones HTTP 1.0 library. Not all functionality
8 ;; is implemented. In particular, the ability to parse an HTTP response is not
9 ;; yet finished, but the ability to parse requests and send both requests and
10 ;; responses is finished.
11 ;; This module has not been rigorously tested. Your mileage may vary. Requires
12 ;; newlisp 10.
13 ;; <h4>Version history</h4>
14 ;; <b>1.1</b>
15 ;; &bull; updated for newlisp 10
16 ;; &bull; code clean-up
17 ;;
18 ;; <b>1.0</b>
19 ;; &bull; initial release
20
21 (context 'Http)
22
23 (constant 'request-init-re (regex-comp {^(GET|POST|HEAD|PUT) (.+?) HTTP/(1.\d)$}))
24 (constant 'request-header-re (regex-comp {^(.+?):\s+(.+?)$}))
25 (constant 'line-ending-re (regex-comp [text][\r\n]{2,4}[/text]))
26 (constant 'response-template "HTTP/1.0 %d OK\r\nConnection: close\r\nContent-Type: %s\r\nDate: %s\r\nContent-Length: %d%s\r\n\r\n%s")
27
28 (define (format-header pair)
29 (format "%s: %s" (title-case (string (pair 0))) (string (pair 1))))
30
31 ;; @syntax (Http:parse-request <str-request>)
32 ;; @param <str-request> an HTTP request received
33 ;; <p>Parses an HTTP request and returns an association list.</p>
34 ;; @example
35 ;; (parse-request
36 ;; (format-request "POST"
37 ;; "/cgi-bin/post_comment.cgi"
38 ;; '(("Host" "www.somesite.com"))
39 ;; "name=Some+Person&comment=Hello+world!"))
40 ;;
41 ;; => (("method" "POST")
42 ;; ("path" "/cgi-bin/post_comment.cgi")
43 ;; ("http-version" "1.0")
44 ;; ("headers" (("host" "www.somesite.com")
45 ;; ("content-length" "37") nil))
46 ;; ("content" ""))
47 (define (parse-request req , lines request headers)
48 (when (and (string? req) (not (empty? req)))
49 (setf lines (map trim (parse req line-ending-re 0x10000)))
50 (setf headers '())
51 (setf request
52 (first (find-all request-init-re (first lines)
53 (list (list "method" $1) (list "path" $2) (list "http-version" $3))
54 0x10000)))
55 (when request
56 (dolist (line (slice lines 1 -1))
57 (push (first (find-all request-header-re line (list (lower-case $1) $2) 0x10000))
58 headers -1))
59 (push (list "headers" headers) request -1)
60 (push (list "content" (slice (last lines) 0)) request -1)
61 request)))
62
63 ;; @syntax (Http:format-response <str-response> [<int-code> [<str-content-type> [<assoc-headers>]]])
64 ;; @param <str-response> the text of the HTTP response
65 ;; @param <int-code> the HTTP response code; default is 200 (success)
66 ;; @param <str-content-type> MIME type of response; default is "text/html"
67 ;; @param <assoc-headers> association list of headers to add to response
68 ;; <p>Formats an HTTP/1.0 response.</p>
69 ;; @example
70 ;; (format-response binary-file-content 200 "audio/mp3")
71 ;; => "HTTP/1.0 200 OK\r\nConnection: close\r\nContent-Type: audio/mp3\r\nDate: Tue, 08 Jul 2008 10:30:09 EDT\r\nContent-Length: 17\r\n\r\n11000101010101..."
72 (define (format-response response (code 200) (content-type "text/html") (extra-headers '()))
73 (format response-template
74 code
75 content-type
76 (date (date-value) 0 "%a, %d %b %Y %H:%M:%S %Z")
77 (length response)
78 (if-not (empty? extra-headers)
79 (string "\r\n" (join (map format-header extra-headers) "\r\n"))
80 "")
81 response))
82
83 ;; @syntax (Http:format-request <str-method> [<str-path> [<assoc-headers> [<str-content>]]])
84 ;; @param <str-method> request method (GET, POST, HEAD, or PUT)
85 ;; @param <str-path> request path; default is "/"
86 ;; @param <assoc-headers> association list of headers to add to request
87 ;; @param <str-content> for POST and PUT methods, string containing request content
88 ;; <p>Formats an appropriate HTTP/1.0 request. Note that the "Host" header must be added explicitly if required.</p>
89 ;; @example
90 ;; (format-request "POST"
91 ;; "/cgi-bin/post_comment.cgi"
92 ;; '(("Host" "www.somesite.com"))
93 ;; "name=Some+Person&comment=Hello+world!"))
94 ;; => "HTTP/1.0 200 OK\r\nConnection: close\r\nContent-Type: text/html\r\nDate: Tue, 08 Jul 2008 10:28:03 EDT\r\nContent-Length: 46\r\n\r\n<html><body><h1>Hello world</h2></body></html>"
95 (define (format-request method (path "/") (headers '()) content, (buf ""))
96 (if-not (and (string? method) (find (upper-case method) '("GET" "POST" "HEAD" "PUT")))
97 (throw-error "Invalid or unimplemented HTTP method"))
98 (setf method (upper-case method))
99 (write-buffer buf (format "%s %s HTTP/1.0\r\n" method (string path)))
100 (dolist (header headers)
101 (write-buffer buf (format "%s\r\n" (format-header header))))
102 (when content
103 (write-buffer buf (format "Content-Length: %d\r\n\r\n" (length content)))
104 (write-buffer buf content))
105 (write-buffer buf "\r\n\r\n")
106 buf)
107
108 (context MAIN)
Something went wrong with that request. Please try again.