Function: url-basic-auth

url-basic-auth is a byte-compiled function defined in url-auth.el.gz.

Signature

(url-basic-auth URL &optional PROMPT OVERWRITE REALM ARGS)

Documentation

Get the username/password for the specified URL.

If optional argument PROMPT is non-nil, ask for the username/password to use for the url and its descendants. If optional third argument OVERWRITE is non-nil, overwrite the old username/password pair if it is found in the assoc list. If REALM is specified, use that as the realm instead of the filename inheritance method.

Source Code

;; Defined in /usr/src/emacs/lisp/url/url-auth.el.gz
(defun url-basic-auth (url &optional prompt overwrite realm _args)
  "Get the username/password for the specified URL.
If optional argument PROMPT is non-nil, ask for the username/password
to use for the url and its descendants.  If optional third argument
OVERWRITE is non-nil, overwrite the old username/password pair if it
is found in the assoc list.  If REALM is specified, use that as the realm
instead of the filename inheritance method."
  (let* ((href (if (stringp url)
		   (url-generic-parse-url url)
		 url))
	 (server (url-host href))
	 (type (url-type href))
	 (port (url-port href))
	 (file (url-filename href))
	 (user (url-user href))
	 (pass (url-password href))
	 (enable-recursive-minibuffers t) ; for url-handler-mode (bug#10298)
	 byserv retval data)
    (setq server (format "%s:%d" server port)
	  file (cond
		(realm realm)
		((string= "" file) "/")
		((string-match "/$" file) file)
		(t (url-file-directory file)))
	  byserv (cdr-safe (assoc server
				  (symbol-value url-basic-auth-storage))))
    (cond
     ((and user pass)
      ;; Explicit http://user:pass@foo/ URL.  Just return the credentials.
      (setq retval (base64-encode-string (format "%s:%s" user pass) t)))
     ((and prompt (not byserv))
      (setq user (or
		  (url-do-auth-source-search server type :user)
                  (and (url-interactive-p)
		       (read-string (url-auth-user-prompt href realm)
                                    (or user (user-real-login-name)))))
	    pass (or
		  (url-do-auth-source-search server type :secret)
                  (and (url-interactive-p)
		       (read-passwd "Password: " nil (or pass "")))))
      (set url-basic-auth-storage
	   (cons (list server
		       (cons file
			     (setq retval
				   (base64-encode-string
				    (format "%s:%s" user
                                            (if pass
                                                (encode-coding-string pass
                                                                      'utf-8)
                                              ""))
                                    t))))
		 (symbol-value url-basic-auth-storage))))
     (byserv
      (setq retval (cdr-safe (assoc file byserv)))
      (if (and (not retval)
	       (string-search "/" file))
          (while (and byserv (not retval))
	    (setq data (car (car byserv)))
	    (if (or (not (string-search "/" data)) ; It's a realm - take it!
		    (and
		     (>= (length file) (length data))
		     (string= data (substring file 0 (length data)))))
		(setq retval (cdr (car byserv))))
	    (setq byserv (cdr byserv))))
      (if (or (and (not retval) prompt) overwrite)
	  (progn
	    (setq user (or
			(url-do-auth-source-search server type :user)
                        (and (url-interactive-p)
			     (read-string (url-auth-user-prompt href realm)
                                          (user-real-login-name))))
		  pass (or
			(url-do-auth-source-search server type :secret)
                        (and (url-interactive-p)
			     (read-passwd "Password: ")))
		  retval (base64-encode-string (format "%s:%s" user pass) t)
		  byserv (assoc server (symbol-value url-basic-auth-storage)))
	    (setcdr byserv
		    (cons (cons file retval) (cdr byserv))))))
     (t (setq retval nil)))
    (if retval (setq retval (concat "Basic " retval)))
    retval))