;;; url-cookie.el --- Netscape Cookie support
;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; See http://home.netscape.com/newsref/std/cookie_spec.html for the
;; 'open standard' defining this crap.
-;;
-;; A cookie is stored internally as a vector of 7 slots
-;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
-
-(defsubst url-cookie-name (cookie) (aref cookie 1))
-(defsubst url-cookie-value (cookie) (aref cookie 2))
-(defsubst url-cookie-expires (cookie) (aref cookie 3))
-(defsubst url-cookie-localpart (cookie) (aref cookie 4))
-(defsubst url-cookie-domain (cookie) (aref cookie 5))
-(defsubst url-cookie-secure (cookie) (aref cookie 6))
-
-(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val))
-(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val))
-(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val))
-(defsubst url-cookie-set-localpart (cookie val) (aset cookie 4 val))
-(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val))
-(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val))
-(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args)))
-
-(defsubst url-cookie-create (&rest args)
- "Create a cookie vector object from keyword-value pairs ARGS.
-The keywords allowed are
- :name NAME
- :value VALUE
- :expires TIME
- :localpart LOCALPAR
- :domain DOMAIN
- :secure ???
-Could someone fill in more information?"
- (let ((retval (make-vector 7 nil)))
- (aset retval 0 'cookie)
- (url-cookie-set-name retval (url-cookie-retrieve-arg :name args))
- (url-cookie-set-value retval (url-cookie-retrieve-arg :value args))
- (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args))
- (url-cookie-set-localpart retval (url-cookie-retrieve-arg :localpart args))
- (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args))
- (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args))
- retval))
-
-(defun url-cookie-p (obj)
- "Return non-nil if OBJ is a cookie vector object.
-These objects represent cookies in the URL package.
-A cookie vector object is a vector of 7 slots:
- [cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE]."
- (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
(defgroup url-cookie nil
"URL cookies."
:prefix "url-cookie-"
:group 'url)
+;; A cookie is stored internally as a vector of 7 slots
+;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
+
+(defstruct (url-cookie
+ (:constructor url-cookie-create)
+ (:copier nil)
+ ;; For compatibility with a previous version which did not use
+ ;; defstruct, and also in order to make sure that the printed
+ ;; representation does not depend on CL internals, we use an
+ ;; explicitly managed tag.
+ (:type vector))
+ (tag 'cookie :read-only t)
+ name value expires localpart domain secure)
+
(defvar url-cookie-storage nil "Where cookies are stored.")
(defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
(defcustom url-cookie-file nil
- "*File where cookies are stored on disk."
+ "File where cookies are stored on disk."
:type '(choice (const :tag "Default" :value nil) file)
:group 'url-file
:group 'url-cookie)
(defcustom url-cookie-confirmation nil
- "*If non-nil, confirmation by the user is required to accept HTTP cookies."
+ "If non-nil, confirmation by the user is required to accept HTTP cookies."
:type 'boolean
:group 'url-cookie)
(defcustom url-cookie-multiple-line nil
- "*If nil, HTTP requests put all cookies for the server on one line.
+ "If nil, HTTP requests put all cookies for the server on one line.
Some web servers, such as http://www.hotmail.com/, only accept cookies
when they are on one line. This is broken behavior, but just try
telling Microsoft that."
(insert ")\n(setq url-cookie-secure-storage\n '")
(pp url-cookie-secure-storage (current-buffer))
(insert ")\n")
+ (insert "\f\n;; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-byte-compile: t\n"
+ ";; End:\n")
+ (set (make-local-variable 'version-control) 'never)
(write-file fname)
+ (setq url-cookies-changed-since-last-save nil)
(kill-buffer (current-buffer))))))
(defun url-cookie-store (name value &optional expires domain localpart secure)
(if (and (equal localpart (url-cookie-localpart cur))
(equal name (url-cookie-name cur)))
(progn
- (url-cookie-set-expires cur expires)
- (url-cookie-set-value cur value)
+ (setf (url-cookie-expires cur) expires)
+ (setf (url-cookie-value cur) value)
(setq tmp t))))
(if (not tmp)
;; New cookie
storage (cdr storage)
cookies (cdr cur))
(if (and (car cur)
- (string-match (concat "^.*" (regexp-quote (car cur)) "$") host))
+ (string-match
+ (concat "^.*"
+ (regexp-quote
+ ;; Remove the dot from wildcard domains
+ ;; before matching.
+ (if (eq ?. (aref (car cur) 0))
+ (substring (car cur) 1)
+ (car cur)))
+ "$") host))
;; The domains match - a possible hit!
(while cookies
(setq cur (car cookies)
'.'s in the domain name in order to set a cookie.")
(defcustom url-cookie-trusted-urls nil
- "*A list of regular expressions matching URLs to always accept cookies from."
+ "A list of regular expressions matching URLs to always accept cookies from."
:type '(repeat regexp)
:group 'url-cookie)
(defcustom url-cookie-untrusted-urls nil
- "*A list of regular expressions matching URLs to never accept cookies from."
+ "A list of regular expressions matching URLs to never accept cookies from."
:type '(repeat regexp)
:group 'url-cookie)
(defun url-cookie-host-can-set-p (host domain)
(let ((numdots 0)
- (tmp domain)
(last nil)
(case-fold-search t)
(mindots 3))
((>= numdots mindots) ; We have enough dots in domain name
;; Need to check and make sure the host is actually _in_ the
;; domain it wants to set a cookie for though.
- (string-match (concat (regexp-quote domain) "$") host))
+ (string-match (concat (regexp-quote
+ ;; Remove the dot from wildcard domains
+ ;; before matching.
+ (if (eq ?. (aref domain 0))
+ (substring domain 1)
+ domain))
+ "$") host))
(t
nil))))
(defvar url-cookie-timer nil)
(defcustom url-cookie-save-interval 3600
- "*The number of seconds between automatic saves of cookies.
+ "The number of seconds between automatic saves of cookies.
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-cookie-setup-save-timer' function manually."
(if (bound-and-true-p url-setup-done)
(url-cookie-setup-save-timer)))
:type 'integer
- :group 'url)
+ :group 'url-cookie)
(defun url-cookie-setup-save-timer ()
"Reset the cookie saver timer."
HCoop / bpt / emacs.git / blobdiff