├── recipes └── web ├── web-file-upload.el ├── README.creole ├── web-test.el ├── web.el └── COPYING /recipes/web: -------------------------------------------------------------------------------- 1 | (web 2 | :files 3 | ("web.el") 4 | :requires ((dash "1.5.0")) 5 | :test 6 | (:requires 7 | ((fakir "0.1.9") 8 | (elnode "0.9.9.6.2")) 9 | :files 10 | ("web-test.el"))) 11 | -------------------------------------------------------------------------------- /web-file-upload.el: -------------------------------------------------------------------------------- 1 | ;;; web-file-upload.el -- example uploader -*- lexical-binding: t -*- 2 | 3 | (require 'elnode) 4 | (require 'fakir) 5 | (require 'time-stamp) 6 | 7 | (defun web-file-upload-handler (httpcon) 8 | (elnode-method httpcon 9 | (POST 10 | (let ((file-data (elnode-http-param httpcon "my-file"))) 11 | (when file-data 12 | (with-current-buffer (get-buffer-create "elnode-file-upload") 13 | (insert (base64-decode-string file-data)) 14 | (pop-to-buffer (current-buffer)))) 15 | (elnode-send-status httpcon 200))))) 16 | 17 | (defun web-file-json-upload-handler (httpcon) 18 | (elnode-method httpcon 19 | (POST 20 | (let ((file-data (elnode-http-param httpcon "package"))) 21 | (when file-data 22 | (with-current-buffer (get-buffer-create "elnode-file-upload") 23 | (insert file-data) 24 | (pop-to-buffer (current-buffer)))) 25 | (elnode-send-json httpcon '(("status" . "done"))))))) 26 | 27 | (defun web-file-upload-test () 28 | ;; Start an elnode server... 29 | (elnode-start 'web-file-json-upload-handler :port 9020) 30 | ;; ... and then make a request to it 31 | (fakir-with-file-buffer myfile 32 | (with-current-buffer myfile (insert "hello!!!!")) 33 | (web-http-post 34 | (lambda (con hdr data)(message "web -- from elnode: %s" hdr)) 35 | :url "http://localhost:9020" 36 | :data `(("my-file" . ,myfile)) 37 | :mime-type web-multipart-mimetype 38 | :logging t))) 39 | 40 | (web-file-upload-test) 41 | 42 | ;;; web-file-upload.el ends here 43 | 44 | -------------------------------------------------------------------------------- /README.creole: -------------------------------------------------------------------------------- 1 | = A useful HTTP client = 2 | 3 | Emacs has quite a few HTTP clients but they are all rather old. This 4 | is my attempt at a modern one. 5 | 6 | The idea is to always use callbacks to collect the response. 7 | 8 | == Interactive == 9 | 10 | An interactive function is included: 11 | 12 | {{{ 13 | M-x web-get [RET] url 14 | }}} 15 | 16 | I'm hoping to make this plugin to ffap. 17 | 18 | == Examples == 19 | 20 | Here's a basic example: 21 | 22 | {{{ 23 | ;; -*- lexical-binding: t -*- 24 | (require 'web) 25 | 26 | (let ((url "http://feeds.pinboard.in/json/u:nicferrier")) 27 | (web-http-get 28 | (lambda (httpc header my-data) 29 | (with-current-buffer (get-buffer-create "nicfeed") 30 | (goto-char (point-max)) 31 | (insert my-data))) 32 | :url url)) 33 | }}} 34 | 35 | That creates the buffer {{{nicfeed}}} with the downloaded contents in 36 | it. 37 | 38 | Here's a POST: 39 | 40 | {{{ 41 | ;; -*- lexical-binding: t -*- 42 | 43 | (require 'web) 44 | 45 | (let ((query-data (make-hash-table :test 'equal))) 46 | (puthash 'name "nic" query-data) 47 | (puthash 'email "nic@example.com" query-data) 48 | (web-http-post 49 | (lambda (con header data) 50 | (message "data received is: %s" data)) 51 | :url "http://localhost:8001/someplace" 52 | :data query-data)) 53 | }}} 54 | 55 | SSL works too: 56 | 57 | {{{ 58 | ;; -*- lexical-binding: t -*- 59 | 60 | (require 'web) 61 | 62 | (web-http-call 63 | "GET" 64 | (lambda (conn headers data) 65 | (message "%S %S" headers data)) 66 | :url "https://duckduckgo.com/" 67 | :data '(("q" . "search+engine"))) 68 | }}} 69 | 70 | and JSON has special support and a *different* callback form: 71 | 72 | {{{ 73 | ;; -*- lexical-binding: t -*- 74 | 75 | (require 'web) 76 | 77 | (web-json-post 78 | (lambda (data conn headers) 79 | (message "%S" data)) 80 | :url "http://someurlthatproducesjson/") 81 | }}} 82 | 83 | The JSON callback form allows just data to be collected: 84 | 85 | {{{ 86 | ;; -*- lexical-binding: t -*- 87 | (require 'web) 88 | 89 | (web-json-post 90 | (lambda (data) 91 | (message "%S" data)) 92 | :url "http://someurlthatproducesjson/") 93 | }}} 94 | 95 | and the JSON support allows the usual overriding of JSON type 96 | mappings: 97 | 98 | {{{ 99 | ;; -*- lexical-binding: t -*- 100 | (require 'web) 101 | 102 | (web-json-post 103 | (lambda (data) 104 | ;; data will be a list 105 | (message "The car => %s" (car data))) 106 | :url "http://someurlthatproducesjson/" 107 | :json-object-type 'list) 108 | }}} 109 | 110 | You can also upload files with web: 111 | 112 | {{{ 113 | ;; -*- lexical-binding: t -*- 114 | (require 'web) 115 | 116 | (let ((myfile (get-buffer-create "my-file.txt"))) 117 | (with-current-buffer myfile 118 | (insert "hello!!!!") 119 | (write-file "my-file.txt")) 120 | (web-http-post 121 | (lambda (con hdr data) (message "the file was uploaded!")) 122 | :url "http://localhost:9020" 123 | :data `(("my-file" . ,myfile)) 124 | :mime-type web-multipart-mimetype)) 125 | }}} 126 | 127 | The request MIME type has to be set to {{{web-multipart-mimetype}}} 128 | which is {{{multipart/form-data}}}. When set like that any buffer 129 | visiting a file used as a parameter value will be uploaded as a file. 130 | 131 | web uses Emacs' default MIME checking on files to try to establish the 132 | right //content-type// to send the file as. 133 | 134 | Currently no extra encoding is done so binary files probably can't be 135 | sent. 136 | 137 | == Most wanted == 138 | 139 | I'd really like web to not have to take a callback there and then but 140 | to be able to return some sort of future. The alteration would allow 141 | things like this: 142 | 143 | {{{ 144 | (web-json-post :future :url "http://marmalade-repo.org/login") 145 | }}} 146 | 147 | == Installing == 148 | 149 | I keep the {{{web}}} package on [[http://marmalade-repo.org]] but if 150 | you want to install it manually you can just install the package file 151 | {{{web.el}}}. 152 | 153 | Using {{{elpakit}}} you can also get testing. 154 | 155 | 156 | == API == 157 | 158 | === web-header-parse data === 159 | 160 | Parse an HTTP response header. 161 | 162 | Each header line is stored in the hash with a symbol form of the 163 | header name. 164 | 165 | The status line is expected to be the first line of the data. 166 | The status is stored in the header as well with the following 167 | keys: 168 | 169 | {{{ 170 | status-version 171 | status-code 172 | status-string 173 | }}} 174 | 175 | which are stored as symbols the same as the normal header keys. 176 | 177 | 178 | === web-http-call method callback &key url (host "localhost") (port 80) secure (path "/") extra-headers data (mime-type web/request-mimetype) (mode 'batch) logging === 179 | 180 | Make an HTTP method to the //url// or the //host//, //port//, //path// and send //data//. 181 | 182 | If //url// is specified then it takes precedence over //secure//, //host//, 183 | //port// and //path//. //url// may be HTTP or HTTPS. 184 | 185 | Important note: any query in //url// is currently IGNORED! 186 | 187 | //secure// is [[nil]] by default but if [[t]] then SSL is used. 188 | 189 | //port// is 80 by default. Even if //secure// it [[t]]. If you manually 190 | specify //secure// you should manually specify //port// to be 443. Using 191 | //url// negates the need for that, an SSL //url// will work correctly. 192 | 193 | //extra-headers// is an alist or a hash-table of extra headers to 194 | send to the server. 195 | 196 | //data// is of //mime-type//. We try to interpret //data// and //mime-type// 197 | usefully: 198 | 199 | If //mime-type// is [[application/form-www-url-encoded]] then 200 | [[web-to-query-string]] is used to to format the //data// into a POST 201 | body. 202 | 203 | When the request comes back the //callback// is called. //callback// is 204 | always passed 3 arguments: the HTTP connection which is a process 205 | object, the HTTP header which is a [[hash-table]] and [[data]], which 206 | is normally a string. [[data]] depends somewhat on the context. 207 | See below. 208 | 209 | //mode// defines what it means for the request to cause the //callback// 210 | to be fired. When //mode// is [[stream]] then the //callback// is called 211 | for every chunk of data received after the header has arrived. 212 | This allows streaming data to somewhere else; hence [[stream]] 213 | mode. In this mode //callback//'s [[data]] argument is a single chunk 214 | of the stream or [[:done]] when the stream ends. 215 | 216 | The default //mode// is [[batch]] which collects all the data from the 217 | response before calling //callback// with all the data as a string. 218 | 219 | 220 | === web-http-get callback &key url (host "localhost") (port 80) (path "/") extra-headers (mode 'batch)) (logging t) === 221 | 222 | Make a GET calling //callback// with the result. 223 | 224 | For information on //url// or //path//, //host//, //port// and also //extra-headers// 225 | and //mode// see [[web-http-call]]. 226 | 227 | The callback probably won't work unless you set [[lexical-binding]] 228 | to [[t]]. 229 | 230 | 231 | === web-http-post callback &key url host ("localhost") port (80) path ("/") extra-headers data mime-type (web/request-mimetype) mode ((quote batch)) logging (t) === 232 | 233 | Make a POST and call //callback// with the result. 234 | 235 | For information on //url// or //path//, //host//, //port// and also //mode// see 236 | [[web-http-call]]. 237 | 238 | The callback probably won't work unless you set [[lexical-binding]] 239 | to [[t]]. 240 | 241 | 242 | === web-json-default-expectation-failure data http-con headers === 243 | 244 | Default expectation callback for JSON expectation errors. 245 | 246 | 247 | === web-json-post callback &key url data headers json-array-type (json-array-type) json-object-type (json-object-type) json-key-type (json-key-type) expectation-failure-callback ((quote web-json-default-expectation-failure)) === 248 | 249 | POST //data// to //url// expecting a JSON response sent to //callback//. 250 | 251 | See [[web-json-expected-mimetypes-list]] for the list of Mime Types 252 | we accept JSON for. This may be let bound. If the expectation 253 | is not met then //expectation-failure-callback// is called being 254 | passed the //callback// parameters. By default 255 | //expectation-failure-callback// is 256 | [[web-json-default-expectation-failure]]. 257 | 258 | The //callback// is called as: 259 | 260 | {{{ 261 | //callback// RESPONSE-//data// HTTPCON RESPONSE-HEADER 262 | }}} 263 | 264 | so the function may be defined like this: 265 | 266 | {{{ 267 | (lambda (data &rest stuff) ...) 268 | }}} 269 | 270 | //headers// may be specified, these are treated as extra-headers to 271 | be sent with the request. 272 | 273 | The //data// is sent as [[application/x-www-form-urlencoded]]. 274 | 275 | //json-array-type//, //json-object-type// and //json-key-type//, if present, 276 | are used to let bind the [[json-read]] variables of the same name 277 | affecting the resulting lisp structure. 278 | 279 | 280 | === web-json/parse json-candidate-data &key json-array-type (json-array-type) json-object-type (json-object-type) json-key-type (json-key-type) === 281 | 282 | Parse DATA as JSON and return the result. 283 | 284 | 285 | === web-to-query-string object === 286 | 287 | Convert //object// (a hash-table or alist) to an HTTP query string. 288 | 289 | If //object// is of type [[hash-table]] then the keys and values of the 290 | hash are iterated into the string depending on their types. 291 | 292 | Keys with [[number]] and [[string]] values are encoded as 293 | "key=value" in the resulting query. 294 | 295 | Keys with a boolean value (or any other value not already 296 | described) are encoded just as "key". 297 | 298 | Keys may be symbols or strings. 299 | 300 | 301 | -------------------------------------------------------------------------------- /web-test.el: -------------------------------------------------------------------------------- 1 | ;;; web-test.el --- tests for the web client 2 | 3 | ;; Copyright (C) 2012 Nic Ferrier 4 | 5 | ;; Author: Nic Ferrier 6 | ;; Keywords: hypermedia, lisp 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This is another attempt at an HTTP client in EmacsLisp. 24 | 25 | ;;; Code: 26 | 27 | (require 'web) 28 | (require 'elnode) 29 | (require 'fakir) 30 | (require 'cl) ; really we need dflet package 31 | (require 'noflet) 32 | 33 | (ert-deftest web-json-let-bind () 34 | "Test whether CL arguments are let-bindings." 35 | ;; First prove that it can be overridden 36 | (flet ((web-json-cl-test (data &key json-array-type json-array-type) 37 | (json-read-from-string data))) 38 | (should 39 | (equal 40 | '(1 2 3) 41 | (web-json-cl-test (json-encode '(1 2 3)) :json-array-type 'list)))) 42 | ;; Now prove that it need not be overridden 43 | (flet ((web-json-cl-test (data &key (json-array-type json-array-type)) 44 | (json-read-from-string data))) 45 | (should 46 | (equal 47 | '[1 2 3] 48 | (web-json-cl-test (json-encode '(1 2 3))))))) 49 | 50 | (ert-deftest web/to-query-string () 51 | "Test query string making." 52 | (let ((t1 #s(hash-table size 5 data (a 1 b 2 c 3 d "str" e t)))) 53 | (should 54 | (equal "a=1&b=2&c=3&d=str&e" 55 | (web-to-query-string t1)))) 56 | (let ((t2 '((a . 1)("b" . 2)(c . 3)(d . "str")(e . t)))) 57 | (should 58 | (equal "a=1&b=2&c=3&d=str&e" 59 | (web-to-query-string t2))))) 60 | 61 | (ert-deftest web-to-multipart () 62 | "Test the multipart creation" 63 | (fakir-with-file-buffer file1 64 | (with-current-buffer file1 (insert (json-encode '((a . "data"))))) 65 | (noflet ((web/to-multipart-boundary () "BOUNDARY") 66 | (buffer-file-name (buffer) "/tmp/test-file.txt")) 67 | (let ((mp (web-to-multipart 68 | `((param . "value") 69 | (somefile . ,file1) 70 | (param2 . "another"))))) 71 | (should 72 | (equal 73 | (substring-no-properties mp) 74 | "--BOUNDARY\r 75 | content-disposition: form-data; name=\"param\"\r 76 | \r 77 | value\r 78 | --BOUNDARY\r 79 | content-disposition: form-data; name=\"param2\"\r 80 | \r 81 | another\r 82 | --BOUNDARY\r 83 | content-disposition: form-data; name=\"somefile\"; filename=\"test-file\"\r 84 | Content-type: text/plain\r 85 | \r 86 | {\"a\":\"data\"}\r 87 | --BOUNDARY--\r 88 | ")))))) 89 | 90 | (ert-deftest web/header-string () 91 | "Test that we can make request headers." 92 | (should 93 | (equal 94 | (web/header-string "GET" '(("X-Test" . "value")) nil nil) 95 | "X-Test: value\r\n")) 96 | ;; Now one that sets the automatic headers 97 | (should 98 | (equal 99 | (web/header-string "POST" '(("X-Test" . "value")) web/request-mimetype "a=1") 100 | "Content-length: 3\r 101 | Content-type: application/x-www-form-urlencoded\r 102 | X-Test: value\r 103 | ")) 104 | ;; And now a mulitpart - note the fake multipart body 105 | (should 106 | (equal 107 | (web/header-string 108 | "POST" '(("X-Test" . "value")) web/request-mimetype 109 | (propertize "a=1" :boundary "BOUNDARY")) 110 | "Content-length: 3\r 111 | Content-type: application/x-www-form-urlencoded; boundary=BOUNDARY\r 112 | X-Test: value\r 113 | "))) 114 | 115 | (ert-deftest web-header-parse () 116 | "Test HTTP header parsing." 117 | (let ((hdrs (web-header-parse 118 | "HTTP/1.0 200 Ok\r 119 | Content-type: text/html\r 120 | Content-length: 1000\r 121 | "))) 122 | (should (equal "1.0" (gethash 'status-version hdrs))) 123 | (should (equal "200" (gethash 'status-code hdrs))) 124 | (should (equal "Ok" (gethash 'status-string hdrs))) 125 | (should (equal "text/html" (gethash 'content-type hdrs))) 126 | (should (equal "1000" (gethash 'content-length hdrs)))) 127 | (let ((hdrs (web-header-parse 128 | "HTTP/1.0 400\r 129 | Content-type: text/html\r 130 | Content-length: 1000\r 131 | "))) 132 | (should (equal "1.0" (gethash 'status-version hdrs))) 133 | (should (equal "400" (gethash 'status-code hdrs))) 134 | (should (equal "" (gethash 'status-string hdrs))) 135 | (should (equal "text/html" (gethash 'content-type hdrs))) 136 | (should (equal "1000" (gethash 'content-length hdrs))))) 137 | 138 | (ert-deftest web--chunked-decode-stream () 139 | "Test the chunked decoding." 140 | ;; Test incomplete chunk delivered (missing trailing crlf) 141 | (let ((proc :fake) 142 | (res "")) 143 | (flet ((consumer (con data) 144 | (unless (eq data :done) 145 | (setq res (concat res data))))) 146 | (fakir-mock-process :fake () 147 | (progn 148 | (should-not 149 | (equal 150 | :done 151 | (web/chunked-decode-stream 152 | proc "b\r\nhello world" 'consumer))) 153 | (should 154 | (equal "b\r\nhello world" 155 | (process-get proc :chunked-encoding-buffer))) 156 | (should 157 | (equal 158 | :done 159 | (web/chunked-decode-stream 160 | proc "\r\n0\r\n\r\n" 'consumer))))))) 161 | ;; Test incomplete chunk packet delivered 162 | (let ((proc :fake) 163 | (res "")) 164 | (flet ((consumer (con data) 165 | (unless (eq data :done) 166 | (setq res (concat res data))))) 167 | (fakir-mock-process :fake () 168 | (progn 169 | (should-not 170 | (equal 171 | :done 172 | (web/chunked-decode-stream 173 | proc "b\r\nhello wor" 'consumer))) 174 | (should 175 | (equal "b\r\nhello wor" 176 | (process-get proc :chunked-encoding-buffer))))))) 177 | ;; Test more than 1 complete chunk delivered 178 | (let ((proc :fake) 179 | (res "")) 180 | (flet ((consumer (con data) 181 | (unless (eq data :done) 182 | (setq res (concat res data))))) 183 | (fakir-mock-process :fake () 184 | (progn 185 | (should 186 | (equal :done 187 | (web/chunked-decode-stream 188 | proc 189 | "6\r\nhello!\r\nb\r\nhello world\r\n0\r\n\r\n" 190 | 'consumer))) 191 | (should 192 | (equal "hello!hello world" res)))))) 193 | ;; Test one call handling one chunk and then the end 194 | (let ((proc :fake) 195 | (res "")) 196 | (flet ((consumer (con data) 197 | (unless (eq data :done) 198 | (setq res (concat res data))))) 199 | (fakir-mock-process :fake () 200 | (progn 201 | (should 202 | (equal :done 203 | (web/chunked-decode-stream 204 | proc "5\r\nhello\r\n0\r\n\r\n" 'consumer))) 205 | (should 206 | (equal "hello" res))))))) 207 | 208 | (ert-deftest web-http-post-filter () 209 | "Test the filter in streaming mode." 210 | (let* (cb-hdr 211 | cd-data 212 | (con :fake) 213 | (callback (lambda (con hdr data) 214 | (unless cb-hdr 215 | (setq cb-hdr hdr)) 216 | (unless (eq data :done) 217 | (setq cb-data data))))) 218 | (fakir-mock-process :fake 219 | ((:buffer "HTTP/1.1 200\r 220 | Host: hostname\r 221 | Transfer-encoding: chunked\r\n")) 222 | (should-not cb-hdr) 223 | (web/http-post-filter con "\r\n" callback 'stream) 224 | ;; Because there is no data yet the header is not set 225 | (should-not cb-hdr) 226 | ;; Now send a valid chunk through the stream api 227 | (web/http-post-filter 228 | con "b\r\nhello world\r\n" callback 'stream) 229 | (should cb-hdr) 230 | (should (equal cb-data "hello world")) 231 | ;; Some header tests 232 | (should 233 | (equal "hostname" (gethash 'host cb-hdr))) 234 | (should 235 | (equal "200" (gethash 'status-code cb-hdr))) 236 | (should 237 | (equal "1.1" (gethash 'status-version cb-hdr))) 238 | ;; Now send the final one and catch deleted 239 | (should 240 | (eq 241 | :mock-process-finished 242 | (catch :mock-process-finished 243 | (web/http-post-filter con "0\r\n\r\n" callback 'stream) 244 | (should (equal cb-data "hello world")))))))) 245 | 246 | (ert-deftest web-http-post-filter-batch-mode-content-length () 247 | "Test the filter in batch mode with fixed content-length." 248 | (let* (cb-hdr 249 | cd-data 250 | (con :fake) 251 | (callback (lambda (con hdr data) 252 | (setq cb-hdr hdr) 253 | (setq cb-data data)))) 254 | (fakir-mock-process :fake ((:buffer "HTTP/1.1 200\r 255 | Host: hostname\r 256 | Content-length: 11\r\n")) 257 | (should-not cb-hdr) 258 | (web/http-post-filter con "\r\n" callback 'batch) 259 | (should-not cb-hdr) 260 | (should 261 | (eq 262 | :mock-process-finished 263 | (catch :mock-process-finished 264 | (web/http-post-filter con "hello world" callback 'batch) 265 | (should cb-hdr)))) 266 | (should 267 | (equal "hostname" 268 | (gethash 'host cb-hdr))) 269 | (should 270 | (equal "200" 271 | (gethash 'status-code cb-hdr))) 272 | (should 273 | (equal "1.1" 274 | (gethash 'status-version cb-hdr)))))) 275 | 276 | (ert-deftest web-http-post-filter-batch-mode-chunked () 277 | "Test the filter in batch mode with chunked encoding." 278 | (let* (cb-hdr 279 | cb-data 280 | (con :fake) 281 | (callback (lambda (con hdr data) 282 | (setq cb-hdr hdr) 283 | (setq cb-data data)))) 284 | (fakir-mock-process :fake ((:buffer "HTTP/1.1 200\r 285 | Transfer-encoding: chunked\r 286 | Host: hostname\r\n")) 287 | (should-not cb-hdr) 288 | (web/http-post-filter con "\r\n" callback 'batch) 289 | (should-not cb-hdr) 290 | (web/http-post-filter 291 | con "b\r\nhello world" callback 'batch) 292 | (should-not cb-hdr) 293 | (should-not cb-data) 294 | (should 295 | (eq 296 | :mock-process-finished 297 | (catch :mock-process-finished 298 | (web/http-post-filter 299 | con "\r\n0\r\n\r\n" callback 'batch) 300 | (should cb-hdr) 301 | (should (equal "hello world" cb-data))))) 302 | (should 303 | (equal "hostname" (gethash 'host cb-hdr))) 304 | (should 305 | (equal "200" (gethash 'status-code cb-hdr))) 306 | (should 307 | (equal "1.1" (gethash 'status-version cb-hdr)))))) 308 | 309 | (ert-deftest web-http-post-full () 310 | "Do a full test of the client using an elnode server. 311 | 312 | This tests the parameter passing by having an elnode handler " 313 | (let* (method 314 | path 315 | params 316 | the-end 317 | data-received 318 | (port (elnode-find-free-service))) 319 | ;; Start a server on the port 320 | (unwind-protect 321 | (let ((init-data (make-hash-table 322 | :test 'equal 323 | :size 5))) 324 | (puthash "a" 10 init-data) 325 | (puthash "b" 20 init-data) 326 | ;; Start the server 327 | (elnode-start 328 | (lambda (httpcon) 329 | (setq method (elnode-http-method httpcon)) 330 | (setq path (elnode-http-pathinfo httpcon)) 331 | (setq params (elnode-http-params httpcon)) 332 | (message "the proc buffer is: %s" (process-buffer httpcon)) 333 | (elnode-http-start httpcon 200 '(Content-type . "text/plain")) 334 | (elnode-http-return httpcon "hello world!")) 335 | :port port) 336 | ;; POST some parameters to the server 337 | (web-http-post 338 | (lambda (con header data) 339 | (setq data-received data) 340 | (message "data received is: %s" data-received) 341 | (setq the-end t)) 342 | :path "/" 343 | :port port 344 | :data init-data) 345 | ;; Hang till the client callback finishes 346 | (while (not the-end) 347 | (sit-for 1))) 348 | ;; And when we're done with the server... 349 | (elnode-stop port)) 350 | ;; Now test the data that was POSTed and collected inside the 351 | ;; elnode handler 352 | (should (equal "POST" method)) 353 | (should 354 | (equal 355 | '(("a" . "10")("b" . "20")) 356 | (sort params 357 | (lambda (a b) 358 | (string-lessp (car a) (car b)))))) 359 | ;; And a quick check of the clients receipt of the data from the handler 360 | (should (equal "hello world!" data-received)))) 361 | 362 | (ert-deftest web-http-get-extra-headers () 363 | "Test an HTTP GET by sending out extra-headers" 364 | (let* 365 | ((port (elnode-find-free-service)) 366 | (headers '()) 367 | the-end 368 | data-received) 369 | ;; Start a server on the port 370 | (unwind-protect 371 | ;; Start the server 372 | (progn 373 | (elnode-start 374 | (lambda (httpcon) 375 | (let ((header-values (mapcar (lambda (header) 376 | (append headers (elnode-http-header httpcon header))) 377 | '("Header1" "Header2")))) 378 | (elnode-http-start httpcon 200 '(Content-type . "text/plain")) 379 | (let ((response (mapconcat 'identity header-values ""))) 380 | (elnode-http-return httpcon response)))) 381 | :port port) 382 | ;; GET with extra headers 383 | (web-http-get 384 | (lambda (con header data) 385 | (setq data-received data) 386 | (message "data received is: %s" data-received) 387 | (setq the-end t)) 388 | :path "/" 389 | :host "localhost" 390 | :port port 391 | :extra-headers '(("Header1" . "Value1") 392 | ("Header2" . "Value2"))) 393 | ;; Hang till the client callback finishes 394 | (while (not the-end) 395 | (sit-for 1))) 396 | ;; And when we're done with the server... 397 | (elnode-stop port)) 398 | ;; And a quick check of the contents 399 | (should (equal "Value1Value2" data-received)))) 400 | 401 | 402 | ;;; web-test.el ends here 403 | -------------------------------------------------------------------------------- /web.el: -------------------------------------------------------------------------------- 1 | ;;; web.el --- useful HTTP client -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2012 Nic Ferrier 4 | 5 | ;; Author: Nic Ferrier 6 | ;; Maintainer: Nic Ferrier 7 | ;; Created: 3 Aug 2012 8 | ;; Version: 0.5.2 9 | ;; Url: http://github.com/nicferrier/emacs-web 10 | ;; Keywords: lisp, http, hypermedia 11 | ;; Package-requires: ((dash "2.9.0")(s "1.5.0")) 12 | 13 | ;; This file is NOT part of GNU Emacs. 14 | 15 | ;; This program is free software; you can redistribute it and/or modify 16 | ;; it under the terms of the GNU General Public License as published by 17 | ;; the Free Software Foundation, either version 3 of the License, or 18 | ;; (at your option) any later version. 19 | 20 | ;; This program is distributed in the hope that it will be useful, 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 | ;; GNU General Public License for more details. 24 | 25 | ;; You should have received a copy of the GNU General Public License 26 | ;; along with this program. If not, see . 27 | 28 | ;;; Commentary: 29 | ;; 30 | ;; This is an HTTP client using lexical scope. This makes coding with 31 | ;; callbacks easier than with `url'. This package also provides a 32 | ;; streaming mode where the callback is continually called whenever 33 | ;; data arrives. This is particularly useful for chunked encoding 34 | ;; scenarios. 35 | 36 | ;; Examples: 37 | 38 | ;; GET-ing an HTTP page 39 | ;; 40 | ;; (web-http-get 41 | ;; (lambda (con header data) 42 | ;; (message "the page returned is: %s" data)) 43 | ;; :url "http://emacswiki.org/wiki/NicFerrier") 44 | 45 | ;; POST-ing to an HTTP app 46 | ;; 47 | ;; (web-http-post 48 | ;; (lambda (con header data) 49 | ;; (message "the data is: %S" data)) 50 | ;; :url "http://example.org/postplace/" 51 | ;; :data '(("parameter1" . "data") 52 | ;; ("parameter2" . "more data"))) 53 | 54 | ;;; Code: 55 | 56 | ;; Style-note: This codes uses the Emacs style of: 57 | ;; 58 | ;; web/private-function 59 | ;; 60 | ;; for private functions. 61 | 62 | (eval-when-compile 63 | (require 'cl)) 64 | (require 'cl-lib) 65 | (require 'url-parse) 66 | (require 'json) 67 | (require 'browse-url) 68 | (require 'dash) 69 | (require 'time-stamp) 70 | (require 'rx) 71 | (require 's) 72 | 73 | (defconst web/request-mimetype 74 | 'application/x-www-form-urlencoded 75 | "The default MIME type used for requests.") 76 | 77 | (defconst web-multipart-mimetype 78 | 'multipart/form-data 79 | "The MIME type used for multipart requests.") 80 | 81 | (defun web-header-parse (data) 82 | "Parse an HTTP response header. 83 | 84 | Each header line is stored in the hash with a symbol form of the 85 | header name. 86 | 87 | The status line is expected to be the first line of the data. 88 | The status is stored in the header as well with the following 89 | keys: 90 | 91 | status-version 92 | status-code 93 | status-string 94 | 95 | which are stored as symbols the same as the normal header keys." 96 | (let* ((header-hash (make-hash-table :test 'equal)) 97 | (header-lines (split-string data "\r\n")) 98 | (status-line (car header-lines))) 99 | (when (string-match 100 | "HTTP/\\([0-9.]+\\) \\([0-9]\\{3\\}\\)\\( \\(.*\\)\\)*" 101 | status-line) 102 | (puthash 'status-version (match-string 1 status-line) header-hash) 103 | (puthash 'status-code (match-string 2 status-line) header-hash) 104 | (puthash 'status-string 105 | (or (match-string 4 status-line) "") 106 | header-hash)) 107 | (cl-loop for line in (cdr header-lines) 108 | if (string-match 109 | "^\\([A-Za-z0-9.-]+\\):[ ]*\\(.*\\)" 110 | line) 111 | do 112 | (let ((name (intern (downcase (match-string 1 line)))) 113 | (value (match-string 2 line))) 114 | (puthash name value header-hash))) 115 | header-hash)) 116 | 117 | (defun web/chunked-decode-stream (con data consumer) 118 | "Decode the chunked encoding stream on the process CON. 119 | 120 | DATA is a lump of data from the stream, as passed from a filter 121 | function for example. 122 | 123 | CONSUMER is a function that will be called with the resulting 124 | data like: 125 | 126 | CON CHUNK 127 | 128 | the CON is the same as the CON in this call. The `chunk' is the 129 | chunk that has been read. Only complete chunks are sent to the 130 | CONSUMER. 131 | 132 | When the chunked stream ends the CONSUMER is called with CHUNK 133 | being `:done'. This can be used to do clean up. It is NOT 134 | expected that the callback will have to clean up the CON, that 135 | should be done by the caller. 136 | 137 | CON is used to store state with the process property 138 | `:chunked-encoding-buffer' being used as a buffer." 139 | ;; Make data the whole chunk 140 | (setq data (let ((saved (process-get con :chunked-encoding-buffer))) 141 | (if saved (concat saved data) data))) 142 | (if (not (string-match "^\\([0-9A-Fa-f]+\\)\r\n" data)) 143 | (process-put con :chunked-encoding-buffer data) 144 | ;; We have identified a chunk 145 | (let* ((chunk-num (match-string 1 data)) 146 | (chunk-size (string-to-number chunk-num 16)) 147 | (toread-pos (+ 2 (length chunk-num))) ; +2 == \r\n after chunk sz 148 | (chunk-end (+ toread-pos chunk-size))) 149 | (if (< (length data) (+ 2 chunk-end)) ; +2 == \r\n at end of chunk 150 | (process-put con :chunked-encoding-buffer data) 151 | (let ((toread (substring data toread-pos chunk-end)) 152 | (trailing (substring data chunk-end (+ chunk-end 2))) 153 | (left (substring data (+ chunk-end 2)))) 154 | (if trailing 155 | (assert (equal trailing "\r\n") t)) 156 | (cond 157 | ((equal 0 chunk-size) 158 | ;; Finished 159 | (funcall consumer con :done) 160 | :done) 161 | ((> chunk-size (length toread)) 162 | (process-put con :chunked-encoding-buffer data)) 163 | (t 164 | ;; Eat the data 165 | (funcall consumer con toread) 166 | ;; Clear the buffer 167 | (process-put con :chunked-encoding-buffer "") 168 | ;; Go round again if we need to 169 | (if left 170 | (web/chunked-decode-stream 171 | con left consumer))))))))) 172 | 173 | (defun web/cleanup-process (proc) 174 | "Kill the buffer and clean the process." 175 | (let ((buf (process-buffer proc))) 176 | (delete-process proc) 177 | (kill-buffer buf))) 178 | 179 | 180 | (defconst web-cookie-jar-file 181 | (expand-file-name "web-cookies" user-emacs-directory) 182 | "The location of the cookie jar file. 183 | 184 | Override this with dynamic scope if you need to use a specific 185 | file.") 186 | 187 | (defun web/cookie-split (cookie-header) 188 | (when (string-match "\\([^=]+\\)=\\(.*\\)" cookie-header) 189 | (let* ((name (match-string 1 cookie-header)) 190 | (cookie-str (match-string 2 cookie-header)) 191 | (parts (s-split ";" cookie-str)) 192 | (value (car parts)) 193 | (args (--keep (s-split "=" (s-trim it) t) (cdr parts)))) 194 | (list name value args)))) 195 | 196 | (defun web/cookie-handler (con hdr) 197 | "Maintains a cookie jar. 198 | 199 | Cookies are written to file \"web-cookie-jar-file\" in a JSON 200 | format but prefixed by the url that caused the cookie to be set." 201 | (save-match-data 202 | (let ((cookie-hdr (gethash 'set-cookie hdr))) 203 | (when (string-match "\\([^=]+\\)=\\(.*\\)" cookie-hdr) 204 | (let* ((name (match-string 1 cookie-hdr)) 205 | (cookie-str (match-string 2 cookie-hdr)) 206 | (parts (s-split ";" cookie-str)) 207 | (value (car parts)) 208 | (args (--keep (s-split "=" (s-trim it) t) (cdr parts)))) 209 | (condition-case err 210 | (when web-cookie-jar-file 211 | (with-current-buffer (find-file-noselect web-cookie-jar-file) 212 | (goto-char (point-min)) 213 | (let ((url (process-get con :web-url)) 214 | (json (json-encode `(,name ,value ,args)))) 215 | (save-match-data 216 | (if (re-search-forward 217 | (rx-to-string `(and bol ,url " " (group-n 1 (* anything)))) 218 | nil t) 219 | (replace-match json nil t nil 1) 220 | (goto-char (point-max)) 221 | (insert url " " json "\n")))) 222 | (write-file (buffer-file-name)))) 223 | (error (message 224 | "web/cookie-handler: '%s' writing cookies to '%s'" 225 | err web-cookie-jar-file)))))))) 226 | 227 | (defun web/chunked-filter (callback con mode header data) 228 | "Filter for the client when we're doing chunking." 229 | (cond 230 | ((eq mode 'stream) 231 | (funcall callback con header data) 232 | (when (eq data :done) 233 | (web/cleanup-process con))) 234 | ((and (eq mode 'batch) 235 | (eq data :done)) 236 | (funcall callback con header (process-get con :web-buffer)) 237 | (web/cleanup-process con)) 238 | (t 239 | (process-put 240 | con :web-buffer 241 | (concat (or (process-get con :web-buffer) "") 242 | data))))) 243 | 244 | (defun web/content-length-filter (callback con mode header data) 245 | "Does the content-length filtering." 246 | (let ((content-len (string-to-number (gethash 'content-length header)))) 247 | (if (eq mode 'batch) 248 | (let ((so-far (concat (process-get con :web-buffer) data))) 249 | (if (> content-len (length so-far)) 250 | (process-put con :web-buffer so-far) 251 | ;; We have all the data, callback and then kill the process 252 | (unwind-protect 253 | (funcall callback con header so-far) 254 | (web/cleanup-process con)))) 255 | ;; Else we're in stream mode so deliver the bits 256 | (let ((collected (+ (or (process-get con :web-len) 0) 257 | (length data)))) 258 | (if (> content-len collected) 259 | (progn 260 | (process-put con :web-len collected) 261 | (funcall callback con header data)) 262 | ;; Else we're done 263 | (funcall callback con header data) 264 | (funcall callback con header :done) 265 | (web/cleanup-process con)))))) 266 | 267 | (defun web/http-post-filter (con data callback mode) 268 | "Filter function for HTTP POST. 269 | 270 | Not actually a filter function because it also receives the 271 | CALLBACK and the MODE from the actual filter function, a lexical 272 | closure inside `web-http-post'. 273 | 274 | CALLBACK is a user supplied function handling the return from the 275 | HTTP server. 276 | 277 | MODE comes from the `web-http-post' call. This function 278 | handles the MODE by either streaming the data to the CALLBACK or 279 | by collecting it and then batching it to the CALLBACK." 280 | (with-current-buffer (process-buffer con) 281 | (let ((header (process-get con :http-header))) 282 | (if (not header) 283 | (save-excursion 284 | (goto-char (point-max)) 285 | (insert data) 286 | ;; Find the header if we don't have it 287 | (if (and (not header) 288 | (progn 289 | (goto-char (point-min)) 290 | (re-search-forward "\r\n\r\n" nil t))) 291 | (let ((hdr (web-header-parse 292 | (buffer-substring (point-min) (point-max)))) 293 | ;; From the point of the end of header to the end 294 | ;; is the data we need... this may be nothing. 295 | (part-data (if (> (point-max) (point)) 296 | (buffer-substring (point) (point-max)) 297 | nil))) 298 | (process-put con :http-header-pos (point)) 299 | (process-put con :http-header hdr) 300 | ;; If we have more data call ourselves to process it 301 | (when part-data 302 | (web/http-post-filter con part-data callback mode))))) 303 | ;; Else we have the header, read the body and call callback 304 | ;; FIXME - we could do cookie handling here... and auto redirect 305 | (cond 306 | ((equal "chunked" (gethash 'transfer-encoding header)) 307 | (web/chunked-decode-stream 308 | con data 309 | ;; FIXME we still need the callback to know if this is completion 310 | (lambda (con data) 311 | (web/chunked-filter callback con mode header data)))) 312 | ;; We have a content-length header so just buffer that much data 313 | ((gethash 'content-length header) 314 | (web/content-length-filter callback con mode header data))))))) 315 | 316 | (defun web/key-value-encode (key value) 317 | "Encode a KEY and VALUE for url encoding." 318 | (cond 319 | ((or 320 | (numberp value) 321 | (stringp value)) 322 | (format 323 | "%s=%s" 324 | (url-hexify-string (format "%s" key)) 325 | (url-hexify-string (format "%s" value)))) 326 | (t 327 | (format "%s" (url-hexify-string (format "%s" key)))))) 328 | 329 | (defun web-to-query-string (object) 330 | "Convert OBJECT (a hash-table or alist) to an HTTP query string. 331 | 332 | If OBJECT is of type `hash-table' then the keys and values of the 333 | hash are iterated into the string depending on their types. 334 | 335 | Keys with `number' and `string' values are encoded as 336 | \"key=value\" in the resulting query. 337 | 338 | Keys with a boolean value (or any other value not already 339 | described) are encoded just as \"key\". 340 | 341 | Keys may be symbols or strings." 342 | (mapconcat 343 | (lambda (pair) 344 | (web/key-value-encode (car pair) (cdr pair))) 345 | (cond 346 | ((hash-table-p object) 347 | (let (result) 348 | (maphash 349 | (lambda (key value) 350 | (setq result (append (list (cons key value)) result))) 351 | object) 352 | (reverse result))) 353 | ((listp object) 354 | object)) 355 | "&")) 356 | 357 | 358 | ;; What a multipart body looks like 359 | ;; Content-type: multipart/form-data, boundary=AaB03x 360 | ;; 361 | ;; --AaB03x 362 | ;; content-disposition: form-data; name="field1" 363 | ;; 364 | ;; Joe Blow 365 | ;; --AaB03x 366 | ;; content-disposition: form-data; name="pics"; filename="file1.txt" 367 | ;; Content-Type: text/plain 368 | ;; 369 | ;; ... contents of file1.txt ... 370 | ;; --AaB03x-- 371 | 372 | (defun web/to-multipart-boundary () 373 | "Make a boundary marker." 374 | (sha1 (format "%s%s" (random) (time-stamp-string)))) 375 | 376 | (defun web/is-file (kv) 377 | (let ((b (cdr kv))) 378 | (and (bufferp b) (buffer-file-name b) b))) 379 | 380 | (defun web-to-multipart (data) 381 | "Convert DATA, an ALIST or Hashtable, into a Multipart body. 382 | 383 | Returns a string of the multipart body propertized with 384 | `:boundary' with a value of the boundary string." 385 | (let* ((boundary (web/to-multipart-boundary)) 386 | (parts (mapconcat ; first the params ... 387 | (lambda (kv) 388 | (let ((name (car kv)) 389 | (value (cdr kv))) 390 | (format "--%s\r 391 | Content-Disposition: form-data; name=\"%s\"\r\n\r\n%s" 392 | boundary name value))) 393 | (-filter (lambda (kv) (not (web/is-file kv))) data) "\r\n")) 394 | (files (mapconcat ; then the files ... 395 | (lambda (kv) 396 | (let* ((name (car kv)) 397 | (buffer (cdr kv)) 398 | (filename (buffer-file-name buffer)) 399 | (mime-enc (or 400 | (mm-default-file-encoding filename) 401 | "text/plain"))) 402 | (format "--%s\r 403 | Content-Transfer-Encoding: BASE64\r 404 | Content-Disposition: form-data; name=\"%s\"; filename=\"%s\"\r 405 | Content-Type: %s\r\n\r\n%s" 406 | boundary name (file-name-nondirectory filename) mime-enc 407 | ;; FIXME - We should base64 the content when appropriate 408 | (base64-encode-string 409 | (apply 410 | 'encode-coding-string 411 | (with-current-buffer buffer 412 | (list (buffer-string) buffer-file-coding-system))))))) 413 | (-filter 'web/is-file data) "\r\n"))) 414 | (propertize 415 | (format "%s%s--%s--\r\n" 416 | (if (and parts (not (equal parts ""))) (concat parts "\r\n") "") 417 | (if (and files (not (equal files ""))) (concat files "\r\n") "") 418 | boundary) 419 | :boundary boundary))) 420 | 421 | (defvar web-log-info nil 422 | "Whether to log info messages, specifically from the sentinel.") 423 | 424 | (defun web/http-post-sentinel (con evt) 425 | "Sentinel for the HTTP POST." 426 | ;; FIXME I'm sure this needs to be different - but how? it needs to 427 | ;; communicate to the filter function? 428 | (cond 429 | ((equal evt "closed\n") 430 | (when web-log-info 431 | (message "web/http-post-sentinel http client post closed"))) 432 | ((equal evt "deleted\n") 433 | (delete-process con) 434 | (when web-log-info 435 | (message "web/http-post-sentinel http client post deleted"))) 436 | ((equal evt "connection broken by peer\n") 437 | (when web-log-info 438 | (message "web/http-post-sentinel http client broken"))) 439 | (t 440 | (when web-log-info 441 | (message "web/http-post-sentinel unexpected evt: %s" evt))))) 442 | 443 | (defun web/http-post-sentinel-with-logging (con evt logging) 444 | "Map a logging variable into the sentinel." 445 | (let ((web-log-info logging)) 446 | (web/http-post-sentinel con evt))) 447 | 448 | (defun web/header-list (headers) 449 | "Convert HEADERS (hash-table or alist) into a header list." 450 | (cl-labels 451 | ((hdr (key val) 452 | (format "%s: %s\r\n" key val))) 453 | (cond 454 | ((hash-table-p headers) 455 | (let (res) 456 | (maphash 457 | (lambda (key val) 458 | (setq res (append (list (hdr key val)) res))) 459 | headers) 460 | res)) 461 | ((listp headers) 462 | (mapcar 463 | (lambda (pair) (hdr (car pair)(cdr pair))) 464 | headers))))) 465 | 466 | (defun web/header-string (method headers mime-type to-send) 467 | "Return a string of all the HEADERS formatted for a request. 468 | 469 | Content-Type and Content-Length are both computed automatically. 470 | 471 | METHOD specifies the usual HTTP method and therefore whether 472 | there might be a Content-Type on the request body. 473 | 474 | MIME-TYPE specifies the MIME-TYPE of any TO-SEND. 475 | 476 | TO-SEND is any request body that needs to be sent. TO-SEND may 477 | be propertized with a multipart boundary marker which needs to be 478 | set on the Content-Type header." 479 | (let ((http-hdrs (web/header-list headers)) 480 | (boundary (and to-send 481 | (plist-get (text-properties-at 0 to-send) :boundary)))) 482 | (when (member method '("POST" "PUT")) 483 | (when (> (length to-send) 1) 484 | (push (format 485 | "Content-type: %s%s\r\n" mime-type 486 | (if boundary (format "; boundary=%s" boundary) "")) 487 | http-hdrs))) 488 | (when (and to-send (> (length to-send) 0)) 489 | (push 490 | (format "Content-length: %d\r\n" (length to-send)) 491 | http-hdrs)) 492 | (cl-loop for hdr in http-hdrs if hdr concat hdr))) 493 | 494 | (defun web/log (log) 495 | (when log 496 | (with-current-buffer (get-buffer-create "*web-log*") 497 | (save-excursion 498 | (goto-char (point-max)) 499 | (insert "web-http ") 500 | (insert (format "%s" log)) 501 | (insert "\n"))))) 502 | 503 | ;;;###autoload 504 | (cl-defun web-http-call (method 505 | callback 506 | &key 507 | url 508 | (host "localhost") 509 | (port 80) 510 | secure 511 | (path "/") 512 | extra-headers 513 | data 514 | (mime-type web/request-mimetype) 515 | (mode 'batch) 516 | logging) 517 | "Make an HTTP method to the URL or the HOST, PORT, PATH and send DATA. 518 | 519 | If URL is specified then it takes precedence over SECURE, HOST, 520 | PORT and PATH. URL may be HTTP or HTTPS. 521 | 522 | Important note: any query in URL is currently IGNORED! 523 | 524 | SECURE is `nil' by default but if `t' then SSL is used. 525 | 526 | PORT is 80 by default. Even if SECURE it `t'. If you manually 527 | specify SECURE you should manually specify PORT to be 443. Using 528 | URL negates the need for that, an SSL URL will work correctly. 529 | 530 | The URL connected to (whether specified by URL or by the HOST and 531 | PORT) is recorded on the resulting connection as the process 532 | property `:web-url'. 533 | 534 | EXTRA-HEADERS is an alist or a hash-table of extra headers to 535 | send to the server. 536 | 537 | The full set of headers sent to the server is recorded on the 538 | connection with the process property `:web-headers'. 539 | 540 | DATA is of MIME-TYPE. We try to interpret DATA and MIME-TYPE 541 | usefully: 542 | 543 | If MIME-TYPE is `application/form-www-url-encoded' then 544 | `web-to-query-string' is used to to format the DATA into a POST 545 | body. 546 | 547 | If MIME-TYPE is `multipart/form-data' then `web-to-multipart' is 548 | called to get a POST body. 549 | 550 | Any data sent to the server is recorded on the connection with 551 | the process property `:web-sent'. 552 | 553 | When the request comes back the CALLBACK is called. CALLBACK is 554 | always passed 3 arguments: the HTTP connection which is a process 555 | object, the HTTP header which is a `hash-table' and `data', which 556 | is normally a string. `data' depends somewhat on the context. 557 | See below. 558 | 559 | MODE defines what it means for the request to cause the CALLBACK 560 | to be fired. When MODE is `stream' then the CALLBACK is called 561 | for every chunk of data received after the header has arrived. 562 | This allows streaming data to somewhere else; hence `stream' 563 | mode. In this mode CALLBACK's `data' argument is a single chunk 564 | of the stream or `:done' when the stream ends. 565 | 566 | The default MODE is `batch' which collects all the data from the 567 | response before calling CALLBACK with all the data as a string." 568 | (when logging (web/log url)) 569 | (let* ((mode (or mode 'batch)) 570 | (parsed-url (url-generic-parse-url 571 | (if url url 572 | (format "%s://%s:%d%s" 573 | (if secure "https" "http") 574 | host port path)))) 575 | (host (progn 576 | (assert 577 | (or (equal (url-type parsed-url) "http") 578 | (equal (url-type parsed-url) "https")) 579 | t "The url scheme must be http") 580 | (url-host parsed-url))) 581 | (port (url-port parsed-url)) 582 | (path (let ((pth (url-filename parsed-url))) 583 | (if (equal pth "") "/" pth))) 584 | (dest (format "%s:%s%s" host port path)) 585 | (buf (generate-new-buffer dest)) 586 | (con (open-network-stream 587 | (format "web-http-post-%s" dest) 588 | buf host port 589 | :type (cond 590 | ((equal (url-type parsed-url) "http") 'plain) 591 | ((equal (url-type parsed-url) "https") 'tls))))) 592 | ;; We must use this coding system or the web dies 593 | (set-process-coding-system con 'raw-text-unix 'raw-text-unix) 594 | (set-process-sentinel con (lambda (con evt) 595 | (web/http-post-sentinel-with-logging 596 | con evt logging))) 597 | (set-process-filter 598 | con 599 | (lambda (con data) 600 | (let ((mode mode) 601 | (cb callback)) 602 | (web/http-post-filter con data cb mode)))) 603 | ;; Send the request 604 | (let* 605 | ((sym-mt (if (symbolp mime-type) mime-type (intern mime-type))) 606 | (to-send (case sym-mt 607 | ('multipart/form-data 608 | (web-to-multipart data)) 609 | ('application/x-www-form-urlencoded 610 | (web-to-query-string data)) 611 | ;; By default just have the data 612 | (t data))) 613 | (headers (or (web/header-string 614 | method extra-headers mime-type to-send) 615 | "")) 616 | (submission 617 | (format 618 | "%s %s HTTP/1.1\r\nHost: %s\r\n%s\r\n%s" 619 | method path host 620 | headers 621 | (if to-send to-send "")))) 622 | ;; Set some data on the connection process so users will be able to find data 623 | (process-put con :web-url (format "http://%s" dest)) 624 | (process-put con :web-headers headers) 625 | (process-put con :web-sent to-send) 626 | (when logging (web/log submission)) 627 | (process-send-string con submission)) 628 | con)) 629 | 630 | ;;;###autoload 631 | (cl-defun web-http-get (callback 632 | &key 633 | url 634 | (host "localhost") 635 | (port 80) 636 | (path "/") 637 | extra-headers 638 | (mode 'batch) 639 | (logging t)) 640 | "Make a GET calling CALLBACK with the result. 641 | 642 | For information on URL or PATH, HOST, PORT and also EXTRA-HEADERS 643 | and MODE see `web-http-call'. 644 | 645 | The callback probably won't work unless you set `lexical-binding' 646 | to `t'." 647 | (web-http-call 648 | "GET" 649 | callback 650 | :url url 651 | :host host 652 | :port port 653 | :path path 654 | :extra-headers extra-headers 655 | :mode mode 656 | :logging logging)) 657 | 658 | ;;;###autoload 659 | (cl-defun web-http-post (callback 660 | &key 661 | url 662 | (host "localhost") 663 | (port 80) 664 | (path "/") 665 | extra-headers 666 | data 667 | (mime-type web/request-mimetype) 668 | (mode 'batch) 669 | (logging t)) 670 | "Make a POST and call CALLBACK with the result. 671 | 672 | For information on URL or PATH, HOST, PORT and also MODE see 673 | `web-http-call'. 674 | 675 | The callback probably won't work unless you set `lexical-binding' 676 | to `t'." 677 | (web-http-call 678 | "POST" 679 | callback 680 | :url url 681 | :host host 682 | :port port 683 | :path path 684 | :extra-headers extra-headers 685 | :data data 686 | :mime-type mime-type 687 | :logging logging 688 | :mode mode)) 689 | 690 | (defvar web-json-expected-mimetypes-list 691 | '("application/json" 692 | "application/x-javascript" 693 | "text/javascript" 694 | "text/x-javascript" 695 | "text/x-json") 696 | "List of mimetypes that we use to accept JSON.") 697 | 698 | (defun web-json-default-expectation-failure (data http-con headers) 699 | "Default expectation callback for JSON expectation errors." 700 | (error "web-json failed to read %S as json with %s and %s" 701 | data http-con headers)) 702 | 703 | (cl-defun web/json-parse (json-candidate-data 704 | &key 705 | (json-array-type json-array-type) 706 | (json-object-type json-object-type) 707 | (json-key-type json-key-type)) 708 | "Parse DATA as JSON and return the result." 709 | (json-read-from-string json-candidate-data)) 710 | 711 | ;;;###autoload 712 | (cl-defun web-json-post (callback 713 | &key 714 | url data headers 715 | (mime-type web/request-mimetype) 716 | (logging t) 717 | (json-array-type json-array-type) 718 | (json-object-type json-object-type) 719 | (json-key-type json-key-type) 720 | (expectation-failure-callback 721 | 'web-json-default-expectation-failure)) 722 | "POST DATA to URL expecting a JSON response sent to CALLBACK. 723 | 724 | See `web-json-expected-mimetypes-list' for the list of Mime Types 725 | we accept JSON for. This may be let bound. If the expectation 726 | is not met then EXPECTATION-FAILURE-CALLBACK is called being 727 | passed the CALLBACK parameters. By default 728 | EXPECTATION-FAILURE-CALLBACK is 729 | `web-json-default-expectation-failure'. 730 | 731 | The CALLBACK is called as: 732 | 733 | CALLBACK RESPONSE-DATA HTTPCON RESPONSE-HEADER 734 | 735 | so the function may be defined like this: 736 | 737 | (lambda (data &rest stuff) ...) 738 | 739 | HEADERS may be specified, these are treated as extra-headers to 740 | be sent with the request. 741 | 742 | The DATA is sent as `application/x-www-form-urlencoded' by 743 | default, MIME-TYPE can change that. 744 | 745 | JSON-ARRAY-TYPE, JSON-OBJECT-TYPE and JSON-KEY-TYPE, if present, 746 | are used to let bind the `json-read' variables of the same name 747 | affecting the resulting lisp structure." 748 | (let ((closed-json-array-type json-array-type) 749 | (closed-json-object-type json-object-type) 750 | (closed-json-key-type json-key-type)) 751 | (web-http-post 752 | (lambda (httpcon header http-data) 753 | ;; Add a member test for the MIMETYPE expectation 754 | (let ((lisp-data 755 | (condition-case err 756 | (web/json-parse 757 | http-data 758 | :json-array-type closed-json-array-type 759 | :json-object-type closed-json-object-type 760 | :json-key-type closed-json-key-type) 761 | (error 762 | (when logging 763 | (message "web-json-post expectation failure %S" err)) 764 | (funcall expectation-failure-callback 765 | http-data httpcon header))))) 766 | (funcall callback lisp-data httpcon header))) 767 | :url url 768 | :data data 769 | :mime-type mime-type 770 | :extra-headers headers 771 | :logging logging))) 772 | 773 | (defvar web-get-history-list nil 774 | "History for `web-get' interactive forms.") 775 | 776 | ;;;###autoload 777 | (defun web-get (url &optional buffer) 778 | "Get the specified URL into the BUFFER." 779 | (interactive 780 | (list 781 | (let ((def-url (browse-url-url-at-point))) 782 | (read-from-minibuffer "URL: " def-url nil nil 'web-get-history-list)) 783 | (when current-prefix-arg 784 | (read-buffer "Buffer: " '("*web-get*"))))) 785 | (let ((handler 786 | (lambda (httpc header data) 787 | (with-current-buffer 788 | (if (bufferp buffer) 789 | buffer 790 | (if (stringp buffer) 791 | (generate-new-buffer buffer) 792 | (generate-new-buffer "*web-get*"))) 793 | (goto-char (point-max)) 794 | (insert data) 795 | (switch-to-buffer (current-buffer)))))) 796 | (web-http-get handler :url url))) 797 | 798 | (defun web-header (header name &optional convert) 799 | "Look up NAME in HEADER." 800 | (let ((val (if (hash-table-p header) 801 | (let ((v (gethash (intern name) header))) 802 | (when v (cons name v))) 803 | ;; Else presume it's an alist 804 | (assoc name header)))) 805 | (when val 806 | (case convert 807 | (:num (string-to-number (cdr val))) 808 | (t val))))) 809 | 810 | 811 | (provide 'web) 812 | 813 | ;;; web.el ends here 814 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | --------------------------------------------------------------------------------