]> code.delx.au - gnu-emacs/blobdiff - lisp/url/url-cookie.el
Use url-lazy-message for warnings about ignored cookies.
[gnu-emacs] / lisp / url / url-cookie.el
index 80dc5e534d6a1f73d4641cdc6839bec6df070890..e056db38a98551c6a4da79e22b1b60a362f03696 100644 (file)
@@ -1,7 +1,7 @@
 ;;; url-cookie.el --- Netscape Cookie support
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
+;;   2009, 2010  Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes, hypermedia
 
@@ -24,7 +24,6 @@
 
 ;;; Code:
 
-(require 'timezone)
 (require 'url-util)
 (require 'url-parse)
 (eval-when-compile (require 'cl))
@@ -194,36 +193,11 @@ telling Microsoft that."
        (setq url-cookie-storage (list (list domain tmp))))))))
 
 (defun url-cookie-expired-p (cookie)
-  (let* (
-        (exp (url-cookie-expires cookie))
-        (cur-date (and exp (timezone-parse-date (current-time-string))))
-        (exp-date (and exp (timezone-parse-date exp)))
-        (cur-greg (and cur-date (timezone-absolute-from-gregorian
-                                 (string-to-number (aref cur-date 1))
-                                 (string-to-number (aref cur-date 2))
-                                 (string-to-number (aref cur-date 0)))))
-        (exp-greg (and exp (timezone-absolute-from-gregorian
-                            (string-to-number (aref exp-date 1))
-                            (string-to-number (aref exp-date 2))
-                            (string-to-number (aref exp-date 0)))))
-        (diff-in-days (and exp (- cur-greg exp-greg)))
-        )
-    (cond
-     ((not exp)        nil)                    ; No expiry == expires at browser quit
-     ((< diff-in-days 0) nil)          ; Expires sometime after today
-     ((> diff-in-days 0) t)            ; Expired before today
-     (t                                        ; Expires sometime today, check times
-      (let* ((cur-time (timezone-parse-time (aref cur-date 3)))
-            (exp-time (timezone-parse-time (aref exp-date 3)))
-            (cur-norm (+ (* 360 (string-to-number (aref cur-time 2)))
-                         (*  60 (string-to-number (aref cur-time 1)))
-                         (*   1 (string-to-number (aref cur-time 0)))))
-            (exp-norm (+ (* 360 (string-to-number (aref exp-time 2)))
-                         (*  60 (string-to-number (aref exp-time 1)))
-                         (*   1 (string-to-number (aref exp-time 0))))))
-       (> (- cur-norm exp-norm) 1))))))
-
-(defun url-cookie-retrieve (host localpart &optional secure)
+  "Return non-nil if COOKIE is expired."
+  (let ((exp (url-cookie-expires cookie)))
+    (and exp (> (float-time) (float-time (date-to-time exp))))))
+
+(defun url-cookie-retrieve (host &optional localpart secure)
   "Retrieve all the netscape-style cookies for a specified HOST and LOCALPART."
   (let ((storage (if secure
                     (append url-cookie-secure-storage url-cookie-storage)
@@ -232,7 +206,7 @@ telling Microsoft that."
        (cookies nil)
        (cur nil)
        (retval nil)
-       (localpart-regexp nil))
+       (localpart-match nil))
     (while storage
       (setq cur (car storage)
            storage (cdr storage)
@@ -251,9 +225,12 @@ telling Microsoft that."
          (while cookies
            (setq cur (car cookies)
                  cookies (cdr cookies)
-                 localpart-regexp (concat "^" (regexp-quote
-                                               (url-cookie-localpart cur))))
-           (if (and (string-match localpart-regexp localpart)
+                 localpart-match (url-cookie-localpart cur))
+           (if (and (if (stringp localpart-match)
+                        (string-match (concat "^" (regexp-quote
+                                                   localpart-match))
+                                      localpart)
+                      (equal localpart localpart-match))
                     (not (url-cookie-expired-p cur)))
                (setq retval (cons cur retval))))))
     retval))
@@ -423,8 +400,8 @@ telling Microsoft that."
          (url-cookie-store (car cur) (cdr cur)
                            expires domain localpart secure))))
      (t
-      (message "%s tried to set a cookie for domain %s - rejected."
-              (url-host url-current-object) domain)))))
+      (url-lazy-message "%s tried to set a cookie for domain %s - rejected."
+                       (url-host url-current-object) domain)))))
 
 (defvar url-cookie-timer nil)