Function: url-cookie-handle-set-cookie

url-cookie-handle-set-cookie is a byte-compiled function defined in url-cookie.el.gz.

Signature

(url-cookie-handle-set-cookie STR)

Source Code

;; Defined in /usr/src/emacs/lisp/url/url-cookie.el.gz
(defun url-cookie-handle-set-cookie (str)
  (setq url-cookies-changed-since-last-save 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))
		     (url-host url-current-object)))
	 (current-url (url-view-url t))
	 (trusted url-cookie-trusted-urls)
	 (untrusted url-cookie-untrusted-urls)
	 (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))))
	 (expires nil))
    (if (and max-age (string-match "\\`-?[0-9]+\\'" max-age))
	(setq expires (ignore-errors
                        (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)))
	(pop trusted)))
    (while (consp untrusted)
      (if (string-match (car untrusted) current-url)
	  (setq untrusted (- (match-end 0) (match-beginning 0)))
	(pop untrusted)))
    (and trusted untrusted
	 ;; Choose the more specific match.
	 (if (> trusted untrusted) (setq untrusted nil) (setq trusted nil)))
    (cond
     (untrusted
      ;; The site was explicitly marked as untrusted by the user.
      nil)
     ((or (eq url-privacy-level 'paranoid)
	  (and (listp url-privacy-level) (memq 'cookies url-privacy-level)))
      ;; User never wants cookies.
      nil)
     ((and url-cookie-confirmation
	   (not trusted)
	   (save-window-excursion
	     (with-output-to-temp-buffer "*Cookie Warning*"
	       (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? "
				       (url-host url-current-object))))
	       (if (get-buffer "*Cookie Warning*")
		   (kill-buffer "*Cookie Warning*")))))
      ;; User wants to be asked, and declined.
      nil)
     ((url-cookie-host-can-set-p (url-host url-current-object) domain)
      ;; Cookie is accepted by the user, and passes our security checks.
      (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)))))