comparison lisp/url/url-cookie.el @ 90533:8a8e69664178

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 343-356) - Update from CVS - Update for ERC 5.1.3. - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 113-115) - Merge from emacs--devo--0 - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-90
author Miles Bader <miles@gnu.org>
date Wed, 19 Jul 2006 00:42:56 +0000
parents c4527316e616
children fd926d483a42 b19aaf4ab0ee
comparison
equal deleted inserted replaced
90532:e22cf6d2400c 90533:8a8e69664178
86 :group 'url) 86 :group 'url)
87 87
88 (defvar url-cookie-storage nil "Where cookies are stored.") 88 (defvar url-cookie-storage nil "Where cookies are stored.")
89 (defvar url-cookie-secure-storage nil "Where secure cookies are stored.") 89 (defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
90 (defcustom url-cookie-file nil 90 (defcustom url-cookie-file nil
91 "*File where cookies are stored on disk." 91 "File where cookies are stored on disk."
92 :type '(choice (const :tag "Default" :value nil) file) 92 :type '(choice (const :tag "Default" :value nil) file)
93 :group 'url-file 93 :group 'url-file
94 :group 'url-cookie) 94 :group 'url-cookie)
95 95
96 (defcustom url-cookie-confirmation nil 96 (defcustom url-cookie-confirmation nil
97 "*If non-nil, confirmation by the user is required to accept HTTP cookies." 97 "If non-nil, confirmation by the user is required to accept HTTP cookies."
98 :type 'boolean 98 :type 'boolean
99 :group 'url-cookie) 99 :group 'url-cookie)
100 100
101 (defcustom url-cookie-multiple-line nil 101 (defcustom url-cookie-multiple-line nil
102 "*If nil, HTTP requests put all cookies for the server on one line. 102 "If nil, HTTP requests put all cookies for the server on one line.
103 Some web servers, such as http://www.hotmail.com/, only accept cookies 103 Some web servers, such as http://www.hotmail.com/, only accept cookies
104 when they are on one line. This is broken behavior, but just try 104 when they are on one line. This is broken behavior, but just try
105 telling Microsoft that." 105 telling Microsoft that."
106 :type 'boolean 106 :type 'boolean
107 :group 'url-cookie) 107 :group 'url-cookie)
166 "(setq url-cookie-storage\n '") 166 "(setq url-cookie-storage\n '")
167 (pp url-cookie-storage (current-buffer)) 167 (pp url-cookie-storage (current-buffer))
168 (insert ")\n(setq url-cookie-secure-storage\n '") 168 (insert ")\n(setq url-cookie-secure-storage\n '")
169 (pp url-cookie-secure-storage (current-buffer)) 169 (pp url-cookie-secure-storage (current-buffer))
170 (insert ")\n") 170 (insert ")\n")
171 (insert " ;; Local Variables:\n"
172 ";; version-control: never\n"
173 ";; no-byte-compile: t\n"
174 ";; End:\n")
175 (set (make-local-variable 'version-control) t)
171 (write-file fname) 176 (write-file fname)
177 (setq url-cookies-changed-since-last-save nil)
172 (kill-buffer (current-buffer)))))) 178 (kill-buffer (current-buffer))))))
173 179
174 (defun url-cookie-store (name value &optional expires domain localpart secure) 180 (defun url-cookie-store (name value &optional expires domain localpart secure)
175 "Store a netscape-style cookie." 181 "Store a netscape-style cookie."
176 (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage)) 182 (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
311 "\\)$") 317 "\\)$")
312 "A regexp of top level domains that only require two matching 318 "A regexp of top level domains that only require two matching
313 '.'s in the domain name in order to set a cookie.") 319 '.'s in the domain name in order to set a cookie.")
314 320
315 (defcustom url-cookie-trusted-urls nil 321 (defcustom url-cookie-trusted-urls nil
316 "*A list of regular expressions matching URLs to always accept cookies from." 322 "A list of regular expressions matching URLs to always accept cookies from."
317 :type '(repeat regexp) 323 :type '(repeat regexp)
318 :group 'url-cookie) 324 :group 'url-cookie)
319 325
320 (defcustom url-cookie-untrusted-urls nil 326 (defcustom url-cookie-untrusted-urls nil
321 "*A list of regular expressions matching URLs to never accept cookies from." 327 "A list of regular expressions matching URLs to never accept cookies from."
322 :type '(repeat regexp) 328 :type '(repeat regexp)
323 :group 'url-cookie) 329 :group 'url-cookie)
324 330
325 (defun url-cookie-host-can-set-p (host domain) 331 (defun url-cookie-host-can-set-p (host domain)
326 (let ((numdots 0) 332 (let ((numdots 0)
327 (tmp domain)
328 (last nil) 333 (last nil)
329 (case-fold-search t) 334 (case-fold-search t)
330 (mindots 3)) 335 (mindots 3))
331 (while (setq last (string-match "\\." domain last)) 336 (while (setq last (string-match "\\." domain last))
332 (setq numdots (1+ numdots) 337 (setq numdots (1+ numdots)
442 (url-host url-current-object) domain))))) 447 (url-host url-current-object) domain)))))
443 448
444 (defvar url-cookie-timer nil) 449 (defvar url-cookie-timer nil)
445 450
446 (defcustom url-cookie-save-interval 3600 451 (defcustom url-cookie-save-interval 3600
447 "*The number of seconds between automatic saves of cookies. 452 "The number of seconds between automatic saves of cookies.
448 Default is 1 hour. Note that if you change this variable outside of 453 Default is 1 hour. Note that if you change this variable outside of
449 the `customize' interface after `url-do-setup' has been run, you need 454 the `customize' interface after `url-do-setup' has been run, you need
450 to run the `url-cookie-setup-save-timer' function manually." 455 to run the `url-cookie-setup-save-timer' function manually."
451 :set #'(lambda (var val) 456 :set #'(lambda (var val)
452 (set-default var val) 457 (set-default var val)
453 (if (bound-and-true-p url-setup-done) 458 (if (bound-and-true-p url-setup-done)
454 (url-cookie-setup-save-timer))) 459 (url-cookie-setup-save-timer)))
455 :type 'integer 460 :type 'integer
456 :group 'url) 461 :group 'url-cookie)
457 462
458 (defun url-cookie-setup-save-timer () 463 (defun url-cookie-setup-save-timer ()
459 "Reset the cookie saver timer." 464 "Reset the cookie saver timer."
460 (interactive) 465 (interactive)
461 (ignore-errors (cancel-timer url-cookie-timer)) 466 (ignore-errors (cancel-timer url-cookie-timer))