/[emacs]/emacs/lisp/url/url-http.el
ViewVC logotype

Diff of /emacs/lisp/url/url-http.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.22 by eliz, Thu Oct 20 14:17:14 2005 UTC revision 1.23 by monnier, Fri Nov 18 16:55:54 2005 UTC
# Line 26  Line 26 
26    
27  ;;; Code:  ;;; Code:
28    
29  (eval-when-compile  (eval-when-compile (require 'cl))
30    (require 'cl)  (defvar url-http-extra-headers)
31    (defvar url-http-extra-headers)  (defvar url-http-target-url)
   (defvar url-http-cookies-sources))  
32  (require 'url-gw)  (require 'url-gw)
33  (require 'url-util)  (require 'url-util)
34  (require 'url-parse)  (require 'url-parse)
# Line 320  This allows us to use `mail-fetch-field' Line 319  This allows us to use `mail-fetch-field'
319                    " authentication.  If you'd like to write it,"                    " authentication.  If you'd like to write it,"
320                    " send it to " url-bug-address ".<hr>")                    " send it to " url-bug-address ".<hr>")
321            (setq status t))            (setq status t))
322        (let* ((args auth)        (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
323               (ctr (1- (length args)))               (auth (url-get-authentication url (cdr-safe (assoc "realm" args))
324               auth)                                             type t args)))
         (while (/= 0 ctr)  
           (if (char-equal ?, (aref args ctr))  
               (aset args ctr ?\;))  
           (setq ctr (1- ctr)))  
         (setq args (url-parse-args args)  
               auth (url-get-authentication url (cdr-safe (assoc "realm" args))  
                                            type t args))  
325          (if (not auth)          (if (not auth)
326              (setq success t)              (setq success t)
327            (push (cons (if proxy "Proxy-Authorization" "Authorization") auth)            (push (cons (if proxy "Proxy-Authorization" "Authorization") auth)
# Line 358  The buffer must already be narrowed to t Line 350  The buffer must already be narrowed to t
350  work correctly."  work correctly."
351    (let ((cookies (mail-fetch-field "Set-Cookie" nil nil t))    (let ((cookies (mail-fetch-field "Set-Cookie" nil nil t))
352          (cookies2 (mail-fetch-field "Set-Cookie2" nil nil t))          (cookies2 (mail-fetch-field "Set-Cookie2" nil nil t))
353          (url-current-object url-http-cookies-sources))          (url-current-object url-http-target-url))
354      (and cookies (url-http-debug "Found %d Set-Cookie headers" (length cookies)))      (and cookies (url-http-debug "Found %d Set-Cookie headers" (length cookies)))
355      (and cookies2 (url-http-debug "Found %d Set-Cookie2 headers" (length cookies2)))      (and cookies2 (url-http-debug "Found %d Set-Cookie2 headers" (length cookies2)))
356      (while cookies      (while cookies
# Line 510  should be shown to the user." Line 502  should be shown to the user."
502             ;; non-fully-qualified URL (ie: /), which royally confuses             ;; non-fully-qualified URL (ie: /), which royally confuses
503             ;; the URL library.             ;; the URL library.
504             (if (not (string-match url-nonrelative-link redirect-uri))             (if (not (string-match url-nonrelative-link redirect-uri))
505                 (setq redirect-uri (url-expand-file-name redirect-uri)))                 ;; Be careful to use the real target URL, otherwise we may
506             (let ((url-request-method url-http-method)                 ;; compute the redirection relative to the URL of the proxy.
507                   (setq redirect-uri
508                         (url-expand-file-name redirect-uri url-http-target-url)))
509               (let ((url-request-method url-http-method)
510                   (url-request-data url-http-data)                   (url-request-data url-http-data)
511                   (url-request-extra-headers url-http-extra-headers))                   (url-request-extra-headers url-http-extra-headers))
512               (url-retrieve redirect-uri url-callback-function               (url-retrieve redirect-uri url-callback-function
# Line 727  should be shown to the user." Line 722  should be shown to the user."
722    (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"    (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
723                    (process-buffer proc))                    (process-buffer proc))
724    (url-http-idle-sentinel proc why)    (url-http-idle-sentinel proc why)
725    (save-excursion    (with-current-buffer (process-buffer proc)
     (set-buffer (process-buffer proc))  
726      (goto-char (point-min))      (goto-char (point-min))
727      (if (not (looking-at "HTTP/"))      (if (not (looking-at "HTTP/"))
728          ;; HTTP/0.9 just gets passed back no matter what          ;; HTTP/0.9 just gets passed back no matter what
# Line 1039  CBARGS as the arguments." Line 1033  CBARGS as the arguments."
1033            (setq buffer nil)            (setq buffer nil)
1034            (error "Could not create connection to %s:%d" (url-host url)            (error "Could not create connection to %s:%d" (url-host url)
1035                   (url-port url)))                   (url-port url)))
1036        (save-excursion        (with-current-buffer buffer
         (set-buffer buffer)  
1037          (mm-disable-multibyte)          (mm-disable-multibyte)
1038          (setq url-current-object url          (setq url-current-object url
1039                mode-line-format "%b [%s]")                mode-line-format "%b [%s]")
# Line 1060  CBARGS as the arguments." Line 1053  CBARGS as the arguments."
1053                         url-http-method                         url-http-method
1054                         url-http-extra-headers                         url-http-extra-headers
1055                         url-http-data                         url-http-data
1056                         url-http-cookies-sources))                         url-http-target-url))
1057            (set (make-local-variable var) nil))            (set (make-local-variable var) nil))
1058    
1059          (setq url-http-method (or url-request-method "GET")          (setq url-http-method (or url-request-method "GET")
# Line 1073  CBARGS as the arguments." Line 1066  CBARGS as the arguments."
1066                url-callback-function callback                url-callback-function callback
1067                url-callback-arguments cbargs                url-callback-arguments cbargs
1068                url-http-after-change-function 'url-http-wait-for-headers-change-function                url-http-after-change-function 'url-http-wait-for-headers-change-function
1069                url-http-cookies-sources (if (boundp 'proxy-object)                url-http-target-url (if (boundp 'proxy-object)
1070                                             proxy-object                                        proxy-object
1071                                           url-current-object))                                      url-current-object))
1072    
1073          (set-process-buffer connection buffer)          (set-process-buffer connection buffer)
1074          (set-process-sentinel connection 'url-http-end-of-document-sentinel)          (set-process-sentinel connection 'url-http-end-of-document-sentinel)
# Line 1096  CBARGS as the arguments." Line 1089  CBARGS as the arguments."
1089    (declare (special url-http-after-change-function))    (declare (special url-http-after-change-function))
1090    (and (process-buffer proc)    (and (process-buffer proc)
1091         (/= (length data) 0)         (/= (length data) 0)
1092         (save-excursion         (with-current-buffer (process-buffer proc)
          (set-buffer (process-buffer proc))  
1093           (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc)           (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc)
1094           (funcall url-http-after-change-function           (funcall url-http-after-change-function
1095                    (point-max)                    (point-max)
# Line 1114  CBARGS as the arguments." Line 1106  CBARGS as the arguments."
1106      (defun url-http-symbol-value-in-buffer (symbol buffer      (defun url-http-symbol-value-in-buffer (symbol buffer
1107                                                     &optional unbound-value)                                                     &optional unbound-value)
1108        "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound."        "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound."
1109        (save-excursion        (with-current-buffer buffer
         (set-buffer buffer)  
1110          (if (not (boundp symbol))          (if (not (boundp symbol))
1111              unbound-value              unbound-value
1112            (symbol-value symbol))))            (symbol-value symbol))))
# Line 1198  p3p Line 1189  p3p
1189      (when (and buffer (= 2 (/ (url-http-symbol-value-in-buffer      (when (and buffer (= 2 (/ (url-http-symbol-value-in-buffer
1190                                 'url-http-response-status buffer 0) 100)))                                 'url-http-response-status buffer 0) 100)))
1191        ;; Only parse the options if we got a 2xx response code!        ;; Only parse the options if we got a 2xx response code!
1192        (save-excursion        (with-current-buffer buffer
1193          (save-restriction          (save-restriction
1194            (save-match-data            (save-match-data
             (set-buffer buffer)  
1195              (mail-narrow-to-head)              (mail-narrow-to-head)
1196    
1197              ;; Figure out what methods are supported.              ;; Figure out what methods are supported.

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26