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