Artifact
bf01624c2bc0258018abaceb97aed04e565e0479:
0000: 3b 3b 3b 0a 3b 3b 3b 20 63 6f 6f 6b 69 65 2e 73 ;;;.;;; cookie.s
0010: 63 6d 20 2d 20 70 61 72 73 65 20 61 6e 64 20 63 cm - parse and c
0020: 6f 6e 73 74 72 75 63 74 20 68 74 74 70 20 73 74 onstruct http st
0030: 61 74 65 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 0a ate information.
0040: 3b 3b 3b 20 20 0a 3b 3b 3b 20 20 20 43 6f 70 79 ;;; .;;; Copy
0050: 72 69 67 68 74 20 28 63 29 20 32 30 30 30 2d 32 right (c) 2000-2
0060: 30 30 33 20 53 68 69 72 6f 20 4b 61 77 61 69 2c 003 Shiro Kawai,
0070: 20 41 6c 6c 20 72 69 67 68 74 73 20 72 65 73 65 All rights rese
0080: 72 76 65 64 2e 0a 3b 3b 3b 20 20 20 0a 3b 3b 3b rved..;;; .;;;
0090: 20 20 20 52 65 64 69 73 74 72 69 62 75 74 69 6f Redistributio
00a0: 6e 20 61 6e 64 20 75 73 65 20 69 6e 20 73 6f 75 n and use in sou
00b0: 72 63 65 20 61 6e 64 20 62 69 6e 61 72 79 20 66 rce and binary f
00c0: 6f 72 6d 73 2c 20 77 69 74 68 20 6f 72 20 77 69 orms, with or wi
00d0: 74 68 6f 75 74 0a 3b 3b 3b 20 20 20 6d 6f 64 69 thout.;;; modi
00e0: 66 69 63 61 74 69 6f 6e 2c 20 61 72 65 20 70 65 fication, are pe
00f0: 72 6d 69 74 74 65 64 20 70 72 6f 76 69 64 65 64 rmitted provided
0100: 20 74 68 61 74 20 74 68 65 20 66 6f 6c 6c 6f 77 that the follow
0110: 69 6e 67 20 63 6f 6e 64 69 74 69 6f 6e 73 0a 3b ing conditions.;
0120: 3b 3b 20 20 20 61 72 65 20 6d 65 74 3a 0a 3b 3b ;; are met:.;;
0130: 3b 20 20 20 0a 3b 3b 3b 20 20 20 31 2e 20 52 65 ; .;;; 1. Re
0140: 64 69 73 74 72 69 62 75 74 69 6f 6e 73 20 6f 66 distributions of
0150: 20 73 6f 75 72 63 65 20 63 6f 64 65 20 6d 75 73 source code mus
0160: 74 20 72 65 74 61 69 6e 20 74 68 65 20 61 62 6f t retain the abo
0170: 76 65 20 63 6f 70 79 72 69 67 68 74 0a 3b 3b 3b ve copyright.;;;
0180: 20 20 20 20 20 20 6e 6f 74 69 63 65 2c 20 74 68 notice, th
0190: 69 73 20 6c 69 73 74 20 6f 66 20 63 6f 6e 64 69 is list of condi
01a0: 74 69 6f 6e 73 20 61 6e 64 20 74 68 65 20 66 6f tions and the fo
01b0: 6c 6c 6f 77 69 6e 67 20 64 69 73 63 6c 61 69 6d llowing disclaim
01c0: 65 72 2e 0a 3b 3b 3b 20 20 0a 3b 3b 3b 20 20 20 er..;;; .;;;
01d0: 32 2e 20 52 65 64 69 73 74 72 69 62 75 74 69 6f 2. Redistributio
01e0: 6e 73 20 69 6e 20 62 69 6e 61 72 79 20 66 6f 72 ns in binary for
01f0: 6d 20 6d 75 73 74 20 72 65 70 72 6f 64 75 63 65 m must reproduce
0200: 20 74 68 65 20 61 62 6f 76 65 20 63 6f 70 79 72 the above copyr
0210: 69 67 68 74 0a 3b 3b 3b 20 20 20 20 20 20 6e 6f ight.;;; no
0220: 74 69 63 65 2c 20 74 68 69 73 20 6c 69 73 74 20 tice, this list
0230: 6f 66 20 63 6f 6e 64 69 74 69 6f 6e 73 20 61 6e of conditions an
0240: 64 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 d the following
0250: 64 69 73 63 6c 61 69 6d 65 72 20 69 6e 20 74 68 disclaimer in th
0260: 65 0a 3b 3b 3b 20 20 20 20 20 20 64 6f 63 75 6d e.;;; docum
0270: 65 6e 74 61 74 69 6f 6e 20 61 6e 64 2f 6f 72 20 entation and/or
0280: 6f 74 68 65 72 20 6d 61 74 65 72 69 61 6c 73 20 other materials
0290: 70 72 6f 76 69 64 65 64 20 77 69 74 68 20 74 68 provided with th
02a0: 65 20 64 69 73 74 72 69 62 75 74 69 6f 6e 2e 0a e distribution..
02b0: 3b 3b 3b 20 20 0a 3b 3b 3b 20 20 20 33 2e 20 4e ;;; .;;; 3. N
02c0: 65 69 74 68 65 72 20 74 68 65 20 6e 61 6d 65 20 either the name
02d0: 6f 66 20 74 68 65 20 61 75 74 68 6f 72 73 20 6e of the authors n
02e0: 6f 72 20 74 68 65 20 6e 61 6d 65 73 20 6f 66 20 or the names of
02f0: 69 74 73 20 63 6f 6e 74 72 69 62 75 74 6f 72 73 its contributors
0300: 0a 3b 3b 3b 20 20 20 20 20 20 6d 61 79 20 62 65 .;;; may be
0310: 20 75 73 65 64 20 74 6f 20 65 6e 64 6f 72 73 65 used to endorse
0320: 20 6f 72 20 70 72 6f 6d 6f 74 65 20 70 72 6f 64 or promote prod
0330: 75 63 74 73 20 64 65 72 69 76 65 64 20 66 72 6f ucts derived fro
0340: 6d 20 74 68 69 73 0a 3b 3b 3b 20 20 20 20 20 20 m this.;;;
0350: 73 6f 66 74 77 61 72 65 20 77 69 74 68 6f 75 74 software without
0360: 20 73 70 65 63 69 66 69 63 20 70 72 69 6f 72 20 specific prior
0370: 77 72 69 74 74 65 6e 20 70 65 72 6d 69 73 73 69 written permissi
0380: 6f 6e 2e 0a 3b 3b 3b 20 20 0a 3b 3b 3b 20 20 20 on..;;; .;;;
0390: 54 48 49 53 20 53 4f 46 54 57 41 52 45 20 49 53 THIS SOFTWARE IS
03a0: 20 50 52 4f 56 49 44 45 44 20 42 59 20 54 48 45 PROVIDED BY THE
03b0: 20 43 4f 50 59 52 49 47 48 54 20 48 4f 4c 44 45 COPYRIGHT HOLDE
03c0: 52 53 20 41 4e 44 20 43 4f 4e 54 52 49 42 55 54 RS AND CONTRIBUT
03d0: 4f 52 53 0a 3b 3b 3b 20 20 20 22 41 53 20 49 53 ORS.;;; "AS IS
03e0: 22 20 41 4e 44 20 41 4e 59 20 45 58 50 52 45 53 " AND ANY EXPRES
03f0: 53 20 4f 52 20 49 4d 50 4c 49 45 44 20 57 41 52 S OR IMPLIED WAR
0400: 52 41 4e 54 49 45 53 2c 20 49 4e 43 4c 55 44 49 RANTIES, INCLUDI
0410: 4e 47 2c 20 42 55 54 20 4e 4f 54 0a 3b 3b 3b 20 NG, BUT NOT.;;;
0420: 20 20 4c 49 4d 49 54 45 44 20 54 4f 2c 20 54 48 LIMITED TO, TH
0430: 45 20 49 4d 50 4c 49 45 44 20 57 41 52 52 41 4e E IMPLIED WARRAN
0440: 54 49 45 53 20 4f 46 20 4d 45 52 43 48 41 4e 54 TIES OF MERCHANT
0450: 41 42 49 4c 49 54 59 20 41 4e 44 20 46 49 54 4e ABILITY AND FITN
0460: 45 53 53 20 46 4f 52 0a 3b 3b 3b 20 20 20 41 20 ESS FOR.;;; A
0470: 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f PARTICULAR PURPO
0480: 53 45 20 41 52 45 20 44 49 53 43 4c 41 49 4d 45 SE ARE DISCLAIME
0490: 44 2e 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 D. IN NO EVENT S
04a0: 48 41 4c 4c 20 54 48 45 20 43 4f 50 59 52 49 47 HALL THE COPYRIG
04b0: 48 54 0a 3b 3b 3b 20 20 20 4f 57 4e 45 52 20 4f HT.;;; OWNER O
04c0: 52 20 43 4f 4e 54 52 49 42 55 54 4f 52 53 20 42 R CONTRIBUTORS B
04d0: 45 20 4c 49 41 42 4c 45 20 46 4f 52 20 41 4e 59 E LIABLE FOR ANY
04e0: 20 44 49 52 45 43 54 2c 20 49 4e 44 49 52 45 43 DIRECT, INDIREC
04f0: 54 2c 20 49 4e 43 49 44 45 4e 54 41 4c 2c 0a 3b T, INCIDENTAL,.;
0500: 3b 3b 20 20 20 53 50 45 43 49 41 4c 2c 20 45 58 ;; SPECIAL, EX
0510: 45 4d 50 4c 41 52 59 2c 20 4f 52 20 43 4f 4e 53 EMPLARY, OR CONS
0520: 45 51 55 45 4e 54 49 41 4c 20 44 41 4d 41 47 45 EQUENTIAL DAMAGE
0530: 53 20 28 49 4e 43 4c 55 44 49 4e 47 2c 20 42 55 S (INCLUDING, BU
0540: 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 0a 3b 3b T NOT LIMITED.;;
0550: 3b 20 20 20 54 4f 2c 20 50 52 4f 43 55 52 45 4d ; TO, PROCUREM
0560: 45 4e 54 20 4f 46 20 53 55 42 53 54 49 54 55 54 ENT OF SUBSTITUT
0570: 45 20 47 4f 4f 44 53 20 4f 52 20 53 45 52 56 49 E GOODS OR SERVI
0580: 43 45 53 3b 20 4c 4f 53 53 20 4f 46 20 55 53 45 CES; LOSS OF USE
0590: 2c 20 44 41 54 41 2c 20 4f 52 0a 3b 3b 3b 20 20 , DATA, OR.;;;
05a0: 20 50 52 4f 46 49 54 53 3b 20 4f 52 20 42 55 53 PROFITS; OR BUS
05b0: 49 4e 45 53 53 20 49 4e 54 45 52 52 55 50 54 49 INESS INTERRUPTI
05c0: 4f 4e 29 20 48 4f 57 45 56 45 52 20 43 41 55 53 ON) HOWEVER CAUS
05d0: 45 44 20 41 4e 44 20 4f 4e 20 41 4e 59 20 54 48 ED AND ON ANY TH
05e0: 45 4f 52 59 20 4f 46 0a 3b 3b 3b 20 20 20 4c 49 EORY OF.;;; LI
05f0: 41 42 49 4c 49 54 59 2c 20 57 48 45 54 48 45 52 ABILITY, WHETHER
0600: 20 49 4e 20 43 4f 4e 54 52 41 43 54 2c 20 53 54 IN CONTRACT, ST
0610: 52 49 43 54 20 4c 49 41 42 49 4c 49 54 59 2c 20 RICT LIABILITY,
0620: 4f 52 20 54 4f 52 54 20 28 49 4e 43 4c 55 44 49 OR TORT (INCLUDI
0630: 4e 47 0a 3b 3b 3b 20 20 20 4e 45 47 4c 49 47 45 NG.;;; NEGLIGE
0640: 4e 43 45 20 4f 52 20 4f 54 48 45 52 57 49 53 45 NCE OR OTHERWISE
0650: 29 20 41 52 49 53 49 4e 47 20 49 4e 20 41 4e 59 ) ARISING IN ANY
0660: 20 57 41 59 20 4f 55 54 20 4f 46 20 54 48 45 20 WAY OUT OF THE
0670: 55 53 45 20 4f 46 20 54 48 49 53 0a 3b 3b 3b 20 USE OF THIS.;;;
0680: 20 20 53 4f 46 54 57 41 52 45 2c 20 45 56 45 4e SOFTWARE, EVEN
0690: 20 49 46 20 41 44 56 49 53 45 44 20 4f 46 20 54 IF ADVISED OF T
06a0: 48 45 20 50 4f 53 53 49 42 49 4c 49 54 59 20 4f HE POSSIBILITY O
06b0: 46 20 53 55 43 48 20 44 41 4d 41 47 45 2e 0a 3b F SUCH DAMAGE..;
06c0: 3b 3b 20 20 0a 3b 3b 3b 20 20 50 6f 72 74 65 64 ;; .;;; Ported
06d0: 20 74 6f 20 43 68 69 63 6b 65 6e 20 62 79 20 52 to Chicken by R
06e0: 65 65 64 20 53 68 65 72 69 64 61 6e 0a 3b 3b 3b eed Sheridan.;;;
06f0: 0a 0a 3b 3b 20 50 61 72 73 65 72 20 61 6e 64 20 ..;; Parser and
0700: 63 6f 6e 73 74 72 75 63 74 6f 72 20 6f 66 20 68 constructor of h
0710: 74 74 70 20 22 43 6f 6f 6b 69 65 73 22 20 64 65 ttp "Cookies" de
0720: 66 69 6e 65 64 20 69 6e 0a 3b 3b 20 52 46 43 20 fined in.;; RFC
0730: 32 39 36 35 20 48 54 54 50 20 73 74 61 74 65 20 2965 HTTP state
0740: 6d 61 6e 61 67 65 6d 6e 65 74 20 6d 65 63 68 61 managemnet mecha
0750: 6e 69 73 6d 0a 3b 3b 20 20 20 3c 66 74 70 3a 2f nism.;; <ftp:/
0760: 2f 66 74 70 2e 69 73 69 2e 65 64 75 2f 69 6e 2d /ftp.isi.edu/in-
0770: 6e 6f 74 65 73 2f 72 66 63 32 39 36 35 2e 74 78 notes/rfc2965.tx
0780: 74 3e 0a 3b 3b 20 53 65 65 20 61 6c 73 6f 0a 3b t>.;; See also.;
0790: 3b 20 52 46 43 20 32 39 36 34 20 55 73 65 20 6f ; RFC 2964 Use o
07a0: 66 20 48 54 54 50 20 73 74 61 74 65 20 6d 61 6e f HTTP state man
07b0: 61 67 65 6d 65 6e 74 0a 3b 3b 20 20 20 3c 66 74 agement.;; <ft
07c0: 70 3a 2f 2f 66 74 70 2e 69 73 69 2e 65 64 75 2f p://ftp.isi.edu/
07d0: 69 6e 2d 6e 6f 74 65 73 2f 72 66 63 32 39 36 34 in-notes/rfc2964
07e0: 2e 74 78 74 3e 0a 3b 3b 20 54 68 65 20 70 61 72 .txt>.;; The par
07f0: 73 65 72 20 61 6c 73 6f 20 73 75 70 70 6f 72 74 ser also support
0800: 73 20 74 68 65 20 6f 6c 64 20 4e 65 74 73 63 61 s the old Netsca
0810: 70 65 20 73 70 65 63 0a 3b 3b 20 20 20 3c 68 74 pe spec.;; <ht
0820: 74 70 3a 2f 2f 77 77 77 2e 6e 65 74 73 63 61 70 tp://www.netscap
0830: 65 2e 63 6f 6d 2f 6e 65 77 73 72 65 66 2f 73 74 e.com/newsref/st
0840: 64 2f 63 6f 6f 6b 69 65 5f 73 70 65 63 2e 68 74 d/cookie_spec.ht
0850: 6d 6c 3e 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 ml>..(declare (u
0860: 6e 69 74 20 63 6f 6f 6b 69 65 29 29 0a 28 72 65 nit cookie)).(re
0870: 71 75 69 72 65 2d 65 78 74 65 6e 73 69 6f 6e 20 quire-extension
0880: 73 72 66 69 2d 31 20 73 72 66 69 2d 31 33 20 73 srfi-1 srfi-13 s
0890: 72 66 69 2d 31 34 20 72 65 67 65 78 29 0a 3b 3b rfi-14 regex).;;
08a0: 20 28 75 73 65 20 20 73 72 66 69 2d 31 20 73 72 (use srfi-1 sr
08b0: 66 69 2d 31 33 20 73 72 66 69 2d 31 34 20 72 65 fi-13 srfi-14 re
08c0: 67 65 78 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 gex).;; (declare
08d0: 20 28 65 78 70 6f 72 74 20 70 61 72 73 65 2d 63 (export parse-c
08e0: 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 20 63 6f 6e ookie-string con
08f0: 73 74 72 75 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 struct-cookie-st
0900: 72 69 6e 67 29 29 0a 0a 23 3e 0a 23 69 6e 63 6c ring))..#>.#incl
0910: 75 64 65 20 3c 74 69 6d 65 2e 68 3e 0a 3c 23 0a ude <time.h>.<#.
0920: 0a 28 64 65 66 69 6e 65 20 66 6d 74 2d 74 69 6d .(define fmt-tim
0930: 65 0a 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d e. (foreign-lam
0940: 62 64 61 2a 20 63 2d 73 74 72 69 6e 67 20 28 28 bda* c-string ((
0950: 6c 6f 6e 67 20 73 65 63 73 5f 73 69 6e 63 65 5f long secs_since_
0960: 65 70 6f 63 68 29 29 0a 20 20 20 20 22 73 74 61 epoch)). "sta
0970: 74 69 63 20 63 68 61 72 20 62 75 66 5b 32 35 36 tic char buf[256
0980: 5d 3b 22 0a 20 20 20 20 22 74 69 6d 65 5f 74 20 ];". "time_t
0990: 74 20 3d 20 28 74 69 6d 65 5f 74 29 20 73 65 63 t = (time_t) sec
09a0: 73 5f 73 69 6e 63 65 5f 65 70 6f 63 68 3b 22 0a s_since_epoch;".
09b0: 20 20 20 20 22 73 74 72 66 74 69 6d 65 28 62 75 "strftime(bu
09c0: 66 2c 20 73 69 7a 65 6f 66 28 62 75 66 29 2c 20 f, sizeof(buf),
09d0: 5c 22 25 61 2c 20 25 64 2d 25 62 2d 25 59 20 25 \"%a, %d-%b-%Y %
09e0: 48 3a 25 4d 3a 25 53 20 47 4d 54 5c 22 2c 20 67 H:%M:%S GMT\", g
09f0: 6d 74 69 6d 65 28 26 74 29 29 3b 22 0a 20 20 20 mtime(&t));".
0a00: 20 22 72 65 74 75 72 6e 28 62 75 66 29 3b 22 29 "return(buf);")
0a10: 29 0a 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 )...;; (define (
0a20: 66 6d 74 2d 74 69 6d 65 20 73 65 63 6f 6e 64 73 fmt-time seconds
0a30: 29 0a 3b 3b 20 20 20 28 74 69 6d 65 2d 3e 73 74 ).;; (time->st
0a40: 72 69 6e 67 20 28 73 65 63 6f 6e 64 73 2d 3e 75 ring (seconds->u
0a50: 74 63 2d 74 69 6d 65 20 73 65 63 6f 6e 64 73 29 tc-time seconds)
0a60: 20 22 25 44 22 29 29 0a 0a 20 3b 3b 20 75 74 69 "%D")).. ;; uti
0a70: 6c 69 74 79 20 66 6e 2e 20 20 62 72 65 61 6b 73 lity fn. breaks
0a80: 20 20 60 60 61 74 74 72 3d 76 61 6c 75 65 3b 61 ``attr=value;a
0a90: 74 74 72 3d 76 61 6c 75 65 20 2e 2e 2e 20 27 27 ttr=value ... ''
0aa0: 20 69 6e 74 6f 20 61 6c 69 73 74 2e 0a 20 3b 3b into alist.. ;;
0ab0: 20 76 65 72 73 69 6f 6e 20 69 73 20 61 20 63 6f version is a co
0ac0: 6f 6b 69 65 20 76 65 72 73 69 6f 6e 2e 20 20 69 okie version. i
0ad0: 66 20 76 65 72 73 69 6f 6e 3e 30 2c 20 77 65 20 f version>0, we
0ae0: 61 6c 6c 6f 77 20 63 6f 6d 6d 61 20 61 73 20 74 allow comma as t
0af0: 68 65 0a 20 3b 3b 20 64 65 6c 69 6d 69 74 65 72 he. ;; delimiter
0b00: 20 61 73 20 77 65 6c 6c 20 61 73 20 73 65 6d 69 as well as semi
0b10: 63 6f 6c 6f 6e 2e 0a 20 28 64 65 66 69 6e 65 20 colon.. (define
0b20: 28 70 61 72 73 65 2d 61 76 2d 70 61 69 72 73 20 (parse-av-pairs
0b30: 69 6e 70 75 74 20 76 65 72 73 69 6f 6e 29 0a 20 input version).
0b40: 20 20 28 64 65 66 69 6e 65 20 61 74 74 72 2d 72 (define attr-r
0b50: 65 67 65 78 70 0a 20 20 20 20 20 28 69 66 20 28 egexp. (if (
0b60: 3d 20 76 65 72 73 69 6f 6e 20 30 29 0a 20 20 20 = version 0).
0b70: 20 20 20 20 20 20 28 72 65 67 65 78 70 20 22 5c (regexp "\
0b80: 5c 73 2a 28 5b 5c 5c 77 24 5f 2d 5d 2b 29 5c 5c \s*([\\w$_-]+)\\
0b90: 73 2a 28 5b 3d 5c 5c 3b 5d 5c 5c 73 2a 29 3f 22 s*([=\\;]\\s*)?"
0ba0: 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 67 65 ). (rege
0bb0: 78 70 20 22 5c 5c 73 2a 28 5b 5c 5c 77 24 5f 2d xp "\\s*([\\w$_-
0bc0: 5d 2b 29 5c 5c 73 2a 28 5b 3d 5c 5c 3b 2c 5d 5c ]+)\\s*([=\\;,]\
0bd0: 5c 73 2a 29 3f 22 29 29 29 0a 20 20 20 28 64 65 \s*)?"))). (de
0be0: 66 69 6e 65 20 61 74 74 72 2d 64 65 6c 69 6d 0a fine attr-delim.
0bf0: 20 20 20 20 20 28 69 66 20 28 3d 20 76 65 72 73 (if (= vers
0c00: 69 6f 6e 20 30 29 20 23 5c 3b 20 28 63 68 61 72 ion 0) #\; (char
0c10: 2d 73 65 74 20 23 5c 2c 20 23 5c 5c 20 23 5c 3b -set #\, #\\ #\;
0c20: 29 29 29 0a 20 20 20 0a 20 20 20 28 64 65 66 69 ))). . (defi
0c30: 6e 65 20 28 72 65 61 64 2d 61 74 74 72 20 69 6e ne (read-attr in
0c40: 70 75 74 20 72 29 0a 20 20 20 20 20 28 63 6f 6e put r). (con
0c50: 64 20 28 28 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f d ((string-null?
0c60: 20 69 6e 70 75 74 29 20 28 72 65 76 65 72 73 65 input) (reverse
0c70: 21 20 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 ! r)).
0c80: 20 28 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 ((string-search
0c90: 20 61 74 74 72 2d 72 65 67 65 78 70 20 69 6e 70 attr-regexp inp
0ca0: 75 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ut).
0cb0: 3d 3e 20 28 6c 61 6d 62 64 61 20 28 6d 29 0a 20 => (lambda (m).
0cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cd0: 28 69 66 20 28 61 6e 64 2d 6c 65 74 2a 20 28 28 (if (and-let* ((
0ce0: 64 65 6c 69 6d 69 74 65 72 20 28 74 68 69 72 64 delimiter (third
0cf0: 20 6d 29 29 29 20 3b 3b 69 73 20 61 6e 20 61 74 m))) ;;is an at
0d00: 74 72 5f 76 61 6c 75 65 20 70 61 69 0a 20 09 09 tr_value pai. ..
0d10: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 70 72 (string-pr
0d20: 65 66 69 78 3f 20 22 3d 22 20 64 65 6c 69 6d 69 efix? "=" delimi
0d30: 74 65 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 ter)).
0d40: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
0d50: 28 28 61 74 74 72 20 28 73 65 63 6f 6e 64 20 6d ((attr (second m
0d60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
0d80: 65 73 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 est (string-sear
0d90: 63 68 2d 61 66 74 65 72 20 61 74 74 72 2d 72 65 ch-after attr-re
0da0: 67 65 78 70 20 69 6e 70 75 74 29 29 29 0a 20 20 gexp input))).
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
0dd0: 2d 70 72 65 66 69 78 3f 20 22 5c 22 22 20 72 65 -prefix? "\"" re
0de0: 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0e00: 72 65 61 64 2d 74 6f 6b 65 6e 2d 71 75 6f 74 65 read-token-quote
0e10: 64 20 61 74 74 72 20 28 73 74 72 69 6e 67 2d 64 d attr (string-d
0e20: 72 6f 70 20 72 65 73 74 20 31 29 20 72 29 0a 20 rop rest 1) r).
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 20 20 20 20 20 20 20 20 20 28 72 65 61 64 2d (read-
0e50: 74 6f 6b 65 6e 20 61 74 74 72 20 72 65 73 74 20 token attr rest
0e60: 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 r))).
0e70: 20 20 20 20 20 20 20 20 20 20 28 72 65 61 64 2d (read-
0e80: 61 74 74 72 20 28 73 74 72 69 6e 67 2d 73 65 61 attr (string-sea
0e90: 72 63 68 2d 61 66 74 65 72 20 61 74 74 72 2d 72 rch-after attr-r
0ea0: 65 67 65 78 70 20 69 6e 70 75 74 29 20 3b 3b 20 egexp input) ;;
0eb0: 53 6b 69 70 20 61 68 65 61 64 20 69 66 20 62 72 Skip ahead if br
0ec0: 6f 6b 65 6e 20 69 6e 70 75 74 3f 0a 20 20 20 20 oken input?.
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6c 69 (ali
0ef0: 73 74 2d 63 6f 6e 73 20 28 73 65 63 6f 6e 64 20 st-cons (second
0f00: 6d 29 20 23 66 20 72 29 29 29 29 29 0a 20 20 20 m) #f r))))).
0f10: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
0f20: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 74 68 65 ;; the
0f30: 20 69 6e 70 75 74 20 69 73 20 62 72 6f 6b 65 6e input is broken
0f40: 3b 20 66 6f 72 20 6e 6f 77 2c 20 77 65 20 69 67 ; for now, we ig
0f50: 6e 6f 72 65 20 74 68 65 20 72 65 73 74 2e 0a 20 nore the rest..
0f60: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 76 65 (reve
0f70: 72 73 65 21 20 72 29 29 29 29 0a 20 20 20 28 64 rse! r)))). (d
0f80: 65 66 69 6e 65 20 28 72 65 61 64 2d 74 6f 6b 65 efine (read-toke
0f90: 6e 20 61 74 74 72 20 69 6e 70 75 74 20 72 29 0a n attr input r).
0fa0: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 73 74 72 (cond ((str
0fb0: 69 6e 67 2d 69 6e 64 65 78 20 69 6e 70 75 74 20 ing-index input
0fc0: 61 74 74 72 2d 64 65 6c 69 6d 29 0a 20 20 20 20 attr-delim).
0fd0: 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d 62 => (lamb
0fe0: 64 61 20 28 69 29 0a 20 20 20 20 20 20 20 20 20 da (i).
0ff0: 20 20 20 20 20 20 20 20 28 72 65 61 64 2d 61 74 (read-at
1000: 74 72 20 28 73 74 72 69 6e 67 2d 64 72 6f 70 20 tr (string-drop
1010: 69 6e 70 75 74 20 28 2b 20 69 20 31 29 29 0a 20 input (+ i 1)).
1020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1030: 20 20 20 20 20 20 20 20 20 20 20 28 61 6c 69 73 (alis
1040: 74 2d 63 6f 6e 73 20 61 74 74 72 0a 20 09 09 09 t-cons attr. ...
1050: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
1060: 74 72 69 6d 2d 72 69 67 68 74 20 28 73 74 72 69 trim-right (stri
1070: 6e 67 2d 74 61 6b 65 20 69 6e 70 75 74 20 69 29 ng-take input i)
1080: 29 0a 20 09 09 09 09 20 20 20 20 20 20 20 72 29 ). .... r)
1090: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
10a0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
10b0: 20 28 72 65 76 65 72 73 65 21 20 28 61 6c 69 73 (reverse! (alis
10c0: 74 2d 63 6f 6e 73 20 61 74 74 72 20 28 73 74 72 t-cons attr (str
10d0: 69 6e 67 2d 74 72 69 6d 2d 72 69 67 68 74 20 69 ing-trim-right i
10e0: 6e 70 75 74 29 20 72 29 29 29 29 29 0a 20 20 20 nput) r))))).
10f0: 28 64 65 66 69 6e 65 20 28 72 65 61 64 2d 74 6f (define (read-to
1100: 6b 65 6e 2d 71 75 6f 74 65 64 20 61 74 74 72 20 ken-quoted attr
1110: 69 6e 70 75 74 20 72 29 0a 20 20 20 20 20 28 6c input r). (l
1120: 65 74 20 6c 6f 6f 70 20 28 28 69 6e 70 75 74 20 et loop ((input
1130: 69 6e 70 75 74 29 0a 20 20 20 20 20 20 20 20 20 input).
1140: 20 20 20 20 20 20 20 28 70 61 72 74 69 61 6c 20 (partial
1150: 27 28 29 29 29 0a 20 20 20 20 20 20 20 28 63 6f '())). (co
1160: 6e 64 20 28 28 73 74 72 69 6e 67 2d 69 6e 64 65 nd ((string-inde
1170: 78 20 69 6e 70 75 74 20 28 63 68 61 72 2d 73 65 x input (char-se
1180: 74 20 23 5c 5c 20 23 5c 22 29 29 0a 20 20 20 20 t #\\ #\")).
1190: 20 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 => (la
11a0: 6d 62 64 61 20 28 69 29 0a 20 20 20 20 20 20 20 mbda (i).
11b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
11c0: 20 28 28 63 20 28 73 74 72 69 6e 67 2d 72 65 66 ((c (string-ref
11d0: 20 69 6e 70 75 74 20 69 29 29 29 0a 20 20 20 20 input i))).
11e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f0: 20 28 69 66 20 28 63 68 61 72 3d 3f 20 63 20 23 (if (char=? c #
1200: 5c 5c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 \\).
1210: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
1220: 20 28 3c 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 (< (string-leng
1230: 74 68 20 69 6e 70 75 74 29 20 28 2b 20 69 20 31 th input) (+ i 1
1240: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1260: 28 65 72 72 6f 72 2d 75 6e 74 65 72 6d 69 6e 61 (error-untermina
1270: 74 65 64 20 61 74 74 72 29 0a 20 20 20 20 20 20 ted attr).
1280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1290: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 73 74 (loop (st
12a0: 72 69 6e 67 2d 64 72 6f 70 20 69 6e 70 75 74 20 ring-drop input
12b0: 28 2b 20 69 20 32 29 29 0a 20 20 20 20 20 20 20 (+ i 2)).
12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
12e0: 73 2a 20 28 73 74 72 69 6e 67 20 28 73 74 72 69 s* (string (stri
12f0: 6e 67 2d 72 65 66 20 69 6e 70 75 74 20 28 2b 20 ng-ref input (+
1300: 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 i 1))).
1310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1330: 20 28 73 74 72 69 6e 67 2d 74 61 6b 65 20 69 6e (string-take in
1340: 70 75 74 20 69 29 0a 20 20 20 20 20 20 20 20 20 put i).
1350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1370: 20 70 61 72 74 69 61 6c 29 29 29 0a 20 20 20 20 partial))).
1380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1390: 20 20 20 20 20 28 72 65 61 64 2d 61 74 74 72 20 (read-attr
13a0: 28 73 74 72 69 6e 67 2d 64 72 6f 70 20 69 6e 70 (string-drop inp
13b0: 75 74 20 28 2b 20 69 20 31 29 29 0a 20 20 20 20 ut (+ i 1)).
13c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13e0: 28 61 6c 69 73 74 2d 63 6f 6e 73 20 61 74 74 72 (alist-cons attr
13f0: 0a 20 09 09 09 09 09 20 20 20 20 20 20 20 28 73 . ..... (s
1400: 74 72 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 tring-concatenat
1410: 65 2d 72 65 76 65 72 73 65 0a 20 09 09 09 09 09 e-reverse. .....
1420: 09 28 63 6f 6e 73 20 28 73 74 72 69 6e 67 2d 74 .(cons (string-t
1430: 61 6b 65 20 69 6e 70 75 74 20 69 29 0a 20 09 09 ake input i). ..
1440: 09 09 09 09 20 20 20 20 20 20 70 61 72 74 69 61 .... partia
1450: 6c 29 29 0a 20 09 09 09 09 09 20 20 20 20 20 20 l)). .....
1460: 20 72 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 r)))))).
1470: 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 72 72 (else (err
1480: 6f 72 2d 75 6e 74 65 72 6d 69 6e 61 74 65 64 20 or-unterminated
1490: 61 74 74 72 29 29 29 29 29 0a 20 20 20 28 64 65 attr))))). (de
14a0: 66 69 6e 65 20 28 65 72 72 6f 72 2d 75 6e 74 65 fine (error-unte
14b0: 72 6d 69 6e 61 74 65 64 20 61 74 74 72 29 0a 20 rminated attr).
14c0: 20 20 20 20 28 65 72 72 6f 72 20 22 55 6e 74 65 (error "Unte
14d0: 72 6d 69 6e 61 74 65 64 20 71 75 6f 74 65 64 20 rminated quoted
14e0: 76 61 6c 75 65 20 67 69 76 65 6e 20 66 6f 72 20 value given for
14f0: 61 74 74 72 69 62 75 74 65 22 20 61 74 74 72 29 attribute" attr)
1500: 29 0a 20 0a 20 20 20 28 72 65 61 64 2d 61 74 74 ). . (read-att
1510: 72 20 69 6e 70 75 74 20 27 28 29 29 29 0a 20 0a r input '())). .
1520: 20 3b 3b 20 50 61 72 73 65 73 20 74 68 65 20 68 ;; Parses the h
1530: 65 61 64 65 72 20 76 61 6c 75 65 20 6f 66 20 22 eader value of "
1540: 43 6f 6f 6b 69 65 22 20 72 65 71 75 65 73 74 20 Cookie" request
1550: 68 65 61 64 65 72 2e 0a 20 3b 3b 20 49 66 20 63 header.. ;; If c
1560: 6f 6f 6b 69 65 20 76 65 72 73 69 6f 6e 20 69 73 ookie version is
1570: 20 6b 6e 6f 77 6e 20 62 79 20 22 43 6f 6f 6b 69 known by "Cooki
1580: 65 32 22 20 72 65 71 75 65 73 74 20 68 65 61 64 e2" request head
1590: 65 72 2c 20 69 74 20 73 68 6f 75 6c 64 0a 20 3b er, it should. ;
15a0: 3b 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 76 ; be passed to v
15b0: 65 72 73 69 6f 6e 20 28 61 73 20 69 6e 74 65 67 ersion (as integ
15c0: 65 72 29 2e 20 20 4f 74 68 65 72 77 69 73 65 2c er). Otherwise,
15d0: 20 69 74 20 66 69 67 75 72 65 73 20 6f 75 74 0a it figures out.
15e0: 20 3b 3b 20 74 68 65 20 63 6f 6f 6b 69 65 20 76 ;; the cookie v
15f0: 65 72 73 69 6f 6e 20 66 72 6f 6d 20 69 6e 70 75 ersion from inpu
1600: 74 2e 0a 20 3b 3b 0a 20 3b 3b 20 52 65 74 75 72 t.. ;;. ;; Retur
1610: 6e 73 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 ns the following
1620: 20 66 6f 72 6d 61 74 2e 0a 20 3b 3b 20 20 20 28 format.. ;; (
1630: 28 3c 6e 61 6d 65 3e 20 3c 76 61 6c 75 65 3e 20 (<name> <value>
1640: 5b 3a 70 61 74 68 20 3c 70 61 74 68 3e 5d 20 5b [:path <path>] [
1650: 3a 64 6f 6d 61 69 6e 20 3c 64 6f 6d 61 69 6e 3e :domain <domain>
1660: 5d 20 5b 3a 70 6f 72 74 20 3c 70 6f 72 74 3e 5d ] [:port <port>]
1670: 29 0a 20 3b 3b 20 20 20 20 2e 2e 2e 29 0a 20 0a ). ;; ...). .
1680: 20 28 64 65 66 69 6e 65 20 28 70 61 72 73 65 2d (define (parse-
1690: 63 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 20 69 6e cookie-string in
16a0: 70 75 74 20 23 21 6f 70 74 69 6f 6e 61 6c 20 76 put #!optional v
16b0: 65 72 73 69 6f 6e 29 0a 20 20 20 28 6c 65 74 20 ersion). (let
16c0: 28 28 76 65 72 20 28 63 6f 6e 64 20 28 28 69 6e ((ver (cond ((in
16d0: 74 65 67 65 72 3f 20 76 65 72 73 69 6f 6e 29 20 teger? version)
16e0: 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 20 version).
16f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 ((s
1700: 74 72 69 6e 67 2d 73 65 61 72 63 68 20 22 5e 5c tring-search "^\
1710: 5c 73 2a 5c 5c 24 56 65 72 73 69 6f 6e 5c 5c 73 \s*\\$Version\\s
1720: 2a 3d 5c 5c 73 2a 28 5c 5c 64 2b 29 22 20 69 6e *=\\s*(\\d+)" in
1730: 70 75 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 put).
1740: 20 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 => (la
1750: 6d 62 64 61 20 28 6d 29 0a 20 20 20 20 20 20 20 mbda (m).
1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1770: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
1780: 65 72 20 28 63 61 64 72 20 6d 29 29 29 29 0a 20 er (cadr m)))).
1790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17a0: 20 20 20 28 65 6c 73 65 20 30 29 29 29 29 0a 20 (else 0)))).
17b0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
17c0: 61 76 2d 70 61 69 72 73 20 28 70 61 72 73 65 2d av-pairs (parse-
17d0: 61 76 2d 70 61 69 72 73 20 69 6e 70 75 74 20 76 av-pairs input v
17e0: 65 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 er)).
17f0: 20 20 20 20 20 28 72 20 27 28 29 29 0a 20 20 20 (r '()).
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 75 (cu
1810: 72 72 65 6e 74 20 27 28 29 29 29 0a 20 20 20 20 rrent '())).
1820: 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f (cond ((null?
1830: 20 61 76 2d 70 61 69 72 73 29 0a 20 20 20 20 20 av-pairs).
1840: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
1850: 6c 6c 3f 20 63 75 72 72 65 6e 74 29 0a 20 20 20 ll? current).
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1870: 72 65 76 65 72 73 65 20 72 29 0a 20 20 20 20 20 reverse r).
1880: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
1890: 76 65 72 73 65 20 28 63 6f 6e 73 20 28 72 65 76 verse (cons (rev
18a0: 65 72 73 65 20 63 75 72 72 65 6e 74 29 20 72 29 erse current) r)
18b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
18c0: 20 28 28 73 74 72 69 6e 67 2d 63 69 3d 3f 20 22 ((string-ci=? "
18d0: 24 70 61 74 68 22 20 28 63 61 61 72 20 61 76 2d $path" (caar av-
18e0: 70 61 69 72 73 29 29 0a 20 20 20 20 20 20 20 20 pairs)).
18f0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 (loop (cdr
1900: 20 61 76 2d 70 61 69 72 73 29 20 72 20 28 63 6f av-pairs) r (co
1910: 6e 73 2a 20 28 63 64 61 72 20 61 76 2d 70 61 69 ns* (cdar av-pai
1920: 72 73 29 20 70 61 74 68 3a 20 63 75 72 72 65 6e rs) path: curren
1930: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
1940: 20 20 28 28 73 74 72 69 6e 67 2d 63 69 3d 3f 20 ((string-ci=?
1950: 22 24 64 6f 6d 61 69 6e 22 20 28 63 61 61 72 20 "$domain" (caar
1960: 61 76 2d 70 61 69 72 73 29 29 0a 20 20 20 20 20 av-pairs)).
1970: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
1980: 63 64 72 20 61 76 2d 70 61 69 72 73 29 20 72 20 cdr av-pairs) r
1990: 28 63 6f 6e 73 2a 20 28 63 64 61 72 20 61 76 2d (cons* (cdar av-
19a0: 70 61 69 72 73 29 20 64 6f 6d 61 69 6e 3a 20 63 pairs) domain: c
19b0: 75 72 72 65 6e 74 29 29 29 0a 20 20 20 20 20 20 urrent))).
19c0: 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d ((string-
19d0: 63 69 3d 3f 20 22 24 70 6f 72 74 22 20 28 63 61 ci=? "$port" (ca
19e0: 61 72 20 61 76 2d 70 61 69 72 73 29 29 0a 20 20 ar av-pairs)).
19f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
1a00: 70 20 28 63 64 72 20 61 76 2d 70 61 69 72 73 29 p (cdr av-pairs)
1a10: 20 72 20 28 63 6f 6e 73 2a 20 28 63 64 61 72 20 r (cons* (cdar
1a20: 61 76 2d 70 61 69 72 73 29 20 70 6f 72 74 3a 20 av-pairs) port:
1a30: 63 75 72 72 65 6e 74 29 29 29 0a 20 20 20 20 20 current))).
1a40: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1a60: 28 6e 75 6c 6c 3f 20 63 75 72 72 65 6e 74 29 0a (null? current).
1a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a80: 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 61 76 2d (loop (cdr av-
1a90: 70 61 69 72 73 29 20 72 20 28 6c 69 73 74 20 28 pairs) r (list (
1aa0: 63 64 61 72 20 61 76 2d 70 61 69 72 73 29 20 28 cdar av-pairs) (
1ab0: 63 61 61 72 20 61 76 2d 70 61 69 72 73 29 29 29 caar av-pairs)))
1ac0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ad0: 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 61 76 (loop (cdr av
1ae0: 2d 70 61 69 72 73 29 0a 20 20 20 20 20 20 20 20 -pairs).
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b00: 28 63 6f 6e 73 20 28 72 65 76 65 72 73 65 20 63 (cons (reverse c
1b10: 75 72 72 65 6e 74 29 20 72 29 0a 20 20 20 20 20 urrent) r).
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 20 20 20 28 6c 69 73 74 20 28 63 64 61 72 20 61 (list (cdar a
1b40: 76 2d 70 61 69 72 73 29 20 28 63 61 61 72 20 61 v-pairs) (caar a
1b50: 76 2d 70 61 69 72 73 29 29 29 29 29 29 29 29 29 v-pairs)))))))))
1b60: 0a 20 0a 20 3b 3b 20 43 6f 6e 73 74 72 75 63 74 . . ;; Construct
1b70: 20 61 20 63 6f 6f 6b 69 65 20 73 74 72 69 6e 67 a cookie string
1b80: 20 73 75 69 74 61 62 6c 65 20 66 6f 72 20 53 65 suitable for Se
1b90: 74 2d 43 6f 6f 6b 69 65 20 6f 72 20 53 65 74 2d t-Cookie or Set-
1ba0: 43 6f 6f 6b 69 65 32 20 68 65 61 64 65 72 2e 0a Cookie2 header..
1bb0: 20 3b 3b 20 73 70 65 63 73 20 69 73 20 74 68 65 ;; specs is the
1bc0: 20 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f 72 6d 61 following forma
1bd0: 74 2e 0a 20 3b 3b 0a 20 3b 3b 20 20 20 28 28 3c t.. ;;. ;; ((<
1be0: 6e 61 6d 65 3e 20 3c 76 61 6c 75 65 3e 20 5b 3a name> <value> [:
1bf0: 63 6f 6d 6d 65 6e 74 20 3c 63 6f 6d 6d 65 6e 74 comment <comment
1c00: 3e 5d 20 5b 3a 63 6f 6d 6d 65 6e 74 2d 75 72 6c >] [:comment-url
1c10: 20 3c 63 6f 6d 6d 65 6e 74 2d 75 72 6c 3e 5d 0a <comment-url>].
1c20: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
1c30: 20 20 20 20 20 20 20 5b 3a 64 69 73 63 61 72 64 [:discard
1c40: 20 3c 62 6f 6f 6c 3e 5d 20 5b 3a 64 6f 6d 61 69 <bool>] [:domai
1c50: 6e 20 3c 64 6f 6d 61 69 6e 3e 5d 0a 20 3b 3b 20 n <domain>]. ;;
1c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c70: 20 20 20 5b 3a 6d 61 78 2d 61 67 65 20 3c 61 67 [:max-age <ag
1c80: 65 3e 5d 20 5b 3a 70 61 74 68 20 3c 76 61 6c 75 e>] [:path <valu
1c90: 65 3e 5d 20 5b 3a 70 6f 72 74 20 3c 70 6f 72 74 e>] [:port <port
1ca0: 2d 6c 69 73 74 3e 5d 0a 20 3b 3b 20 20 20 20 20 -list>]. ;;
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b [
1cc0: 3a 73 65 63 75 72 65 20 3c 62 6f 6f 6c 3e 5d 20 :secure <bool>]
1cd0: 5b 3a 76 65 72 73 69 6f 6e 20 3c 76 65 72 73 69 [:version <versi
1ce0: 6f 6e 3e 5d 20 5b 3a 65 78 70 69 72 65 73 20 3c on>] [:expires <
1cf0: 64 61 74 65 3e 5d 0a 20 3b 3b 20 20 20 20 29 20 date>]. ;; )
1d00: 2e 2e 2e 29 0a 20 3b 3b 0a 20 3b 3b 20 52 65 74 ...). ;;. ;; Ret
1d10: 75 72 6e 73 20 61 20 6c 69 73 74 20 6f 66 20 63 urns a list of c
1d20: 6f 6f 6b 69 65 20 73 74 72 69 6e 67 73 20 66 6f ookie strings fo
1d30: 72 20 65 61 63 68 20 3c 6e 61 6d 65 3e 3d 3c 76 r each <name>=<v
1d40: 61 6c 75 65 3e 20 70 61 69 72 2e 20 20 49 6e 20 alue> pair. In
1d50: 74 68 65 0a 20 3b 3b 20 60 60 6e 65 77 20 63 6f the. ;; ``new co
1d60: 6f 6b 69 65 27 27 20 69 6d 70 6c 65 6d 65 6e 74 okie'' implement
1d70: 61 74 69 6f 6e 2c 20 79 6f 75 20 63 61 6e 20 6a ation, you can j
1d80: 6f 69 6e 20 74 68 65 6d 20 62 79 20 63 6f 6d 6d oin them by comm
1d90: 61 20 61 6e 64 20 73 65 6e 64 20 69 74 0a 20 3b a and send it. ;
1da0: 3b 20 61 74 20 6f 6e 63 65 20 77 69 74 68 20 53 ; at once with S
1db0: 65 74 2d 63 6f 6f 6b 69 65 32 20 68 65 61 64 65 et-cookie2 heade
1dc0: 72 2e 20 20 46 6f 72 20 74 68 65 20 6f 6c 64 20 r. For the old
1dd0: 6e 65 74 73 63 61 70 65 20 70 72 6f 74 6f 63 6f netscape protoco
1de0: 6c 2c 20 79 6f 75 0a 20 3b 3b 20 6d 75 73 74 20 l, you. ;; must
1df0: 73 65 6e 64 20 65 61 63 68 20 6f 66 20 74 68 65 send each of the
1e00: 6d 20 62 79 20 53 65 74 2d 63 6f 6f 6b 69 65 20 m by Set-cookie
1e10: 68 65 61 64 65 72 2e 0a 20 0a 20 0a 20 28 64 65 header.. . . (de
1e20: 66 69 6e 65 20 28 63 6f 6e 73 74 72 75 63 74 2d fine (construct-
1e30: 63 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 20 73 70 cookie-string sp
1e40: 65 63 73 20 23 21 6f 70 74 69 6f 6e 61 6c 20 28 ecs #!optional (
1e50: 76 65 72 73 69 6f 6e 20 31 29 29 0a 20 20 20 28 version 1)). (
1e60: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 70 65 map (lambda (spe
1e70: 63 29 20 28 63 6f 6e 73 74 72 75 63 74 2d 63 6f c) (construct-co
1e80: 6f 6b 69 65 2d 73 74 72 69 6e 67 2d 31 20 73 70 okie-string-1 sp
1e90: 65 63 20 76 65 72 73 69 6f 6e 29 29 0a 20 20 20 ec version)).
1ea0: 20 20 20 20 20 73 70 65 63 73 29 29 0a 20 0a 20 specs)). .
1eb0: 28 64 65 66 69 6e 65 20 28 63 6f 6e 73 74 72 75 (define (constru
1ec0: 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 ct-cookie-string
1ed0: 2d 31 20 73 70 65 63 20 76 65 72 29 0a 20 20 20 -1 spec ver).
1ee0: 28 77 68 65 6e 20 28 3c 20 28 6c 65 6e 67 74 68 (when (< (length
1ef0: 20 73 70 65 63 29 20 32 29 0a 20 20 20 20 20 28 spec) 2). (
1f00: 65 72 72 6f 72 20 22 62 61 64 20 63 6f 6f 6b 69 error "bad cooki
1f10: 65 20 73 70 65 63 3a 20 61 74 20 6c 65 61 73 74 e spec: at least
1f20: 20 3c 6e 61 6d 65 3e 20 61 6e 64 20 3c 76 61 6c <name> and <val
1f30: 75 65 3e 20 72 65 71 75 69 72 65 64 22 20 73 70 ue> required" sp
1f40: 65 63 29 29 0a 20 20 20 28 6c 65 74 20 28 28 6e ec)). (let ((n
1f50: 61 6d 65 20 28 63 61 72 20 73 70 65 63 29 29 0a ame (car spec)).
1f60: 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 20 (value
1f70: 28 63 61 64 72 20 73 70 65 63 29 29 29 0a 20 20 (cadr spec))).
1f80: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 61 (let loop ((a
1f90: 74 74 72 20 28 63 64 64 72 20 73 70 65 63 29 29 ttr (cddr spec))
1fa0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1fb0: 20 28 72 20 20 20 20 28 6c 69 73 74 20 28 69 66 (r (list (if
1fc0: 20 76 61 6c 75 65 0a 20 20 20 20 20 20 20 20 20 value.
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 (string-a
1ff0: 70 70 65 6e 64 20 6e 61 6d 65 20 22 3d 22 0a 20 ppend name "=".
2000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 71 (q
2030: 75 6f 74 65 2d 69 66 2d 6e 65 65 64 65 64 20 76 uote-if-needed v
2040: 61 6c 75 65 29 29 0a 20 20 20 20 20 20 20 20 20 alue)).
2050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2060: 20 20 20 20 20 20 20 6e 61 6d 65 29 29 29 29 0a name)))).
2070: 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 (define (
2080: 6e 65 78 74 20 73 29 20 28 6c 6f 6f 70 20 28 63 next s) (loop (c
2090: 64 64 72 20 61 74 74 72 29 20 28 63 6f 6e 73 20 ddr attr) (cons
20a0: 73 20 72 29 29 29 0a 20 20 20 20 20 20 20 28 64 s r))). (d
20b0: 65 66 69 6e 65 20 28 69 67 6e 6f 72 65 29 20 28 efine (ignore) (
20c0: 6c 6f 6f 70 20 28 63 64 64 72 20 61 74 74 72 29 loop (cddr attr)
20d0: 20 72 29 29 0a 20 20 20 20 20 20 20 28 63 6f 6e r)). (con
20e0: 64 0a 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c d. ((null
20f0: 3f 20 61 74 74 72 29 20 28 73 74 72 69 6e 67 2d ? attr) (string-
2100: 6a 6f 69 6e 20 28 72 65 76 65 72 73 65 20 72 29 join (reverse r)
2110: 20 22 3b 22 29 29 0a 20 20 20 20 20 20 20 20 28 ";")). (
2120: 28 6e 75 6c 6c 3f 20 28 63 64 72 20 61 74 74 72 (null? (cdr attr
2130: 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 72 72 )). (err
2140: 6f 72 20 28 63 6f 6e 63 20 22 62 61 64 20 63 6f or (conc "bad co
2150: 6f 6b 69 65 20 73 70 65 63 3a 20 61 74 74 72 69 okie spec: attri
2160: 62 75 74 65 20 22 20 28 63 61 72 20 61 74 74 72 bute " (car attr
2170: 29 20 22 20 72 65 71 75 69 72 65 73 20 76 61 6c ) " requires val
2180: 75 65 22 20 29 29 29 0a 20 20 20 20 20 20 20 20 ue" ))).
2190: 28 28 65 71 76 3f 20 63 6f 6d 6d 65 6e 74 3a 20 ((eqv? comment:
21a0: 28 63 61 72 20 61 74 74 72 29 29 0a 20 20 20 20 (car attr)).
21b0: 20 20 20 20 20 28 69 66 20 28 3e 20 76 65 72 20 (if (> ver
21c0: 30 29 0a 20 09 20 20 20 20 28 6e 65 78 74 20 28 0). . (next (
21d0: 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 43 string-append "C
21e0: 6f 6d 6d 65 6e 74 3d 22 20 28 71 75 6f 74 65 2d omment=" (quote-
21f0: 69 66 2d 6e 65 65 64 65 64 20 28 63 61 64 72 20 if-needed (cadr
2200: 61 74 74 72 29 29 29 29 0a 20 20 20 20 20 20 20 attr)))).
2210: 20 20 20 20 20 20 28 69 67 6e 6f 72 65 29 29 29 (ignore)))
2220: 0a 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 . ((eqv?
2230: 63 6f 6d 6d 65 6e 74 2d 75 72 6c 3a 20 28 63 61 comment-url: (ca
2240: 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 r attr)).
2250: 20 20 28 69 66 20 28 3e 20 76 65 72 20 30 29 0a (if (> ver 0).
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
2270: 78 74 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e xt (string-appen
2280: 64 20 22 43 6f 6d 6d 65 6e 74 55 52 4c 3d 22 20 d "CommentURL="
2290: 28 71 75 6f 74 65 2d 76 61 6c 75 65 20 28 63 61 (quote-value (ca
22a0: 64 72 20 61 74 74 72 29 29 29 29 0a 20 20 20 20 dr attr)))).
22b0: 20 20 20 20 20 20 20 20 20 28 69 67 6e 6f 72 65 (ignore
22c0: 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 65 71 ))). ((eq
22d0: 76 3f 20 64 69 73 63 61 72 64 3a 20 28 63 61 72 v? discard: (car
22e0: 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 20 attr)).
22f0: 20 28 69 66 20 28 61 6e 64 20 28 3e 20 76 65 72 (if (and (> ver
2300: 20 30 29 20 28 63 61 64 72 20 61 74 74 72 29 29 0) (cadr attr))
2310: 20 28 6e 65 78 74 20 22 44 69 73 63 61 72 64 22 (next "Discard"
2320: 29 20 28 69 67 6e 6f 72 65 29 29 29 0a 20 20 20 ) (ignore))).
2330: 20 20 20 20 20 28 28 65 71 76 3f 20 64 6f 6d 61 ((eqv? doma
2340: 69 6e 3a 20 28 63 61 72 20 61 74 74 72 29 29 0a in: (car attr)).
2350: 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 28 (next (
2360: 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 44 string-append "D
2370: 6f 6d 61 69 6e 3d 22 20 28 63 61 64 72 20 61 74 omain=" (cadr at
2380: 74 72 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 tr)))). (
2390: 28 65 71 76 3f 20 6d 61 78 2d 61 67 65 3a 20 28 (eqv? max-age: (
23a0: 63 61 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 car attr)).
23b0: 20 20 20 20 28 69 66 20 28 3e 20 76 65 72 20 30 (if (> ver 0
23c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
23d0: 6e 65 78 74 20 28 73 70 72 69 6e 74 66 20 22 4d next (sprintf "M
23e0: 61 78 2d 41 67 65 3d 7e 61 22 20 28 63 61 64 72 ax-Age=~a" (cadr
23f0: 20 61 74 74 72 29 29 29 0a 20 20 20 20 20 20 20 attr))).
2400: 20 20 20 20 20 20 28 69 67 6e 6f 72 65 29 29 29 (ignore)))
2410: 0a 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 . ((eqv?
2420: 70 61 74 68 3a 20 28 63 61 72 20 61 74 74 72 29 path: (car attr)
2430: 29 0a 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 ). (next
2440: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 (string-append
2450: 22 50 61 74 68 3d 22 20 28 71 75 6f 74 65 2d 69 "Path=" (quote-i
2460: 66 2d 6e 65 65 64 65 64 20 28 63 61 64 72 20 61 f-needed (cadr a
2470: 74 74 72 29 29 29 29 29 0a 20 20 20 20 20 20 20 ttr))))).
2480: 20 28 28 65 71 76 3f 20 70 6f 72 74 3a 20 28 63 ((eqv? port: (c
2490: 61 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 ar attr)).
24a0: 20 20 20 28 69 66 20 28 3e 20 76 65 72 20 30 29 (if (> ver 0)
24b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e . (n
24c0: 65 78 74 20 28 73 74 72 69 6e 67 2d 61 70 70 65 ext (string-appe
24d0: 6e 64 20 22 50 6f 72 74 3d 22 20 28 71 75 6f 74 nd "Port=" (quot
24e0: 65 2d 76 61 6c 75 65 20 28 63 61 64 72 20 61 74 e-value (cadr at
24f0: 74 72 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 tr)))).
2500: 20 20 20 20 28 69 67 6e 6f 72 65 29 29 29 0a 20 (ignore))).
2510: 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 73 65 ((eqv? se
2520: 63 75 72 65 3a 20 28 63 61 72 20 61 74 74 72 29 cure: (car attr)
2530: 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28 ). (if (
2540: 63 61 64 72 20 61 74 74 72 29 20 28 6e 65 78 74 cadr attr) (next
2550: 20 22 53 65 63 75 72 65 22 29 20 28 69 67 6e 6f "Secure") (igno
2560: 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 re))). ((
2570: 65 71 76 3f 20 76 65 72 73 69 6f 6e 3a 20 28 63 eqv? version: (c
2580: 61 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 ar attr)).
2590: 20 20 20 28 69 66 20 28 3e 20 76 65 72 20 30 29 (if (> ver 0)
25a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e . (n
25b0: 65 78 74 20 28 73 70 72 69 6e 74 66 20 22 56 65 ext (sprintf "Ve
25c0: 72 73 69 6f 6e 3d 7e 61 22 20 28 63 61 64 72 20 rsion=~a" (cadr
25d0: 61 74 74 72 29 29 29 0a 20 20 20 20 20 20 20 20 attr))).
25e0: 20 20 20 20 20 28 69 67 6e 6f 72 65 29 29 29 0a (ignore))).
25f0: 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 65 ((eqv? e
2600: 78 70 69 72 65 73 3a 20 28 63 61 72 20 61 74 74 xpires: (car att
2610: 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 r)). (if
2620: 20 28 3e 20 76 65 72 20 30 29 0a 20 20 20 20 20 (> ver 0).
2630: 20 20 20 20 20 20 20 20 28 69 67 6e 6f 72 65 29 (ignore)
2640: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e . (n
2650: 65 78 74 20 28 6d 61 6b 65 2d 65 78 70 69 72 65 ext (make-expire
2660: 73 2d 61 74 74 72 20 28 63 61 64 72 20 61 74 74 s-attr (cadr att
2670: 72 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 r))))). (
2680: 65 6c 73 65 20 28 65 72 72 6f 72 20 22 55 6e 6b else (error "Unk
2690: 6e 6f 77 6e 20 63 6f 6f 6b 69 65 20 61 74 74 72 nown cookie attr
26a0: 69 62 75 74 65 22 20 28 63 61 72 20 61 74 74 72 ibute" (car attr
26b0: 29 29 29 29 0a 20 20 20 20 20 20 20 29 29 0a 20 )))). )).
26c0: 20 20 29 0a 20 0a 20 0a 20 3b 3b 20 28 64 65 66 ). . . ;; (def
26d0: 69 6e 65 20 28 71 75 6f 74 65 2d 76 61 6c 75 65 ine (quote-value
26e0: 20 76 61 6c 75 65 29 0a 20 3b 3b 20 20 20 28 73 value). ;; (s
26f0: 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 5c 22 tring-append "\"
2700: 22 20 28 72 65 67 65 78 70 2d 72 65 70 6c 61 63 " (regexp-replac
2710: 65 2d 61 6c 6c 20 23 2f 5c 22 7c 5c 5c 2f 20 76 e-all #/\"|\\/ v
2720: 61 6c 75 65 20 22 5c 5c 5c 5c 5c 5c 30 22 29 20 alue "\\\\\\0")
2730: 22 5c 22 22 29 29 0a 20 0a 20 28 64 65 66 69 6e "\"")). . (defin
2740: 65 20 28 71 75 6f 74 65 2d 76 61 6c 75 65 20 76 e (quote-value v
2750: 61 6c 75 65 29 0a 20 20 20 28 73 74 72 69 6e 67 alue). (string
2760: 2d 61 70 70 65 6e 64 20 22 5c 22 22 20 28 73 74 -append "\"" (st
2770: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 2a ring-substitute*
2780: 20 76 61 6c 75 65 20 27 28 28 22 5c 5c 5c 22 22 value '(("\\\""
2790: 20 2e 20 22 5c 5c 5c 22 22 29 20 28 22 5c 5c 5c . "\\\"") ("\\\
27a0: 5c 22 20 2e 20 22 5c 5c 5c 5c 22 29 29 29 20 22 \" . "\\\\"))) "
27b0: 5c 22 22 29 29 0a 20 0a 20 28 64 65 66 69 6e 65 \"")). . (define
27c0: 20 71 75 6f 74 65 2d 69 66 2d 6e 65 65 64 65 64 quote-if-needed
27d0: 0a 20 20 20 28 6c 65 74 20 28 28 72 78 20 28 72 . (let ((rx (r
27e0: 65 67 65 78 70 20 22 5b 5c 5c 5c 22 2c 3b 5c 5c egexp "[\\\",;\\
27f0: 5c 5c 20 5c 5c 74 5c 5c 6e 5d 22 29 29 29 0a 20 \\ \\t\\n]"))).
2800: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 6c (lambda (val
2810: 75 65 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 ue). (if (
2820: 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 72 78 string-search rx
2830: 20 76 61 6c 75 65 29 0a 20 09 20 20 28 71 75 6f value). . (quo
2840: 74 65 2d 76 61 6c 75 65 20 76 61 6c 75 65 29 0a te-value value).
2850: 20 09 20 20 76 61 6c 75 65 29 29 29 29 0a 20 0a . value)))). .
2860: 20 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 65 (define (make-e
2870: 78 70 69 72 65 73 2d 61 74 74 72 20 74 69 6d 65 xpires-attr time
2880: 29 0a 20 20 20 28 73 70 72 69 6e 74 66 20 22 45 ). (sprintf "E
2890: 78 70 69 72 65 73 3d 7e 61 22 0a 20 09 20 20 20 xpires=~a". .
28a0: 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d (if (number? tim
28b0: 65 29 0a 20 09 20 20 20 20 20 20 20 28 66 6d 74 e). . (fmt
28c0: 2d 74 69 6d 65 20 74 69 6d 65 29 0a 20 09 20 20 -time time). .
28d0: 20 20 20 20 20 74 69 6d 65 29 29 29 0a 20 0a 20 time))). .
28e0: 3b 3b 3b 3b 20 41 64 64 65 64 20 73 75 70 70 6f ;;;; Added suppo
28f0: 72 74 20 66 75 6e 63 74 69 6f 6e 73 20 66 72 6f rt functions fro
2900: 6d 20 6d 79 20 75 74 69 6c 73 2c 20 73 70 6c 69 m my utils, spli
2910: 74 20 74 68 69 73 20 6f 75 74 0a 20 0a 20 28 64 t this out. . (d
2920: 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d 73 65 efine (string-se
2930: 61 72 63 68 2d 61 66 74 65 72 20 72 20 73 20 23 arch-after r s #
2940: 21 6f 70 74 69 6f 6e 61 6c 20 28 73 74 61 72 74 !optional (start
2950: 20 30 29 29 0a 20 20 20 28 61 6e 64 2d 6c 65 74 0)). (and-let
2960: 2a 20 28 28 6d 61 74 63 68 2d 69 6e 64 69 63 65 * ((match-indice
2970: 73 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 s (string-search
2980: 2d 70 6f 73 69 74 69 6f 6e 73 20 72 20 73 20 73 -positions r s s
2990: 74 61 72 74 29 29 0a 20 09 20 20 20 20 20 28 72 tart)). . (r
29a0: 69 67 68 74 2d 6d 61 74 63 68 20 28 73 65 63 6f ight-match (seco
29b0: 6e 64 20 28 66 69 72 73 74 20 6d 61 74 63 68 2d nd (first match-
29c0: 69 6e 64 69 63 65 73 29 29 29 29 0a 20 20 20 20 indices)))).
29d0: 20 28 73 75 62 73 74 72 69 6e 67 20 73 20 72 69 (substring s ri
29e0: 67 68 74 2d 6d 61 74 63 68 29 29 29 0a ght-match))).