Mercurial > emacs

annotate lisp/url/url-auth.el @ 97419:62b35141dda8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(do-applescript): Fix declaration.
author Glenn Morris <rgm@gnu.org>
date Mon, 11 Aug 2008 01:18:53 +0000 (2008-08-11)
parents 7369ded3b436
children 1fa392febf9a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
1 ;;; url-auth.el --- Uniform Resource Locator authorization modules
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
2
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007,
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
4 ;; 2008 Free Software Foundation, Inc.
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
5
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
6 ;; Keywords: comm, data, processes, hypermedia
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
7
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
8 ;; This file is part of GNU Emacs.
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
9
94668
8259d0d8e107 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 88054
diff changeset
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
94668
8259d0d8e107 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 88054
diff changeset
12 ;; the Free Software Foundation, either version 3 of the License, or
8259d0d8e107 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 88054
diff changeset
13 ;; (at your option) any later version.
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
14
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
18 ;; GNU General Public License for more details.
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
19
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
20 ;; You should have received a copy of the GNU General Public License
94668
8259d0d8e107 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 88054
diff changeset
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
22
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
23 ;;; Code:
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
24
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
25 (require 'url-vars)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
26 (require 'url-parse)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
27 (autoload 'url-warn "url")
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
28 (autoload 'auth-source-user-or-password "auth-source")
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
29
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
30 (defsubst url-auth-user-prompt (url realm)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
31 "String to usefully prompt for a username."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
32 (concat "Username [for "
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
33 (or realm (url-truncate-url-for-viewing
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
34 (url-recreate-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
35 (- (window-width) 10 20)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
36 "]: "))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
37
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
39 ;;; Basic authorization code
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
40 ;;; ------------------------
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
41 ;;; This implements the BASIC authorization type. See the online
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
42 ;;; documentation at
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
43 ;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
44 ;;; for the complete documentation on this type.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
45 ;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
46 ;;; This is very insecure, but it works as a proof-of-concept
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
48 (defvar url-basic-auth-storage 'url-http-real-basic-auth-storage
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
49 "Where usernames and passwords are stored.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
50
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
51 Must be a symbol pointing to another variable that will actually store
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
52 the information. The value of this variable is an assoc list of assoc
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
53 lists. The first assoc list is keyed by the server name. The cdr of
96486
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
54 this is an assoc list based on the 'directory' specified by the URL we
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
55 are looking up.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
56
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
57 (defun url-basic-auth (url &optional prompt overwrite realm args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
58 "Get the username/password for the specified URL.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
59 If optional argument PROMPT is non-nil, ask for the username/password
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
60 to use for the url and its descendants. If optional third argument
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
61 OVERWRITE is non-nil, overwrite the old username/password pair if it
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
62 is found in the assoc list. If REALM is specified, use that as the realm
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
63 instead of the filename inheritance method."
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
64 (let* ((href (if (stringp url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
65 (url-generic-parse-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
66 url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
67 (server (url-host href))
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
68 (type (url-type href))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
69 (port (url-port href))
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
70 (file (url-filename href))
78514
364329b928dc username and password default
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 78481
diff changeset
71 (user (url-user href))
364329b928dc username and password default
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 78481
diff changeset
72 (pass (url-password href))
364329b928dc username and password default
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 78481
diff changeset
73 byserv retval data)
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
74 (setq server (format "%s:%d" server port)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
75 file (cond
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
76 (realm realm)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
77 ((string= "" file) "/")
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
78 ((string-match "/$" file) file)
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
79 (t (url-file-directory file)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
80 byserv (cdr-safe (assoc server
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
81 (symbol-value url-basic-auth-storage))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
82 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
83 ((and prompt (not byserv))
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
84 (setq user (or
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
85 (auth-source-user-or-password "login" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
86 (read-string (url-auth-user-prompt url realm)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
87 (or user (user-real-login-name))))
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
88 pass (or
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
89 (auth-source-user-or-password "password" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
90 (read-passwd "Password: " nil (or pass ""))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
91 (set url-basic-auth-storage
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
92 (cons (list server
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
93 (cons file
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
94 (setq retval
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
95 (base64-encode-string
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
96 (format "%s:%s" user pass)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
97 (symbol-value url-basic-auth-storage))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
98 (byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
99 (setq retval (cdr-safe (assoc file byserv)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
100 (if (and (not retval)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
101 (string-match "/" file))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
102 (while (and byserv (not retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
103 (setq data (car (car byserv)))
75519
b271481fb8d2 (url-get-authentication): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 75347
diff changeset
104 (if (or (not (string-match "/" data)) ; It's a realm - take it!
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
105 (and
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
106 (>= (length file) (length data))
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
107 (string= data (substring file 0 (length data)))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
108 (setq retval (cdr (car byserv))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
109 (setq byserv (cdr byserv))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
110 (if (or (and (not retval) prompt) overwrite)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
111 (progn
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
112 (setq user (or
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
113 (auth-source-user-or-password "login" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
114 (read-string (url-auth-user-prompt url realm)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
115 (user-real-login-name)))
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
116 pass (or
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
117 (auth-source-user-or-password "password" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
118 (read-passwd "Password: "))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
119 retval (base64-encode-string (format "%s:%s" user pass))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
120 byserv (assoc server (symbol-value url-basic-auth-storage)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
121 (setcdr byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
122 (cons (cons file retval) (cdr byserv))))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
123 (t (setq retval nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
124 (if retval (setq retval (concat "Basic " retval)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
125 retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
126
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
127 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
128 ;;; Digest authorization code
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
129 ;;; ------------------------
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
130 ;;; This implements the DIGEST authorization type. See the internet draft
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
131 ;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
132 ;;; for the complete documentation on this type.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
133 ;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
134 ;;; This is very secure
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
136 (defvar url-digest-auth-storage nil
96486
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
137 "Where usernames and passwords are stored.
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
138 Its value is an assoc list of assoc lists. The first assoc list is
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
139 keyed by the server name. The cdr of this is an assoc list based
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
140 on the 'directory' specified by the url we are looking up.")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
141
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
142 (defun url-digest-auth-create-key (username password realm method uri)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
143 "Create a key for digest authentication method"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
144 (let* ((info (if (stringp uri)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
145 (url-generic-parse-url uri)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
146 uri))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
147 (a1 (md5 (concat username ":" realm ":" password)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
148 (a2 (md5 (concat method ":" (url-filename info)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
149 (list a1 a2)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
150
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
151 (defun url-digest-auth (url &optional prompt overwrite realm args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
152 "Get the username/password for the specified URL.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
153 If optional argument PROMPT is non-nil, ask for the username/password
96486
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
154 to use for the URL and its descendants. If optional third argument
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
155 OVERWRITE is non-nil, overwrite the old username/password pair if it
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
156 is found in the assoc list. If REALM is specified, use that as the realm
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
157 instead of hostname:portnum."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
158 (if args
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
159 (let* ((href (if (stringp url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
160 (url-generic-parse-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
161 url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
162 (server (url-host href))
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
163 (type (url-type href))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
164 (port (url-port href))
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
165 (file (url-filename href))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
166 user pass byserv retval data)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
167 (setq file (cond
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
168 (realm realm)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
169 ((string-match "/$" file) file)
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
170 (t (url-file-directory file)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
171 server (format "%s:%d" server port)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
172 byserv (cdr-safe (assoc server url-digest-auth-storage)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
173 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
174 ((and prompt (not byserv))
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
175 (setq user (or
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
176 (auth-source-user-or-password "login" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
177 (read-string (url-auth-user-prompt url realm)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
178 (user-real-login-name)))
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
179 pass (or
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
180 (auth-source-user-or-password "password" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
181 (read-passwd "Password: "))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
182 url-digest-auth-storage
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
183 (cons (list server
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
184 (cons file
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
185 (setq retval
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
186 (cons user
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
187 (url-digest-auth-create-key
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
188 user pass realm
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
189 (or url-request-method "GET")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
190 url)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
191 url-digest-auth-storage)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
192 (byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
193 (setq retval (cdr-safe (assoc file byserv)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
194 (if (and (not retval) ; no exact match, check directories
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
195 (string-match "/" file)) ; not looking for a realm
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
196 (while (and byserv (not retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
197 (setq data (car (car byserv)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
198 (if (or (not (string-match "/" data))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
199 (and
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
200 (>= (length file) (length data))
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
201 (string= data (substring file 0 (length data)))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
202 (setq retval (cdr (car byserv))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
203 (setq byserv (cdr byserv))))
88054
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
204 (if overwrite
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
205 (if (and (not retval) prompt)
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
206 (setq user (or
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
207 (auth-source-user-or-password "login" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
208 (read-string (url-auth-user-prompt url realm)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
209 (user-real-login-name)))
95612
26c59cfcaeff (auth-source-user-or-password): Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents: 94879
diff changeset
210 pass (or
94879
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
211 (auth-source-user-or-password "password" server type)
fc66ed3d9938 Add autoload cookie for
Teodor Zlatanov <tzz@lifelogs.com>
parents: 94668
diff changeset
212 (read-passwd "Password: "))
88054
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
213 retval (setq retval
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
214 (cons user
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
215 (url-digest-auth-create-key
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
216 user pass realm
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
217 (or url-request-method "GET")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
218 url)))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
219 byserv (assoc server url-digest-auth-storage))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
220 (setcdr byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
221 (cons (cons file retval) (cdr byserv))))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
222 (t (setq retval nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
223 (if retval
88054
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
224 (if (cdr-safe (assoc "opaque" args))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
225 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
226 (opaque (cdr-safe (assoc "opaque" args))))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
227 (format
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
228 (concat "Digest username=\"%s\", realm=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
229 "nonce=\"%s\", uri=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
230 "response=\"%s\", opaque=\"%s\"")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
231 (nth 0 retval) realm nonce (url-filename href)
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
232 (md5 (concat (nth 1 retval) ":" nonce ":"
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
233 (nth 2 retval))) opaque))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
234 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
235 (format
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
236 (concat "Digest username=\"%s\", realm=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
237 "nonce=\"%s\", uri=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
238 "response=\"%s\"")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
239 (nth 0 retval) realm nonce (url-filename href)
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
240 (md5 (concat (nth 1 retval) ":" nonce ":"
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
241 (nth 2 retval))))))))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
242
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
243 (defvar url-registered-auth-schemes nil
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
244 "A list of the registered authorization schemes and various and sundry
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
245 information associated with them.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
246
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
247 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
248 (defun url-get-authentication (url realm type prompt &optional args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
249 "Return an authorization string suitable for use in the WWW-Authenticate
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
250 header in an HTTP/1.0 request.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
251
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
252 URL is the url you are requesting authorization to. This can be either a
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
253 string representing the URL, or the parsed representation returned by
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
254 `url-generic-parse-url'
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
255 REALM is the realm at a specific site we are looking for. This should be a
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
256 string specifying the exact realm, or nil or the symbol 'any' to
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
257 specify that the filename portion of the URL should be used as the
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
258 realm
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
259 TYPE is the type of authentication to be returned. This is either a string
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
260 representing the type (basic, digest, etc), or nil or the symbol 'any'
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
261 to specify that any authentication is acceptable. If requesting 'any'
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
262 the strongest matching authentication will be returned. If this is
75519
b271481fb8d2 (url-get-authentication): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 75347
diff changeset
263 wrong, it's no big deal, the error from the server will specify exactly
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
264 what type of auth to use
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
265 PROMPT is boolean - specifies whether to ask the user for a username/password
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
266 if one cannot be found in the cache"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
267 (if (not realm)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
268 (setq realm (cdr-safe (assoc "realm" args))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
269 (if (stringp url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
270 (setq url (url-generic-parse-url url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
271 (if (or (null type) (eq type 'any))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
272 ;; Whooo doogies!
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
273 ;; Go through and get _all_ the authorization strings that could apply
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
274 ;; to this URL, store them along with the 'rating' we have in the list
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
275 ;; of schemes, then sort them so that the 'best' is at the front of the
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
276 ;; list, then get the car, then get the cdr.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
277 ;; Zooom zooom zoooooom
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
278 (cdr-safe
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
279 (car-safe
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
280 (sort
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
281 (mapcar
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
282 (function
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
283 (lambda (scheme)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
284 (if (fboundp (car (cdr scheme)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
285 (cons (cdr (cdr scheme))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
286 (funcall (car (cdr scheme)) url nil nil realm))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
287 (cons 0 nil))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
288 url-registered-auth-schemes)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
289 (function
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
290 (lambda (x y)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
291 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
292 ((null (cdr x)) nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
293 ((and (cdr x) (null (cdr y))) t)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
294 ((and (cdr x) (cdr y))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
295 (>= (car x) (car y)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
296 (t nil)))))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
297 (if (symbolp type) (setq type (symbol-name type)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
298 (let* ((scheme (car-safe
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
299 (cdr-safe (assoc (downcase type)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
300 url-registered-auth-schemes)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
301 (if (and scheme (fboundp scheme))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
302 (funcall scheme url prompt
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
303 (and prompt
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
304 (funcall scheme url nil nil realm args))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
305 realm args)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
306
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
307 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
308 (defun url-register-auth-scheme (type &optional function rating)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
309 "Register an HTTP authentication method.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
310
96486
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
311 TYPE is a string or symbol specifying the name of the method.
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
312 This should be the same thing you expect to get returned in
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
313 an Authenticate header in HTTP/1.0 - it will be downcased.
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
314 FUNCTION is the function to call to get the authorization information.
7369ded3b436 Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 95612
diff changeset
315 This defaults to `url-?-auth', where ? is TYPE.
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
316 RATING a rating between 1 and 10 of the strength of the authentication.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
317 This is used when asking for the best authentication for a specific
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
318 URL. The item with the highest rating is returned."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
319 (let* ((type (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
320 ((stringp type) (downcase type))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
321 ((symbolp type) (downcase (symbol-name type)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
322 (t (error "Bad call to `url-register-auth-scheme'"))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
323 (function (or function (intern (concat "url-" type "-auth"))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
324 (rating (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
325 ((null rating) 2)
62400
e30c08177a3b Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 57612
diff changeset
326 ((stringp rating) (string-to-number rating))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
327 (t rating)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
328 (node (assoc type url-registered-auth-schemes)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
329 (if (not (fboundp function))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
330 (url-warn 'security
54792
369ef3f04d8e (url-register-auth-scheme): Fix `format' call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
331 (format (concat
369ef3f04d8e (url-register-auth-scheme): Fix `format' call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
332 "Tried to register `%s' as an auth scheme"
369ef3f04d8e (url-register-auth-scheme): Fix `format' call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
333 ", but it is not a function!") function)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
334
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
335 (if node
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
336 (setcdr node (cons function rating))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
337 (setq url-registered-auth-schemes
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
338 (cons (cons type (cons function rating))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
339 url-registered-auth-schemes)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
340
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
341 (defun url-auth-registered (scheme)
78481
bc53aa750f3b Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents: 78222
diff changeset
342 "Return non-nil if SCHEME is registered as an auth type."
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
343 (assoc scheme url-registered-auth-schemes))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
344
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
345 (provide 'url-auth)
54699
7784ae10206d Resolve CVS conflicts
Miles Bader <miles@gnu.org>
parents: 54695
diff changeset
346
84378
3c9ba55f960b Comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 82365
diff changeset
347 ;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
348 ;;; url-auth.el ends here