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