Mercurial > hg > xemacs-beta

comparison lisp/w3/url-http.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 0d2f883870bc
children 360340f9fd5f
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
1 ;;; url-http.el --- HTTP Uniform Resource Locator retrieval code 1 ;;; url-http.el --- HTTP Uniform Resource Locator retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/08 05:29:12 3 ;; Created: 1997/02/19 00:50:08
4 ;; Version: 1.13 4 ;; Version: 1.15
5 ;; Keywords: comm, data, processes 5 ;; Keywords: comm, data, processes
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
135 (url-get-authentication url nil 'any nil)))) 135 (url-get-authentication url nil 'any nil))))
136 (proxy-obj (if (and (boundp 'proxy-info) proxy-info) 136 (proxy-obj (if (and (boundp 'proxy-info) proxy-info)
137 (url-generic-parse-url proxy-info))) 137 (url-generic-parse-url proxy-info)))
138 (real-fname (if proxy-obj (url-filename proxy-obj) fname)) 138 (real-fname (if proxy-obj (url-filename proxy-obj) fname))
139 (host (or (and proxy-obj (url-host proxy-obj)) 139 (host (or (and proxy-obj (url-host proxy-obj))
140 url-current-server)) 140 (url-host url-current-object)))
141 (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers)) 141 (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers))
142 nil 142 nil
143 (url-get-authentication (or 143 (url-get-authentication (or
144 (and (boundp 'proxy-info) 144 (and (boundp 'proxy-info)
145 proxy-info) 145 proxy-info)
195 url-mime-encoding-string 195 url-mime-encoding-string
196 url-mime-language-string 196 url-mime-language-string
197 url-mime-accept-string 197 url-mime-accept-string
198 (url-http-user-agent-string) 198 (url-http-user-agent-string)
199 (or auth "") 199 (or auth "")
200 (url-cookie-generate-header-lines host 200 (url-cookie-generate-header-lines
201 real-fname 201 host real-fname (equal "https" (url-type url-current-object)))
202 (string-match "https"
203 url-current-type))
204 (or proxy-auth "") 202 (or proxy-auth "")
205 (if (and (not no-cache) 203 (if (and (not no-cache)
206 (member url-request-method '("GET" nil))) 204 (member url-request-method '("GET" nil)))
207 (let ((tm (url-is-cached url))) 205 (let ((tm (url-is-cached url)))
208 (if tm 206 (if tm
413 (url (url-view-url t)) 411 (url (url-view-url t))
414 (type (downcase (if (string-match "[ \t]" y) 412 (type (downcase (if (string-match "[ \t]" y)
415 (substring y 0 (match-beginning 0)) 413 (substring y 0 (match-beginning 0))
416 y)))) 414 y))))
417 (cond 415 (cond
418 ((or (equal "pem" type) (equal "pgp" type))
419 (if (string-match "entity=\"\\([^\"]+\\)\"" y)
420 (url-fetch-with-pgp url-current-file
421 (url-match y 1) (intern type))
422 (error "Could not find entity in %s!" type)))
423 ((url-auth-registered type) 416 ((url-auth-registered type)
424 (let ((args y) 417 (let ((args y)
425 (ctr (1- (length y))) 418 (ctr (1- (length y)))
426 auth 419 auth
427 (url-request-extra-headers url-request-extra-headers)) 420 (url-request-extra-headers url-request-extra-headers))
452 (url-basic-auth-storage url-proxy-basic-authentication) 445 (url-basic-auth-storage url-proxy-basic-authentication)
453 (type (downcase (if (string-match "[ \t]" y) 446 (type (downcase (if (string-match "[ \t]" y)
454 (substring y 0 (match-beginning 0)) 447 (substring y 0 (match-beginning 0))
455 y)))) 448 y))))
456 (cond 449 (cond
457 ((or (equal "pem" type) (equal "pgp" type))
458 (if (string-match "entity=\"\\([^\"]+\\)\"" y)
459 (url-fetch-with-pgp url-current-file
460 (url-match y 1) (intern type))
461 (error "Could not find entity in %s!" type)))
462 ((url-auth-registered type) 450 ((url-auth-registered type)
463 (let ((args y) 451 (let ((args y)
464 (ctr (1- (length y))) 452 (ctr (1- (length y)))
465 auth 453 auth
466 (url-request-extra-headers url-request-extra-headers)) 454 (url-request-extra-headers url-request-extra-headers))
538 (defun url-http (url &optional proxy-info) 526 (defun url-http (url &optional proxy-info)
539 ;; Retrieve URL via http. 527 ;; Retrieve URL via http.
540 (let* ((urlobj (url-generic-parse-url url)) 528 (let* ((urlobj (url-generic-parse-url url))
541 (ref-url (or url-current-referer (url-view-url t)))) 529 (ref-url (or url-current-referer (url-view-url t))))
542 (url-clear-tmp-buffer) 530 (url-clear-tmp-buffer)
543 (setq url-current-type (if (boundp 'url-this-is-ssl)
544 "https" "http"))
545 (let* ((server (url-host urlobj)) 531 (let* ((server (url-host urlobj))
546 (port (url-port urlobj)) 532 (port (url-port urlobj))
547 (file (or proxy-info (url-recreate-with-attributes urlobj))) 533 (file (or proxy-info (url-recreate-with-attributes urlobj)))
548 (dest (url-target urlobj)) 534 (dest (url-target urlobj))
549 request) 535 request)
558 "Malformed URL got passed into url-retrieve.\n" 544 "Malformed URL got passed into url-retrieve.\n"
559 "Either `url-expand-file-name' is broken in some\n" 545 "Either `url-expand-file-name' is broken in some\n"
560 "way, or an incorrect URL was manually entered (more likely)." 546 "way, or an incorrect URL was manually entered (more likely)."
561 ))) 547 )))
562 (error "Malformed URL: `%s'" url))) 548 (error "Malformed URL: `%s'" url)))
563 (if proxy-info
564 (let ((x (url-generic-parse-url url)))
565 (setq url-current-server (url-host urlobj)
566 url-current-port (url-port urlobj)
567 url-current-file (url-filename urlobj)
568 url-find-this-link (url-target urlobj)
569 request (url-create-mime-request file ref-url)))
570 (setq url-current-server server
571 url-current-port port
572 url-current-file file
573 url-find-this-link dest
574 request (url-create-mime-request file ref-url)))
575 (if (or (not (member port url-bad-port-list)) 549 (if (or (not (member port url-bad-port-list))
576 (funcall url-confirmation-func 550 (funcall url-confirmation-func
577 (concat 551 (concat
578 "Warning! Trying to connect to port " 552 "Warning! Trying to connect to port "
579 port 553 port
580 " - continue? "))) 554 " - continue? ")))
581 (progn 555 (progn
556 (setq request (url-create-mime-request file ref-url))
582 (url-lazy-message "Contacting %s:%s" server port) 557 (url-lazy-message "Contacting %s:%s" server port)
583 (let ((process 558 (let ((process
584 (url-open-stream "WWW" url-working-buffer server 559 (url-open-stream "WWW" url-working-buffer server
585 (string-to-int port)))) 560 (string-to-int port))))
586 (if (not (processp process)) 561 (if (not (processp process))
611 'url-after-change-function)))))) 586 'url-after-change-function))))))
612 (progn 587 (progn
613 (ding) 588 (ding)
614 (url-warn 'security "Aborting connection to bad port...")))))) 589 (url-warn 'security "Aborting connection to bad port..."))))))
615 590
616 (defun url-shttp (url)
617 ;; Retrieve a URL via Secure-HTTP
618 (error "Secure-HTTP not implemented yet."))
619
620 (defun url-https (url) 591 (defun url-https (url)
621 ;; Retrieve a URL via SSL 592 ;; Retrieve a URL via SSL
622 (condition-case () 593 (condition-case ()
623 (require 'ssl) 594 (require 'ssl)
624 (error (error "Not configured for SSL, please read the info pages."))) 595 (error (error "Not configured for SSL, please read the info pages.")))