summaryrefslogtreecommitdiff
path: root/lisp/url/url-cookie.el
diff options
context:
space:
mode:
authorGlenn Morris <rgm@gnu.org>2017-11-14 17:43:06 -0500
committerGlenn Morris <rgm@gnu.org>2017-11-14 17:43:06 -0500
commit52d822f31bc7cb57694c1e209b2d02e5efb8f48c (patch)
treea3d07b0e0e1e4a692a2420c7e5c0d7c05e3ab62b /lisp/url/url-cookie.el
parent13248f7444630508cfc3b78a07e8d96613af11c8 (diff)
parent796c7f7a949c83d64ae37cadb9a0ca28a2f1823a (diff)
downloademacs-52d822f31bc7cb57694c1e209b2d02e5efb8f48c.tar.gz
Merge from origin/emacs-26
796c7f7 (origin/emacs-26) ; Fix last fix of 'mouse-drag-and-drop-region' 40d41dd (emacs-26) Fix Bug#28139 a5ec644 Fix Bug#29291 8b900e5 Fix Bug#2928 ff7bd84 Make 'mouse-drag-and-drop-region' work with 'mouse-autoselect... 0491de8 * etc/PROBLEMS: Remove fixed xterm-mouse-mode problems caa39f4 Fix cookie handling (bug#29282) 93304e3 Improve documentation of Edebug and macros
Diffstat (limited to 'lisp/url/url-cookie.el')
-rw-r--r--lisp/url/url-cookie.el53
1 files changed, 13 insertions, 40 deletions
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 109d55ad39d..8045050c61e 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -290,7 +290,7 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
(defun url-cookie-handle-set-cookie (str)
(setq url-cookies-changed-since-last-save t)
- (let* ((args (url-parse-args str t))
+ (let* ((args (nreverse (url-parse-args str t)))
(case-fold-search t)
(secure (and (assoc-string "secure" args t) t))
(domain (or (cdr-safe (assoc-string "domain" args t))
@@ -298,44 +298,16 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
(current-url (url-view-url t))
(trusted url-cookie-trusted-urls)
(untrusted url-cookie-untrusted-urls)
- (expires (cdr-safe (assoc-string "expires" args t)))
+ (max-age (cdr-safe (assoc-string "max-age" args t)))
(localpart (or (cdr-safe (assoc-string "path" args t))
(file-name-directory
(url-filename url-current-object))))
- (rest nil))
- (dolist (this args)
- (or (member (downcase (car this)) '("secure" "domain" "expires" "path"))
- (setq rest (cons this rest))))
-
- ;; Sometimes we get dates that the timezone package cannot handle very
- ;; gracefully - take care of this here, instead of in url-cookie-expired-p
- ;; to speed things up.
- (and expires
- (string-match
- (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
- "\\(..:..:..\\) +\\[*\\([^]]+\\)\\]*$")
- expires)
- (setq expires (concat (match-string 1 expires) " "
- (match-string 2 expires) " "
- (match-string 3 expires) " "
- (match-string 4 expires) " ["
- (match-string 5 expires) "]")))
-
- ;; This one is for older Emacs/XEmacs variants that don't
- ;; understand this format without tenths of a second in it.
- ;; Wednesday, 30-Dec-2037 16:00:00 GMT
- ;; - vs -
- ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
- (and expires
- (string-match
- "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
- expires)
- (setq expires (concat (match-string 1 expires) "-" ; day
- (match-string 2 expires) "-" ; month
- (match-string 3 expires) " " ; year
- (match-string 4 expires) ".00 " ; hour:minutes:seconds
- (match-string 6 expires)))) ":" ; timezone
-
+ (expires nil))
+ (if (and max-age (string-match "\\`-?[0-9]+\\'" max-age))
+ (setq expires (format-time-string "%a %b %d %H:%M:%S %Y GMT"
+ (time-add nil (read max-age))
+ t))
+ (setq expires (cdr-safe (assoc-string "expires" args t))))
(while (consp trusted)
(if (string-match (car trusted) current-url)
(setq trusted (- (match-end 0) (match-beginning 0)))
@@ -359,8 +331,9 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
(not trusted)
(save-window-excursion
(with-output-to-temp-buffer "*Cookie Warning*"
- (dolist (x rest)
- (princ (format "%s - %s" (car x) (cdr x)))))
+ (princ (format "%s=\"%s\"\n" (caar args) (cdar args)))
+ (dolist (x (cdr args))
+ (princ (format " %s=\"%s\"\n" (car x) (cdr x)))))
(prog1
(not (funcall url-confirmation-func
(format "Allow %s to set these cookies? "
@@ -371,8 +344,8 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
nil)
((url-cookie-host-can-set-p (url-host url-current-object) domain)
;; Cookie is accepted by the user, and passes our security checks.
- (dolist (cur rest)
- (url-cookie-store (car cur) (cdr cur) expires domain localpart secure)))
+ (url-cookie-store (caar args) (cdar args)
+ expires domain localpart secure))
(t
(url-lazy-message "%s tried to set a cookie for domain %s - rejected."
(url-host url-current-object) domain)))))