;;; 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-2013 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'url-vars)
(require 'url-parse)
(autoload 'url-warn "url")
+(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)
(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
(symbol-value url-basic-auth-storage))))
(cond
((and prompt (not byserv))
- (setq user (read-string (url-auth-user-prompt url realm)
- (or user (user-real-login-name)))
- pass (read-passwd "Password: " nil (or pass "")))
+ (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
+ (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 (read-string (url-auth-user-prompt url realm)
- (user-real-login-name))
- pass (read-passwd "Password: ")
+ (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
+ (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)))
(setcdr byserv
;;; 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."
(url-generic-parse-url url)
url))
(server (url-host href))
+ (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)
byserv (cdr-safe (assoc server url-digest-auth-storage)))
(cond
((and prompt (not byserv))
- (setq user (read-string (url-auth-user-prompt url realm)
- (user-real-login-name))
- pass (read-passwd "Password: ")
+ (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
+ (url-do-auth-source-search server type :secret)
+ (read-passwd "Password: "))
url-digest-auth-storage
(cons (list server
(cons file
(setq byserv (cdr byserv))))
(if overwrite
(if (and (not retval) prompt)
- (setq user (read-string (url-auth-user-prompt url realm)
- (user-real-login-name))
- pass (read-passwd "Password: ")
+ (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
+ (url-do-auth-source-search server type :secret)
+ (read-passwd "Password: "))
retval (setq retval
(cons user
(url-digest-auth-create-key
"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