annotate lisp/url/url-auth.el @ 91569:4a3d0b905c9e

(--with-gcc): Give an error saying this option has been removed. (--with-gtk): Remove this option.
author Glenn Morris <rgm@gnu.org>
date Wed, 06 Feb 2008 07:57:24 +0000
parents eae3aec0f807
children 8259d0d8e107
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
64748
875dcc490074 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64084
diff changeset
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
79720
9c0b3f269b92 Add 2008 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 79065
diff changeset
4 ;; 2005, 2006, 2007, 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
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
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
78222
8932997d0b62 Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents: 75519
diff changeset
12 ;; the Free Software Foundation; either version 3, or (at your option)
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
13 ;; any later version.
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
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64084
a8fa7c632ee4 Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62400
diff changeset
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
a8fa7c632ee4 Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62400
diff changeset
23 ;; Boston, MA 02110-1301, USA.
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
24
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
25 ;;; Code:
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
26
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
27 (require 'url-vars)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
28 (require 'url-parse)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
29 (autoload 'url-warn "url")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
30
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
31 (defsubst url-auth-user-prompt (url realm)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
32 "String to usefully prompt for a username."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
33 (concat "Username [for "
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
34 (or realm (url-truncate-url-for-viewing
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
35 (url-recreate-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
36 (- (window-width) 10 20)))
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
40 ;;; Basic authorization code
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
41 ;;; ------------------------
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
42 ;;; This implements the BASIC authorization type. See the online
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
43 ;;; documentation at
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
44 ;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
45 ;;; for the complete documentation on this type.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
46 ;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
47 ;;; This is very insecure, but it works as a proof-of-concept
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
49 (defvar url-basic-auth-storage 'url-http-real-basic-auth-storage
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
50 "Where usernames and passwords are stored.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
51
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
52 Must be a symbol pointing to another variable that will actually store
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
53 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
54 lists. The first assoc list is keyed by the server name. The cdr of
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
55 this is an assoc list based on the 'directory' specified by the url we
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
56 are looking up.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
57
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
58 (defun url-basic-auth (url &optional prompt overwrite realm args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
59 "Get the username/password for the specified URL.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
60 If optional argument PROMPT is non-nil, ask for the username/password
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
61 to use for the url and its descendants. If optional third argument
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
62 OVERWRITE is non-nil, overwrite the old username/password pair if it
3fb37923e567 Initial revision
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
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
64 instead of the filename inheritance method."
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
65 (let* ((href (if (stringp url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
66 (url-generic-parse-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
67 url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
68 (server (url-host href))
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))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
84 (setq user (read-string (url-auth-user-prompt url realm)
78514
364329b928dc username and password default
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 78481
diff changeset
85 (or user (user-real-login-name)))
364329b928dc username and password default
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 78481
diff changeset
86 pass (read-passwd "Password: " nil (or pass "")))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
87 (set url-basic-auth-storage
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
88 (cons (list server
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
89 (cons file
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
90 (setq retval
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
91 (base64-encode-string
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
92 (format "%s:%s" user pass)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
93 (symbol-value url-basic-auth-storage))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
94 (byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
95 (setq retval (cdr-safe (assoc file byserv)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
96 (if (and (not retval)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
97 (string-match "/" file))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
98 (while (and byserv (not retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
99 (setq data (car (car byserv)))
75519
b271481fb8d2 (url-get-authentication): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 75347
diff changeset
100 (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
101 (and
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
102 (>= (length file) (length data))
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
103 (string= data (substring file 0 (length data)))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
104 (setq retval (cdr (car byserv))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
105 (setq byserv (cdr byserv))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
106 (if (or (and (not retval) prompt) overwrite)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
107 (progn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
108 (setq user (read-string (url-auth-user-prompt url realm)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
109 (user-real-login-name))
57509
e5a1e83cfb02 (url-basic-auth, url-digest-auth): Use read-passwd.
Richard M. Stallman <rms@gnu.org>
parents: 57427
diff changeset
110 pass (read-passwd "Password: ")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
111 retval (base64-encode-string (format "%s:%s" user pass))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
112 byserv (assoc server (symbol-value url-basic-auth-storage)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
113 (setcdr byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
114 (cons (cons file retval) (cdr byserv))))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
115 (t (setq retval nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
116 (if retval (setq retval (concat "Basic " retval)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
117 retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
118
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
120 ;;; Digest authorization code
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
121 ;;; ------------------------
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
122 ;;; This implements the DIGEST authorization type. See the internet draft
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
123 ;;; 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
124 ;;; for the complete documentation on this type.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
125 ;;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
126 ;;; This is very secure
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 (defvar url-digest-auth-storage nil
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
129 "Where usernames and passwords are stored. Its value is an assoc list of
3fb37923e567 Initial revision
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
3fb37923e567 Initial revision
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
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
132 looking up.")
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 (defun url-digest-auth-create-key (username password realm method uri)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
135 "Create a key for digest authentication method"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
136 (let* ((info (if (stringp uri)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
137 (url-generic-parse-url uri)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
138 uri))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
139 (a1 (md5 (concat username ":" realm ":" password)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
140 (a2 (md5 (concat method ":" (url-filename info)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
141 (list a1 a2)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
142
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
143 (defun url-digest-auth (url &optional prompt overwrite realm args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
144 "Get the username/password for the specified URL.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
145 If optional argument PROMPT is non-nil, ask for the username/password
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
146 to use for the url and its descendants. If optional third argument
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
147 OVERWRITE is non-nil, overwrite the old username/password pair if it
3fb37923e567 Initial revision
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
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
149 instead of hostname:portnum."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
150 (if args
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
151 (let* ((href (if (stringp url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
152 (url-generic-parse-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
153 url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
154 (server (url-host href))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
155 (port (url-port href))
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
156 (file (url-filename href))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
157 user pass byserv retval data)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
158 (setq file (cond
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
159 (realm realm)
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
160 ((string-match "/$" file) file)
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
161 (t (url-file-directory file)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
162 server (format "%s:%d" server port)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
163 byserv (cdr-safe (assoc server url-digest-auth-storage)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
164 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
165 ((and prompt (not byserv))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
166 (setq user (read-string (url-auth-user-prompt url realm)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
167 (user-real-login-name))
57509
e5a1e83cfb02 (url-basic-auth, url-digest-auth): Use read-passwd.
Richard M. Stallman <rms@gnu.org>
parents: 57427
diff changeset
168 pass (read-passwd "Password: ")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
169 url-digest-auth-storage
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
170 (cons (list server
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
171 (cons file
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
172 (setq retval
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
173 (cons user
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
174 (url-digest-auth-create-key
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
175 user pass realm
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
176 (or url-request-method "GET")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
177 url)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
178 url-digest-auth-storage)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
179 (byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
180 (setq retval (cdr-safe (assoc file byserv)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
181 (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
182 (string-match "/" file)) ; not looking for a realm
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
183 (while (and byserv (not retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
184 (setq data (car (car byserv)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
185 (if (or (not (string-match "/" data))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
186 (and
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
187 (>= (length file) (length data))
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
188 (string= data (substring file 0 (length data)))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
189 (setq retval (cdr (car byserv))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
190 (setq byserv (cdr byserv))))
88054
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
191 (if overwrite
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
192 (if (and (not retval) prompt)
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
193 (setq user (read-string (url-auth-user-prompt url realm)
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
194 (user-real-login-name))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
195 pass (read-passwd "Password: ")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
196 retval (setq retval
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
197 (cons user
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
198 (url-digest-auth-create-key
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
199 user pass realm
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
200 (or url-request-method "GET")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
201 url)))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
202 byserv (assoc server url-digest-auth-storage))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
203 (setcdr byserv
79065
de62e8014967 (url-digest-auth, url-basic-auth):
Richard M. Stallman <rms@gnu.org>
parents: 79056
diff changeset
204 (cons (cons file retval) (cdr byserv))))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
205 (t (setq retval nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
206 (if retval
88054
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
207 (if (cdr-safe (assoc "opaque" args))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
208 (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
209 (opaque (cdr-safe (assoc "opaque" args))))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
210 (format
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
211 (concat "Digest username=\"%s\", realm=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
212 "nonce=\"%s\", uri=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
213 "response=\"%s\", opaque=\"%s\"")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
214 (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
215 (md5 (concat (nth 1 retval) ":" nonce ":"
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
216 (nth 2 retval))) opaque))
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
217 (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
218 (format
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
219 (concat "Digest username=\"%s\", realm=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
220 "nonce=\"%s\", uri=\"%s\","
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
221 "response=\"%s\"")
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
222 (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
223 (md5 (concat (nth 1 retval) ":" nonce ":"
eae3aec0f807 2008-01-29 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents: 87649
diff changeset
224 (nth 2 retval))))))))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
225
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
226 (defvar url-registered-auth-schemes nil
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
227 "A list of the registered authorization schemes and various and sundry
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
228 information associated with them.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
229
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
230 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
231 (defun url-get-authentication (url realm type prompt &optional args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
232 "Return an authorization string suitable for use in the WWW-Authenticate
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
233 header in an HTTP/1.0 request.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
234
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
235 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
236 string representing the URL, or the parsed representation returned by
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
237 `url-generic-parse-url'
3fb37923e567 Initial revision
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
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
239 string specifying the exact realm, or nil or the symbol 'any' to
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
240 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
241 realm
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
242 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
243 representing the type (basic, digest, etc), or nil or the symbol 'any'
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
244 to specify that any authentication is acceptable. If requesting 'any'
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
245 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
246 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
247 what type of auth to use
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
248 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
249 if one cannot be found in the cache"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
250 (if (not realm)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
251 (setq realm (cdr-safe (assoc "realm" args))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
252 (if (stringp url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
253 (setq url (url-generic-parse-url url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
254 (if (or (null type) (eq type 'any))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
255 ;; Whooo doogies!
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
256 ;; Go through and get _all_ the authorization strings that could apply
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
257 ;; 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
258 ;; 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
259 ;; list, then get the car, then get the cdr.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
260 ;; Zooom zooom zoooooom
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
261 (cdr-safe
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
262 (car-safe
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
263 (sort
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
264 (mapcar
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
265 (function
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
266 (lambda (scheme)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
267 (if (fboundp (car (cdr scheme)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
268 (cons (cdr (cdr scheme))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
269 (funcall (car (cdr scheme)) url nil nil realm))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
270 (cons 0 nil))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
271 url-registered-auth-schemes)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
272 (function
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
273 (lambda (x y)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
274 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
275 ((null (cdr x)) nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
276 ((and (cdr x) (null (cdr y))) t)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
277 ((and (cdr x) (cdr y))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
278 (>= (car x) (car y)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
279 (t nil)))))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
280 (if (symbolp type) (setq type (symbol-name type)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
281 (let* ((scheme (car-safe
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
282 (cdr-safe (assoc (downcase type)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
283 url-registered-auth-schemes)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
284 (if (and scheme (fboundp scheme))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
285 (funcall scheme url prompt
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
286 (and prompt
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
287 (funcall scheme url nil nil realm args))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
288 realm args)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
289
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
290 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
291 (defun url-register-auth-scheme (type &optional function rating)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
292 "Register an HTTP authentication method.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
293
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
294 TYPE is a string or symbol specifying the name of the method. This
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
295 should be the same thing you expect to get returned in an Authenticate
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
296 header in HTTP/1.0 - it will be downcased.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
297 FUNCTION is the function to call to get the authorization information. This
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
298 defaults to `url-?-auth', where ? is TYPE
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
299 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
300 This is used when asking for the best authentication for a specific
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
301 URL. The item with the highest rating is returned."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
302 (let* ((type (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
303 ((stringp type) (downcase type))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
304 ((symbolp type) (downcase (symbol-name type)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
305 (t (error "Bad call to `url-register-auth-scheme'"))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
306 (function (or function (intern (concat "url-" type "-auth"))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
307 (rating (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
308 ((null rating) 2)
62400
e30c08177a3b Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 57612
diff changeset
309 ((stringp rating) (string-to-number rating))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
310 (t rating)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
311 (node (assoc type url-registered-auth-schemes)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
312 (if (not (fboundp function))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
313 (url-warn 'security
54792
369ef3f04d8e (url-register-auth-scheme): Fix `format' call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
314 (format (concat
369ef3f04d8e (url-register-auth-scheme): Fix `format' call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
315 "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
316 ", but it is not a function!") function)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
317
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
318 (if node
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
319 (setcdr node (cons function rating))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
320 (setq url-registered-auth-schemes
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
321 (cons (cons type (cons function rating))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
322 url-registered-auth-schemes)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
323
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
324 (defun url-auth-registered (scheme)
78481
bc53aa750f3b Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents: 78222
diff changeset
325 "Return non-nil if SCHEME is registered as an auth type."
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
326 (assoc scheme url-registered-auth-schemes))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
327
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
328 (provide 'url-auth)
54699
7784ae10206d Resolve CVS conflicts
Miles Bader <miles@gnu.org>
parents: 54695
diff changeset
329
84378
3c9ba55f960b Comment style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 82365
diff changeset
330 ;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
57612
2954cb243379 Update header and footer.
Lars Hansen <larsh@soem.dk>
parents: 57509
diff changeset
331 ;;; url-auth.el ends here