;;; url-auth.el --- Uniform Resource Locator authorization modules
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
(require 'url-vars)
(require 'url-parse)
(autoload 'url-warn "url")
-
-(eval-and-compile
- (autoload 'auth-source-user-or-password "auth-source"))
+(autoload 'auth-source-search "auth-source")
(defsubst url-auth-user-prompt (url realm)
"String to usefully prompt for a username."
Must be a symbol pointing to another variable that will actually store
the information. The value of this variable is an assoc list of assoc
lists. The first assoc list is keyed by the server name. The cdr of
-this is an assoc list based on the 'directory' specified by the url we
+this is an assoc list based on the 'directory' specified by the URL we
are looking up.")
(defun url-basic-auth (url &optional prompt overwrite realm args)
(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
(symbol-value url-basic-auth-storage))))
(cond
((and prompt (not byserv))
- (setq user (or
- (auth-source-user-or-password "login" server type)
+ (setq user (or
+ (url-do-auth-source-search server type :user)
(read-string (url-auth-user-prompt url realm)
(or user (user-real-login-name))))
- pass (or
- (auth-source-user-or-password "password" server type)
+ pass (or
+ (url-do-auth-source-search server type :secret)
(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 pass)))))
+ (format "%s:%s" user
+ (encode-coding-string pass 'utf-8))))))
(symbol-value url-basic-auth-storage))))
(byserv
(setq retval (cdr-safe (assoc file byserv)))
(setq byserv (cdr byserv))))
(if (or (and (not retval) prompt) overwrite)
(progn
- (setq user (or
- (auth-source-user-or-password "login" server type)
+ (setq user (or
+ (url-do-auth-source-search server type :user)
(read-string (url-auth-user-prompt url realm)
(user-real-login-name)))
- pass (or
- (auth-source-user-or-password "password" server type)
+ pass (or
+ (url-do-auth-source-search server type :secret)
(read-passwd "Password: "))
retval (base64-encode-string (format "%s:%s" user pass))
byserv (assoc server (symbol-value url-basic-auth-storage)))
;;; This is very secure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar url-digest-auth-storage nil
- "Where usernames and passwords are stored. Its value is an assoc list of
-assoc lists. The first assoc list is keyed by the server name. The cdr of
-this is an assoc list based on the 'directory' specified by the url we are
-looking up.")
+ "Where usernames and passwords are stored.
+Its value is an assoc list of assoc lists. The first assoc list is
+keyed by the server name. The cdr of this is an assoc list based
+on the 'directory' specified by the url we are looking up.")
(defun url-digest-auth-create-key (username password realm method uri)
"Create a key for digest authentication method"
(defun url-digest-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
+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 hostname:portnum."
(type (url-type href))
(port (url-port href))
(file (url-filename href))
+ (enable-recursive-minibuffers t)
user pass byserv retval data)
(setq file (cond
(realm realm)
(cond
((and prompt (not byserv))
(setq user (or
- (auth-source-user-or-password "login" server type)
+ (url-do-auth-source-search server type :user)
(read-string (url-auth-user-prompt url realm)
(user-real-login-name)))
pass (or
- (auth-source-user-or-password "password" server type)
+ (url-do-auth-source-search server type :secret)
(read-passwd "Password: "))
url-digest-auth-storage
(cons (list server
(setq byserv (cdr byserv))))
(if overwrite
(if (and (not retval) prompt)
- (setq user (or
- (auth-source-user-or-password "login" server type)
+ (setq user (or
+ (url-do-auth-source-search server type :user)
(read-string (url-auth-user-prompt url realm)
(user-real-login-name)))
- pass (or
- (auth-source-user-or-password "password" server type)
+ pass (or
+ (url-do-auth-source-search server type :secret)
(read-passwd "Password: "))
retval (setq retval
(cons user
"A list of the registered authorization schemes and various and sundry
information associated with them.")
+(defun url-do-auth-source-search (server type parameter)
+ (let* ((auth-info (auth-source-search :max 1 :host server :port type))
+ (auth-info (nth 0 auth-info))
+ (token (plist-get auth-info parameter))
+ (token (if (functionp token) (funcall token) token)))
+ token))
+
;;;###autoload
(defun url-get-authentication (url realm type prompt &optional args)
"Return an authorization string suitable for use in the WWW-Authenticate
(defun url-register-auth-scheme (type &optional function rating)
"Register an HTTP authentication method.
-TYPE is a string or symbol specifying the name of the method. This
- should be the same thing you expect to get returned in an Authenticate
- header in HTTP/1.0 - it will be downcased.
-FUNCTION is the function to call to get the authorization information. This
- defaults to `url-?-auth', where ? is TYPE
+TYPE is a string or symbol specifying the name of the method.
+ This should be the same thing you expect to get returned in
+ an Authenticate header in HTTP/1.0 - it will be downcased.
+FUNCTION is the function to call to get the authorization information.
+ This defaults to `url-?-auth', where ? is TYPE.
RATING a rating between 1 and 10 of the strength of the authentication.
This is used when asking for the best authentication for a specific
URL. The item with the highest rating is returned."
(provide 'url-auth)
-;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
;;; url-auth.el ends here