Mercurial > emacs
comparison lisp/url/url-auth.el @ 94879:fc66ed3d9938
Add autoload cookie for
`auth-source-user-or-password'.
(url-basic-auth, url-digest-auth): Use it with any realm,
overriding the user name and password before the prompt.
| author | Teodor Zlatanov <tzz@lifelogs.com> |
|---|---|
| date | Mon, 12 May 2008 12:39:46 +0000 |
| parents | 8259d0d8e107 |
| children | 26c59cfcaeff |
comparison
equal
deleted
inserted
replaced
| 94878:112212c5e23c | 94879:fc66ed3d9938 |
|---|---|
| 23 ;;; Code: | 23 ;;; Code: |
| 24 | 24 |
| 25 (require 'url-vars) | 25 (require 'url-vars) |
| 26 (require 'url-parse) | 26 (require 'url-parse) |
| 27 (autoload 'url-warn "url") | 27 (autoload 'url-warn "url") |
| 28 | |
| 29 (eval-and-compile | |
| 30 (autoload 'auth-source-user-or-password "auth-source")) | |
| 28 | 31 |
| 29 (defsubst url-auth-user-prompt (url realm) | 32 (defsubst url-auth-user-prompt (url realm) |
| 30 "String to usefully prompt for a username." | 33 "String to usefully prompt for a username." |
| 31 (concat "Username [for " | 34 (concat "Username [for " |
| 32 (or realm (url-truncate-url-for-viewing | 35 (or realm (url-truncate-url-for-viewing |
| 62 instead of the filename inheritance method." | 65 instead of the filename inheritance method." |
| 63 (let* ((href (if (stringp url) | 66 (let* ((href (if (stringp url) |
| 64 (url-generic-parse-url url) | 67 (url-generic-parse-url url) |
| 65 url)) | 68 url)) |
| 66 (server (url-host href)) | 69 (server (url-host href)) |
| 70 (type (url-type href)) | |
| 67 (port (url-port href)) | 71 (port (url-port href)) |
| 68 (file (url-filename href)) | 72 (file (url-filename href)) |
| 69 (user (url-user href)) | 73 (user (url-user href)) |
| 70 (pass (url-password href)) | 74 (pass (url-password href)) |
| 71 byserv retval data) | 75 byserv retval data) |
| 77 (t (url-file-directory file))) | 81 (t (url-file-directory file))) |
| 78 byserv (cdr-safe (assoc server | 82 byserv (cdr-safe (assoc server |
| 79 (symbol-value url-basic-auth-storage)))) | 83 (symbol-value url-basic-auth-storage)))) |
| 80 (cond | 84 (cond |
| 81 ((and prompt (not byserv)) | 85 ((and prompt (not byserv)) |
| 82 (setq user (read-string (url-auth-user-prompt url realm) | 86 (setq user (or |
| 83 (or user (user-real-login-name))) | 87 (auth-source-user-or-password "login" server type) |
| 84 pass (read-passwd "Password: " nil (or pass ""))) | 88 (read-string (url-auth-user-prompt url realm) |
| 89 (or user (user-real-login-name)))) | |
| 90 pass (or | |
| 91 (auth-source-user-or-password "password" server type) | |
| 92 (read-passwd "Password: " nil (or pass "")))) | |
| 85 (set url-basic-auth-storage | 93 (set url-basic-auth-storage |
| 86 (cons (list server | 94 (cons (list server |
| 87 (cons file | 95 (cons file |
| 88 (setq retval | 96 (setq retval |
| 89 (base64-encode-string | 97 (base64-encode-string |
| 101 (string= data (substring file 0 (length data))))) | 109 (string= data (substring file 0 (length data))))) |
| 102 (setq retval (cdr (car byserv)))) | 110 (setq retval (cdr (car byserv)))) |
| 103 (setq byserv (cdr byserv)))) | 111 (setq byserv (cdr byserv)))) |
| 104 (if (or (and (not retval) prompt) overwrite) | 112 (if (or (and (not retval) prompt) overwrite) |
| 105 (progn | 113 (progn |
| 106 (setq user (read-string (url-auth-user-prompt url realm) | 114 (setq user (or |
| 107 (user-real-login-name)) | 115 (auth-source-user-or-password "login" server type) |
| 108 pass (read-passwd "Password: ") | 116 (read-string (url-auth-user-prompt url realm) |
| 117 (user-real-login-name))) | |
| 118 pass (or | |
| 119 (auth-source-user-or-password "password" server type) | |
| 120 (read-passwd "Password: ")) | |
| 109 retval (base64-encode-string (format "%s:%s" user pass)) | 121 retval (base64-encode-string (format "%s:%s" user pass)) |
| 110 byserv (assoc server (symbol-value url-basic-auth-storage))) | 122 byserv (assoc server (symbol-value url-basic-auth-storage))) |
| 111 (setcdr byserv | 123 (setcdr byserv |
| 112 (cons (cons file retval) (cdr byserv)))))) | 124 (cons (cons file retval) (cdr byserv)))))) |
| 113 (t (setq retval nil))) | 125 (t (setq retval nil))) |
| 148 (if args | 160 (if args |
| 149 (let* ((href (if (stringp url) | 161 (let* ((href (if (stringp url) |
| 150 (url-generic-parse-url url) | 162 (url-generic-parse-url url) |
| 151 url)) | 163 url)) |
| 152 (server (url-host href)) | 164 (server (url-host href)) |
| 165 (type (url-type href)) | |
| 153 (port (url-port href)) | 166 (port (url-port href)) |
| 154 (file (url-filename href)) | 167 (file (url-filename href)) |
| 155 user pass byserv retval data) | 168 user pass byserv retval data) |
| 156 (setq file (cond | 169 (setq file (cond |
| 157 (realm realm) | 170 (realm realm) |
| 159 (t (url-file-directory file))) | 172 (t (url-file-directory file))) |
| 160 server (format "%s:%d" server port) | 173 server (format "%s:%d" server port) |
| 161 byserv (cdr-safe (assoc server url-digest-auth-storage))) | 174 byserv (cdr-safe (assoc server url-digest-auth-storage))) |
| 162 (cond | 175 (cond |
| 163 ((and prompt (not byserv)) | 176 ((and prompt (not byserv)) |
| 164 (setq user (read-string (url-auth-user-prompt url realm) | 177 (setq user (or |
| 165 (user-real-login-name)) | 178 (auth-source-user-or-password "login" server type) |
| 166 pass (read-passwd "Password: ") | 179 (read-string (url-auth-user-prompt url realm) |
| 180 (user-real-login-name))) | |
| 181 pass (or | |
| 182 (auth-source-user-or-password "password" server type) | |
| 183 (read-passwd "Password: ")) | |
| 167 url-digest-auth-storage | 184 url-digest-auth-storage |
| 168 (cons (list server | 185 (cons (list server |
| 169 (cons file | 186 (cons file |
| 170 (setq retval | 187 (setq retval |
| 171 (cons user | 188 (cons user |
| 186 (string= data (substring file 0 (length data))))) | 203 (string= data (substring file 0 (length data))))) |
| 187 (setq retval (cdr (car byserv)))) | 204 (setq retval (cdr (car byserv)))) |
| 188 (setq byserv (cdr byserv)))) | 205 (setq byserv (cdr byserv)))) |
| 189 (if overwrite | 206 (if overwrite |
| 190 (if (and (not retval) prompt) | 207 (if (and (not retval) prompt) |
| 191 (setq user (read-string (url-auth-user-prompt url realm) | 208 (setq user (or |
| 192 (user-real-login-name)) | 209 (auth-source-user-or-password "login" server type) |
| 193 pass (read-passwd "Password: ") | 210 (read-string (url-auth-user-prompt url realm) |
| 211 (user-real-login-name))) | |
| 212 pass (or | |
| 213 (auth-source-user-or-password "password" server type) | |
| 214 (read-passwd "Password: ")) | |
| 194 retval (setq retval | 215 retval (setq retval |
| 195 (cons user | 216 (cons user |
| 196 (url-digest-auth-create-key | 217 (url-digest-auth-create-key |
| 197 user pass realm | 218 user pass realm |
| 198 (or url-request-method "GET") | 219 (or url-request-method "GET") |