;;; url-auth.el --- Uniform Resource Locator authorization modules
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010, 2011 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")
-(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
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))))
((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)
(or user (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: " nil (or pass ""))))
(set url-basic-auth-storage
(cons (list server
(if (or (and (not retval) prompt) overwrite)
(progn
(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: "))
retval (base64-encode-string (format "%s:%s" user pass))
byserv (assoc server (symbol-value url-basic-auth-storage)))
"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.")
+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"
(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
(if overwrite
(if (and (not retval) prompt)
(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: "))
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
string representing the URL, or the parsed representation returned by
`url-generic-parse-url'
REALM is the realm at a specific site we are looking for. This should be a
- string specifying the exact realm, or nil or the symbol 'any' to
+ string specifying the exact realm, or nil or the symbol `any' to
specify that the filename portion of the URL should be used as the
realm
TYPE is the type of authentication to be returned. This is either a string
- representing the type (basic, digest, etc), or nil or the symbol 'any'
- to specify that any authentication is acceptable. If requesting 'any'
+ representing the type (basic, digest, etc), or nil or the symbol `any'
+ to specify that any authentication is acceptable. If requesting `any'
the strongest matching authentication will be returned. If this is
wrong, it's no big deal, the error from the server will specify exactly
what type of auth to use
(t rating)))
(node (assoc type url-registered-auth-schemes)))
(if (not (fboundp function))
- (url-warn 'security
- (format (concat
- "Tried to register `%s' as an auth scheme"
- ", but it is not a function!") function)))
-
+ (url-warn
+ 'security
+ (format-message
+ "Tried to register `%s' as an auth scheme, but it is not a function!"
+ function)))
(if node
(setcdr node (cons function rating))
(setq url-registered-auth-schemes