/lib/web.arc
Unknown | 129 lines | 110 code | 19 blank | 0 comment | 0 complexity | e590a8613ef9557f7fd06fe03c670916 MD5 | raw file
1; written by Mark Huetsch 2; same license as Arc 3 4($ (require openssl)) 5($ (xdef ssl-connect (lambda (host port) 6 (ar-init-socket 7 (lambda () (ssl-connect host port)))))) 8 9(load "lib/re.arc") 10(load "lib/util.arc") 11 12(def parse-server-cookies (s) 13 (map [map trim _] 14 (map [matchsplit "=" _] 15 (tokens s #\;)))) 16 17(def read-headers ((o s (stdin))) 18 (accum a 19 (whiler line (readline s) blank 20 (a line)))) 21 22(def parse-server-headers (lines) 23 (let http-response (tokens car.lines) 24 (list 25 (map http-response '(0 1 2)) 26 (some [aand (begins-rest "Set-Cookie:" _) parse-server-cookies.it] 27 cdr.lines)))) 28 29(def args->query-string (args) 30 (if args 31 (let equals-list (map [joinstr _ "="] (pair (map [coerce _ 'string] args))) 32 (joinstr equals-list "&")) 33 "")) 34 35(def parse-url (url) 36 (withs ((resource url) (split-by "://" (ensure-resource:strip-after url "#")) 37 (host+port path+query) (split-by "/" url) 38 (host portstr) (split-by ":" host+port) 39 (path query) (split-by "?" path+query)) 40 (obj resource resource 41 host host 42 port (or (only.int portstr) default-port.resource) 43 filename path 44 query query))) 45 46; TODO: only handles https for now 47(def default-port(resource) 48 (if (is resource "https") 49 443 50 80)) 51 52(def encode-cookie (o) 53 (let joined-list (map [joinstr _ #\=] (tablist o)) 54 (+ "Cookie: " 55 (if (len> joined-list 1) 56 (reduce [+ _1 "; " _2] joined-list) 57 (car joined-list)) 58 ";"))) 59 60; TODO this isn't very pretty 61(def get-or-post-url (url (o args) (o method "GET") (o cookie)) 62 (withs (method (upcase method) 63 parsed-url (parse-url url) 64 args-query-string (args->query-string args) 65 full-args (joinstr (list args-query-string (parsed-url 'query)) "&") 66 request-path (+ "/" (parsed-url 'filename) 67 (if (and (is method "GET") (> (len full-args) 0)) 68 (+ "?" full-args))) 69 header-components (list (+ method " " request-path " HTTP/1.0") 70 (+ "Host: " (parsed-url 'host)) 71 "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; uk; rv:1.9.1.2) Gecko/20090729 Firefox/3.5.2")) 72 (when (is method "POST") 73 (pushend (+ "Content-Length: " 74 (len (utf-8-bytes full-args))) 75 header-components) 76 (pushend "Content-Type: application/x-www-form-urlencoded" 77 header-components)) 78 (when cookie 79 (push (encode-cookie cookie) header-components)) 80 (withs (header (reduce [+ _1 "\r\n" _2] header-components) 81 body (if (is method "POST") (+ full-args "\r\n")) 82 request-message (+ header "\r\n\r\n" body)) 83 (let (in out) (if (is "https" (parsed-url 'resource)) 84 (ssl-connect (parsed-url 'host) (parsed-url 'port)) 85 (socket-connect (parsed-url 'host) (parsed-url 'port))) 86 (disp request-message out) 87 (with (header (parse-server-headers (read-headers in)) 88 body (tostring (whilet line (readline in) (prn line)))) 89 (close in out) 90 (list header body)))))) 91 92(def get-url (url) 93 ((get-or-post-url url) 1)) 94 95(def post-url (url args) 96 ((get-or-post-url url args "POST") 1)) 97 98 99 100(def split-by(delim s) 101 (iflet idx (posmatch delim s) 102 (list (cut s 0 idx) (cut s (+ idx len.delim))) 103 (list s nil))) 104 105(def strip-after(s delim) 106 ((split-by delim s) 0)) 107 108(def ensure-resource(url) 109 (if (posmatch "://" url) 110 url 111 (+ "http://" url))) 112 113 114 115(def google (q) 116 (get-url (+ "www.google.com/search?q=" (urlencode q)))) 117 118; just some preliminary hacking 119(mac w/browser body 120 `(withs (cookies* (table) 121 get-url 122 (fn (url) (let (parsed-header html) (get-or-post-url url '() "GET" cookies*) 123 (= cookies* (fill-table cookies* (flat (parsed-header 1)))) 124 html)) 125 post-url 126 (fn (url args) (let (parsed-header html) (get-or-post-url url args "POST" cookies*) 127 (= cookies* (fill-table cookies* (flat (parsed-header 1)))) 128 html))) 129 (do ,@body)))