Artifact
d78a525a3a7f8790df667dbbeb385bd35d8ded96:
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 63 *..(import c
0890: 68 69 63 6b 65 6e 20 73 63 68 65 6d 65 20 64 61 hicken scheme da
08a0: 74 61 2d 73 74 72 75 63 74 75 72 65 73 20 65 78 ta-structures ex
08b0: 74 72 61 73 20 73 72 66 69 2d 31 33 20 70 6f 72 tras srfi-13 por
08c0: 74 73 20 70 6f 73 69 78 29 0a 20 20 0a 28 72 65 ts posix). .(re
08d0: 71 75 69 72 65 2d 65 78 74 65 6e 73 69 6f 6e 20 quire-extension
08e0: 73 72 66 69 2d 31 20 73 72 66 69 2d 31 33 20 73 srfi-1 srfi-13 s
08f0: 72 66 69 2d 31 34 20 72 65 67 65 78 29 0a 3b 3b rfi-14 regex).;;
0900: 20 28 75 73 65 20 20 73 72 66 69 2d 31 20 73 72 (use srfi-1 sr
0910: 66 69 2d 31 33 20 73 72 66 69 2d 31 34 20 72 65 fi-13 srfi-14 re
0920: 67 65 78 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 gex).;; (declare
0930: 20 28 65 78 70 6f 72 74 20 70 61 72 73 65 2d 63 (export parse-c
0940: 6f 6f 6b 69 65 2d 73 74 72 69 6e 67 20 63 6f 6e ookie-string con
0950: 73 74 72 75 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 struct-cookie-st
0960: 72 69 6e 67 29 29 0a 0a 3b 3b 20 23 3e 0a 3b 3b ring))..;; #>.;;
0970: 20 23 69 6e 63 6c 75 64 65 20 3c 74 69 6d 65 2e #include <time.
0980: 68 3e 0a 3b 3b 20 3c 23 0a 3b 3b 20 0a 3b 3b 20 h>.;; <#.;; .;;
0990: 28 64 65 66 69 6e 65 20 66 6d 74 2d 74 69 6d 65 (define fmt-time
09a0: 0a 3b 3b 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c .;; (foreign-l
09b0: 61 6d 62 64 61 2a 20 63 2d 73 74 72 69 6e 67 20 ambda* c-string
09c0: 28 28 6c 6f 6e 67 20 73 65 63 73 5f 73 69 6e 63 ((long secs_sinc
09d0: 65 5f 65 70 6f 63 68 29 29 0a 3b 3b 20 20 20 20 e_epoch)).;;
09e0: 20 22 73 74 61 74 69 63 20 63 68 61 72 20 62 75 "static char bu
09f0: 66 5b 32 35 36 5d 3b 22 0a 3b 3b 20 20 20 20 20 f[256];".;;
0a00: 22 74 69 6d 65 5f 74 20 74 20 3d 20 28 74 69 6d "time_t t = (tim
0a10: 65 5f 74 29 20 73 65 63 73 5f 73 69 6e 63 65 5f e_t) secs_since_
0a20: 65 70 6f 63 68 3b 22 0a 3b 3b 20 20 20 20 20 22 epoch;".;; "
0a30: 73 74 72 66 74 69 6d 65 28 62 75 66 2c 20 73 69 strftime(buf, si
0a40: 7a 65 6f 66 28 62 75 66 29 2c 20 5c 22 25 61 2c zeof(buf), \"%a,
0a50: 20 25 64 2d 25 62 2d 25 59 20 25 48 3a 25 4d 3a %d-%b-%Y %H:%M:
0a60: 25 53 20 47 4d 54 5c 22 2c 20 67 6d 74 69 6d 65 %S GMT\", gmtime
0a70: 28 26 74 29 29 3b 22 0a 3b 3b 20 20 20 20 20 22 (&t));".;; "
0a80: 72 65 74 75 72 6e 28 62 75 66 29 3b 22 29 29 0a return(buf);")).
0a90: 0a 0a 28 64 65 66 69 6e 65 20 28 66 6d 74 2d 74 ..(define (fmt-t
0aa0: 69 6d 65 20 73 65 63 6f 6e 64 73 29 0a 20 20 20 ime seconds).
0ab0: 28 74 69 6d 65 2d 3e 73 74 72 69 6e 67 20 28 73 (time->string (s
0ac0: 65 63 6f 6e 64 73 2d 3e 75 74 63 2d 74 69 6d 65 econds->utc-time
0ad0: 20 73 65 63 6f 6e 64 73 29 20 22 25 44 22 29 29 seconds) "%D"))
0ae0: 0a 0a 20 3b 3b 20 75 74 69 6c 69 74 79 20 66 6e .. ;; utility fn
0af0: 2e 20 20 62 72 65 61 6b 73 20 20 60 60 61 74 74 . breaks ``att
0b00: 72 3d 76 61 6c 75 65 3b 61 74 74 72 3d 76 61 6c r=value;attr=val
0b10: 75 65 20 2e 2e 2e 20 27 27 20 69 6e 74 6f 20 61 ue ... '' into a
0b20: 6c 69 73 74 2e 0a 20 3b 3b 20 76 65 72 73 69 6f list.. ;; versio
0b30: 6e 20 69 73 20 61 20 63 6f 6f 6b 69 65 20 76 65 n is a cookie ve
0b40: 72 73 69 6f 6e 2e 20 20 69 66 20 76 65 72 73 69 rsion. if versi
0b50: 6f 6e 3e 30 2c 20 77 65 20 61 6c 6c 6f 77 20 63 on>0, we allow c
0b60: 6f 6d 6d 61 20 61 73 20 74 68 65 0a 20 3b 3b 20 omma as the. ;;
0b70: 64 65 6c 69 6d 69 74 65 72 20 61 73 20 77 65 6c delimiter as wel
0b80: 6c 20 61 73 20 73 65 6d 69 63 6f 6c 6f 6e 2e 0a l as semicolon..
0b90: 20 28 64 65 66 69 6e 65 20 28 70 61 72 73 65 2d (define (parse-
0ba0: 61 76 2d 70 61 69 72 73 20 69 6e 70 75 74 20 76 av-pairs input v
0bb0: 65 72 73 69 6f 6e 29 0a 20 20 20 28 64 65 66 69 ersion). (defi
0bc0: 6e 65 20 61 74 74 72 2d 72 65 67 65 78 70 0a 20 ne attr-regexp.
0bd0: 20 20 20 20 28 69 66 20 28 3d 20 76 65 72 73 69 (if (= versi
0be0: 6f 6e 20 30 29 0a 20 20 20 20 20 20 20 20 20 28 on 0). (
0bf0: 72 65 67 65 78 70 20 22 5c 5c 73 2a 28 5b 5c 5c regexp "\\s*([\\
0c00: 77 24 5f 2d 5d 2b 29 5c 5c 73 2a 28 5b 3d 5c 5c w$_-]+)\\s*([=\\
0c10: 3b 5d 5c 5c 73 2a 29 3f 22 29 0a 20 20 20 20 20 ;]\\s*)?").
0c20: 20 20 20 20 28 72 65 67 65 78 70 20 22 5c 5c 73 (regexp "\\s
0c30: 2a 28 5b 5c 5c 77 24 5f 2d 5d 2b 29 5c 5c 73 2a *([\\w$_-]+)\\s*
0c40: 28 5b 3d 5c 5c 3b 2c 5d 5c 5c 73 2a 29 3f 22 29 ([=\\;,]\\s*)?")
0c50: 29 29 0a 20 20 20 28 64 65 66 69 6e 65 20 61 74 )). (define at
0c60: 74 72 2d 64 65 6c 69 6d 0a 20 20 20 20 20 28 69 tr-delim. (i
0c70: 66 20 28 3d 20 76 65 72 73 69 6f 6e 20 30 29 20 f (= version 0)
0c80: 23 5c 3b 20 28 63 68 61 72 2d 73 65 74 20 23 5c #\; (char-set #\
0c90: 2c 20 23 5c 5c 20 23 5c 3b 29 29 29 0a 20 20 20 , #\\ #\;))).
0ca0: 0a 20 20 20 28 64 65 66 69 6e 65 20 28 72 65 61 . (define (rea
0cb0: 64 2d 61 74 74 72 20 69 6e 70 75 74 20 72 29 0a d-attr input r).
0cc0: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 73 74 72 (cond ((str
0cd0: 69 6e 67 2d 6e 75 6c 6c 3f 20 69 6e 70 75 74 29 ing-null? input)
0ce0: 20 28 72 65 76 65 72 73 65 21 20 72 29 29 0a 20 (reverse! r)).
0cf0: 20 20 20 20 20 20 20 20 20 20 28 28 73 74 72 69 ((stri
0d00: 6e 67 2d 73 65 61 72 63 68 20 61 74 74 72 2d 72 ng-search attr-r
0d10: 65 67 65 78 70 20 69 6e 70 75 74 29 0a 20 20 20 egexp input).
0d20: 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d => (lam
0d30: 62 64 61 20 28 6d 29 0a 20 20 20 20 20 20 20 20 bda (m).
0d40: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
0d50: 64 2d 6c 65 74 2a 20 28 28 64 65 6c 69 6d 69 74 d-let* ((delimit
0d60: 65 72 20 28 74 68 69 72 64 20 6d 29 29 29 20 3b er (third m))) ;
0d70: 3b 69 73 20 61 6e 20 61 74 74 72 5f 76 61 6c 75 ;is an attr_valu
0d80: 65 20 70 61 69 0a 20 09 09 20 20 20 20 20 20 28 e pai. .. (
0d90: 73 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 22 string-prefix? "
0da0: 3d 22 20 64 65 6c 69 6d 69 74 65 72 29 29 0a 20 =" delimiter)).
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 20 20 20 28 6c 65 74 20 28 28 61 74 74 72 20 (let ((attr
0dd0: 28 73 65 63 6f 6e 64 20 6d 29 29 0a 20 20 20 20 (second m)).
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 20 20 20 20 28 72 65 73 74 20 28 73 74 (rest (st
0e00: 72 69 6e 67 2d 73 65 61 72 63 68 2d 61 66 74 65 ring-search-afte
0e10: 72 20 61 74 74 72 2d 72 65 67 65 78 70 20 69 6e r attr-regexp in
0e20: 70 75 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 put))).
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
0e40: 66 20 28 73 74 72 69 6e 67 2d 70 72 65 66 69 78 f (string-prefix
0e50: 3f 20 22 5c 22 22 20 72 65 73 74 29 0a 20 20 20 ? "\"" rest).
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 20 20 20 20 20 28 72 65 61 64 2d 74 6f (read-to
0e80: 6b 65 6e 2d 71 75 6f 74 65 64 20 61 74 74 72 20 ken-quoted attr
0e90: 28 73 74 72 69 6e 67 2d 64 72 6f 70 20 72 65 73 (string-drop res
0ea0: 74 20 31 29 20 72 29 0a 20 20 20 20 20 20 20 20 t 1) r).
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 20 20 28 72 65 61 64 2d 74 6f 6b 65 6e 20 61 (read-token a
0ed0: 74 74 72 20 72 65 73 74 20 72 29 29 29 0a 20 20 ttr rest r))).
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ef0: 20 20 20 28 72 65 61 64 2d 61 74 74 72 20 28 73 (read-attr (s
0f00: 74 72 69 6e 67 2d 73 65 61 72 63 68 2d 61 66 74 tring-search-aft
0f10: 65 72 20 61 74 74 72 2d 72 65 67 65 78 70 20 69 er attr-regexp i
0f20: 6e 70 75 74 29 20 3b 3b 20 53 6b 69 70 20 61 68 nput) ;; Skip ah
0f30: 65 61 64 20 69 66 20 62 72 6f 6b 65 6e 20 69 6e ead if broken in
0f40: 70 75 74 3f 0a 20 20 20 20 20 20 20 20 20 20 20 put?.
0f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f60: 20 20 20 20 20 28 61 6c 69 73 74 2d 63 6f 6e 73 (alist-cons
0f70: 20 28 73 65 63 6f 6e 64 20 6d 29 20 23 66 20 72 (second m) #f r
0f80: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
0f90: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
0fa0: 20 20 20 3b 3b 20 74 68 65 20 69 6e 70 75 74 20 ;; the input
0fb0: 69 73 20 62 72 6f 6b 65 6e 3b 20 66 6f 72 20 6e is broken; for n
0fc0: 6f 77 2c 20 77 65 20 69 67 6e 6f 72 65 20 74 68 ow, we ignore th
0fd0: 65 20 72 65 73 74 2e 0a 20 20 20 20 20 20 20 20 e rest..
0fe0: 20 20 20 20 28 72 65 76 65 72 73 65 21 20 72 29 (reverse! r)
0ff0: 29 29 29 0a 20 20 20 28 64 65 66 69 6e 65 20 28 ))). (define (
1000: 72 65 61 64 2d 74 6f 6b 65 6e 20 61 74 74 72 20 read-token attr
1010: 69 6e 70 75 74 20 72 29 0a 20 20 20 20 20 28 63 input r). (c
1020: 6f 6e 64 20 28 28 73 74 72 69 6e 67 2d 69 6e 64 ond ((string-ind
1030: 65 78 20 69 6e 70 75 74 20 61 74 74 72 2d 64 65 ex input attr-de
1040: 6c 69 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 lim).
1050: 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 69 29 0a => (lambda (i).
1060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1070: 20 28 72 65 61 64 2d 61 74 74 72 20 28 73 74 72 (read-attr (str
1080: 69 6e 67 2d 64 72 6f 70 20 69 6e 70 75 74 20 28 ing-drop input (
1090: 2b 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 20 + i 1)).
10a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10b0: 20 20 20 20 28 61 6c 69 73 74 2d 63 6f 6e 73 20 (alist-cons
10c0: 61 74 74 72 0a 20 09 09 09 09 20 20 20 20 20 20 attr. ....
10d0: 20 28 73 74 72 69 6e 67 2d 74 72 69 6d 2d 72 69 (string-trim-ri
10e0: 67 68 74 20 28 73 74 72 69 6e 67 2d 74 61 6b 65 ght (string-take
10f0: 20 69 6e 70 75 74 20 69 29 29 0a 20 09 09 09 09 input i)). ....
1100: 20 20 20 20 20 20 20 72 29 29 29 29 0a 20 20 20 r)))).
1110: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
1120: 20 20 20 20 20 20 20 20 20 20 28 72 65 76 65 72 (rever
1130: 73 65 21 20 28 61 6c 69 73 74 2d 63 6f 6e 73 20 se! (alist-cons
1140: 61 74 74 72 20 28 73 74 72 69 6e 67 2d 74 72 69 attr (string-tri
1150: 6d 2d 72 69 67 68 74 20 69 6e 70 75 74 29 20 72 m-right input) r
1160: 29 29 29 29 29 0a 20 20 20 28 64 65 66 69 6e 65 ))))). (define
1170: 20 28 72 65 61 64 2d 74 6f 6b 65 6e 2d 71 75 6f (read-token-quo
1180: 74 65 64 20 61 74 74 72 20 69 6e 70 75 74 20 72 ted attr input r
1190: 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 ). (let loop
11a0: 20 28 28 69 6e 70 75 74 20 69 6e 70 75 74 29 0a ((input input).
11b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c0: 28 70 61 72 74 69 61 6c 20 27 28 29 29 29 0a 20 (partial '())).
11d0: 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 73 74 (cond ((st
11e0: 72 69 6e 67 2d 69 6e 64 65 78 20 69 6e 70 75 74 ring-index input
11f0: 20 28 63 68 61 72 2d 73 65 74 20 23 5c 5c 20 23 (char-set #\\ #
1200: 5c 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 \")).
1210: 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 69 => (lambda (i
1220: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1230: 20 20 20 20 20 28 6c 65 74 20 28 28 63 20 28 73 (let ((c (s
1240: 74 72 69 6e 67 2d 72 65 66 20 69 6e 70 75 74 20 tring-ref input
1250: 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i))).
1260: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 63 (if (c
1270: 68 61 72 3d 3f 20 63 20 23 5c 5c 29 0a 20 20 20 har=? c #\\).
1280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1290: 20 20 20 20 20 20 28 69 66 20 28 3c 20 28 73 74 (if (< (st
12a0: 72 69 6e 67 2d 6c 65 6e 67 74 68 20 69 6e 70 75 ring-length inpu
12b0: 74 29 20 28 2b 20 69 20 31 29 29 0a 20 20 20 20 t) (+ i 1)).
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 28 65 72 72 6f 72 2d (error-
12e0: 75 6e 74 65 72 6d 69 6e 61 74 65 64 20 61 74 74 unterminated att
12f0: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
1300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1310: 28 6c 6f 6f 70 20 28 73 74 72 69 6e 67 2d 64 72 (loop (string-dr
1320: 6f 70 20 69 6e 70 75 74 20 28 2b 20 69 20 32 29 op input (+ i 2)
1330: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1350: 20 20 20 20 20 28 63 6f 6e 73 2a 20 28 73 74 72 (cons* (str
1360: 69 6e 67 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ing (string-ref
1370: 69 6e 70 75 74 20 28 2b 20 69 20 31 29 29 29 0a input (+ i 1))).
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 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e (strin
13b0: 67 2d 74 61 6b 65 20 69 6e 70 75 74 20 69 29 0a g-take input i).
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: 20 20 20 20 20 20 20 20 20 20 70 61 72 74 69 61 partia
13f0: 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 l))).
1400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
1410: 65 61 64 2d 61 74 74 72 20 28 73 74 72 69 6e 67 ead-attr (string
1420: 2d 64 72 6f 70 20 69 6e 70 75 74 20 28 2b 20 69 -drop input (+ i
1430: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1)).
1440: 20 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 28 61 6c 69 73 74 2d (alist-
1460: 63 6f 6e 73 20 61 74 74 72 0a 20 09 09 09 09 09 cons attr. .....
1470: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 63 (string-c
1480: 6f 6e 63 61 74 65 6e 61 74 65 2d 72 65 76 65 72 oncatenate-rever
1490: 73 65 0a 20 09 09 09 09 09 09 28 63 6f 6e 73 20 se. ......(cons
14a0: 28 73 74 72 69 6e 67 2d 74 61 6b 65 20 69 6e 70 (string-take inp
14b0: 75 74 20 69 29 0a 20 09 09 09 09 09 09 20 20 20 ut i). ......
14c0: 20 20 20 70 61 72 74 69 61 6c 29 29 0a 20 09 09 partial)). ..
14d0: 09 09 09 20 20 20 20 20 20 20 72 29 29 29 29 29 ... r)))))
14e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
14f0: 65 6c 73 65 20 28 65 72 72 6f 72 2d 75 6e 74 65 else (error-unte
1500: 72 6d 69 6e 61 74 65 64 20 61 74 74 72 29 29 29 rminated attr)))
1510: 29 29 0a 20 20 20 28 64 65 66 69 6e 65 20 28 65 )). (define (e
1520: 72 72 6f 72 2d 75 6e 74 65 72 6d 69 6e 61 74 65 rror-unterminate
1530: 64 20 61 74 74 72 29 0a 20 20 20 20 20 28 65 72 d attr). (er
1540: 72 6f 72 20 22 55 6e 74 65 72 6d 69 6e 61 74 65 ror "Unterminate
1550: 64 20 71 75 6f 74 65 64 20 76 61 6c 75 65 20 67 d quoted value g
1560: 69 76 65 6e 20 66 6f 72 20 61 74 74 72 69 62 75 iven for attribu
1570: 74 65 22 20 61 74 74 72 29 29 0a 20 0a 20 20 20 te" attr)). .
1580: 28 72 65 61 64 2d 61 74 74 72 20 69 6e 70 75 74 (read-attr input
1590: 20 27 28 29 29 29 0a 20 0a 20 3b 3b 20 50 61 72 '())). . ;; Par
15a0: 73 65 73 20 74 68 65 20 68 65 61 64 65 72 20 76 ses the header v
15b0: 61 6c 75 65 20 6f 66 20 22 43 6f 6f 6b 69 65 22 alue of "Cookie"
15c0: 20 72 65 71 75 65 73 74 20 68 65 61 64 65 72 2e request header.
15d0: 0a 20 3b 3b 20 49 66 20 63 6f 6f 6b 69 65 20 76 . ;; If cookie v
15e0: 65 72 73 69 6f 6e 20 69 73 20 6b 6e 6f 77 6e 20 ersion is known
15f0: 62 79 20 22 43 6f 6f 6b 69 65 32 22 20 72 65 71 by "Cookie2" req
1600: 75 65 73 74 20 68 65 61 64 65 72 2c 20 69 74 20 uest header, it
1610: 73 68 6f 75 6c 64 0a 20 3b 3b 20 62 65 20 70 61 should. ;; be pa
1620: 73 73 65 64 20 74 6f 20 76 65 72 73 69 6f 6e 20 ssed to version
1630: 28 61 73 20 69 6e 74 65 67 65 72 29 2e 20 20 4f (as integer). O
1640: 74 68 65 72 77 69 73 65 2c 20 69 74 20 66 69 67 therwise, it fig
1650: 75 72 65 73 20 6f 75 74 0a 20 3b 3b 20 74 68 65 ures out. ;; the
1660: 20 63 6f 6f 6b 69 65 20 76 65 72 73 69 6f 6e 20 cookie version
1670: 66 72 6f 6d 20 69 6e 70 75 74 2e 0a 20 3b 3b 0a from input.. ;;.
1680: 20 3b 3b 20 52 65 74 75 72 6e 73 20 74 68 65 20 ;; Returns the
1690: 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f 72 6d 61 74 following format
16a0: 2e 0a 20 3b 3b 20 20 20 28 28 3c 6e 61 6d 65 3e .. ;; ((<name>
16b0: 20 3c 76 61 6c 75 65 3e 20 5b 3a 70 61 74 68 20 <value> [:path
16c0: 3c 70 61 74 68 3e 5d 20 5b 3a 64 6f 6d 61 69 6e <path>] [:domain
16d0: 20 3c 64 6f 6d 61 69 6e 3e 5d 20 5b 3a 70 6f 72 <domain>] [:por
16e0: 74 20 3c 70 6f 72 74 3e 5d 29 0a 20 3b 3b 20 20 t <port>]). ;;
16f0: 20 20 2e 2e 2e 29 0a 20 0a 20 28 64 65 66 69 6e ...). . (defin
1700: 65 20 28 70 61 72 73 65 2d 63 6f 6f 6b 69 65 2d e (parse-cookie-
1710: 73 74 72 69 6e 67 20 69 6e 70 75 74 20 23 21 6f string input #!o
1720: 70 74 69 6f 6e 61 6c 20 76 65 72 73 69 6f 6e 29 ptional version)
1730: 0a 20 20 20 28 6c 65 74 20 28 28 76 65 72 20 28 . (let ((ver (
1740: 63 6f 6e 64 20 28 28 69 6e 74 65 67 65 72 3f 20 cond ((integer?
1750: 76 65 72 73 69 6f 6e 29 20 76 65 72 73 69 6f 6e version) version
1760: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1770: 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 2d 73 ((string-s
1780: 65 61 72 63 68 20 22 5e 5c 5c 73 2a 5c 5c 24 56 earch "^\\s*\\$V
1790: 65 72 73 69 6f 6e 5c 5c 73 2a 3d 5c 5c 73 2a 28 ersion\\s*=\\s*(
17a0: 5c 5c 64 2b 29 22 20 69 6e 70 75 74 29 0a 20 20 \\d+)" input).
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 6d => (lambda (m
17d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
17e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
17f0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 ing->number (cad
1800: 72 20 6d 29 29 29 29 0a 20 20 20 20 20 20 20 20 r m)))).
1810: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
1820: 65 20 30 29 29 29 29 0a 20 20 20 20 20 28 6c 65 e 0)))). (le
1830: 74 20 6c 6f 6f 70 20 28 28 61 76 2d 70 61 69 72 t loop ((av-pair
1840: 73 20 28 70 61 72 73 65 2d 61 76 2d 70 61 69 72 s (parse-av-pair
1850: 73 20 69 6e 70 75 74 20 76 65 72 29 29 0a 20 20 s input ver)).
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
1870: 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 '()).
1880: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 20 27 (current '
1890: 28 29 29 29 0a 20 20 20 20 20 20 20 28 63 6f 6e ())). (con
18a0: 64 20 28 28 6e 75 6c 6c 3f 20 61 76 2d 70 61 69 d ((null? av-pai
18b0: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs).
18c0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 75 72 (if (null? cur
18d0: 72 65 6e 74 29 0a 20 20 20 20 20 20 20 20 20 20 rent).
18e0: 20 20 20 20 20 20 20 20 28 72 65 76 65 72 73 65 (reverse
18f0: 20 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r).
1900: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 28 (reverse (
1910: 63 6f 6e 73 20 28 72 65 76 65 72 73 65 20 63 75 cons (reverse cu
1920: 72 72 65 6e 74 29 20 72 29 29 29 29 0a 20 20 20 rrent) r)))).
1930: 20 20 20 20 20 20 20 20 20 20 28 28 73 74 72 69 ((stri
1940: 6e 67 2d 63 69 3d 3f 20 22 24 70 61 74 68 22 20 ng-ci=? "$path"
1950: 28 63 61 61 72 20 61 76 2d 70 61 69 72 73 29 29 (caar av-pairs))
1960: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
1970: 6c 6f 6f 70 20 28 63 64 72 20 61 76 2d 70 61 69 loop (cdr av-pai
1980: 72 73 29 20 72 20 28 63 6f 6e 73 2a 20 28 63 64 rs) r (cons* (cd
1990: 61 72 20 61 76 2d 70 61 69 72 73 29 20 70 61 74 ar av-pairs) pat
19a0: 68 3a 20 63 75 72 72 65 6e 74 29 29 29 0a 20 20 h: current))).
19b0: 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 72 ((str
19c0: 69 6e 67 2d 63 69 3d 3f 20 22 24 64 6f 6d 61 69 ing-ci=? "$domai
19d0: 6e 22 20 28 63 61 61 72 20 61 76 2d 70 61 69 72 n" (caar av-pair
19e0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
19f0: 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 61 76 2d (loop (cdr av-
1a00: 70 61 69 72 73 29 20 72 20 28 63 6f 6e 73 2a 20 pairs) r (cons*
1a10: 28 63 64 61 72 20 61 76 2d 70 61 69 72 73 29 20 (cdar av-pairs)
1a20: 64 6f 6d 61 69 6e 3a 20 63 75 72 72 65 6e 74 29 domain: current)
1a30: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1a40: 28 28 73 74 72 69 6e 67 2d 63 69 3d 3f 20 22 24 ((string-ci=? "$
1a50: 70 6f 72 74 22 20 28 63 61 61 72 20 61 76 2d 70 port" (caar av-p
1a60: 61 69 72 73 29 29 0a 20 20 20 20 20 20 20 20 20 airs)).
1a70: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 (loop (cdr
1a80: 61 76 2d 70 61 69 72 73 29 20 72 20 28 63 6f 6e av-pairs) r (con
1a90: 73 2a 20 28 63 64 61 72 20 61 76 2d 70 61 69 72 s* (cdar av-pair
1aa0: 73 29 20 70 6f 72 74 3a 20 63 75 72 72 65 6e 74 s) port: current
1ab0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1ac0: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
1ad0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
1ae0: 63 75 72 72 65 6e 74 29 0a 20 20 20 20 20 20 20 current).
1af0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
1b00: 20 28 63 64 72 20 61 76 2d 70 61 69 72 73 29 20 (cdr av-pairs)
1b10: 72 20 28 6c 69 73 74 20 28 63 64 61 72 20 61 76 r (list (cdar av
1b20: 2d 70 61 69 72 73 29 20 28 63 61 61 72 20 61 76 -pairs) (caar av
1b30: 2d 70 61 69 72 73 29 29 29 0a 20 20 20 20 20 20 -pairs))).
1b40: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
1b50: 70 20 28 63 64 72 20 61 76 2d 70 61 69 72 73 29 p (cdr av-pairs)
1b60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1b70: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
1b80: 72 65 76 65 72 73 65 20 63 75 72 72 65 6e 74 29 reverse current)
1b90: 20 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r).
1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
1bb0: 74 20 28 63 64 61 72 20 61 76 2d 70 61 69 72 73 t (cdar av-pairs
1bc0: 29 20 28 63 61 61 72 20 61 76 2d 70 61 69 72 73 ) (caar av-pairs
1bd0: 29 29 29 29 29 29 29 29 29 0a 20 0a 20 3b 3b 20 ))))))))). . ;;
1be0: 43 6f 6e 73 74 72 75 63 74 20 61 20 63 6f 6f 6b Construct a cook
1bf0: 69 65 20 73 74 72 69 6e 67 20 73 75 69 74 61 62 ie string suitab
1c00: 6c 65 20 66 6f 72 20 53 65 74 2d 43 6f 6f 6b 69 le for Set-Cooki
1c10: 65 20 6f 72 20 53 65 74 2d 43 6f 6f 6b 69 65 32 e or Set-Cookie2
1c20: 20 68 65 61 64 65 72 2e 0a 20 3b 3b 20 73 70 65 header.. ;; spe
1c30: 63 73 20 69 73 20 74 68 65 20 66 6f 6c 6c 6f 77 cs is the follow
1c40: 69 6e 67 20 66 6f 72 6d 61 74 2e 0a 20 3b 3b 0a ing format.. ;;.
1c50: 20 3b 3b 20 20 20 28 28 3c 6e 61 6d 65 3e 20 3c ;; ((<name> <
1c60: 76 61 6c 75 65 3e 20 5b 3a 63 6f 6d 6d 65 6e 74 value> [:comment
1c70: 20 3c 63 6f 6d 6d 65 6e 74 3e 5d 20 5b 3a 63 6f <comment>] [:co
1c80: 6d 6d 65 6e 74 2d 75 72 6c 20 3c 63 6f 6d 6d 65 mment-url <comme
1c90: 6e 74 2d 75 72 6c 3e 5d 0a 20 3b 3b 20 20 20 20 nt-url>]. ;;
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cb0: 5b 3a 64 69 73 63 61 72 64 20 3c 62 6f 6f 6c 3e [:discard <bool>
1cc0: 5d 20 5b 3a 64 6f 6d 61 69 6e 20 3c 64 6f 6d 61 ] [:domain <doma
1cd0: 69 6e 3e 5d 0a 20 3b 3b 20 20 20 20 20 20 20 20 in>]. ;;
1ce0: 20 20 20 20 20 20 20 20 20 20 20 20 5b 3a 6d 61 [:ma
1cf0: 78 2d 61 67 65 20 3c 61 67 65 3e 5d 20 5b 3a 70 x-age <age>] [:p
1d00: 61 74 68 20 3c 76 61 6c 75 65 3e 5d 20 5b 3a 70 ath <value>] [:p
1d10: 6f 72 74 20 3c 70 6f 72 74 2d 6c 69 73 74 3e 5d ort <port-list>]
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 73 65 63 75 72 65 [:secure
1d40: 20 3c 62 6f 6f 6c 3e 5d 20 5b 3a 76 65 72 73 69 <bool>] [:versi
1d50: 6f 6e 20 3c 76 65 72 73 69 6f 6e 3e 5d 20 5b 3a on <version>] [:
1d60: 65 78 70 69 72 65 73 20 3c 64 61 74 65 3e 5d 0a expires <date>].
1d70: 20 3b 3b 20 20 20 20 29 20 2e 2e 2e 29 0a 20 3b ;; ) ...). ;
1d80: 3b 0a 20 3b 3b 20 52 65 74 75 72 6e 73 20 61 20 ;. ;; Returns a
1d90: 6c 69 73 74 20 6f 66 20 63 6f 6f 6b 69 65 20 73 list of cookie s
1da0: 74 72 69 6e 67 73 20 66 6f 72 20 65 61 63 68 20 trings for each
1db0: 3c 6e 61 6d 65 3e 3d 3c 76 61 6c 75 65 3e 20 70 <name>=<value> p
1dc0: 61 69 72 2e 20 20 49 6e 20 74 68 65 0a 20 3b 3b air. In the. ;;
1dd0: 20 60 60 6e 65 77 20 63 6f 6f 6b 69 65 27 27 20 ``new cookie''
1de0: 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 2c 20 implementation,
1df0: 79 6f 75 20 63 61 6e 20 6a 6f 69 6e 20 74 68 65 you can join the
1e00: 6d 20 62 79 20 63 6f 6d 6d 61 20 61 6e 64 20 73 m by comma and s
1e10: 65 6e 64 20 69 74 0a 20 3b 3b 20 61 74 20 6f 6e end it. ;; at on
1e20: 63 65 20 77 69 74 68 20 53 65 74 2d 63 6f 6f 6b ce with Set-cook
1e30: 69 65 32 20 68 65 61 64 65 72 2e 20 20 46 6f 72 ie2 header. For
1e40: 20 74 68 65 20 6f 6c 64 20 6e 65 74 73 63 61 70 the old netscap
1e50: 65 20 70 72 6f 74 6f 63 6f 6c 2c 20 79 6f 75 0a e protocol, you.
1e60: 20 3b 3b 20 6d 75 73 74 20 73 65 6e 64 20 65 61 ;; must send ea
1e70: 63 68 20 6f 66 20 74 68 65 6d 20 62 79 20 53 65 ch of them by Se
1e80: 74 2d 63 6f 6f 6b 69 65 20 68 65 61 64 65 72 2e t-cookie header.
1e90: 0a 20 0a 20 0a 20 28 64 65 66 69 6e 65 20 28 63 . . . (define (c
1ea0: 6f 6e 73 74 72 75 63 74 2d 63 6f 6f 6b 69 65 2d onstruct-cookie-
1eb0: 73 74 72 69 6e 67 20 73 70 65 63 73 20 23 21 6f string specs #!o
1ec0: 70 74 69 6f 6e 61 6c 20 28 76 65 72 73 69 6f 6e ptional (version
1ed0: 20 31 29 29 0a 20 20 20 28 6d 61 70 20 28 6c 61 1)). (map (la
1ee0: 6d 62 64 61 20 28 73 70 65 63 29 20 28 63 6f 6e mbda (spec) (con
1ef0: 73 74 72 75 63 74 2d 63 6f 6f 6b 69 65 2d 73 74 struct-cookie-st
1f00: 72 69 6e 67 2d 31 20 73 70 65 63 20 76 65 72 73 ring-1 spec vers
1f10: 69 6f 6e 29 29 0a 20 20 20 20 20 20 20 20 73 70 ion)). sp
1f20: 65 63 73 29 29 0a 20 0a 20 28 64 65 66 69 6e 65 ecs)). . (define
1f30: 20 28 63 6f 6e 73 74 72 75 63 74 2d 63 6f 6f 6b (construct-cook
1f40: 69 65 2d 73 74 72 69 6e 67 2d 31 20 73 70 65 63 ie-string-1 spec
1f50: 20 76 65 72 29 0a 20 20 20 28 77 68 65 6e 20 28 ver). (when (
1f60: 3c 20 28 6c 65 6e 67 74 68 20 73 70 65 63 29 20 < (length spec)
1f70: 32 29 0a 20 20 20 20 20 28 65 72 72 6f 72 20 22 2). (error "
1f80: 62 61 64 20 63 6f 6f 6b 69 65 20 73 70 65 63 3a bad cookie spec:
1f90: 20 61 74 20 6c 65 61 73 74 20 3c 6e 61 6d 65 3e at least <name>
1fa0: 20 61 6e 64 20 3c 76 61 6c 75 65 3e 20 72 65 71 and <value> req
1fb0: 75 69 72 65 64 22 20 73 70 65 63 29 29 0a 20 20 uired" spec)).
1fc0: 20 28 6c 65 74 20 28 28 6e 61 6d 65 20 28 63 61 (let ((name (ca
1fd0: 72 20 73 70 65 63 29 29 0a 20 20 20 20 20 20 20 r spec)).
1fe0: 20 20 28 76 61 6c 75 65 20 28 63 61 64 72 20 73 (value (cadr s
1ff0: 70 65 63 29 29 29 0a 20 20 20 20 20 28 6c 65 74 pec))). (let
2000: 20 6c 6f 6f 70 20 28 28 61 74 74 72 20 28 63 64 loop ((attr (cd
2010: 64 72 20 73 70 65 63 29 29 0a 20 20 20 20 20 20 dr spec)).
2020: 20 20 20 20 20 20 20 20 20 20 28 72 20 20 20 20 (r
2030: 28 6c 69 73 74 20 28 69 66 20 76 61 6c 75 65 0a (list (if value.
2040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2060: 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 6e (string-append n
2070: 61 6d 65 20 22 3d 22 0a 20 20 20 20 20 20 20 20 ame "=".
2080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 71 75 6f 74 65 2d 69 66 (quote-if
20b0: 2d 6e 65 65 64 65 64 20 76 61 6c 75 65 29 29 0a -needed value)).
20c0: 20 20 20 20 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: 6e 61 6d 65 29 29 29 29 0a 20 20 20 20 20 20 20 name)))).
20f0: 28 64 65 66 69 6e 65 20 28 6e 65 78 74 20 73 29 (define (next s)
2100: 20 28 6c 6f 6f 70 20 28 63 64 64 72 20 61 74 74 (loop (cddr att
2110: 72 29 20 28 63 6f 6e 73 20 73 20 72 29 29 29 0a r) (cons s r))).
2120: 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 (define (
2130: 69 67 6e 6f 72 65 29 20 28 6c 6f 6f 70 20 28 63 ignore) (loop (c
2140: 64 64 72 20 61 74 74 72 29 20 72 29 29 0a 20 20 ddr attr) r)).
2150: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
2160: 20 20 20 28 28 6e 75 6c 6c 3f 20 61 74 74 72 29 ((null? attr)
2170: 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 28 72 (string-join (r
2180: 65 76 65 72 73 65 20 72 29 20 22 3b 22 29 29 0a everse r) ";")).
2190: 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 ((null?
21a0: 28 63 64 72 20 61 74 74 72 29 29 0a 20 20 20 20 (cdr attr)).
21b0: 20 20 20 20 20 28 65 72 72 6f 72 20 28 63 6f 6e (error (con
21c0: 63 20 22 62 61 64 20 63 6f 6f 6b 69 65 20 73 70 c "bad cookie sp
21d0: 65 63 3a 20 61 74 74 72 69 62 75 74 65 20 22 20 ec: attribute "
21e0: 28 63 61 72 20 61 74 74 72 29 20 22 20 72 65 71 (car attr) " req
21f0: 75 69 72 65 73 20 76 61 6c 75 65 22 20 29 29 29 uires value" )))
2200: 0a 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 . ((eqv?
2210: 63 6f 6d 6d 65 6e 74 3a 20 28 63 61 72 20 61 74 comment: (car at
2220: 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 tr)). (i
2230: 66 20 28 3e 20 76 65 72 20 30 29 0a 20 09 20 20 f (> ver 0). .
2240: 20 20 28 6e 65 78 74 20 28 73 74 72 69 6e 67 2d (next (string-
2250: 61 70 70 65 6e 64 20 22 43 6f 6d 6d 65 6e 74 3d append "Comment=
2260: 22 20 28 71 75 6f 74 65 2d 69 66 2d 6e 65 65 64 " (quote-if-need
2270: 65 64 20 28 63 61 64 72 20 61 74 74 72 29 29 29 ed (cadr attr)))
2280: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
2290: 69 67 6e 6f 72 65 29 29 29 0a 20 20 20 20 20 20 ignore))).
22a0: 20 20 28 28 65 71 76 3f 20 63 6f 6d 6d 65 6e 74 ((eqv? comment
22b0: 2d 75 72 6c 3a 20 28 63 61 72 20 61 74 74 72 29 -url: (car attr)
22c0: 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28 ). (if (
22d0: 3e 20 76 65 72 20 30 29 0a 20 20 20 20 20 20 20 > ver 0).
22e0: 20 20 20 20 20 20 28 6e 65 78 74 20 28 73 74 72 (next (str
22f0: 69 6e 67 2d 61 70 70 65 6e 64 20 22 43 6f 6d 6d ing-append "Comm
2300: 65 6e 74 55 52 4c 3d 22 20 28 71 75 6f 74 65 2d entURL=" (quote-
2310: 76 61 6c 75 65 20 28 63 61 64 72 20 61 74 74 72 value (cadr attr
2320: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
2330: 20 20 28 69 67 6e 6f 72 65 29 29 29 0a 20 20 20 (ignore))).
2340: 20 20 20 20 20 28 28 65 71 76 3f 20 64 69 73 63 ((eqv? disc
2350: 61 72 64 3a 20 28 63 61 72 20 61 74 74 72 29 29 ard: (car attr))
2360: 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 . (if (a
2370: 6e 64 20 28 3e 20 76 65 72 20 30 29 20 28 63 61 nd (> ver 0) (ca
2380: 64 72 20 61 74 74 72 29 29 20 28 6e 65 78 74 20 dr attr)) (next
2390: 22 44 69 73 63 61 72 64 22 29 20 28 69 67 6e 6f "Discard") (igno
23a0: 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 re))). ((
23b0: 65 71 76 3f 20 64 6f 6d 61 69 6e 3a 20 28 63 61 eqv? domain: (ca
23c0: 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 20 20 r attr)).
23d0: 20 20 28 6e 65 78 74 20 28 73 74 72 69 6e 67 2d (next (string-
23e0: 61 70 70 65 6e 64 20 22 44 6f 6d 61 69 6e 3d 22 append "Domain="
23f0: 20 28 63 61 64 72 20 61 74 74 72 29 29 29 29 0a (cadr attr)))).
2400: 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 6d ((eqv? m
2410: 61 78 2d 61 67 65 3a 20 28 63 61 72 20 61 74 74 ax-age: (car att
2420: 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 r)). (if
2430: 20 28 3e 20 76 65 72 20 30 29 0a 20 20 20 20 20 (> ver 0).
2440: 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 28 73 (next (s
2450: 70 72 69 6e 74 66 20 22 4d 61 78 2d 41 67 65 3d printf "Max-Age=
2460: 7e 61 22 20 28 63 61 64 72 20 61 74 74 72 29 29 ~a" (cadr attr))
2470: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
2480: 69 67 6e 6f 72 65 29 29 29 0a 20 20 20 20 20 20 ignore))).
2490: 20 20 28 28 65 71 76 3f 20 70 61 74 68 3a 20 28 ((eqv? path: (
24a0: 63 61 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 car attr)).
24b0: 20 20 20 20 28 6e 65 78 74 20 28 73 74 72 69 6e (next (strin
24c0: 67 2d 61 70 70 65 6e 64 20 22 50 61 74 68 3d 22 g-append "Path="
24d0: 20 28 71 75 6f 74 65 2d 69 66 2d 6e 65 65 64 65 (quote-if-neede
24e0: 64 20 28 63 61 64 72 20 61 74 74 72 29 29 29 29 d (cadr attr))))
24f0: 29 0a 20 20 20 20 20 20 20 20 28 28 65 71 76 3f ). ((eqv?
2500: 20 70 6f 72 74 3a 20 28 63 61 72 20 61 74 74 72 port: (car attr
2510: 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 )). (if
2520: 28 3e 20 76 65 72 20 30 29 0a 20 20 20 20 20 20 (> ver 0).
2530: 20 20 20 20 20 20 20 28 6e 65 78 74 20 28 73 74 (next (st
2540: 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 50 6f 72 ring-append "Por
2550: 74 3d 22 20 28 71 75 6f 74 65 2d 76 61 6c 75 65 t=" (quote-value
2560: 20 28 63 61 64 72 20 61 74 74 72 29 29 29 29 0a (cadr attr)))).
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 67 (ig
2580: 6e 6f 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 nore))).
2590: 28 28 65 71 76 3f 20 73 65 63 75 72 65 3a 20 28 ((eqv? secure: (
25a0: 63 61 72 20 61 74 74 72 29 29 0a 20 20 20 20 20 car attr)).
25b0: 20 20 20 20 28 69 66 20 28 63 61 64 72 20 61 74 (if (cadr at
25c0: 74 72 29 20 28 6e 65 78 74 20 22 53 65 63 75 72 tr) (next "Secur
25d0: 65 22 29 20 28 69 67 6e 6f 72 65 29 29 29 0a 20 e") (ignore))).
25e0: 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 76 65 ((eqv? ve
25f0: 72 73 69 6f 6e 3a 20 28 63 61 72 20 61 74 74 72 rsion: (car attr
2600: 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 )). (if
2610: 28 3e 20 76 65 72 20 30 29 0a 20 20 20 20 20 20 (> ver 0).
2620: 20 20 20 20 20 20 20 28 6e 65 78 74 20 28 73 70 (next (sp
2630: 72 69 6e 74 66 20 22 56 65 72 73 69 6f 6e 3d 7e rintf "Version=~
2640: 61 22 20 28 63 61 64 72 20 61 74 74 72 29 29 29 a" (cadr attr)))
2650: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 . (i
2660: 67 6e 6f 72 65 29 29 29 0a 20 20 20 20 20 20 20 gnore))).
2670: 20 28 28 65 71 76 3f 20 65 78 70 69 72 65 73 3a ((eqv? expires:
2680: 20 28 63 61 72 20 61 74 74 72 29 29 0a 20 20 20 (car attr)).
2690: 20 20 20 20 20 20 28 69 66 20 28 3e 20 76 65 72 (if (> ver
26a0: 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0).
26b0: 20 28 69 67 6e 6f 72 65 29 0a 20 20 20 20 20 20 (ignore).
26c0: 20 20 20 20 20 20 20 28 6e 65 78 74 20 28 6d 61 (next (ma
26d0: 6b 65 2d 65 78 70 69 72 65 73 2d 61 74 74 72 20 ke-expires-attr
26e0: 28 63 61 64 72 20 61 74 74 72 29 29 29 29 29 0a (cadr attr))))).
26f0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 (else (e
2700: 72 72 6f 72 20 22 55 6e 6b 6e 6f 77 6e 20 63 6f rror "Unknown co
2710: 6f 6b 69 65 20 61 74 74 72 69 62 75 74 65 22 20 okie attribute"
2720: 28 63 61 72 20 61 74 74 72 29 29 29 29 0a 20 20 (car attr)))).
2730: 20 20 20 20 20 29 29 0a 20 20 20 29 0a 20 0a 20 )). ). .
2740: 0a 20 3b 3b 20 28 64 65 66 69 6e 65 20 28 71 75 . ;; (define (qu
2750: 6f 74 65 2d 76 61 6c 75 65 20 76 61 6c 75 65 29 ote-value value)
2760: 0a 20 3b 3b 20 20 20 28 73 74 72 69 6e 67 2d 61 . ;; (string-a
2770: 70 70 65 6e 64 20 22 5c 22 22 20 28 72 65 67 65 ppend "\"" (rege
2780: 78 70 2d 72 65 70 6c 61 63 65 2d 61 6c 6c 20 23 xp-replace-all #
2790: 2f 5c 22 7c 5c 5c 2f 20 76 61 6c 75 65 20 22 5c /\"|\\/ value "\
27a0: 5c 5c 5c 5c 5c 30 22 29 20 22 5c 22 22 29 29 0a \\\\\0") "\"")).
27b0: 20 0a 20 28 64 65 66 69 6e 65 20 28 71 75 6f 74 . (define (quot
27c0: 65 2d 76 61 6c 75 65 20 76 61 6c 75 65 29 0a 20 e-value value).
27d0: 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 (string-append
27e0: 20 22 5c 22 22 20 28 73 74 72 69 6e 67 2d 73 75 "\"" (string-su
27f0: 62 73 74 69 74 75 74 65 2a 20 76 61 6c 75 65 20 bstitute* value
2800: 27 28 28 22 5c 5c 5c 22 22 20 2e 20 22 5c 5c 5c '(("\\\"" . "\\\
2810: 22 22 29 20 28 22 5c 5c 5c 5c 22 20 2e 20 22 5c "") ("\\\\" . "\
2820: 5c 5c 5c 22 29 29 29 20 22 5c 22 22 29 29 0a 20 \\\"))) "\"")).
2830: 0a 20 28 64 65 66 69 6e 65 20 71 75 6f 74 65 2d . (define quote-
2840: 69 66 2d 6e 65 65 64 65 64 0a 20 20 20 28 6c 65 if-needed. (le
2850: 74 20 28 28 72 78 20 28 72 65 67 65 78 70 20 22 t ((rx (regexp "
2860: 5b 5c 5c 5c 22 2c 3b 5c 5c 5c 5c 20 5c 5c 74 5c [\\\",;\\\\ \\t\
2870: 5c 6e 5d 22 29 29 29 0a 20 20 20 20 20 28 6c 61 \n]"))). (la
2880: 6d 62 64 61 20 28 76 61 6c 75 65 29 0a 20 20 20 mbda (value).
2890: 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d (if (string-
28a0: 73 65 61 72 63 68 20 72 78 20 76 61 6c 75 65 29 search rx value)
28b0: 0a 20 09 20 20 28 71 75 6f 74 65 2d 76 61 6c 75 . . (quote-valu
28c0: 65 20 76 61 6c 75 65 29 0a 20 09 20 20 76 61 6c e value). . val
28d0: 75 65 29 29 29 29 0a 20 0a 20 28 64 65 66 69 6e ue)))). . (defin
28e0: 65 20 28 6d 61 6b 65 2d 65 78 70 69 72 65 73 2d e (make-expires-
28f0: 61 74 74 72 20 74 69 6d 65 29 0a 20 20 20 28 73 attr time). (s
2900: 70 72 69 6e 74 66 20 22 45 78 70 69 72 65 73 3d printf "Expires=
2910: 7e 61 22 0a 20 09 20 20 20 28 69 66 20 28 6e 75 ~a". . (if (nu
2920: 6d 62 65 72 3f 20 74 69 6d 65 29 0a 20 09 20 20 mber? time). .
2930: 20 20 20 20 20 28 66 6d 74 2d 74 69 6d 65 20 74 (fmt-time t
2940: 69 6d 65 29 0a 20 09 20 20 20 20 20 20 20 74 69 ime). . ti
2950: 6d 65 29 29 29 0a 20 0a 20 3b 3b 3b 3b 20 41 64 me))). . ;;;; Ad
2960: 64 65 64 20 73 75 70 70 6f 72 74 20 66 75 6e 63 ded support func
2970: 74 69 6f 6e 73 20 66 72 6f 6d 20 6d 79 20 75 74 tions from my ut
2980: 69 6c 73 2c 20 73 70 6c 69 74 20 74 68 69 73 20 ils, split this
2990: 6f 75 74 0a 20 0a 20 28 64 65 66 69 6e 65 20 28 out. . (define (
29a0: 73 74 72 69 6e 67 2d 73 65 61 72 63 68 2d 61 66 string-search-af
29b0: 74 65 72 20 72 20 73 20 23 21 6f 70 74 69 6f 6e ter r s #!option
29c0: 61 6c 20 28 73 74 61 72 74 20 30 29 29 0a 20 20 al (start 0)).
29d0: 20 28 61 6e 64 2d 6c 65 74 2a 20 28 28 6d 61 74 (and-let* ((mat
29e0: 63 68 2d 69 6e 64 69 63 65 73 20 28 73 74 72 69 ch-indices (stri
29f0: 6e 67 2d 73 65 61 72 63 68 2d 70 6f 73 69 74 69 ng-search-positi
2a00: 6f 6e 73 20 72 20 73 20 73 74 61 72 74 29 29 0a ons r s start)).
2a10: 20 09 20 20 20 20 20 28 72 69 67 68 74 2d 6d 61 . (right-ma
2a20: 74 63 68 20 28 73 65 63 6f 6e 64 20 28 66 69 72 tch (second (fir
2a30: 73 74 20 6d 61 74 63 68 2d 69 6e 64 69 63 65 73 st match-indices
2a40: 29 29 29 29 0a 20 20 20 20 20 28 73 75 62 73 74 )))). (subst
2a50: 72 69 6e 67 20 73 20 72 69 67 68 74 2d 6d 61 74 ring s right-mat
2a60: 63 68 29 29 29 0a 29 0a ch))).).