Mercurial > hg > xemacs-beta

comparison lisp/url/url-http.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; url-http.el,v --- HTTP Uniform Resource Locator retrieval code
2 ;; Author: wmperry
3 ;; Created: 1996/05/29 15:07:01
4 ;; Version: 1.19
5 ;; Keywords: comm, data, processes
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
9 ;;;
10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
11 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2, or (at your option)
15 ;;; any later version.
16 ;;;
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27 (require 'url-vars)
28 (require 'url-parse)
29 (require 'url-cookie)
30 (require 'timezone)
31
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;;; Support for HTTP/1.0 MIME messages
34 ;;; ----------------------------------
35 ;;; These functions are the guts of the HTTP/0.9 and HTTP/1.0 transfer
36 ;;; protocol, handling access authorization, format negotiation, the
37 ;;; whole nine yards.
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 (defun url-parse-viewer-types ()
40 "Create a string usable for an Accept: header from mm-mime-data"
41 (let ((tmp mm-mime-data)
42 label mjr mnr cur-mnr (str ""))
43 (while tmp
44 (setq mnr (cdr (car tmp))
45 mjr (car (car tmp))
46 tmp (cdr tmp))
47 (while mnr
48 (setq cur-mnr (car mnr)
49 label (concat mjr "/" (if (string= ".*" (car cur-mnr))
50 "*"
51 (car cur-mnr))))
52 (cond
53 ((string-match (regexp-quote label) str) nil)
54 ((> (+ (% (length str) 60)
55 (length (concat ", " mjr "/" (car cur-mnr)))) 60)
56 (setq str (format "%s\r\nAccept: %s" str label)))
57 (t
58 (setq str (format "%s, %s" str label))))
59 (setq mnr (cdr mnr))))
60 (substring str 2 nil)))
61
62 (defun url-create-multipart-request (file-list)
63 "Create a multi-part MIME request for all files in FILE-LIST"
64 (let ((separator (current-time-string))
65 (content "message/http-request")
66 (ref-url nil))
67 (setq separator
68 (concat "separator-"
69 (mapconcat
70 (function
71 (lambda (char)
72 (if (memq char url-mime-separator-chars)
73 (char-to-string char) ""))) separator "")))
74 (cons separator
75 (concat
76 (mapconcat
77 (function
78 (lambda (file)
79 (concat "--" separator "\nContent-type: " content "\n\n"
80 (url-create-mime-request file ref-url)))) file-list
81 "\n")
82 "--" separator))))
83
84 (defun url-create-message-id ()
85 "Generate a string suitable for the Message-ID field of a request"
86 (concat "<" (url-create-unique-id) "@" (system-name) ">"))
87
88 (defun url-create-unique-id ()
89 ;; Generate unique ID from user name and current time.
90 (let* ((date (current-time-string))
91 (name (user-login-name))
92 (dateinfo (and date (timezone-parse-date date)))
93 (timeinfo (and date (timezone-parse-time (aref dateinfo 3)))))
94 (if (and dateinfo timeinfo)
95 (concat (upcase name) "."
96 (aref dateinfo 0) ; Year
97 (aref dateinfo 1) ; Month
98 (aref dateinfo 2) ; Day
99 (aref timeinfo 0) ; Hour
100 (aref timeinfo 1) ; Minute
101 (aref timeinfo 2) ; Second
102 )
103 (error "Cannot understand current-time-string: %s." date))
104 ))
105
106 (defun url-http-user-agent-string ()
107 (if (or (eq url-privacy-level 'paranoid)
108 (and (listp url-privacy-level)
109 (memq 'agent url-privacy-level)))
110 ""
111 (format "User-Agent: %s/%s URL/%s%s\r\n"
112 url-package-name url-package-version
113 url-version
114 (cond
115 ((and url-os-type url-system-type)
116 (concat " (" url-os-type "; " url-system-type ")"))
117 ((or url-os-type url-system-type)
118 (concat " (" (or url-system-type url-os-type) ")"))
119 (t "")))))
120
121 (defun url-create-mime-request (fname ref-url)
122 "Create a MIME request for fname, referred to by REF-URL."
123 (let* ((extra-headers)
124 (request nil)
125 (url (url-view-url t))
126 (no-cache (cdr-safe (assoc "Pragma" url-request-extra-headers)))
127 (proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization"
128 url-request-extra-headers))
129 (not (boundp 'proxy-info)))
130 nil
131 (let ((url-basic-auth-storage
132 url-proxy-basic-authentication))
133 (url-get-authentication url nil 'any nil))))
134 (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers))
135 nil
136 (url-get-authentication (or
137 (and (boundp 'proxy-info)
138 proxy-info)
139 url) nil 'any nil))))
140 (setq no-cache (and no-cache (string-match "no-cache" no-cache)))
141 (if auth
142 (setq auth (concat "Authorization: " auth "\r\n")))
143 (if proxy-auth
144 (setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n")))
145
146 (if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil")
147 (string= ref-url "")))
148 (setq ref-url nil))
149
150 (if (or (memq url-privacy-level '(low high paranoid))
151 (and (listp url-privacy-level)
152 (memq 'lastloc url-privacy-level)))
153 (setq ref-url nil))
154
155 (setq extra-headers (mapconcat
156 (function (lambda (x)
157 (concat (car x) ": " (cdr x))))
158 url-request-extra-headers "\r\n"))
159 (if (not (equal extra-headers ""))
160 (setq extra-headers (concat extra-headers "\r\n")))
161 (setq request
162 (format
163 (concat
164 "%s %s HTTP/1.0\r\n" ; The request
165 "MIME-Version: 1.0\r\n" ; Version of MIME we speaketh
166 "Extension: %s\r\n" ; HTTP extensions we support
167 "Host: %s\r\n" ; Who we want to talk to
168 "%s" ; Who its from
169 "Accept-encoding: %s\r\n" ; Encodings we understand
170 "Accept-language: %s\r\n" ; Languages we understand
171 "Accept: %s\r\n" ; Types we understand
172 "%s" ; User agent
173 "%s" ; Authorization
174 "%s" ; Cookies
175 "%s" ; Proxy Authorization
176 "%s" ; If-modified-since
177 "%s" ; Where we came from
178 "%s" ; Any extra headers
179 "%s" ; Any data
180 "\r\n") ; End request
181 (or url-request-method "GET")
182 fname
183 (or url-extensions-header "none")
184 (or url-current-server "UNKNOWN.HOST.NAME")
185 (if url-personal-mail-address
186 (concat "From: " url-personal-mail-address "\r\n")
187 "")
188 url-mime-encoding-string
189 url-mime-language-string
190 url-mime-accept-string
191 (url-http-user-agent-string)
192 (or auth "")
193 (url-cookie-generate-header-lines url-current-server
194 fname
195 (string-match "https"
196 url-current-type))
197 (or proxy-auth "")
198 (if (and (not no-cache)
199 (member url-request-method '("GET" nil)))
200 (let ((tm (url-is-cached url)))
201 (if tm
202 (concat "If-modified-since: "
203 (url-get-normalized-date tm) "\r\n")
204 ""))
205 "")
206 (if ref-url (concat "Referer: " ref-url "\r\n") "")
207 extra-headers
208 (if url-request-data
209 (format "Content-length: %d\r\n\r\n%s"
210 (length url-request-data) url-request-data)
211 "")))
212 request))
213
214 (defun url-setup-reload-timer (url must-be-viewing &optional time)
215 ;; Set up a timer to load URL at optional TIME. If TIME is unspecified,
216 ;; default to 5 seconds. Only loads document if MUST-BE-VIEWING is the
217 ;; current URL when the timer expires."
218 (or time (setq time 5))
219 (let ((func
220 (` (lambda ()
221 (if (equal (url-view-url t) (, must-be-viewing))
222 (let ((w3-reuse-buffers 'no))
223 (if (equal (, url) (url-view-url t))
224 (kill-buffer (current-buffer)))
225 (w3-fetch (, url))))))))
226 (cond
227 ((featurep 'itimer)
228 (start-itimer "reloader" func time))
229 ((fboundp 'run-at-time)
230 (run-at-time time nil func))
231 (t
232 (url-warn 'url "Cannot set up timer for automatic reload, sorry!")))))
233
234 (defun url-handle-refresh-header (reload)
235 (if (and reload
236 url-honor-refresh-requests
237 (or (eq url-honor-refresh-requests t)
238 (funcall url-confirmation-func "Honor refresh request? ")))
239 (let ((uri (url-view-url t)))
240 (if (string-match ";" reload)
241 (progn
242 (setq uri (substring reload (match-end 0) nil)
243 reload (substring reload 0 (match-beginning 0)))
244 (if (string-match
245 "ur[li][ \t]*=[ \t]*\"*\\([^ \t\"]+\\)\"*"
246 uri)
247 (setq uri (url-match uri 1)))
248 (setq uri (url-expand-file-name uri (url-view-url t)))))
249 (url-setup-reload-timer uri (url-view-url t)
250 (string-to-int (or reload "5"))))))
251
252 (defun url-parse-mime-headers (&optional no-delete switch-buff)
253 ;; Parse mime headers and remove them from the html
254 (and switch-buff (set-buffer url-working-buffer))
255 (let* ((st (point-min))
256 (nd (progn
257 (goto-char (point-min))
258 (skip-chars-forward " \t\n")
259 (if (re-search-forward "^\r*$" nil t)
260 (1+ (point))
261 (point-max))))
262 save-pos
263 status
264 class
265 hname
266 hvalu
267 result
268 )
269 (narrow-to-region st (min nd (point-max)))
270 (goto-char (point-min))
271 (skip-chars-forward " \t\n") ; Get past any blank crap
272 (skip-chars-forward "^ \t") ; Skip over the HTTP/xxx
273 (setq status (read (current-buffer)); Quicker than buffer-substring, etc.
274 result (cons (cons "status" status) result))
275 (end-of-line)
276 (while (not (eobp))
277 (skip-chars-forward " \t\n\r")
278 (setq save-pos (point))
279 (skip-chars-forward "^:\n\r")
280 (downcase-region save-pos (point))
281 (setq hname (buffer-substring save-pos (point)))
282 (skip-chars-forward ": \t ")
283 (setq save-pos (point))
284 (skip-chars-forward "^\n\r")
285 (setq hvalu (buffer-substring save-pos (point))
286 result (cons (cons hname hvalu) result))
287 (if (string= hname "set-cookie")
288 (url-cookie-handle-set-cookie hvalu)))
289 (or no-delete (delete-region st (min nd (point))))
290 (setq url-current-mime-type (cdr (assoc "content-type" result))
291 url-current-mime-encoding (cdr (assoc "content-encoding" result))
292 url-current-mime-viewer (mm-mime-info url-current-mime-type nil t)
293 url-current-mime-headers result
294 url-current-can-be-cached
295 (not (string-match "no-cache"
296 (or (cdr-safe (assoc "pragma" result)) ""))))
297 (url-handle-refresh-header (cdr-safe (assoc "refresh" result)))
298 (if (and url-request-method
299 (not (string= url-request-method "GET")))
300 (setq url-current-can-be-cached nil))
301 (let ((expires (cdr-safe (assoc "expires" result))))
302 (if (and expires url-current-can-be-cached (featurep 'timezone))
303 (progn
304 (if (string-match
305 (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
306 "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
307 expires)
308 (setq expires (concat (url-match expires 1) " "
309 (url-match expires 2) " "
310 (url-match expires 3) " "
311 (url-match expires 4) " ["
312 (url-match expires 5) "]")))
313 (setq expires
314 (let ((d1 (mapcar
315 (function
316 (lambda (s) (and s (string-to-int s))))
317 (timezone-parse-date
318 (current-time-string))))
319 (d2 (mapcar
320 (function (lambda (s) (and s (string-to-int s))))
321 (timezone-parse-date expires))))
322 (- (timezone-absolute-from-gregorian
323 (nth 1 d1) (nth 2 d1) (car d1))
324 (timezone-absolute-from-gregorian
325 (nth 1 d2) (nth 2 d2) (car d2))))
326 url-current-can-be-cached (/= 0 expires)))))
327 (setq class (/ status 100))
328 (cond
329 ;; Classes of response codes
330 ;;
331 ;; 5xx = Server Error
332 ;; 4xx = Client Error
333 ;; 3xx = Redirection
334 ;; 2xx = Successful
335 ;; 1xx = Informational
336 ;;
337 ((= class 2) ; Successful in some form or another
338 (cond
339 ((or (= status 206) ; Partial content
340 (= status 205)) ; Reset content
341 (setq url-current-can-be-cached nil))
342 ((= status 204) ; No response - leave old document
343 (kill-buffer url-working-buffer))
344 (t nil)) ; All others indicate success
345 )
346 ((= class 3) ; Redirection of some type
347 (cond
348 ((or (= status 301) ; Moved - retry with Location: header
349 (= status 302) ; Found - retry with Location: header
350 (= status 303)) ; Method - retry with location/method
351 (let ((x (url-view-url t))
352 (redir (or (cdr (assoc "uri" result))
353 (cdr (assoc "location" result))))
354 (redirmeth (upcase (or (cdr (assoc "method" result))
355 url-request-method
356 "get"))))
357 (if (and redir (string-match "\\([^ \t]+\\)[ \t]" redir))
358 (setq redir (url-match redir 1)))
359 (if (and redir (string-match "^<\\(.*\\)>$" redir))
360 (setq redir (url-match redir 1)))
361
362 ;; As per Roy Fielding, 303 maps _any_ method to a 'GET'
363 (if (= 303 status)
364 (setq redirmeth "GET"))
365
366 ;; As per Roy Fielding, 301, 302 use the same method as the
367 ;; original request, but if != GET, user interaction is
368 ;; required.
369 (if (and (not (string= "GET" redirmeth))
370 (not (funcall
371 url-confirmation-func
372 (concat
373 "Honor redirection with non-GET method "
374 "(possible security risks)? "))))
375 (progn
376 (url-warn 'url
377 (format
378 "The URL %s tried to issue a redirect to %s using a method other than
379 GET, which can open up various security holes. Please see the
380 HTTP/1.0 specification for more details." x redir) 'error)
381 (if (funcall url-confirmation-func
382 "Continue (with method of GET)? ")
383 (setq redirmeth "GET")
384 (error "Transaction aborted."))))
385
386 (if (not (equal x redir))
387 (let ((url-request-method redirmeth))
388 (url-maybe-relative redir))
389 (progn
390 (goto-char (point-max))
391 (insert "<hr>Error! This URL tried to redirect me to itself!<P>"
392 "Please notify the server maintainer.")))))
393 ((= status 304) ; Cached document is newer
394 (message "Extracting from cache...")
395 (url-extract-from-cache (url-create-cached-filename (url-view-url t))))
396 ((= status 305) ; Use proxy in Location: header
397 nil)))
398 ((= class 4) ; Client error
399 (cond
400 ((and (= status 401) ; Unauthorized access, retry w/auth.
401 (< url-current-passwd-count url-max-password-attempts))
402 (setq url-current-passwd-count (1+ url-current-passwd-count))
403 (let* ((y (or (cdr (assoc "www-authenticate" result)) "basic"))
404 (url (url-view-url t))
405 (type (downcase (if (string-match "[ \t]" y)
406 (substring y 0 (match-beginning 0))
407 y))))
408 (cond
409 ((or (equal "pem" type) (equal "pgp" type))
410 (if (string-match "entity=\"\\([^\"]+\\)\"" y)
411 (url-fetch-with-pgp url-current-file
412 (url-match y 1) (intern type))
413 (error "Could not find entity in %s!" type)))
414 ((url-auth-registered type)
415 (let ((args y)
416 (ctr (1- (length y)))
417 auth
418 (url-request-extra-headers url-request-extra-headers))
419 (while (/= 0 ctr)
420 (if (= ?, (aref args ctr))
421 (aset args ctr ?\;))
422 (setq ctr (1- ctr)))
423 (setq args (mm-parse-args y)
424 auth (url-get-authentication url
425 (cdr-safe
426 (assoc "realm" args))
427 type t args))
428 (if auth
429 (setq url-request-extra-headers
430 (cons (cons "Authorization" auth)
431 url-request-extra-headers)))
432 (url-retrieve url t)))
433 (t
434 (widen)
435 (goto-char (point-max))
436 (setq url-current-can-be-cached nil)
437 (insert "<hr>Sorry, but I do not know how to handle " y
438 " authentication. If you'd like to write it,"
439 " send it to " url-bug-address ".<hr>")))))
440 ((= status 407) ; Proxy authentication required
441 (let* ((y (or (cdr (assoc "proxy-authenticate" result)) "basic"))
442 (url (url-view-url t))
443 (url-basic-auth-storage url-proxy-basic-authentication)
444 (type (downcase (if (string-match "[ \t]" y)
445 (substring y 0 (match-beginning 0))
446 y))))
447 (cond
448 ((or (equal "pem" type) (equal "pgp" type))
449 (if (string-match "entity=\"\\([^\"]+\\)\"" y)
450 (url-fetch-with-pgp url-current-file
451 (url-match y 1) (intern type))
452 (error "Could not find entity in %s!" type)))
453 ((url-auth-registered type)
454 (let ((args y)
455 (ctr (1- (length y)))
456 auth
457 (url-request-extra-headers url-request-extra-headers))
458 (while (/= 0 ctr)
459 (if (= ?, (aref args ctr))
460 (aset args ctr ?\;))
461 (setq ctr (1- ctr)))
462 (setq args (mm-parse-args y)
463 auth (url-get-authentication (or url-using-proxy url)
464 (cdr-safe
465 (assoc "realm" args))
466 type t args))
467 (if auth
468 (setq url-request-extra-headers
469 (cons (cons "Proxy-Authorization" auth)
470 url-request-extra-headers)))
471 (setq url-proxy-basic-authentication url-basic-auth-storage)
472 (url-retrieve url t)))
473 (t
474 (widen)
475 (goto-char (point-max))
476 (setq url-current-can-be-cached nil)
477 (insert "<hr>Sorry, but I do not know how to handle " y
478 " authentication. If you'd like to write it,"
479 " send it to " url-bug-address ".<hr>")))))
480 ;;((= status 400) nil) ; Bad request - syntax
481 ;;((= status 401) nil) ; Tried too many times
482 ;;((= status 402) nil) ; Payment required, retry w/Chargeto:
483 ;;((= status 403) nil) ; Access is forbidden
484 ;;((= status 404) nil) ; Not found...
485 ;;((= status 405) nil) ; Method not allowed
486 ;;((= status 406) nil) ; None acceptable
487 ;;((= status 408) nil) ; Request timeout
488 ;;((= status 409) nil) ; Conflict
489 ;;((= status 410) nil) ; Document is gone
490 ;;((= status 411) nil) ; Length required
491 ;;((= status 412) nil) ; Unless true
492 (t ; All others mena something hosed
493 (setq url-current-can-be-cached nil))))
494 ((= class 5)
495 ;;; (= status 504) ; Gateway timeout
496 ;;; (= status 503) ; Service unavailable
497 ;;; (= status 502) ; Bad gateway
498 ;;; (= status 501) ; Facility not supported
499 ;;; (= status 500) ; Internal server error
500 (setq url-current-can-be-cached nil))
501 ((= class 1)
502 (cond
503 ((or (= status 100) ; Continue
504 (= status 101)) ; Switching protocols
505 nil)))
506 (t
507 (setq url-current-can-be-cached nil)))
508 (widen)
509 status))
510
511 (defun url-mime-response-p (&optional switch-buff)
512 ;; Determine if the current buffer is a MIME response
513 (and switch-buff (set-buffer url-working-buffer))
514 (goto-char (point-min))
515 (skip-chars-forward " \t\n")
516 (and (looking-at "^HTTP/.+")))
517
518 (defsubst url-recreate-with-attributes (obj)
519 (if (url-attributes obj)
520 (concat (url-filename obj) ";"
521 (mapconcat
522 (function
523 (lambda (x)
524 (if (cdr x)
525 (concat (car x) "=" (cdr x))
526 (car x)))) (url-attributes obj) ";"))
527 (url-filename obj)))
528
529 (defun url-http (url &optional proxy-info)
530 ;; Retrieve URL via http.
531 (let* ((urlobj (url-generic-parse-url url))
532 (ref-url (or url-current-referer (url-view-url t))))
533 (url-clear-tmp-buffer)
534 (setq url-current-type (if (boundp 'url-this-is-ssl)
535 "https" "http"))
536 (let* ((server (url-host urlobj))
537 (port (url-port urlobj))
538 (file (or proxy-info (url-recreate-with-attributes urlobj)))
539 (dest (url-target urlobj))
540 request)
541 (if (equal port "") (setq port "80"))
542 (if (equal file "") (setq file "/"))
543 (if (not server)
544 (progn
545 (url-warn
546 'url
547 (eval-when-compile
548 (concat
549 "Malformed URL got passed into url-retrieve.\n"
550 "Either `url-expand-file-name' is broken in some\n"
551 "way, or an incorrect URL was manually entered (more likely)."
552 )))
553 (error "Malformed URL: `%s'" url)))
554 (if proxy-info
555 (let ((x (url-generic-parse-url url)))
556 (setq url-current-server (url-host urlobj)
557 url-current-port (url-port urlobj)
558 url-current-file (url-filename urlobj)
559 url-find-this-link (url-target urlobj)
560 request (url-create-mime-request file ref-url)))
561 (setq url-current-server server
562 url-current-port port
563 url-current-file file
564 url-find-this-link dest
565 request (url-create-mime-request file ref-url)))
566 (if (or (not (member port url-bad-port-list))
567 (funcall url-confirmation-func
568 (concat
569 "Warning! Trying to connect to port "
570 port
571 " - continue? ")))
572 (progn
573 (url-lazy-message "Contacting %s:%s" server port)
574 (let ((process
575 (url-open-stream "WWW" url-working-buffer server
576 (string-to-int port))))
577 (if (stringp process)
578 (progn
579 (set-buffer url-working-buffer)
580 (erase-buffer)
581 (setq url-current-mime-type "text/html"
582 url-current-mime-viewer
583 (mm-mime-info "text/html" nil 5))
584 (insert "<title>ERROR</title>\n"
585 "<h1>ERROR - Could not establish connection</h1>"
586 "<p>"
587 "The browser could not establish a connection "
588 (format "to %s:%s.<P>" server port)
589 "The server is either down, or the URL"
590 (format "(%s) is malformed.<p>" (url-view-url t)))
591 (message "%s" process))
592 (progn
593 (process-kill-without-query process)
594 (process-send-string process request)
595 (url-lazy-message "Request sent, waiting for response...")
596 (if url-show-http2-transfer
597 (progn
598 (make-local-variable 'after-change-functions)
599 (add-hook 'after-change-functions
600 'url-after-change-function)))
601 (if url-be-asynchronous
602 (set-process-sentinel process 'url-sentinel)
603 (unwind-protect
604 (save-excursion
605 (set-buffer url-working-buffer)
606 (while (memq (url-process-status process)
607 '(run open))
608 (url-accept-process-output process)))
609 (condition-case ()
610 (url-kill-process process)
611 (error nil))))
612 (if (not url-be-asynchronous)
613 (message "Retrieval complete."))
614 (remove-hook 'after-change-functions
615 'url-after-change-function)))))
616 (progn
617 (ding)
618 (url-warn 'security "Aborting connection to bad port..."))))))
619
620 (defun url-shttp (url)
621 ;; Retrieve a URL via Secure-HTTP
622 (error "Secure-HTTP not implemented yet."))
623
624 (defun url-https (url)
625 ;; Retrieve a URL via SSL
626 (condition-case ()
627 (require 'ssl)
628 (error (error "Not configured for SSL, please read the info pages.")))
629 (let ((url-this-is-ssl t)
630 (url-gateway-method 'ssl))
631 (url-http url)))
632
633 (provide 'url-http)