Artifact
fba413a4c87b9ca4525d8637bf3e459dae84d8da:
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 3b 3b 20 28 64 65 63 6c 61 72 65 ml>..;; (declare
0860: 20 28 75 6e 69 74 20 63 6f 6f 6b 69 65 29 29 0a (unit cookie)).
0870: 0a 28 6d 6f 64 75 6c 65 20 63 6f 6f 6b 69 65 0a .(module cookie.
0880: 20 20 20 20 2a 0a 0a 28 69 6d 70 6f 72 74 20 28 *..(import (
0890: 63 68 69 63 6b 65 6e 20 62 61 73 65 29 20 73 63 chicken base) sc
08a0: 68 65 6d 65 20 71 75 65 75 65 73 20 73 72 66 69 heme queues srfi
08b0: 2d 31 33 20 28 63 68 69 63 6b 65 6e 20 70 6f 72 -13 (chicken por
08c0: 74 29 20 28 63 68 69 63 6b 65 6e 20 69 6f 29 28 t) (chicken io)(
08d0: 63 68 69 63 6b 65 6e 20 66 69 6c 65 29 20 28 63 chicken file) (c
08e0: 68 69 63 6b 65 6e 20 66 6f 72 6d 61 74 29 20 28 hicken format) (
08f0: 63 68 69 63 6b 65 6e 20 73 74 72 69 6e 67 29 20 chicken string)
0900: 28 63 68 69 63 6b 65 6e 20 74 69 6d 65 20 70 6f (chicken time po
0910: 73 69 78 29 29 0a 20 20 0a 28 72 65 71 75 69 72 six)). .(requir
0920: 65 2d 65 78 74 65 6e 73 69 6f 6e 20 73 72 66 69 e-extension srfi
0930: 2d 31 20 73 72 66 69 2d 31 33 20 73 72 66 69 2d -1 srfi-13 srfi-
0940: 31 34 20 72 65 67 65 78 29 0a 3b 3b 20 28 75 73 14 regex).;; (us
0950: 65 20 20 73 72 66 69 2d 31 20 73 72 66 69 2d 31 e srfi-1 srfi-1
0960: 33 20 73 72 66 69 2d 31 34 20 72 65 67 65 78 29 3 srfi-14 regex)
0970: 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 65 78 .;; (declare (ex
0980: 70 6f 72 74 20 70 61 72 73 65 2d 63 6f 6f 6b 69 port parse-cooki
0990: 65 2d 73 74 72 69 6e 67 20 63 6f 6e 73 74 72 75 e-string constru
09a0: 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 ct-cookie-string
09b0: 29 29 0a 0a 3b 3b 20 23 3e 0a 3b 3b 20 23 69 6e ))..;; #>.;; #in
09c0: 63 6c 75 64 65 20 3c 74 69 6d 65 2e 68 3e 0a 3b clude <time.h>.;
09d0: 3b 20 3c 23 0a 3b 3b 20 0a 3b 3b 20 28 64 65 66 ; <#.;; .;; (def
09e0: 69 6e 65 20 66 6d 74 2d 74 69 6d 65 0a 3b 3b 20 ine fmt-time.;;
09f0: 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 (foreign-lambd
0a00: 61 2a 20 63 2d 73 74 72 69 6e 67 20 28 28 6c 6f a* c-string ((lo
0a10: 6e 67 20 73 65 63 73 5f 73 69 6e 63 65 5f 65 70 ng secs_since_ep
0a20: 6f 63 68 29 29 0a 3b 3b 20 20 20 20 20 22 73 74 och)).;; "st
0a30: 61 74 69 63 20 63 68 61 72 20 62 75 66 5b 32 35 atic char buf[25
0a40: 36 5d 3b 22 0a 3b 3b 20 20 20 20 20 22 74 69 6d 6];".;; "tim
0a50: 65 5f 74 20 74 20 3d 20 28 74 69 6d 65 5f 74 29 e_t t = (time_t)
0a60: 20 73 65 63 73 5f 73 69 6e 63 65 5f 65 70 6f 63 secs_since_epoc
0a70: 68 3b 22 0a 3b 3b 20 20 20 20 20 22 73 74 72 66 h;".;; "strf
0a80: 74 69 6d 65 28 62 75 66 2c 20 73 69 7a 65 6f 66 time(buf, sizeof
0a90: 28 62 75 66 29 2c 20 5c 22 25 61 2c 20 25 64 2d (buf), \"%a, %d-
0aa0: 25 62 2d 25 59 20 25 48 3a 25 4d 3a 25 53 20 47 %b-%Y %H:%M:%S G
0ab0: 4d 54 5c 22 2c 20 67 6d 74 69 6d 65 28 26 74 29 MT\", gmtime(&t)
0ac0: 29 3b 22 0a 3b 3b 20 20 20 20 20 22 72 65 74 75 );".;; "retu
0ad0: 72 6e 28 62 75 66 29 3b 22 29 29 0a 0a 0a 28 64 rn(buf);"))...(d
0ae0: 65 66 69 6e 65 20 28 66 6d 74 2d 74 69 6d 65 20 efine (fmt-time
0af0: 73 65 63 6f 6e 64 73 29 0a 20 20 20 28 74 69 6d seconds). (tim
0b00: 65 2d 3e 73 74 72 69 6e 67 20 28 73 65 63 6f 6e e->string (secon
0b10: 64 73 2d 3e 75 74 63 2d 74 69 6d 65 20 73 65 63 ds->utc-time sec
0b20: 6f 6e 64 73 29 20 22 25 44 22 29 29 0a 0a 20 3b onds) "%D")).. ;
0b30: 3b 20 75 74 69 6c 69 74 79 20 66 6e 2e 20 20 62 ; utility fn. b
0b40: 72 65 61 6b 73 20 20 60 60 61 74 74 72 3d 76 61 reaks ``attr=va
0b50: 6c 75 65 3b 61 74 74 72 3d 76 61 6c 75 65 20 2e lue;attr=value .
0b60: 2e 2e 20 27 27 20 69 6e 74 6f 20 61 6c 69 73 74 .. '' into alist
0b70: 2e 0a 20 3b 3b 20 76 65 72 73 69 6f 6e 20 69 73 .. ;; version is
0b80: 20 61 20 63 6f 6f 6b 69 65 20 76 65 72 73 69 6f a cookie versio
0b90: 6e 2e 20 20 69 66 20 76 65 72 73 69 6f 6e 3e 30 n. if version>0
0ba0: 2c 20 77 65 20 61 6c 6c 6f 77 20 63 6f 6d 6d 61 , we allow comma
0bb0: 20 61 73 20 74 68 65 0a 20 3b 3b 20 64 65 6c 69 as the. ;; deli
0bc0: 6d 69 74 65 72 20 61 73 20 77 65 6c 6c 20 61 73 miter as well as
0bd0: 20 73 65 6d 69 63 6f 6c 6f 6e 2e 0a 20 28 64 65 semicolon.. (de
0be0: 66 69 6e 65 20 28 70 61 72 73 65 2d 61 76 2d 70 fine (parse-av-p
0bf0: 61 69 72 73 20 69 6e 70 75 74 20 76 65 72 73 69 airs input versi
0c00: 6f 6e 29 0a 20 20 20 28 64 65 66 69 6e 65 20 61 on). (define a
0c10: 74 74 72 2d 72 65 67 65 78 70 0a 20 20 20 20 20 ttr-regexp.
0c20: 28 69 66 20 28 3d 20 76 65 72 73 69 6f 6e 20 30 (if (= version 0
0c30: 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 67 65 ). (rege
0c40: 78 70 20 22 5c 5c 73 2a 28 5b 5c 5c 77 24 5f 2d xp "\\s*([\\w$_-
0c50: 5d 2b 29 5c 5c 73 2a 28 5b 3d 5c 5c 3b 5d 5c 5c ]+)\\s*([=\\;]\\
0c60: 73 2a 29 3f 22 29 0a 20 20 20 20 20 20 20 20 20 s*)?").
0c70: 28 72 65 67 65 78 70 20 22 5c 5c 73 2a 28 5b 5c (regexp "\\s*([\
0c80: 5c 77 24 5f 2d 5d 2b 29 5c 5c 73 2a 28 5b 3d 5c \w$_-]+)\\s*([=\
0c90: 5c 3b 2c 5d 5c 5c 73 2a 29 3f 22 29 29 29 0a 20 \;,]\\s*)?"))).
0ca0: 20 20 28 64 65 66 69 6e 65 20 61 74 74 72 2d 64 (define attr-d
0cb0: 65 6c 69 6d 0a 20 20 20 20 20 28 69 66 20 28 3d elim. (if (=
0cc0: 20 76 65 72 73 69 6f 6e 20 30 29 20 23 5c 3b 20 version 0) #\;
0cd0: 28 63 68 61 72 2d 73 65 74 20 23 5c 2c 20 23 5c (char-set #\, #\
0ce0: 5c 20 23 5c 3b 29 29 29 0a 20 20 20 0a 20 20 20 \ #\;))). .
0cf0: 28 64 65 66 69 6e 65 20 28 72 65 61 64 2d 61 74 (define (read-at
0d00: 74 72 20 69 6e 70 75 74 20 72 29 0a 20 20 20 20 tr input r).
0d10: 20 28 63 6f 6e 64 20 28 28 73 74 72 69 6e 67 2d (cond ((string-
0d20: 6e 75 6c 6c 3f 20 69 6e 70 75 74 29 20 28 72 65 null? input) (re
0d30: 76 65 72 73 65 21 20 72 29 29 0a 20 20 20 20 20 verse! r)).
0d40: 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d 73 ((string-s
0d50: 65 61 72 63 68 20 61 74 74 72 2d 72 65 67 65 78 earch attr-regex
0d60: 70 20 69 6e 70 75 74 29 0a 20 20 20 20 20 20 20 p input).
0d70: 20 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 => (lambda
0d80: 28 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 (m).
0d90: 20 20 20 20 20 28 69 66 20 28 61 6e 64 2d 6c 65 (if (and-le
0da0: 74 2a 20 28 28 64 65 6c 69 6d 69 74 65 72 20 28 t* ((delimiter (
0db0: 74 68 69 72 64 20 6d 29 29 29 20 3b 3b 69 73 20 third m))) ;;is
0dc0: 61 6e 20 61 74 74 72 5f 76 61 6c 75 65 20 70 61 an attr_value pa
0dd0: 69 0a 20 09 09 20 20 20 20 20 20 28 73 74 72 69 i. .. (stri
0de0: 6e 67 2d 70 72 65 66 69 78 3f 20 22 3d 22 20 64 ng-prefix? "=" d
0df0: 65 6c 69 6d 69 74 65 72 29 29 0a 20 20 20 20 20 elimiter)).
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e10: 28 6c 65 74 20 28 28 61 74 74 72 20 28 73 65 63 (let ((attr (sec
0e20: 6f 6e 64 20 6d 29 29 0a 20 20 20 20 20 20 20 20 ond m)).
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 20 20 28 72 65 73 74 20 28 73 74 72 69 6e 67 (rest (string
0e50: 2d 73 65 61 72 63 68 2d 61 66 74 65 72 20 61 74 -search-after at
0e60: 74 72 2d 72 65 67 65 78 70 20 69 6e 70 75 74 29 tr-regexp input)
0e70: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0e80: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 (if (s
0e90: 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 22 5c tring-prefix? "\
0ea0: 22 22 20 72 65 73 74 29 0a 20 20 20 20 20 20 20 "" rest).
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 20 20 20 28 72 65 61 64 2d 74 6f 6b 65 6e 2d (read-token-
0ed0: 71 75 6f 74 65 64 20 61 74 74 72 20 28 73 74 72 quoted attr (str
0ee0: 69 6e 67 2d 64 72 6f 70 20 72 65 73 74 20 31 29 ing-drop rest 1)
0ef0: 20 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r).
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0f10: 72 65 61 64 2d 74 6f 6b 65 6e 20 61 74 74 72 20 read-token attr
0f20: 72 65 73 74 20 72 29 29 29 0a 20 20 20 20 20 20 rest r))).
0f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0f40: 72 65 61 64 2d 61 74 74 72 20 28 73 74 72 69 6e read-attr (strin
0f50: 67 2d 73 65 61 72 63 68 2d 61 66 74 65 72 20 61 g-search-after a
0f60: 74 74 72 2d 72 65 67 65 78 70 20 69 6e 70 75 74 ttr-regexp input
0f70: 29 20 3b 3b 20 53 6b 69 70 20 61 68 65 61 64 20 ) ;; Skip ahead
0f80: 69 66 20 62 72 6f 6b 65 6e 20 69 6e 70 75 74 3f if broken input?
0f90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fb0: 20 28 61 6c 69 73 74 2d 63 6f 6e 73 20 28 73 65 (alist-cons (se
0fc0: 63 6f 6e 64 20 6d 29 20 23 66 20 72 29 29 29 29 cond m) #f r))))
0fd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 6c ). (el
0fe0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b se. ;
0ff0: 3b 20 74 68 65 20 69 6e 70 75 74 20 69 73 20 62 ; the input is b
1000: 72 6f 6b 65 6e 3b 20 66 6f 72 20 6e 6f 77 2c 20 roken; for now,
1010: 77 65 20 69 67 6e 6f 72 65 20 74 68 65 20 72 65 we ignore the re
1020: 73 74 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 st..
1030: 28 72 65 76 65 72 73 65 21 20 72 29 29 29 29 0a (reverse! r)))).
1040: 20 20 20 28 64 65 66 69 6e 65 20 28 72 65 61 64 (define (read
1050: 2d 74 6f 6b 65 6e 20 61 74 74 72 20 69 6e 70 75 -token attr inpu
1060: 74 20 72 29 0a 20 20 20 20 20 28 63 6f 6e 64 20 t r). (cond
1070: 28 28 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 69 ((string-index i
1080: 6e 70 75 74 20 61 74 74 72 2d 64 65 6c 69 6d 29 nput attr-delim)
1090: 0a 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 . =>
10a0: 28 6c 61 6d 62 64 61 20 28 69 29 0a 20 20 20 20 (lambda (i).
10b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
10c0: 61 64 2d 61 74 74 72 20 28 73 74 72 69 6e 67 2d ad-attr (string-
10d0: 64 72 6f 70 20 69 6e 70 75 74 20 28 2b 20 69 20 drop input (+ i
10e0: 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1)).
10f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1100: 28 61 6c 69 73 74 2d 63 6f 6e 73 20 61 74 74 72 (alist-cons attr
1110: 0a 20 09 09 09 09 20 20 20 20 20 20 20 28 73 74 . .... (st
1120: 72 69 6e 67 2d 74 72 69 6d 2d 72 69 67 68 74 20 ring-trim-right
1130: 28 73 74 72 69 6e 67 2d 74 61 6b 65 20 69 6e 70 (string-take inp
1140: 75 74 20 69 29 29 0a 20 09 09 09 09 20 20 20 20 ut i)). ....
1150: 20 20 20 72 29 29 29 29 0a 20 20 20 20 20 20 20 r)))).
1160: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
1170: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 21 20 (reverse!
1180: 28 61 6c 69 73 74 2d 63 6f 6e 73 20 61 74 74 72 (alist-cons attr
1190: 20 28 73 74 72 69 6e 67 2d 74 72 69 6d 2d 72 69 (string-trim-ri
11a0: 67 68 74 20 69 6e 70 75 74 29 20 72 29 29 29 29 ght input) r))))
11b0: 29 0a 20 20 20 28 64 65 66 69 6e 65 20 28 72 65 ). (define (re
11c0: 61 64 2d 74 6f 6b 65 6e 2d 71 75 6f 74 65 64 20 ad-token-quoted
11d0: 61 74 74 72 20 69 6e 70 75 74 20 72 29 0a 20 20 attr input r).
11e0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 (let loop ((i
11f0: 6e 70 75 74 20 69 6e 70 75 74 29 0a 20 20 20 20 nput input).
1200: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 72 (par
1210: 74 69 61 6c 20 27 28 29 29 29 0a 20 20 20 20 20 tial '())).
1220: 20 20 28 63 6f 6e 64 20 28 28 73 74 72 69 6e 67 (cond ((string
1230: 2d 69 6e 64 65 78 20 69 6e 70 75 74 20 28 63 68 -index input (ch
1240: 61 72 2d 73 65 74 20 23 5c 5c 20 23 5c 22 29 29 ar-set #\\ #\"))
1250: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d . =
1260: 3e 20 28 6c 61 6d 62 64 61 20 28 69 29 0a 20 20 > (lambda (i).
1270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1280: 20 28 6c 65 74 20 28 28 63 20 28 73 74 72 69 6e (let ((c (strin
1290: 67 2d 72 65 66 20 69 6e 70 75 74 20 69 29 29 29 g-ref input i)))
12a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12b0: 20 20 20 20 20 20 28 69 66 20 28 63 68 61 72 3d (if (char=
12c0: 3f 20 63 20 23 5c 5c 29 0a 20 20 20 20 20 20 20 ? c #\\).
12d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e0: 20 20 28 69 66 20 28 3c 20 28 73 74 72 69 6e 67 (if (< (string
12f0: 2d 6c 65 6e 67 74 68 20 69 6e 70 75 74 29 20 28 -length input) (
1300: 2b 20 69 20 31 29 29 0a 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 28 65 72 72 6f 72 2d 75 6e 74 65 (error-unte
1330: 72 6d 69 6e 61 74 65 64 20 61 74 74 72 29 0a 20 rminated attr).
1340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1350: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
1360: 70 20 28 73 74 72 69 6e 67 2d 64 72 6f 70 20 69 p (string-drop i
1370: 6e 70 75 74 20 28 2b 20 69 20 32 29 29 0a 20 20 nput (+ i 2)).
1380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13a0: 20 28 63 6f 6e 73 2a 20 28 73 74 72 69 6e 67 20 (cons* (string
13b0: 28 73 74 72 69 6e 67 2d 72 65 66 20 69 6e 70 75 (string-ref inpu
13c0: 74 20 28 2b 20 69 20 31 29 29 29 0a 20 20 20 20 t (+ i 1))).
13d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 74 61 (string-ta
1400: 6b 65 20 69 6e 70 75 74 20 69 29 0a 20 20 20 20 ke input i).
1410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1430: 20 20 20 20 20 20 70 61 72 74 69 61 6c 29 29 29 partial)))
1440: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1450: 20 20 20 20 20 20 20 20 20 20 28 72 65 61 64 2d (read-
1460: 61 74 74 72 20 28 73 74 72 69 6e 67 2d 64 72 6f attr (string-dro
1470: 70 20 69 6e 70 75 74 20 28 2b 20 69 20 31 29 29 p input (+ i 1))
1480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a0: 20 20 20 20 20 28 61 6c 69 73 74 2d 63 6f 6e 73 (alist-cons
14b0: 20 61 74 74 72 0a 20 09 09 09 09 09 20 20 20 20 attr. .....
14c0: 20 20 20 28 73 74 72 69 6e 67 2d 63 6f 6e 63 61 (string-conca
14d0: 74 65 6e 61 74 65 2d 72 65 76 65 72 73 65 0a 20 tenate-reverse.
14e0: 09 09 09 09 09 09 28 63 6f 6e 73 20 28 73 74 72 ......(cons (str
14f0: 69 6e 67 2d 74 61 6b 65 20 69 6e 70 75 74 20 69 ing-take input i
1500: 29 0a 20 09 09 09 09 09 09 20 20 20 20 20 20 70 ). ...... p
1510: 61 72 74 69 61 6c 29 29 0a 20 09 09 09 09 09 20 artial)). .....
1520: 20 20 20 20 20 20 72 29 29 29 29 29 29 0a 20 20 r)))))).
1530: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
1540: 20 28 65 72 72 6f 72 2d 75 6e 74 65 72 6d 69 6e (error-untermin
1550: 61 74 65 64 20 61 74 74 72 29 29 29 29 29 0a 20 ated attr))))).
1560: 20 20 28 64 65 66 69 6e 65 20 28 65 72 72 6f 72 (define (error
1570: 2d 75 6e 74 65 72 6d 69 6e 61 74 65 64 20 61 74 -unterminated at
1580: 74 72 29 0a 20 20 20 20 20 28 65 72 72 6f 72 20 tr). (error
1590: 22 55 6e 74 65 72 6d 69 6e 61 74 65 64 20 71 75 "Unterminated qu
15a0: 6f 74 65 64 20 76 61 6c 75 65 20 67 69 76 65 6e oted value given
15b0: 20 66 6f 72 20 61 74 74 72 69 62 75 74 65 22 20 for attribute"
15c0: 61 74 74 72 29 29 0a 20 0a 20 20 20 28 72 65 61 attr)). . (rea
15d0: 64 2d 61 74 74 72 20 69 6e 70 75 74 20 27 28 29 d-attr input '()
15e0: 29 29 0a 20 0a 20 3b 3b 20 50 61 72 73 65 73 20 )). . ;; Parses
15f0: 74 68 65 20 68 65 61 64 65 72 20 76 61 6c 75 65 the header value
1600: 20 6f 66 20 22 43 6f 6f 6b 69 65 22 20 72 65 71 of "Cookie" req
1610: 75 65 73 74 20 68 65 61 64 65 72 2e 0a 20 3b 3b uest header.. ;;
1620: 20 49 66 20 63 6f 6f 6b 69 65 20 76 65 72 73 69 If cookie versi
1630: 6f 6e 20 69 73 20 6b 6e 6f 77 6e 20 62 79 20 22 on is known by "
1640: 43 6f 6f 6b 69 65 32 22 20 72 65 71 75 65 73 74 Cookie2" request
1650: 20 68 65 61 64 65 72 2c 20 69 74 20 73 68 6f 75 header, it shou
1660: 6c 64 0a 20 3b 3b 20 62 65 20 70 61 73 73 65 64 ld. ;; be passed
1670: 20 74 6f 20 76 65 72 73 69 6f 6e 20 28 61 73 20 to version (as
1680: 69 6e 74 65 67 65 72 29 2e 20 20 4f 74 68 65 72 integer). Other
1690: 77 69 73 65 2c 20 69 74 20 66 69 67 75 72 65 73 wise, it figures
16a0: 20 6f 75 74 0a 20 3b 3b 20 74 68 65 20 63 6f 6f out. ;; the coo
16b0: 6b 69 65 20 76 65 72 73 69 6f 6e 20 66 72 6f 6d kie version from
16c0: 20 69 6e 70 75 74 2e 0a 20 3b 3b 0a 20 3b 3b 20 input.. ;;. ;;
16d0: 52 65 74 75 72 6e 73 20 74 68 65 20 66 6f 6c 6c Returns the foll
16e0: 6f 77 69 6e 67 20 66 6f 72 6d 61 74 2e 0a 20 3b owing format.. ;
16f0: 3b 20 20 20 28 28 3c 6e 61 6d 65 3e 20 3c 76 61 ; ((<name> <va
1700: 6c 75 65 3e 20 5b 3a 70 61 74 68 20 3c 70 61 74 lue> [:path <pat
1710: 68 3e 5d 20 5b 3a 64 6f 6d 61 69 6e 20 3c 64 6f h>] [:domain <do
1720: 6d 61 69 6e 3e 5d 20 5b 3a 70 6f 72 74 20 3c 70 main>] [:port <p
1730: 6f 72 74 3e 5d 29 0a 20 3b 3b 20 20 20 20 2e 2e ort>]). ;; ..
1740: 2e 29 0a 20 0a 20 28 64 65 66 69 6e 65 20 28 70 .). . (define (p
1750: 61 72 73 65 2d 63 6f 6f 6b 69 65 2d 73 74 72 69 arse-cookie-stri
1760: 6e 67 20 69 6e 70 75 74 20 23 21 6f 70 74 69 6f ng input #!optio
1770: 6e 61 6c 20 76 65 72 73 69 6f 6e 29 0a 20 20 20 nal version).
1780: 28 6c 65 74 20 28 28 76 65 72 20 28 63 6f 6e 64 (let ((ver (cond
1790: 20 28 28 69 6e 74 65 67 65 72 3f 20 76 65 72 73 ((integer? vers
17a0: 69 6f 6e 29 20 76 65 72 73 69 6f 6e 29 0a 20 20 ion) version).
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 28 28 73 74 72 69 6e 67 2d 73 65 61 72 63 ((string-searc
17d0: 68 20 22 5e 5c 5c 73 2a 5c 5c 24 56 65 72 73 69 h "^\\s*\\$Versi
17e0: 6f 6e 5c 5c 73 2a 3d 5c 5c 73 2a 28 5c 5c 64 2b on\\s*=\\s*(\\d+
17f0: 29 22 20 69 6e 70 75 74 29 0a 20 20 20 20 20 20 )" input).
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d =
1810: 3e 20 28 6c 61 6d 62 64 61 20 28 6d 29 0a 20 20 > (lambda (m).
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1830: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
1840: 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 6d 29 >number (cadr m)
1850: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1860: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 30 29 (else 0)
1870: 29 29 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f ))). (let lo
1880: 6f 70 20 28 28 61 76 2d 70 61 69 72 73 20 28 70 op ((av-pairs (p
1890: 61 72 73 65 2d 61 76 2d 70 61 69 72 73 20 69 6e arse-av-pairs in
18a0: 70 75 74 20 76 65 72 29 29 0a 20 20 20 20 20 20 put ver)).
18b0: 20 20 20 20 20 20 20 20 20 20 28 72 20 27 28 29 (r '()
18c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
18d0: 20 20 28 63 75 72 72 65 6e 74 20 27 28 29 29 29 (current '()))
18e0: 0a 20 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 . (cond ((
18f0: 6e 75 6c 6c 3f 20 61 76 2d 70 61 69 72 73 29 0a null? av-pairs).
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1910: 66 20 28 6e 75 6c 6c 3f 20 63 75 72 72 65 6e 74 f (null? current
1920: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1930: 20 20 20 20 28 72 65 76 65 72 73 65 20 72 29 0a (reverse r).
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1950: 20 20 28 72 65 76 65 72 73 65 20 28 63 6f 6e 73 (reverse (cons
1960: 20 28 72 65 76 65 72 73 65 20 63 75 72 72 65 6e (reverse curren
1970: 74 29 20 72 29 29 29 29 0a 20 20 20 20 20 20 20 t) r)))).
1980: 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d 63 ((string-c
1990: 69 3d 3f 20 22 24 70 61 74 68 22 20 28 63 61 61 i=? "$path" (caa
19a0: 72 20 61 76 2d 70 61 69 72 73 29 29 0a 20 20 20 r av-pairs)).
19b0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
19c0: 20 28 63 64 72 20 61 76 2d 70 61 69 72 73 29 20 (cdr av-pairs)
19d0: 72 20 28 63 6f 6e 73 2a 20 28 63 64 61 72 20 61 r (cons* (cdar a
19e0: 76 2d 70 61 69 72 73 29 20 70 61 74 68 3a 20 63 v-pairs) path: c
19f0: 75 72 72 65 6e 74 29 29 29 0a 20 20 20 20 20 20 urrent))).
1a00: 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d ((string-
1a10: 63 69 3d 3f 20 22 24 64 6f 6d 61 69 6e 22 20 28 ci=? "$domain" (
1a20: 63 61 61 72 20 61 76 2d 70 61 69 72 73 29 29 0a caar av-pairs)).
1a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1a40: 6f 6f 70 20 28 63 64 72 20 61 76 2d 70 61 69 72 oop (cdr av-pair
1a50: 73 29 20 72 20 28 63 6f 6e 73 2a 20 28 63 64 61 s) r (cons* (cda
1a60: 72 20 61 76 2d 70 61 69 72 73 29 20 64 6f 6d 61 r av-pairs) doma
1a70: 69 6e 3a 20 63 75 72 72 65 6e 74 29 29 29 0a 20 in: current))).
1a80: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 ((st
1a90: 72 69 6e 67 2d 63 69 3d 3f 20 22 24 70 6f 72 74 ring-ci=? "$port
1aa0: 22 20 28 63 61 61 72 20 61 76 2d 70 61 69 72 73 " (caar av-pairs
1ab0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1ac0: 20 28 6c 6f 6f 70 20 28 63 64 72 20 61 76 2d 70 (loop (cdr av-p
1ad0: 61 69 72 73 29 20 72 20 28 63 6f 6e 73 2a 20 28 airs) r (cons* (
1ae0: 63 64 61 72 20 61 76 2d 70 61 69 72 73 29 20 70 cdar av-pairs) p
1af0: 6f 72 74 3a 20 63 75 72 72 65 6e 74 29 29 29 0a ort: current))).
1b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
1b10: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
1b20: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 75 72 72 (if (null? curr
1b30: 65 6e 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ent).
1b40: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 (loop (cd
1b50: 72 20 61 76 2d 70 61 69 72 73 29 20 72 20 28 6c r av-pairs) r (l
1b60: 69 73 74 20 28 63 64 61 72 20 61 76 2d 70 61 69 ist (cdar av-pai
1b70: 72 73 29 20 28 63 61 61 72 20 61 76 2d 70 61 69 rs) (caar av-pai
1b80: 72 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 rs))).
1b90: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 (loop (c
1ba0: 64 72 20 61 76 2d 70 61 69 72 73 29 0a 20 20 20 dr av-pairs).
1bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc0: 20 20 20 20 20 28 63 6f 6e 73 20 28 72 65 76 65 (cons (reve
1bd0: 72 73 65 20 63 75 72 72 65 6e 74 29 20 72 29 0a rse current) r).
1be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf0: 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 63 (list (c
1c00: 64 61 72 20 61 76 2d 70 61 69 72 73 29 20 28 63 dar av-pairs) (c
1c10: 61 61 72 20 61 76 2d 70 61 69 72 73 29 29 29 29 aar av-pairs))))
1c20: 29 29 29 29 29 0a 20 0a 20 3b 3b 20 43 6f 6e 73 ))))). . ;; Cons
1c30: 74 72 75 63 74 20 61 20 63 6f 6f 6b 69 65 20 73 truct a cookie s
1c40: 74 72 69 6e 67 20 73 75 69 74 61 62 6c 65 20 66 tring suitable f
1c50: 6f 72 20 53 65 74 2d 43 6f 6f 6b 69 65 20 6f 72 or Set-Cookie or
1c60: 20 53 65 74 2d 43 6f 6f 6b 69 65 32 20 68 65 61 Set-Cookie2 hea
1c70: 64 65 72 2e 0a 20 3b 3b 20 73 70 65 63 73 20 69 der.. ;; specs i
1c80: 73 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 s the following
1c90: 66 6f 72 6d 61 74 2e 0a 20 3b 3b 0a 20 3b 3b 20 format.. ;;. ;;
1ca0: 20 20 28 28 3c 6e 61 6d 65 3e 20 3c 76 61 6c 75 ((<name> <valu
1cb0: 65 3e 20 5b 3a 63 6f 6d 6d 65 6e 74 20 3c 63 6f e> [:comment <co
1cc0: 6d 6d 65 6e 74 3e 5d 20 5b 3a 63 6f 6d 6d 65 6e mment>] [:commen
1cd0: 74 2d 75 72 6c 20 3c 63 6f 6d 6d 65 6e 74 2d 75 t-url <comment-u
1ce0: 72 6c 3e 5d 0a 20 3b 3b 20 20 20 20 20 20 20 20 rl>]. ;;
1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 5b 3a 64 69 [:di
1d00: 73 63 61 72 64 20 3c 62 6f 6f 6c 3e 5d 20 5b 3a scard <bool>] [:
1d10: 64 6f 6d 61 69 6e 20 3c 64 6f 6d 61 69 6e 3e 5d domain <domain>]
1d20: 0a 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 . ;;
1d30: 20 20 20 20 20 20 20 20 5b 3a 6d 61 78 2d 61 67 [:max-ag
1d40: 65 20 3c 61 67 65 3e 5d 20 5b 3a 70 61 74 68 20 e <age>] [:path
1d50: 3c 76 61 6c 75 65 3e 5d 20 5b 3a 70 6f 72 74 20 <value>] [:port
1d60: 3c 70 6f 72 74 2d 6c 69 73 74 3e 5d 0a 20 3b 3b <port-list>]. ;;
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 20 20 20 5b 3a 73 65 63 75 72 65 20 3c 62 6f [:secure <bo
1d90: 6f 6c 3e 5d 20 5b 3a 76 65 72 73 69 6f 6e 20 3c ol>] [:version <
1da0: 76 65 72 73 69 6f 6e 3e 5d 20 5b 3a 65 78 70 69 version>] [:expi
1db0: 72 65 73 20 3c 64 61 74 65 3e 5d 0a 20 3b 3b 20 res <date>]. ;;
1dc0: 20 20 20 29 20 2e 2e 2e 29 0a 20 3b 3b 0a 20 3b ) ...). ;;. ;
1dd0: 3b 20 52 65 74 75 72 6e 73 20 61 20 6c 69 73 74 ; Returns a list
1de0: 20 6f 66 20 63 6f 6f 6b 69 65 20 73 74 72 69 6e of cookie strin
1df0: 67 73 20 66 6f 72 20 65 61 63 68 20 3c 6e 61 6d gs for each <nam
1e00: 65 3e 3d 3c 76 61 6c 75 65 3e 20 70 61 69 72 2e e>=<value> pair.
1e10: 20 20 49 6e 20 74 68 65 0a 20 3b 3b 20 60 60 6e In the. ;; ``n
1e20: 65 77 20 63 6f 6f 6b 69 65 27 27 20 69 6d 70 6c ew cookie'' impl
1e30: 65 6d 65 6e 74 61 74 69 6f 6e 2c 20 79 6f 75 20 ementation, you
1e40: 63 61 6e 20 6a 6f 69 6e 20 74 68 65 6d 20 62 79 can join them by
1e50: 20 63 6f 6d 6d 61 20 61 6e 64 20 73 65 6e 64 20 comma and send
1e60: 69 74 0a 20 3b 3b 20 61 74 20 6f 6e 63 65 20 77 it. ;; at once w
1e70: 69 74 68 20 53 65 74 2d 63 6f 6f 6b 69 65 32 20 ith Set-cookie2
1e80: 68 65 61 64 65 72 2e 20 20 46 6f 72 20 74 68 65 header. For the
1e90: 20 6f 6c 64 20 6e 65 74 73 63 61 70 65 20 70 72 old netscape pr
1ea0: 6f 74 6f 63 6f 6c 2c 20 79 6f 75 0a 20 3b 3b 20 otocol, you. ;;
1eb0: 6d 75 73 74 20 73 65 6e 64 20 65 61 63 68 20 6f must send each o
1ec0: 66 20 74 68 65 6d 20 62 79 20 53 65 74 2d 63 6f f them by Set-co
1ed0: 6f 6b 69 65 20 68 65 61 64 65 72 2e 0a 20 0a 20 okie header.. .
1ee0: 0a 20 28 64 65 66 69 6e 65 20 28 63 6f 6e 73 74 . (define (const
1ef0: 72 75 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 72 69 ruct-cookie-stri
1f00: 6e 67 20 73 70 65 63 73 20 23 21 6f 70 74 69 6f ng specs #!optio
1f10: 6e 61 6c 20 28 76 65 72 73 69 6f 6e 20 31 29 29 nal (version 1))
1f20: 0a 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 . (map (lambda
1f30: 20 28 73 70 65 63 29 20 28 63 6f 6e 73 74 72 75 (spec) (constru
1f40: 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 ct-cookie-string
1f50: 2d 31 20 73 70 65 63 20 76 65 72 73 69 6f 6e 29 -1 spec version)
1f60: 29 0a 20 20 20 20 20 20 20 20 73 70 65 63 73 29 ). specs)
1f70: 29 0a 20 0a 20 28 64 65 66 69 6e 65 20 28 63 6f ). . (define (co
1f80: 6e 73 74 72 75 63 74 2d 63 6f 6f 6b 69 65 2d 73 nstruct-cookie-s
1f90: 74 72 69 6e 67 2d 31 20 73 70 65 63 20 76 65 72 tring-1 spec ver
1fa0: 29 0a 20 20 20 28 77 68 65 6e 20 28 3c 20 28 6c ). (when (< (l
1fb0: 65 6e 67 74 68 20 73 70 65 63 29 20 32 29 0a 20 ength spec) 2).
1fc0: 20 20 20 20 28 65 72 72 6f 72 20 22 62 61 64 20 (error "bad
1fd0: 63 6f 6f 6b 69 65 20 73 70 65 63 3a 20 61 74 20 cookie spec: at
1fe0: 6c 65 61 73 74 20 3c 6e 61 6d 65 3e 20 61 6e 64 least <name> and
1ff0: 20 3c 76 61 6c 75 65 3e 20 72 65 71 75 69 72 65 <value> require
2000: 64 22 20 73 70 65 63 29 29 0a 20 20 20 28 6c 65 d" spec)). (le
2010: 74 20 28 28 6e 61 6d 65 20 28 63 61 72 20 73 70 t ((name (car sp
2020: 65 63 29 29 0a 20 20 20 20 20 20 20 20 20 28 76 ec)). (v
2030: 61 6c 75 65 20 28 63 61 64 72 20 73 70 65 63 29 alue (cadr spec)
2040: 29 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f )). (let loo
2050: 70 20 28 28 61 74 74 72 20 28 63 64 64 72 20 73 p ((attr (cddr s
2060: 70 65 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 pec)).
2070: 20 20 20 20 20 20 28 72 20 20 20 20 28 6c 69 73 (r (lis
2080: 74 20 28 69 66 20 76 61 6c 75 65 0a 20 20 20 20 t (if value.
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
20b0: 69 6e 67 2d 61 70 70 65 6e 64 20 6e 61 6d 65 20 ing-append name
20c0: 22 3d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 "=".
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20f0: 20 20 20 28 71 75 6f 74 65 2d 69 66 2d 6e 65 65 (quote-if-nee
2100: 64 65 64 20 76 61 6c 75 65 29 29 0a 20 20 20 20 ded value)).
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2120: 20 20 20 20 20 20 20 20 20 20 20 20 6e 61 6d 65 name
2130: 29 29 29 29 0a 20 20 20 20 20 20 20 28 64 65 66 )))). (def
2140: 69 6e 65 20 28 6e 65 78 74 20 73 29 20 28 6c 6f ine (next s) (lo
2150: 6f 70 20 28 63 64 64 72 20 61 74 74 72 29 20 28 op (cddr attr) (
2160: 63 6f 6e 73 20 73 20 72 29 29 29 0a 20 20 20 20 cons s r))).
2170: 20 20 20 28 64 65 66 69 6e 65 20 28 69 67 6e 6f (define (igno
2180: 72 65 29 20 28 6c 6f 6f 70 20 28 63 64 64 72 20 re) (loop (cddr
2190: 61 74 74 72 29 20 72 29 29 0a 20 20 20 20 20 20 attr) r)).
21a0: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 28 (cond. (
21b0: 28 6e 75 6c 6c 3f 20 61 74 74 72 29 20 28 73 74 (null? attr) (st
21c0: 72 69 6e 67 2d 6a 6f 69 6e 20 28 72 65 76 65 72 ring-join (rever
21d0: 73 65 20 72 29 20 22 3b 22 29 29 0a 20 20 20 20 se r) ";")).
21e0: 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 ((null? (cdr
21f0: 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 20 attr)).
2200: 20 28 65 72 72 6f 72 20 28 63 6f 6e 63 20 22 62 (error (conc "b
2210: 61 64 20 63 6f 6f 6b 69 65 20 73 70 65 63 3a 20 ad cookie spec:
2220: 61 74 74 72 69 62 75 74 65 20 22 20 28 63 61 72 attribute " (car
2230: 20 61 74 74 72 29 20 22 20 72 65 71 75 69 72 65 attr) " require
2240: 73 20 76 61 6c 75 65 22 20 29 29 29 0a 20 20 20 s value" ))).
2250: 20 20 20 20 20 28 28 65 71 76 3f 20 63 6f 6d 6d ((eqv? comm
2260: 65 6e 74 3a 20 28 63 61 72 20 61 74 74 72 29 29 ent: (car attr))
2270: 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3e . (if (>
2280: 20 76 65 72 20 30 29 0a 20 09 20 20 20 20 28 6e ver 0). . (n
2290: 65 78 74 20 28 73 74 72 69 6e 67 2d 61 70 70 65 ext (string-appe
22a0: 6e 64 20 22 43 6f 6d 6d 65 6e 74 3d 22 20 28 71 nd "Comment=" (q
22b0: 75 6f 74 65 2d 69 66 2d 6e 65 65 64 65 64 20 28 uote-if-needed (
22c0: 63 61 64 72 20 61 74 74 72 29 29 29 29 0a 20 20 cadr attr)))).
22d0: 20 20 20 20 20 20 20 20 20 20 20 28 69 67 6e 6f (igno
22e0: 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 re))). ((
22f0: 65 71 76 3f 20 63 6f 6d 6d 65 6e 74 2d 75 72 6c eqv? comment-url
2300: 3a 20 28 63 61 72 20 61 74 74 72 29 29 0a 20 20 : (car attr)).
2310: 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 76 65 (if (> ve
2320: 72 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 r 0).
2330: 20 20 28 6e 65 78 74 20 28 73 74 72 69 6e 67 2d (next (string-
2340: 61 70 70 65 6e 64 20 22 43 6f 6d 6d 65 6e 74 55 append "CommentU
2350: 52 4c 3d 22 20 28 71 75 6f 74 65 2d 76 61 6c 75 RL=" (quote-valu
2360: 65 20 28 63 61 64 72 20 61 74 74 72 29 29 29 29 e (cadr attr))))
2370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 . (i
2380: 67 6e 6f 72 65 29 29 29 0a 20 20 20 20 20 20 20 gnore))).
2390: 20 28 28 65 71 76 3f 20 64 69 73 63 61 72 64 3a ((eqv? discard:
23a0: 20 28 63 61 72 20 61 74 74 72 29 29 0a 20 20 20 (car attr)).
23b0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
23c0: 3e 20 76 65 72 20 30 29 20 28 63 61 64 72 20 61 > ver 0) (cadr a
23d0: 74 74 72 29 29 20 28 6e 65 78 74 20 22 44 69 73 ttr)) (next "Dis
23e0: 63 61 72 64 22 29 20 28 69 67 6e 6f 72 65 29 29 card") (ignore))
23f0: 29 0a 20 20 20 20 20 20 20 20 28 28 65 71 76 3f ). ((eqv?
2400: 20 64 6f 6d 61 69 6e 3a 20 28 63 61 72 20 61 74 domain: (car at
2410: 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 6e tr)). (n
2420: 65 78 74 20 28 73 74 72 69 6e 67 2d 61 70 70 65 ext (string-appe
2430: 6e 64 20 22 44 6f 6d 61 69 6e 3d 22 20 28 63 61 nd "Domain=" (ca
2440: 64 72 20 61 74 74 72 29 29 29 29 0a 20 20 20 20 dr attr)))).
2450: 20 20 20 20 28 28 65 71 76 3f 20 6d 61 78 2d 61 ((eqv? max-a
2460: 67 65 3a 20 28 63 61 72 20 61 74 74 72 29 29 0a ge: (car attr)).
2470: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 (if (>
2480: 76 65 72 20 30 29 0a 20 20 20 20 20 20 20 20 20 ver 0).
2490: 20 20 20 20 28 6e 65 78 74 20 28 73 70 72 69 6e (next (sprin
24a0: 74 66 20 22 4d 61 78 2d 41 67 65 3d 7e 61 22 20 tf "Max-Age=~a"
24b0: 28 63 61 64 72 20 61 74 74 72 29 29 29 0a 20 20 (cadr attr))).
24c0: 20 20 20 20 20 20 20 20 20 20 20 28 69 67 6e 6f (igno
24d0: 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 re))). ((
24e0: 65 71 76 3f 20 70 61 74 68 3a 20 28 63 61 72 20 eqv? path: (car
24f0: 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 attr)).
2500: 28 6e 65 78 74 20 28 73 74 72 69 6e 67 2d 61 70 (next (string-ap
2510: 70 65 6e 64 20 22 50 61 74 68 3d 22 20 28 71 75 pend "Path=" (qu
2520: 6f 74 65 2d 69 66 2d 6e 65 65 64 65 64 20 28 63 ote-if-needed (c
2530: 61 64 72 20 61 74 74 72 29 29 29 29 29 0a 20 20 adr attr))))).
2540: 20 20 20 20 20 20 28 28 65 71 76 3f 20 70 6f 72 ((eqv? por
2550: 74 3a 20 28 63 61 72 20 61 74 74 72 29 29 0a 20 t: (car attr)).
2560: 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 76 (if (> v
2570: 65 72 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 er 0).
2580: 20 20 20 28 6e 65 78 74 20 28 73 74 72 69 6e 67 (next (string
2590: 2d 61 70 70 65 6e 64 20 22 50 6f 72 74 3d 22 20 -append "Port="
25a0: 28 71 75 6f 74 65 2d 76 61 6c 75 65 20 28 63 61 (quote-value (ca
25b0: 64 72 20 61 74 74 72 29 29 29 29 0a 20 20 20 20 dr attr)))).
25c0: 20 20 20 20 20 20 20 20 20 28 69 67 6e 6f 72 65 (ignore
25d0: 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 65 71 ))). ((eq
25e0: 76 3f 20 73 65 63 75 72 65 3a 20 28 63 61 72 20 v? secure: (car
25f0: 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 attr)).
2600: 28 69 66 20 28 63 61 64 72 20 61 74 74 72 29 20 (if (cadr attr)
2610: 28 6e 65 78 74 20 22 53 65 63 75 72 65 22 29 20 (next "Secure")
2620: 28 69 67 6e 6f 72 65 29 29 29 0a 20 20 20 20 20 (ignore))).
2630: 20 20 20 28 28 65 71 76 3f 20 76 65 72 73 69 6f ((eqv? versio
2640: 6e 3a 20 28 63 61 72 20 61 74 74 72 29 29 0a 20 n: (car attr)).
2650: 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 76 (if (> v
2660: 65 72 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 er 0).
2670: 20 20 20 28 6e 65 78 74 20 28 73 70 72 69 6e 74 (next (sprint
2680: 66 20 22 56 65 72 73 69 6f 6e 3d 7e 61 22 20 28 f "Version=~a" (
2690: 63 61 64 72 20 61 74 74 72 29 29 29 0a 20 20 20 cadr attr))).
26a0: 20 20 20 20 20 20 20 20 20 20 28 69 67 6e 6f 72 (ignor
26b0: 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 65 e))). ((e
26c0: 71 76 3f 20 65 78 70 69 72 65 73 3a 20 28 63 61 qv? expires: (ca
26d0: 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 r attr)).
26e0: 20 20 28 69 66 20 28 3e 20 76 65 72 20 30 29 0a (if (> ver 0).
26f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 67 (ig
2700: 6e 6f 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 nore).
2710: 20 20 20 28 6e 65 78 74 20 28 6d 61 6b 65 2d 65 (next (make-e
2720: 78 70 69 72 65 73 2d 61 74 74 72 20 28 63 61 64 xpires-attr (cad
2730: 72 20 61 74 74 72 29 29 29 29 29 0a 20 20 20 20 r attr))))).
2740: 20 20 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 (else (error
2750: 20 22 55 6e 6b 6e 6f 77 6e 20 63 6f 6f 6b 69 65 "Unknown cookie
2760: 20 61 74 74 72 69 62 75 74 65 22 20 28 63 61 72 attribute" (car
2770: 20 61 74 74 72 29 29 29 29 0a 20 20 20 20 20 20 attr)))).
2780: 20 29 29 0a 20 20 20 29 0a 20 0a 20 0a 20 3b 3b )). ). . . ;;
2790: 20 28 64 65 66 69 6e 65 20 28 71 75 6f 74 65 2d (define (quote-
27a0: 76 61 6c 75 65 20 76 61 6c 75 65 29 0a 20 3b 3b value value). ;;
27b0: 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e (string-appen
27c0: 64 20 22 5c 22 22 20 28 72 65 67 65 78 70 2d 72 d "\"" (regexp-r
27d0: 65 70 6c 61 63 65 2d 61 6c 6c 20 23 2f 5c 22 7c eplace-all #/\"|
27e0: 5c 5c 2f 20 76 61 6c 75 65 20 22 5c 5c 5c 5c 5c \\/ value "\\\\\
27f0: 5c 30 22 29 20 22 5c 22 22 29 29 0a 20 0a 20 28 \0") "\"")). . (
2800: 64 65 66 69 6e 65 20 28 71 75 6f 74 65 2d 76 61 define (quote-va
2810: 6c 75 65 20 76 61 6c 75 65 29 0a 20 20 20 28 73 lue value). (s
2820: 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 5c 22 tring-append "\"
2830: 22 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 " (string-substi
2840: 74 75 74 65 2a 20 76 61 6c 75 65 20 27 28 28 22 tute* value '(("
2850: 5c 5c 5c 22 22 20 2e 20 22 5c 5c 5c 22 22 29 20 \\\"" . "\\\"")
2860: 28 22 5c 5c 5c 5c 22 20 2e 20 22 5c 5c 5c 5c 22 ("\\\\" . "\\\\"
2870: 29 29 29 20 22 5c 22 22 29 29 0a 20 0a 20 28 64 ))) "\"")). . (d
2880: 65 66 69 6e 65 20 71 75 6f 74 65 2d 69 66 2d 6e efine quote-if-n
2890: 65 65 64 65 64 0a 20 20 20 28 6c 65 74 20 28 28 eeded. (let ((
28a0: 72 78 20 28 72 65 67 65 78 70 20 22 5b 5c 5c 5c rx (regexp "[\\\
28b0: 22 2c 3b 5c 5c 5c 5c 20 5c 5c 74 5c 5c 6e 5d 22 ",;\\\\ \\t\\n]"
28c0: 29 29 29 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ))). (lambda
28d0: 20 28 76 61 6c 75 65 29 0a 20 20 20 20 20 20 20 (value).
28e0: 28 69 66 20 28 73 74 72 69 6e 67 2d 73 65 61 72 (if (string-sear
28f0: 63 68 20 72 78 20 76 61 6c 75 65 29 0a 20 09 20 ch rx value). .
2900: 20 28 71 75 6f 74 65 2d 76 61 6c 75 65 20 76 61 (quote-value va
2910: 6c 75 65 29 0a 20 09 20 20 76 61 6c 75 65 29 29 lue). . value))
2920: 29 29 0a 20 0a 20 28 64 65 66 69 6e 65 20 28 6d )). . (define (m
2930: 61 6b 65 2d 65 78 70 69 72 65 73 2d 61 74 74 72 ake-expires-attr
2940: 20 74 69 6d 65 29 0a 20 20 20 28 73 70 72 69 6e time). (sprin
2950: 74 66 20 22 45 78 70 69 72 65 73 3d 7e 61 22 0a tf "Expires=~a".
2960: 20 09 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 . (if (number
2970: 3f 20 74 69 6d 65 29 0a 20 09 20 20 20 20 20 20 ? time). .
2980: 20 28 66 6d 74 2d 74 69 6d 65 20 74 69 6d 65 29 (fmt-time time)
2990: 0a 20 09 20 20 20 20 20 20 20 74 69 6d 65 29 29 . . time))
29a0: 29 0a 20 0a 20 3b 3b 3b 3b 20 41 64 64 65 64 20 ). . ;;;; Added
29b0: 73 75 70 70 6f 72 74 20 66 75 6e 63 74 69 6f 6e support function
29c0: 73 20 66 72 6f 6d 20 6d 79 20 75 74 69 6c 73 2c s from my utils,
29d0: 20 73 70 6c 69 74 20 74 68 69 73 20 6f 75 74 0a split this out.
29e0: 20 0a 20 28 64 65 66 69 6e 65 20 28 73 74 72 69 . (define (stri
29f0: 6e 67 2d 73 65 61 72 63 68 2d 61 66 74 65 72 20 ng-search-after
2a00: 72 20 73 20 23 21 6f 70 74 69 6f 6e 61 6c 20 28 r s #!optional (
2a10: 73 74 61 72 74 20 30 29 29 0a 20 20 20 28 61 6e start 0)). (an
2a20: 64 2d 6c 65 74 2a 20 28 28 6d 61 74 63 68 2d 69 d-let* ((match-i
2a30: 6e 64 69 63 65 73 20 28 73 74 72 69 6e 67 2d 73 ndices (string-s
2a40: 65 61 72 63 68 2d 70 6f 73 69 74 69 6f 6e 73 20 earch-positions
2a50: 72 20 73 20 73 74 61 72 74 29 29 0a 20 09 20 20 r s start)). .
2a60: 20 20 20 28 72 69 67 68 74 2d 6d 61 74 63 68 20 (right-match
2a70: 28 73 65 63 6f 6e 64 20 28 66 69 72 73 74 20 6d (second (first m
2a80: 61 74 63 68 2d 69 6e 64 69 63 65 73 29 29 29 29 atch-indices))))
2a90: 0a 20 20 20 20 20 28 73 75 62 73 74 72 69 6e 67 . (substring
2aa0: 20 73 20 72 69 67 68 74 2d 6d 61 74 63 68 29 29 s right-match))
2ab0: 29 0a 29 0a ).).