;;; url-auth.el --- Uniform Resource Locator authorization modules
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007,
+;; 2008 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 2, 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-user-or-password "auth-source")
(defsubst url-auth-user-prompt (url realm)
"String to usefully prompt for a username."
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 pathname inheritance method."
+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))
- (path (url-filename href))
- user pass byserv retval data)
+ (file (url-filename href))
+ (user (url-user href))
+ (pass (url-password href))
+ byserv retval data)
(setq server (format "%s:%d" server port)
- path (cond
+ file (cond
(realm realm)
- ((string-match "/$" path) path)
- (t (url-basepath path)))
+ ((string= "" file) "/")
+ ((string-match "/$" file) file)
+ (t (url-file-directory file)))
byserv (cdr-safe (assoc server
(symbol-value url-basic-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
+ (auth-source-user-or-password "login" server type)
+ (read-string (url-auth-user-prompt url realm)
+ (or user (user-real-login-name))))
+ pass (or
+ (auth-source-user-or-password "password" server type)
+ (read-passwd "Password: " nil (or pass ""))))
(set url-basic-auth-storage
(cons (list server
- (cons path
+ (cons file
(setq retval
(base64-encode-string
(format "%s:%s" user pass)))))
(symbol-value url-basic-auth-storage))))
(byserv
- (setq retval (cdr-safe (assoc path byserv)))
+ (setq retval (cdr-safe (assoc file byserv)))
(if (and (not retval)
- (string-match "/" path))
+ (string-match "/" file))
(while (and byserv (not retval))
(setq data (car (car byserv)))
- (if (or (not (string-match "/" data)) ; Its a realm - take it!
+ (if (or (not (string-match "/" data)) ; It's a realm - take it!
(and
- (>= (length path) (length data))
- (string= data (substring path 0 (length data)))))
+ (>= (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 (read-string (url-auth-user-prompt url realm)
- (user-real-login-name))
- pass (read-passwd "Password: ")
+ (setq user (or
+ (auth-source-user-or-password "login" server type)
+ (read-string (url-auth-user-prompt url realm)
+ (user-real-login-name)))
+ pass (or
+ (auth-source-user-or-password "password" server type)
+ (read-passwd "Password: "))
retval (base64-encode-string (format "%s:%s" user pass))
byserv (assoc server (symbol-value url-basic-auth-storage)))
(setcdr byserv
- (cons (cons path retval) (cdr byserv))))))
+ (cons (cons file retval) (cdr byserv))))))
(t (setq retval nil)))
(if retval (setq retval (concat "Basic " retval)))
retval))
(url-generic-parse-url url)
url))
(server (url-host href))
+ (type (url-type href))
(port (url-port href))
- (path (url-filename href))
+ (file (url-filename href))
user pass byserv retval data)
- (setq path (cond
+ (setq file (cond
(realm realm)
- ((string-match "/$" path) path)
- (t (url-basepath path)))
+ ((string-match "/$" file) file)
+ (t (url-file-directory file)))
server (format "%s:%d" server port)
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
+ (auth-source-user-or-password "login" server type)
+ (read-string (url-auth-user-prompt url realm)
+ (user-real-login-name)))
+ pass (or
+ (auth-source-user-or-password "password" server type)
+ (read-passwd "Password: "))
url-digest-auth-storage
(cons (list server
- (cons path
+ (cons file
(setq retval
(cons user
(url-digest-auth-create-key
url)))))
url-digest-auth-storage)))
(byserv
- (setq retval (cdr-safe (assoc path byserv)))
+ (setq retval (cdr-safe (assoc file byserv)))
(if (and (not retval) ; no exact match, check directories
- (string-match "/" path)) ; not looking for a realm
+ (string-match "/" file)) ; not looking for a realm
(while (and byserv (not retval))
(setq data (car (car byserv)))
(if (or (not (string-match "/" data))
(and
- (>= (length path) (length data))
- (string= data (substring path 0 (length data)))))
+ (>= (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 (read-string (url-auth-user-prompt url realm)
- (user-real-login-name))
- pass (read-passwd "Password: ")
- retval (setq retval
- (cons user
- (url-digest-auth-create-key
- user pass realm
- (or url-request-method "GET")
- url)))
- byserv (assoc server url-digest-auth-storage))
+ (if overwrite
+ (if (and (not retval) prompt)
+ (setq user (or
+ (auth-source-user-or-password "login" server type)
+ (read-string (url-auth-user-prompt url realm)
+ (user-real-login-name)))
+ pass (or
+ (auth-source-user-or-password "password" server type)
+ (read-passwd "Password: "))
+ retval (setq retval
+ (cons user
+ (url-digest-auth-create-key
+ user pass realm
+ (or url-request-method "GET")
+ url)))
+ byserv (assoc server url-digest-auth-storage))
(setcdr byserv
- (cons (cons path retval) (cdr byserv))))))
+ (cons (cons file retval) (cdr byserv))))))
(t (setq retval nil)))
(if retval
- (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
- (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven")))
- (format
- (concat "Digest username=\"%s\", realm=\"%s\","
- "nonce=\"%s\", uri=\"%s\","
- "response=\"%s\", opaque=\"%s\"")
- (nth 0 retval) realm nonce (url-filename href)
- (md5 (concat (nth 1 retval) ":" nonce ":"
- (nth 2 retval))) opaque))))))
+ (if (cdr-safe (assoc "opaque" args))
+ (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
+ (opaque (cdr-safe (assoc "opaque" args))))
+ (format
+ (concat "Digest username=\"%s\", realm=\"%s\","
+ "nonce=\"%s\", uri=\"%s\","
+ "response=\"%s\", opaque=\"%s\"")
+ (nth 0 retval) realm nonce (url-filename href)
+ (md5 (concat (nth 1 retval) ":" nonce ":"
+ (nth 2 retval))) opaque))
+ (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")))
+ (format
+ (concat "Digest username=\"%s\", realm=\"%s\","
+ "nonce=\"%s\", uri=\"%s\","
+ "response=\"%s\"")
+ (nth 0 retval) realm nonce (url-filename href)
+ (md5 (concat (nth 1 retval) ":" nonce ":"
+ (nth 2 retval))))))))))
(defvar url-registered-auth-schemes nil
"A list of the registered authorization schemes and various and sundry
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, its no big deal, the error from the server will specify exactly
+ wrong, it's no big deal, the error from the server will specify exactly
what type of auth to use
PROMPT is boolean - specifies whether to ask the user for a username/password
if one cannot be found in the cache"
url-registered-auth-schemes)))))
(defun url-auth-registered (scheme)
- ;; Return non-nil iff SCHEME is registered as an auth type
+ "Return non-nil if SCHEME is registered as an auth type."
(assoc scheme url-registered-auth-schemes))
(provide 'url-auth)
-;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
+;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
;;; url-auth.el ends here