Function: url-http-handle-authentication

url-http-handle-authentication is a byte-compiled function defined in url-http.el.gz.

Signature

(url-http-handle-authentication PROXY)

Source Code

;; Defined in /usr/src/emacs/lisp/url/url-http.el.gz
(defun url-http-handle-authentication (proxy)
  (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
  (let ((auths (or (nreverse
		    (mail-fetch-field
		     (if proxy "proxy-authenticate" "www-authenticate")
		     nil nil t))
		  '("basic")))
	(type nil)
	(url (url-recreate-url url-current-object))
	(auth-url (url-recreate-url
		   (if (and proxy (boundp 'url-http-proxy))
		       url-http-proxy
		     url-current-object)))
	(url-basic-auth-storage (if proxy
				    ;; Cheating, but who cares? :)
				    'url-http-proxy-basic-auth-storage
				  'url-http-real-basic-auth-storage))
	auth
	(strength 0))

    ;; If we're here, then we got a 40x Unauthorized response from the
    ;; server.  If we already have "Authorization" in the extra
    ;; headers, then this means that we've already tried sending
    ;; credentials to the server, and they were wrong, so just give
    ;; up.
    (let ((authorization (assoc "Authorization" url-http-extra-headers)))
      (if (and authorization
               (not (string-match "^NTLM " (cdr authorization)))) ;Bug#43566
          t ;; Instruct caller to signal an error.  Bug#50511
        ;; Find strongest supported auth.
        (dolist (this-auth auths)
          (setq this-auth (string-trim this-auth))
          (let* ((this-type
                  (downcase (if (string-match "[ \t]" this-auth)
                                (substring this-auth 0 (match-beginning 0))
                              this-auth)))
                 (registered (url-auth-registered this-type))
                 (this-strength (cddr registered)))
            (when (and registered (> this-strength strength))
              (setq auth this-auth
                    type this-type
                    strength this-strength))))

        (if (not (url-auth-registered type))
            (progn
              (widen)
              (goto-char (point-max))
              (insert "<hr>Sorry, but I do not know how to handle "
                      (or type auth url "")
                      " authentication.  If you'd like to write it,"
                      " please use M-x report-emacs-bug RET.<hr>")
              ;; We used to set a `status' var (declared "special") but I can't
              ;; find the corresponding let-binding, so it's probably an error.
              ;; FIXME: Maybe it was supposed to set `success', i.e. to return t?
              ;; (setq status t)
              nil) ;; Not success yet.

          (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
                 (auth (url-get-authentication auth-url
                                               (cdr-safe (assoc "realm" args))
                                               type t args)))
            (if (not auth)
                t                           ;Success.
              (push (cons (if proxy "Proxy-Authorization" "Authorization") auth)
                    url-http-extra-headers)
              (let ((url-request-method url-http-method)
                    (url-request-data url-http-data)
                    (url-request-extra-headers url-http-extra-headers))
                (url-retrieve-internal url url-callback-function
                                       url-callback-arguments))
              nil))))))) ;; Not success yet.