Mercurial > hg > xemacs-beta
diff lisp/w3/url-cookie.el @ 16:0293115a14e9 r19-15b91
Import from CVS: tag r19-15b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:49:20 +0200 |
parents | 9ee227acff29 |
children | 441bb1e64a06 |
line wrap: on
line diff
--- a/lisp/w3/url-cookie.el Mon Aug 13 08:48:43 2007 +0200 +++ b/lisp/w3/url-cookie.el Mon Aug 13 08:49:20 2007 +0200 @@ -1,12 +1,12 @@ ;;; url-cookie.el --- Netscape Cookie support ;; Author: wmperry -;; Created: 1996/10/09 19:00:59 -;; Version: 1.5 +;; Created: 1997/01/26 00:40:23 +;; Version: 1.10 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996 Free Software Foundation, Inc. +;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. ;;; ;;; This file is not part of GNU Emacs, but the same permissions apply. ;;; @@ -29,12 +29,13 @@ (require 'timezone) (require 'cl) -(let ((keywords - '(:name :value :expires :path :domain :test :secure))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords)))) +(eval-and-compile + (let ((keywords + '(:name :value :expires :path :domain :test :secure))) + (while keywords + (or (boundp (car keywords)) + (set (car keywords) (car keywords))) + (setq keywords (cdr keywords))))) ;; See http://home.netscape.com/newsref/std/cookie_spec.html for the ;; 'open standard' defining this crap. @@ -68,10 +69,6 @@ (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args)) retval)) -(defvar url-cookie-storage nil "Where cookies are stored.") -(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") -(defvar url-cookie-file nil "*Where cookies are stored on disk.") - (defun url-cookie-p (obj) (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie))) @@ -110,6 +107,7 @@ (setq new (cons cur new)))) (set var new))) +;;###autoload (defun url-cookie-write-file (&optional fname) (setq fname (or fname url-cookie-file)) (url-cookie-clean-up) @@ -208,6 +206,7 @@ (* 1 (string-to-int (aref exp-time 0)))))) (> (- cur-norm exp-norm) 1)))))) +;;###autoload (defun url-cookie-retrieve (host path &optional secure) "Retrieves all the netscape-style cookies for a specified HOST and PATH" (let ((storage (if secure @@ -235,6 +234,7 @@ (setq retval (cons cur retval)))))) retval)) +;;###autolaod (defun url-cookie-generate-header-lines (host path secure) (let* ((cookies (url-cookie-retrieve host path secure)) (retval nil) @@ -290,6 +290,7 @@ (defun url-header-comparison (x y) (string= (downcase x) (downcase y))) +;;###autoload (defun url-cookie-handle-set-cookie (str) (let* ((args (mm-parse-args str nil t)) ; Don't downcase names (case-fold-search t) @@ -334,10 +335,17 @@ nil) ((url-cookie-host-can-set-p url-current-server domain) ;; Cookie is accepted by the user, and passes our security checks - (while rest - (url-cookie-store (car (car rest)) (cdr (car rest)) - expires domain path secure) - (setq rest (cdr rest)))) + (let ((cur nil)) + (while rest + (setq cur (pop rest)) + ;; Oh gross, this is for microsoft & netscape. + ;; Fuck them fuck them fuchk them fuck them. + (if (string-match "^\\([^=]+\\)=\\(.*\\)" (cdr cur)) + (setq rest (cons (cons (match-string 1 (cdr cur)) + (match-string 2 (cdr cur))) rest) + cur (cons (car cur) ""))) + (url-cookie-store (car cur) (cdr cur) + expires domain path secure)))) (t (url-warn 'url (format (concat "%s tried to set a cookie for domain %s\n"