0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 20 6-2017, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 This file is par
0040: 74 20 6f 66 20 50 6b 74 73 0a 3b 3b 20 0a 3b 3b t of Pkts.;; .;;
0050: 20 20 20 20 20 50 6b 74 73 20 69 73 20 66 72 65 Pkts is fre
0060: 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f 75 20 e software: you
0070: 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 74 65 can redistribute
0080: 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 66 it and/or modif
0090: 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e 64 65 y.;; it unde
00a0: 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 r the terms of t
00b0: 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 he GNU General P
00c0: 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 61 73 ublic License as
00d0: 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a 3b 3b published by.;;
00e0: 20 20 20 20 20 74 68 65 20 46 72 65 65 20 53 6f the Free So
00f0: 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f ftware Foundatio
0100: 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 6f n, either versio
0110: 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 6e n 3 of the Licen
0120: 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 28 61 se, or.;; (a
0130: 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 t your option) a
0140: 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 6f 6e ny later version
0150: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 50 6b 74 ..;; .;; Pkt
0160: 73 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 s is distributed
0170: 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 in the hope tha
0180: 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 t it will be use
0190: 66 75 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 ful,.;; but
01a0: 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 WITHOUT ANY WARR
01b0: 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 ANTY; without ev
01c0: 65 6e 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 en the implied w
01d0: 61 72 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 arranty of.;;
01e0: 20 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 MERCHANTABILIT
01f0: 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 Y or FITNESS FOR
0200: 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 A PARTICULAR PU
0210: 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a RPOSE. See the.
0220: 3b 3b 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 ;; GNU Gener
0230: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
0240: 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 e for more detai
0250: 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 ls..;; .;; Y
0260: 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 ou should have r
0270: 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f eceived a copy o
0280: 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 f the GNU Genera
0290: 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 l Public License
02a0: 0a 3b 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 .;; along wi
02b0: 74 68 20 50 6b 74 73 2e 20 20 49 66 20 6e 6f 74 th Pkts. If not
02c0: 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 77 , see <http://ww
02d0: 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 w.gnu.org/licens
02e0: 65 73 2f 3e 2e 0a 3b 3b 0a 0a 3b 3b 20 43 41 52 es/>..;;..;; CAR
02f0: 44 53 3a 0a 3b 3b 0a 3b 3b 20 41 20 63 61 72 64 DS:.;;.;; A card
0300: 20 69 73 20 61 20 6c 69 6e 65 20 6f 66 20 74 65 is a line of te
0310: 78 74 2c 20 74 68 65 20 66 69 72 73 74 20 74 77 xt, the first tw
0320: 6f 20 63 68 61 72 61 63 74 65 72 73 20 61 72 65 o characters are
0330: 20 61 20 6c 65 74 74 65 72 20 66 6f 6c 6c 6f 77 a letter follow
0340: 65 64 20 62 79 20 61 0a 3b 3b 20 20 20 73 70 61 ed by a.;; spa
0350: 63 65 2e 20 54 68 65 20 6c 65 74 74 65 72 20 69 ce. The letter i
0360: 73 20 74 68 65 20 63 61 72 64 20 74 79 70 65 2e s the card type.
0370: 0a 3b 3b 0a 3b 3b 20 50 4b 54 53 3a 0a 3b 3b 0a .;;.;; PKTS:.;;.
0380: 3b 3b 20 41 20 70 6b 74 20 69 73 20 61 20 73 6f ;; A pkt is a so
0390: 72 74 65 64 20 6c 69 73 74 20 6f 66 20 63 61 72 rted list of car
03a0: 64 73 20 77 69 74 68 20 61 20 66 69 6e 61 6c 20 ds with a final
03b0: 63 61 72 64 20 5a 20 74 68 61 74 20 63 6f 6e 74 card Z that cont
03c0: 61 69 6e 73 20 74 68 65 20 73 68 61 72 31 20 68 ains the shar1 h
03d0: 61 73 68 0a 3b 3b 20 20 20 6f 66 20 61 6c 6c 20 ash.;; of all
03e0: 6f 66 20 74 68 65 20 70 72 65 63 65 64 69 6e 67 of the preceding
03f0: 20 63 61 72 64 73 2e 0a 3b 3b 0a 3b 3b 20 41 50 cards..;;.;; AP
0400: 4b 54 3a 0a 3b 3b 0a 3b 3b 20 20 41 6e 20 61 6c KT:.;;.;; An al
0410: 69 73 74 20 6d 61 70 70 69 6e 67 20 63 61 72 64 ist mapping card
0420: 20 74 79 70 65 73 20 74 6f 20 63 61 72 64 20 64 types to card d
0430: 61 74 61 0a 3b 3b 20 20 20 20 20 20 27 28 28 54 ata.;; '((T
0440: 20 2e 20 22 70 6b 74 74 79 70 65 22 29 0a 3b 3b . "pkttype").;;
0450: 20 20 20 20 20 20 20 20 28 61 20 2e 20 22 73 6f (a . "so
0460: 6d 65 20 63 6f 6e 74 65 6e 74 22 29 29 0a 3b 3b me content")).;;
0470: 0a 3b 3b 20 45 50 4b 54 3a 0a 3b 3b 0a 3b 3b 20 .;; EPKT:.;;.;;
0480: 20 45 78 74 65 6e 64 65 64 20 70 61 63 6b 65 74 Extended packet
0490: 20 75 73 69 6e 67 20 66 72 69 65 6e 64 6c 79 20 using friendly
04a0: 6b 65 79 73 2e 20 4d 75 73 74 20 75 73 65 20 61 keys. Must use a
04b0: 20 70 6b 74 73 70 65 63 20 74 6f 20 63 6f 6e 76 pktspec to conv
04c0: 65 72 74 20 74 6f 2f 66 72 6f 6d 20 65 70 6b 74 ert to/from epkt
04d0: 73 0a 3b 3b 20 20 20 20 27 28 28 70 74 79 70 65 s.;; '((ptype
04e0: 20 2e 20 22 70 6b 74 74 79 70 65 22 29 0a 3b 3b . "pkttype").;;
04f0: 20 20 20 20 20 20 28 61 64 61 74 61 20 2e 20 22 (adata . "
0500: 73 6f 6d 65 20 63 6f 6e 74 65 6e 74 29 29 0a 3b some content)).;
0510: 3b 0a 3b 3b 20 44 50 4b 54 3a 0a 3b 3b 0a 3b 3b ;.;; DPKT:.;;.;;
0520: 20 70 6b 74 73 20 70 75 6c 6c 65 64 20 66 72 6f pkts pulled fro
0530: 6d 20 74 68 65 20 64 61 74 61 62 61 73 65 20 68 m the database h
0540: 61 76 65 20 74 68 69 73 20 66 6f 72 6d 61 74 3a ave this format:
0550: 0a 3b 3b 0a 3b 3b 28 28 61 70 6b 74 20 28 5a 20 .;;.;;((apkt (Z
0560: 2e 20 22 37 64 65 38 39 63 30 39 61 63 30 32 34 . "7de89c09ac024
0570: 62 33 38 33 32 63 39 33 65 31 36 63 64 37 38 64 b3832c93e16cd78d
0580: 31 31 65 32 65 32 38 37 33 33 62 22 29 20 20 20 11e2e28733b")
0590: 20 20 3c 3d 20 74 68 69 73 20 69 73 20 61 20 74 <= this is a t
05a0: 68 65 20 61 6c 69 73 74 0a 3b 3b 20 20 20 20 20 he alist.;;
05b0: 20 20 28 74 20 2e 20 22 76 31 2e 36 33 2f 74 69 (t . "v1.63/ti
05c0: 70 2f 64 65 76 22 29 0a 3b 3b 20 20 20 20 20 20 p/dev").;;
05d0: 20 28 63 20 2e 20 22 51 55 49 43 4b 50 41 54 54 (c . "QUICKPATT
05e0: 22 29 0a 3b 3b 20 20 20 20 20 20 20 28 54 20 2e ").;; (T .
05f0: 20 22 72 75 6e 73 74 61 72 74 22 29 0a 3b 3b 20 "runstart").;;
0600: 20 20 20 20 20 20 28 50 20 2e 20 22 33 35 34 65 (P . "354e
0610: 65 62 36 37 31 32 30 61 39 32 31 65 33 65 33 33 eb67120a921e3e33
0620: 31 35 35 65 63 61 62 31 62 35 32 32 61 63 31 30 155ecab1b522ac10
0630: 62 36 62 64 22 29 0a 3b 3b 20 20 20 20 20 20 20 b6bd").;;
0640: 28 44 20 2e 20 22 31 34 38 38 39 39 35 30 39 36 (D . "1488995096
0650: 2e 30 22 29 29 0a 3b 3b 20 20 28 69 64 20 2e 20 .0")).;; (id .
0660: 38 29 0a 3b 3b 20 20 28 67 72 6f 75 70 2d 69 64 8).;; (group-id
0670: 20 2e 20 30 29 0a 3b 3b 20 20 28 75 75 69 64 20 . 0).;; (uuid
0680: 2e 20 22 37 64 65 38 39 63 30 39 61 63 30 32 34 . "7de89c09ac024
0690: 62 33 38 33 32 63 39 33 65 31 36 63 64 37 38 64 b3832c93e16cd78d
06a0: 31 31 65 32 65 32 38 37 33 33 62 22 29 0a 3b 3b 11e2e28733b").;;
06b0: 20 20 28 70 61 72 65 6e 74 20 2e 20 22 22 29 0a (parent . "").
06c0: 3b 3b 20 20 28 70 6b 74 2d 74 79 70 65 20 2e 20 ;; (pkt-type .
06d0: 22 72 75 6e 73 74 61 72 74 22 29 0a 3b 3b 20 20 "runstart").;;
06e0: 28 70 6b 74 20 2e 20 22 44 20 31 34 38 38 39 39 (pkt . "D 148899
06f0: 35 30 39 36 2e 30 5c 6e 50 20 33 35 34 65 65 62 5096.0\nP 354eeb
0700: 36 37 31 32 30 61 39 32 31 65 33 65 33 33 31 35 67120a921e3e3315
0710: 35 65 63 61 62 31 62 35 32 32 61 63 31 30 62 36 5ecab1b522ac10b6
0720: 62 64 5c 6e 54 20 72 75 6e 73 74 61 72 74 5c 6e bd\nT runstart\n
0730: 63 20 51 55 49 43 4b 50 41 54 54 5c 6e 74 20 76 c QUICKPATT\nt v
0740: 31 2e 36 33 2f 74 69 70 2f 64 65 76 5c 6e 5a 20 1.63/tip/dev\nZ
0750: 37 64 65 38 39 63 30 39 61 63 30 32 34 62 33 38 7de89c09ac024b38
0760: 33 32 63 39 33 65 31 36 63 64 37 38 64 31 31 65 32c93e16cd78d11e
0770: 32 65 32 38 37 33 33 62 22 29 29 0a 3b 3b 0a 3b 2e28733b")).;;.;
0780: 3b 20 70 6b 74 73 70 65 63 20 69 73 20 61 6c 69 ; pktspec is ali
0790: 73 74 20 6f 66 20 61 6c 69 73 74 73 20 6d 61 70 st of alists map
07a0: 70 69 6e 67 20 74 79 70 65 73 20 61 6e 64 20 6e ping types and n
07b0: 69 63 65 6b 65 79 73 20 74 6f 20 6b 65 79 73 0a icekeys to keys.
07c0: 3b 3b 0a 3b 3b 20 27 28 28 70 6f 73 74 69 6e 67 ;;.;; '((posting
07d0: 20 2e 20 28 28 74 69 74 6c 65 20 2e 20 74 29 0a . ((title . t).
07e0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
07f0: 20 28 75 72 6c 20 20 20 2e 20 75 29 0a 3b 3b 20 (url . u).;;
0800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
0810: 6c 75 72 62 20 2e 20 62 29 29 29 0a 3b 3b 20 20 lurb . b))).;;
0820: 20 28 63 6f 6d 6d 65 6e 74 20 2e 20 28 28 63 6f (comment . ((co
0830: 6d 6d 65 6e 74 20 2e 20 63 29 0a 3b 3b 20 20 20 mment . c).;;
0840: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 63 6f (sco
0850: 72 65 20 20 20 2e 20 73 29 29 29 29 0a 0a 3b 3b re . s))))..;;
0860: 20 52 65 73 65 72 76 65 64 20 63 61 72 64 73 3a Reserved cards:
0870: 0a 3b 3b 20 20 20 50 20 20 20 20 20 20 3a 20 70 .;; P : p
0880: 6b 74 20 70 61 72 65 6e 74 0a 3b 3b 20 20 20 52 kt parent.;; R
0890: 20 20 20 20 20 20 3a 20 72 65 66 65 72 65 6e 63 : referenc
08a0: 65 20 70 6b 74 20 63 6f 6e 74 61 69 6e 69 6e 67 e pkt containing
08b0: 20 6d 61 70 70 69 6e 67 20 6f 66 20 73 68 6f 72 mapping of shor
08c0: 74 20 73 74 72 69 6e 67 20 2d 3e 20 73 68 61 31 t string -> sha1
08d0: 73 75 6d 20 73 74 72 69 6e 67 73 0a 3b 3b 20 20 sum strings.;;
08e0: 20 54 20 20 20 20 20 20 3a 20 70 6b 74 20 74 79 T : pkt ty
08f0: 70 65 0a 3b 3b 20 20 20 44 20 20 20 20 20 20 3a pe.;; D :
0900: 20 63 75 72 72 65 6e 74 20 74 69 6d 65 20 66 72 current time fr
0910: 6f 6d 20 28 63 75 72 72 65 6e 74 2d 74 69 6d 65 om (current-time
0920: 29 2c 20 75 6e 6c 65 73 73 20 70 72 6f 76 69 64 ), unless provid
0930: 65 64 0a 3b 3b 20 20 20 5a 20 20 20 20 20 20 3a ed.;; Z :
0940: 20 73 68 61 72 31 20 68 61 73 68 20 6f 66 20 74 shar1 hash of t
0950: 68 65 20 70 61 63 6b 65 74 0a 0a 3b 3b 20 45 78 he packet..;; Ex
0960: 61 6d 70 6c 65 20 75 73 61 67 65 3a 0a 3b 3b 0a ample usage:.;;.
0970: 3b 3b 20 43 72 65 61 74 65 20 61 20 70 6b 74 3a ;; Create a pkt:
0980: 0a 3b 3b 0a 3b 3b 20 28 75 73 65 20 70 6b 74 73 .;;.;; (use pkts
0990: 29 0a 3b 3b 20 28 64 65 66 69 6e 65 2d 76 61 6c ).;; (define-val
09a0: 75 65 73 20 28 75 75 69 64 20 70 6b 74 29 0a 3b ues (uuid pkt).;
09b0: 3b 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 70 6b ; (alist->pk
09c0: 74 0a 3b 3b 20 20 20 20 20 20 20 27 28 28 66 72 t.;; '((fr
09d0: 75 69 74 20 2e 20 22 61 70 70 6c 65 22 29 20 28 uit . "apple") (
09e0: 6d 65 61 74 20 2e 20 22 62 65 65 66 22 29 29 20 meat . "beef"))
09f0: 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 ;; this is the
0a00: 64 61 74 61 20 74 6f 20 63 6f 6e 76 65 72 74 0a data to convert.
0a10: 3b 3b 20 20 20 20 20 20 20 27 28 28 66 6f 6f 64 ;; '((food
0a20: 73 20 28 66 72 75 69 74 20 2e 20 66 29 20 28 6d s (fruit . f) (m
0a30: 65 61 74 20 2e 20 6d 29 29 29 20 20 20 20 20 3b eat . m))) ;
0a40: 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 70 6b ; this is the pk
0a50: 74 20 73 70 65 63 0a 3b 3b 20 20 20 20 20 20 20 t spec.;;
0a60: 70 74 79 70 65 3a 0a 3b 3b 20 20 20 20 20 20 20 ptype:.;;
0a70: 27 66 6f 6f 64 73 29 29 0a 3b 3b 0a 3b 3b 20 41 'foods)).;;.;; A
0a80: 64 64 20 74 6f 20 70 6b 74 20 71 75 65 75 65 3a dd to pkt queue:
0a90: 0a 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 64 .;;.;; (define d
0aa0: 62 20 28 6f 70 65 6e 2d 71 75 65 75 65 2d 64 62 b (open-queue-db
0ab0: 20 22 2f 74 6d 70 2f 70 6b 74 73 22 20 22 70 6b "/tmp/pkts" "pk
0ac0: 74 73 2e 64 62 22 29 29 0a 3b 3b 20 28 61 64 64 ts.db")).;; (add
0ad0: 2d 74 6f 2d 71 75 65 75 65 20 64 62 20 70 6b 74 -to-queue db pkt
0ae0: 20 75 75 69 64 20 27 66 6f 6f 64 73 20 23 66 20 uuid 'foods #f
0af0: 30 29 20 3b 3b 20 6e 6f 20 70 61 72 65 6e 74 20 0) ;; no parent
0b00: 61 6e 64 20 75 73 65 20 67 72 6f 75 70 5f 69 64 and use group_id
0b10: 20 6f 66 20 30 0a 3b 3b 0a 3b 3b 20 52 65 74 72 of 0.;;.;; Retr
0b20: 69 65 76 65 20 74 68 65 20 70 61 63 6b 65 74 20 ieve the packet
0b30: 66 72 6f 6d 20 74 68 65 20 64 62 20 61 6e 64 20 from the db and
0b40: 65 78 74 72 61 63 74 20 61 20 76 61 6c 75 65 3a extract a value:
0b50: 0a 3b 3b 0a 3b 3b 20 28 61 6c 69 73 74 2d 72 65 .;;.;; (alist-re
0b60: 66 0a 3b 3b 20 20 20 20 27 6d 65 61 74 0a 3b 3b f.;; 'meat.;;
0b70: 20 20 20 20 28 64 70 6b 74 2d 3e 61 6c 69 73 74 (dpkt->alist
0b80: 0a 3b 3b 20 20 20 20 20 20 20 20 20 28 63 61 72 .;; (car
0b90: 20 28 67 65 74 2d 64 70 6b 74 73 20 64 62 20 23 (get-dpkts db #
0ba0: 66 20 30 20 23 66 29 29 0a 3b 3b 20 20 20 20 20 f 0 #f)).;;
0bb0: 20 20 20 27 28 28 66 6f 6f 64 73 20 28 66 72 75 '((foods (fru
0bc0: 69 74 20 2e 20 66 29 0a 3b 3b 20 20 20 20 20 20 it . f).;;
0bd0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 65 61 74 (meat
0be0: 20 2e 20 6d 29 29 29 29 29 0a 3b 3b 20 3d 3e 20 . m))))).;; =>
0bf0: 22 62 65 65 66 22 0a 3b 3b 0a 0a 28 6d 6f 64 75 "beef".;;..(modu
0c00: 6c 65 20 70 6b 74 73 0a 28 0a 3b 3b 20 63 61 72 le pkts.(.;; car
0c10: 64 73 2c 20 75 74 69 6c 20 61 6e 64 20 6d 69 73 ds, util and mis
0c20: 63 0a 3b 3b 20 73 6f 72 74 2d 63 61 72 64 73 0a c.;; sort-cards.
0c30: 3b 3b 20 63 61 6c 63 2d 73 68 61 72 31 0a 3b 3b ;; calc-shar1.;;
0c40: 0a 3b 3b 20 6c 6f 77 2d 6c 65 76 65 6c 20 63 6f .;; low-level co
0c50: 6e 73 74 72 75 63 74 6f 72 20 70 72 6f 63 73 2c nstructor procs,
0c60: 20 65 78 70 6f 73 65 64 20 6f 6e 6c 79 20 66 6f exposed only fo
0c70: 72 20 64 65 76 65 6c 6f 70 6d 65 6e 74 2f 74 65 r development/te
0c80: 73 74 69 6e 67 2c 20 77 69 6c 6c 20 62 65 20 72 sting, will be r
0c90: 65 6d 6f 76 65 64 0a 63 6f 6e 73 74 72 75 63 74 emoved.construct
0ca0: 2d 73 64 61 74 0a 63 6f 6e 73 74 72 75 63 74 2d -sdat.construct-
0cb0: 70 6b 74 20 20 20 20 20 0a 63 61 72 64 2d 3e 74 pkt .card->t
0cc0: 79 70 65 2f 76 61 6c 75 65 20 20 0a 61 64 64 2d ype/value .add-
0cd0: 7a 2d 63 61 72 64 0a 0a 3b 3b 20 71 75 65 75 65 z-card..;; queue
0ce0: 20 64 61 74 61 62 61 73 65 20 70 72 6f 63 73 0a database procs.
0cf0: 6f 70 65 6e 2d 71 75 65 75 65 2d 64 62 0a 61 64 open-queue-db.ad
0d00: 64 2d 74 6f 2d 71 75 65 75 65 0a 63 72 65 61 74 d-to-queue.creat
0d10: 65 2d 61 6e 64 2d 71 75 65 75 65 0a 6c 6f 6f 6b e-and-queue.look
0d20: 75 70 2d 62 79 2d 75 75 69 64 0a 6c 6f 6f 6b 75 up-by-uuid.looku
0d30: 70 2d 62 79 2d 69 64 0a 67 65 74 2d 64 70 6b 74 p-by-id.get-dpkt
0d40: 73 0a 67 65 74 2d 6e 6f 74 2d 70 72 6f 63 65 73 s.get-not-proces
0d50: 73 65 64 2d 70 6b 74 73 0a 67 65 74 2d 72 65 6c sed-pkts.get-rel
0d60: 61 74 65 64 0a 66 69 6e 64 2d 70 6b 74 73 0a 70 ated.find-pkts.p
0d70: 72 6f 63 65 73 73 2d 70 6b 74 73 0a 67 65 74 2d rocess-pkts.get-
0d80: 64 65 73 63 65 6e 64 65 6e 74 73 0a 67 65 74 2d descendents.get-
0d90: 61 6e 63 65 73 74 6f 72 73 0a 67 65 74 2d 70 6b ancestors.get-pk
0da0: 74 73 0a 67 65 74 2d 6c 61 73 74 2d 64 65 73 63 ts.get-last-desc
0db0: 65 6e 64 65 6e 74 0a 77 69 74 68 2d 71 75 65 75 endent.with-queu
0dc0: 65 2d 64 62 0a 6c 6f 61 64 2d 70 6b 74 73 2d 74 e-db.load-pkts-t
0dd0: 6f 2d 64 62 0a 0a 3b 3b 20 70 72 6f 63 73 20 74 o-db..;; procs t
0de0: 68 61 74 20 6f 70 65 72 61 74 65 20 64 69 72 65 hat operate dire
0df0: 63 74 6c 79 20 6f 6e 20 70 6b 74 73 2c 20 73 64 ctly on pkts, sd
0e00: 61 74 2c 20 61 70 6b 74 73 2c 20 64 70 6b 74 73 at, apkts, dpkts
0e10: 20 65 74 63 2e 0a 70 6b 74 2d 3e 61 6c 69 73 74 etc..pkt->alist
0e20: 20 20 20 20 3b 3b 20 70 6b 74 20 2d 3e 20 61 70 ;; pkt -> ap
0e30: 6b 74 20 28 69 2e 65 2e 20 61 6c 69 73 74 29 0a kt (i.e. alist).
0e40: 70 6b 74 2d 3e 73 64 61 74 20 20 20 20 20 3b 3b pkt->sdat ;;
0e50: 20 70 6b 74 20 2d 3e 20 27 28 22 61 20 61 76 61 pkt -> '("a ava
0e60: 6c 22 20 22 62 20 62 76 61 6c 22 20 2e 2e 2e 29 l" "b bval" ...)
0e70: 0a 73 64 61 74 2d 3e 61 6c 69 73 74 20 20 20 3b .sdat->alist ;
0e80: 3b 20 27 28 22 61 20 61 76 61 6c 22 20 22 62 20 ; '("a aval" "b
0e90: 62 76 61 6c 22 2e 2e 2e 29 20 2d 3e 20 28 28 61 bval"...) -> ((a
0ea0: 20 2e 20 22 61 76 61 6c 22 29 28 62 20 2e 20 22 . "aval")(b . "
0eb0: 62 76 61 6c 22 29 20 2e 2e 2e 29 0a 64 62 6c 73 bval") ...).dbls
0ec0: 74 2d 3e 64 70 6b 74 73 20 20 3b 3b 20 63 6f 6e t->dpkts ;; con
0ed0: 76 65 72 74 20 6c 69 73 74 20 6f 66 20 74 75 70 vert list of tup
0ee0: 6c 65 73 20 66 72 6f 6d 20 71 75 65 75 65 20 64 les from queue d
0ef0: 62 20 69 6e 74 6f 20 64 70 6b 74 73 0a 64 70 6b b into dpkts.dpk
0f00: 74 2d 3e 61 6c 69 73 74 20 20 20 3b 3b 20 66 6c t->alist ;; fl
0f10: 61 74 74 65 6e 20 61 20 64 70 6b 74 20 69 6e 74 atten a dpkt int
0f20: 6f 20 61 6e 20 61 6c 69 73 74 20 63 6f 6e 74 61 o an alist conta
0f30: 69 6e 69 6e 67 20 61 6c 6c 20 64 62 20 66 69 65 ining all db fie
0f40: 6c 64 73 20 61 6e 64 20 74 68 65 20 70 6b 74 20 lds and the pkt
0f50: 61 6c 69 73 74 0a 64 70 6b 74 73 2d 3e 61 6c 69 alist.dpkts->ali
0f60: 73 74 73 20 3b 3b 20 61 70 70 6c 79 20 64 70 6b sts ;; apply dpk
0f70: 74 2d 3e 61 6c 69 73 74 20 74 6f 20 61 20 6c 69 t->alist to a li
0f80: 73 74 20 6f 66 20 61 6c 69 73 74 73 20 75 73 69 st of alists usi
0f90: 6e 67 20 61 20 70 6b 74 2d 73 70 65 63 0a 61 6c ng a pkt-spec.al
0fa0: 69 73 74 2d 3e 70 6b 74 20 20 20 20 3b 3b 20 72 ist->pkt ;; r
0fb0: 65 74 75 72 6e 73 20 74 77 6f 20 76 61 6c 75 65 eturns two value
0fc0: 73 20 75 75 69 64 2c 20 70 6b 74 0a 67 65 74 2d s uuid, pkt.get-
0fd0: 76 61 6c 75 65 20 20 20 20 20 3b 3b 20 6c 6f 6f value ;; loo
0fe0: 6b 73 20 75 70 20 61 20 76 61 6c 75 65 20 67 69 ks up a value gi
0ff0: 76 65 6e 20 61 20 6b 65 79 20 69 6e 20 61 20 64 ven a key in a d
1000: 70 6b 74 0a 66 6c 61 74 74 65 6e 2d 61 6c 6c 20 pkt.flatten-all
1010: 20 20 3b 3b 20 6d 65 72 67 65 20 74 68 65 20 6c ;; merge the l
1020: 69 73 74 20 6f 66 20 76 61 6c 75 65 73 20 66 72 ist of values fr
1030: 6f 6d 20 61 20 71 75 65 72 79 20 77 68 69 63 68 om a query which
1040: 20 69 6e 63 6c 75 64 65 73 20 61 20 70 6b 74 20 includes a pkt
1050: 69 6e 74 6f 20 61 20 66 6c 61 74 20 61 6c 69 73 into a flat alis
1060: 74 20 3c 3d 3d 20 72 65 61 6c 6c 79 20 75 73 65 t <== really use
1070: 66 75 6c 21 0a 63 68 65 63 6b 2d 70 6b 74 0a 0a ful!.check-pkt..
1080: 3b 3b 20 70 6b 74 20 61 6c 69 73 74 73 0a 77 72 ;; pkt alists.wr
1090: 69 74 65 2d 61 6c 69 73 74 2d 3e 70 6b 74 0a 72 ite-alist->pkt.r
10a0: 65 61 64 2d 70 6b 74 2d 3e 61 6c 69 73 74 0a 0a ead-pkt->alist..
10b0: 3b 3b 20 61 72 63 68 69 76 65 20 64 61 74 61 62 ;; archive datab
10c0: 61 73 65 0a 61 72 63 68 69 76 65 2d 6f 70 65 6e ase.archive-open
10d0: 2d 64 62 0a 77 72 69 74 65 2d 61 72 63 68 69 76 -db.write-archiv
10e0: 65 2d 70 6b 74 73 0a 61 72 63 68 69 76 65 2d 70 e-pkts.archive-p
10f0: 6b 74 73 0a 6d 61 72 6b 2d 70 72 6f 63 65 73 73 kts.mark-process
1100: 65 64 0a 0a 3b 3b 20 70 6b 74 73 64 62 0a 70 6b ed..;; pktsdb.pk
1110: 74 64 62 2d 63 6f 6e 6e 20 20 20 20 20 3b 3b 20 tdb-conn ;;
1120: 75 73 65 66 75 6c 0a 70 6b 74 64 62 2d 66 6e 61 useful.pktdb-fna
1130: 6d 65 0a 70 6b 74 73 64 62 2d 6f 70 65 6e 0a 70 me.pktsdb-open.p
1140: 6b 74 73 64 62 2d 63 6c 6f 73 65 0a 70 6b 74 73 ktsdb-close.pkts
1150: 64 62 2d 61 64 64 2d 72 65 63 6f 72 64 0a 3b 3b db-add-record.;;
1160: 20 74 65 6d 70 6f 72 61 72 79 0a 70 6b 74 64 62 temporary.pktdb
1170: 2d 70 6b 74 73 70 65 63 0a 0a 3b 3b 20 75 74 69 -pktspec..;; uti
1180: 6c 69 74 79 20 70 72 6f 63 73 0a 69 6e 63 72 65 lity procs.incre
1190: 6d 65 6e 74 2d 73 74 72 69 6e 67 20 3b 3b 20 75 ment-string ;; u
11a0: 73 65 64 20 74 6f 20 67 65 74 20 69 6e 64 65 78 sed to get index
11b0: 65 73 20 66 6f 72 20 73 74 72 69 6e 67 73 20 69 es for strings i
11c0: 6e 20 72 65 66 20 70 6b 74 73 0a 6d 61 6b 65 2d n ref pkts.make-
11d0: 72 65 70 6f 72 74 20 20 20 20 20 20 3b 3b 20 6d report ;; m
11e0: 61 6b 65 20 61 20 2e 64 6f 74 20 66 69 6c 65 20 ake a .dot file
11f0: 0a 29 0a 0a 28 69 6d 70 6f 72 74 20 63 68 69 63 .)..(import chic
1200: 6b 65 6e 20 73 63 68 65 6d 65 20 64 61 74 61 2d ken scheme data-
1210: 73 74 72 75 63 74 75 72 65 73 20 70 6f 73 69 78 structures posix
1220: 20 73 72 66 69 2d 31 20 72 65 67 65 78 20 73 72 srfi-1 regex sr
1230: 66 69 2d 31 33 20 73 72 66 69 2d 36 39 20 70 6f fi-13 srfi-69 po
1240: 72 74 73 20 65 78 74 72 61 73 29 0a 28 75 73 65 rts extras).(use
1250: 20 63 72 79 70 74 20 73 68 61 31 20 6d 65 73 73 crypt sha1 mess
1260: 61 67 65 2d 64 69 67 65 73 74 20 28 70 72 65 66 age-digest (pref
1270: 69 78 20 64 62 69 20 64 62 69 3a 29 20 74 79 70 ix dbi dbi:) typ
1280: 65 64 2d 72 65 63 6f 72 64 73 29 0a 0a 3b 3b 3d ed-records)..;;=
1290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d0: 3d 3d 3d 3d 3d 0a 3b 3b 20 44 41 54 41 20 4d 41 =====.;; DATA MA
12e0: 4e 49 50 55 4c 41 54 49 4f 4e 20 55 54 49 4c 53 NIPULATION UTILS
12f0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
1300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
1340: 6e 65 2d 69 6e 6c 69 6e 65 20 28 75 6e 65 73 63 ne-inline (unesc
1350: 61 70 65 2d 64 61 74 61 20 64 61 74 61 29 0a 20 ape-data data).
1360: 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 (string-transla
1370: 74 65 2a 20 64 61 74 61 20 27 28 28 22 5c 5c 6e te* data '(("\\n
1380: 22 20 2e 20 22 5c 6e 22 29 20 28 22 5c 5c 5c 5c " . "\n") ("\\\\
1390: 22 20 2e 20 22 5c 5c 22 29 29 29 29 0a 0a 28 64 " . "\\"))))..(d
13a0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 65 73 efine-inline (es
13b0: 63 61 70 65 2d 64 61 74 61 20 64 61 74 61 29 0a cape-data data).
13c0: 20 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c (string-transl
13d0: 61 74 65 2a 20 64 61 74 61 20 27 28 28 22 5c 6e ate* data '(("\n
13e0: 22 20 2e 20 22 5c 5c 6e 22 29 20 28 22 5c 5c 22 " . "\\n") ("\\"
13f0: 20 2e 20 22 5c 5c 5c 5c 22 29 29 29 29 0a 0a 28 . "\\\\"))))..(
1400: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 6d define-inline (m
1410: 61 6b 65 2d 63 61 72 64 20 74 79 70 65 20 64 61 ake-card type da
1420: 74 61 29 0a 20 20 28 63 6f 6e 63 20 74 79 70 65 ta). (conc type
1430: 20 22 20 22 20 28 65 73 63 61 70 65 2d 64 61 74 " " (escape-dat
1440: 61 20 28 2d 3e 73 74 72 69 6e 67 20 64 61 74 61 a (->string data
1450: 29 29 29 29 0a 0a 3b 3b 20 72 65 76 65 72 73 65 ))))..;; reverse
1460: 20 61 6e 20 61 6c 69 73 74 20 66 6f 72 20 64 6f an alist for do
1470: 69 6e 67 20 70 6b 74 6b 65 79 20 2d 3e 20 65 78 ing pktkey -> ex
1480: 74 65 72 6e 61 6c 20 6b 65 79 20 63 6f 6e 76 65 ternal key conve
1490: 72 73 69 6f 6e 73 0a 3b 3b 0a 28 64 65 66 69 6e rsions.;;.(defin
14a0: 65 2d 69 6e 6c 69 6e 65 20 28 72 65 76 65 72 73 e-inline (revers
14b0: 65 2d 61 73 70 65 63 20 61 73 70 65 63 29 0a 20 e-aspec aspec).
14c0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 64 (map (lambda (d
14d0: 61 74 29 0a 09 20 28 63 6f 6e 73 20 28 63 64 72 at).. (cons (cdr
14e0: 20 64 61 74 29 28 63 61 72 20 64 61 74 29 29 29 dat)(car dat)))
14f0: 0a 20 20 20 20 20 20 20 61 73 70 65 63 29 29 0a . aspec)).
1500: 0a 3b 3b 20 61 64 64 20 61 20 63 61 72 64 20 74 .;; add a card t
1510: 6f 20 74 68 65 20 6c 69 73 74 20 6f 66 20 63 61 o the list of ca
1520: 72 64 73 2c 20 73 64 61 74 0a 3b 3b 20 69 66 20 rds, sdat.;; if
1530: 74 79 70 65 20 69 73 20 23 66 20 72 65 74 75 72 type is #f retur
1540: 6e 20 6f 6e 6c 79 20 73 64 61 74 0a 3b 3b 20 69 n only sdat.;; i
1550: 66 20 64 61 74 61 20 69 73 20 23 66 20 72 65 74 f data is #f ret
1560: 75 72 6e 20 6f 6e 6c 79 20 73 64 61 74 0a 3b 3b urn only sdat.;;
1570: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
1580: 28 61 64 64 2d 63 61 72 64 20 73 64 61 74 20 74 (add-card sdat t
1590: 79 70 65 20 64 61 74 61 29 0a 20 20 28 69 66 20 ype data). (if
15a0: 28 61 6e 64 20 74 79 70 65 20 64 61 74 61 29 0a (and type data).
15b0: 20 20 20 20 20 20 28 63 6f 6e 73 20 28 6d 61 6b (cons (mak
15c0: 65 2d 63 61 72 64 20 74 79 70 65 20 64 61 74 61 e-card type data
15d0: 29 20 73 64 61 74 29 0a 20 20 20 20 20 20 73 64 ) sdat). sd
15e0: 61 74 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d at))..;;========
15f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
1630: 3b 20 53 54 52 49 4e 47 20 41 53 20 46 55 4e 4b ; STRING AS FUNK
1640: 59 20 4e 55 4d 42 45 52 0a 3b 3b 3d 3d 3d 3d 3d Y NUMBER.;;=====
1650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1690: 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 50 54 44 5a =..;; NOTE: PTDZ
16a0: 20 61 72 65 20 72 65 6d 6f 76 65 64 20 61 73 20 are removed as
16b0: 74 68 65 79 20 61 72 65 20 72 65 73 65 72 76 65 they are reserve
16c0: 64 2e 20 4e 42 2f 2f 20 74 68 65 20 52 20 63 61 d. NB// the R ca
16d0: 72 64 20 69 73 20 6e 6f 74 20 75 73 65 64 20 69 rd is not used i
16e0: 6e 20 61 0a 3b 3b 20 20 20 20 20 20 20 72 65 66 n a.;; ref
16f0: 2c 20 69 6e 73 74 65 61 64 20 74 68 65 20 50 20 , instead the P
1700: 70 61 72 65 6e 74 20 63 61 72 64 20 69 73 20 75 parent card is u
1710: 73 65 64 2e 0a 3b 3b 20 20 20 20 20 20 20 51 75 sed..;; Qu
1720: 65 73 74 69 6f 6e 3a 20 57 68 79 20 64 6f 65 73 estion: Why does
1730: 20 69 74 20 6d 61 74 74 65 72 20 74 6f 20 72 65 it matter to re
1740: 6d 6f 76 65 20 50 54 44 5a 3f 0a 3b 3b 20 20 20 move PTDZ?.;;
1750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54 6f To
1760: 20 6d 61 6b 65 20 74 68 65 20 72 65 66 20 65 61 make the ref ea
1770: 73 69 65 72 20 74 6f 20 75 73 65 20 74 68 65 20 sier to use the
1780: 72 65 66 20 73 74 72 69 6e 67 73 20 77 69 6c 6c ref strings will
1790: 20 62 65 20 74 68 65 20 6b 65 79 73 0a 3b 3b 20 be the keys.;;
17a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17b0: 73 6f 20 77 65 20 63 61 6e 6e 6f 74 20 68 61 76 so we cannot hav
17c0: 65 20 6f 76 65 72 6c 61 70 20 77 69 74 68 20 61 e overlap with a
17d0: 6e 79 20 61 63 74 75 61 6c 20 6b 65 79 73 2e 20 ny actual keys.
17e0: 42 75 74 20 74 68 69 73 20 69 73 20 61 0a 3b 3b But this is a.;;
17f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1800: 20 62 69 74 20 73 69 6c 6c 79 2e 20 57 68 61 74 bit silly. What
1810: 20 77 65 20 6e 65 65 64 20 74 6f 20 64 6f 20 69 we need to do i
1820: 6e 73 74 65 61 64 20 69 73 20 72 65 6a 65 63 74 nstead is reject
1830: 20 6b 65 79 73 20 6f 66 20 6c 65 6e 67 74 68 0a keys of length.
1840: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
1850: 20 20 20 6f 6e 65 20 77 68 65 72 65 20 74 68 65 one where the
1860: 20 63 68 61 72 20 69 73 20 69 6e 20 50 54 44 5a char is in PTDZ
1870: 0a 3b 3b 0a 3b 3b 20 54 68 69 73 20 69 73 20 62 .;;.;; This is b
1880: 61 73 69 63 61 6c 6c 79 20 62 61 73 65 39 32 0a asically base92.
1890: 3b 3b 0a 28 64 65 66 69 6e 65 20 73 74 72 69 6e ;;.(define strin
18a0: 67 2d 6e 75 6d 2d 63 68 61 72 73 20 28 73 74 72 g-num-chars (str
18b0: 69 6e 67 2d 3e 6c 69 73 74 20 22 21 23 24 25 26 ing->list "!#$%&
18c0: 27 28 29 2a 2b 2c 2d 2e 2f 30 31 32 33 34 35 36 '()*+,-./0123456
18d0: 37 38 39 3a 3b 3c 3d 3e 3f 40 41 42 43 45 46 47 789:;<=>?@ABCEFG
18e0: 48 49 4a 4b 4c 4d 4e 4f 51 52 53 55 56 57 58 59 HIJKLMNOQRSUVWXY
18f0: 5b 5c 5c 5d 5e 5f 61 62 63 64 65 66 67 68 69 6a [\\]^_abcdefghij
1900: 6b 6c 6d 6e 6f 70 71 72 73 74 75 76 77 78 79 7a klmnopqrstuvwxyz
1910: 7b 7c 7d 7e 22 29 29 0a 3b 3b 20 22 30 31 32 33 {|}~")).;; "0123
1920: 34 35 36 37 38 39 61 62 63 64 65 66 67 68 69 6a 456789abcdefghij
1930: 6b 6c 6d 6e 6f 70 71 72 73 74 75 76 77 78 79 7a klmnopqrstuvwxyz
1940: 41 42 43 45 46 47 48 49 4a 4b 4c 4d 4e 4f 51 53 ABCEFGHIJKLMNOQS
1950: 55 56 57 58 59 21 23 24 25 26 27 28 29 2a 2b 2c UVWXY!#$%&'()*+,
1960: 2d 2e 2f 5b 5d 3a 3b 3c 3d 3e 3f 5c 5c 5e 5f 7b -./[]:;<=>?\\^_{
1970: 7d 7c 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 }|"))..(define (
1980: 63 68 61 72 2d 69 6e 63 72 20 69 6e 63 68 61 72 char-incr inchar
1990: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 61 72 72 ). (let* ((carr
19a0: 79 20 20 20 20 20 23 66 29 0a 09 20 28 6e 65 78 y #f).. (nex
19b0: 74 2d 63 68 61 72 20 28 6c 65 74 20 28 28 72 65 t-char (let ((re
19c0: 6d 20 28 6d 65 6d 62 65 72 20 69 6e 63 68 61 72 m (member inchar
19d0: 20 73 74 72 69 6e 67 2d 6e 75 6d 2d 63 68 61 72 string-num-char
19e0: 73 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 s)))... (if
19f0: 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 72 65 (eq? (length re
1a00: 6d 29 20 31 29 20 3b 3b 20 77 65 20 61 72 65 20 m) 1) ;; we are
1a10: 61 74 20 74 68 65 20 6c 61 73 74 20 63 68 61 72 at the last char
1a20: 61 63 74 65 72 20 69 6e 20 6f 75 72 20 73 74 72 acter in our str
1a30: 69 6e 67 2d 6e 75 6d 2d 63 68 61 72 73 20 6c 69 ing-num-chars li
1a40: 73 74 0a 09 09 09 20 20 28 62 65 67 69 6e 0a 09 st.... (begin..
1a50: 09 09 20 20 20 20 28 73 65 74 21 20 63 61 72 72 .. (set! carr
1a60: 79 20 23 74 29 0a 09 09 09 20 20 20 20 28 63 61 y #t).... (ca
1a70: 72 20 73 74 72 69 6e 67 2d 6e 75 6d 2d 63 68 61 r string-num-cha
1a80: 72 73 29 29 0a 09 09 09 20 20 28 63 61 64 72 20 rs)).... (cadr
1a90: 72 65 6d 29 29 29 29 29 0a 20 20 20 20 28 76 61 rem))))). (va
1aa0: 6c 75 65 73 20 6e 65 78 74 2d 63 68 61 72 20 63 lues next-char c
1ab0: 61 72 72 79 29 29 29 0a 20 20 20 20 0a 28 64 65 arry))). .(de
1ac0: 66 69 6e 65 20 28 69 6e 63 72 65 6d 65 6e 74 2d fine (increment-
1ad0: 73 74 72 69 6e 67 20 73 74 72 29 0a 20 20 28 69 string str). (i
1ae0: 66 20 28 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 f (string-null?
1af0: 73 74 72 29 0a 20 20 20 20 20 20 22 30 22 0a 20 str). "0".
1b00: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 72 6c (let ((strl
1b10: 73 74 20 28 72 65 76 65 72 73 65 20 28 73 74 72 st (reverse (str
1b20: 69 6e 67 2d 3e 6c 69 73 74 20 73 74 72 29 29 29 ing->list str)))
1b30: 29 20 3b 3b 20 6e 65 65 64 20 74 6f 20 70 72 6f ) ;; need to pro
1b40: 63 65 73 73 20 74 68 65 20 73 74 72 69 6e 67 20 cess the string
1b50: 66 72 6f 6d 20 74 68 65 20 6c 73 64 0a 09 28 6c from the lsd..(l
1b60: 69 73 74 2d 3e 73 74 72 69 6e 67 0a 09 20 28 6c ist->string.. (l
1b70: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
1b80: 61 72 20 73 74 72 6c 73 74 29 29 0a 09 09 20 20 ar strlst))...
1b90: 20 20 28 74 61 6c 20 28 63 64 72 20 73 74 72 6c (tal (cdr strl
1ba0: 73 74 29 29 0a 09 09 20 20 20 20 28 72 65 73 20 st))... (res
1bb0: 27 28 29 29 29 0a 09 20 20 20 28 6c 65 74 2d 76 '())).. (let-v
1bc0: 61 6c 75 65 73 20 28 28 28 6e 65 77 68 65 64 20 alues (((newhed
1bd0: 63 61 72 72 79 29 28 63 68 61 72 2d 69 6e 63 72 carry)(char-incr
1be0: 20 68 65 64 29 29 29 0a 09 20 20 20 20 20 3b 3b hed))).. ;;
1bf0: 20 28 70 72 69 6e 74 20 22 6e 65 77 68 65 64 3a (print "newhed:
1c00: 20 22 20 6e 65 77 68 65 64 20 22 20 63 61 72 72 " newhed " carr
1c10: 79 3a 20 22 20 63 61 72 72 79 20 22 20 74 61 6c y: " carry " tal
1c20: 3a 20 22 20 74 61 6c 29 0a 09 20 20 20 20 20 28 : " tal).. (
1c30: 6c 65 74 20 28 28 6e 65 77 72 65 73 20 28 63 6f let ((newres (co
1c40: 6e 73 20 6e 65 77 68 65 64 20 72 65 73 29 29 29 ns newhed res)))
1c50: 0a 09 20 20 20 20 20 20 20 28 69 66 20 63 61 72 .. (if car
1c60: 72 79 20 3b 3b 20 77 65 27 6c 6c 20 68 61 76 65 ry ;; we'll have
1c70: 20 74 6f 20 70 72 6f 70 61 67 61 74 65 20 74 68 to propagate th
1c80: 65 20 63 61 72 72 79 0a 09 09 20 20 20 28 69 66 e carry... (if
1c90: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 3b 3b 20 (null? tal) ;;
1ca0: 61 74 20 74 68 65 20 65 6e 64 2c 20 74 61 63 6b at the end, tack
1cb0: 20 6f 6e 20 22 30 22 20 28 77 68 69 63 68 20 69 on "0" (which i
1cc0: 73 20 72 65 61 6c 6c 79 20 61 20 22 31 22 29 0a s really a "1").
1cd0: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 .. (cons (
1ce0: 63 61 72 20 73 74 72 69 6e 67 2d 6e 75 6d 2d 63 car string-num-c
1cf0: 68 61 72 73 29 20 6e 65 77 72 65 73 29 0a 09 09 hars) newres)...
1d00: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 (loop (ca
1d10: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
1d20: 6e 65 77 72 65 73 29 29 0a 09 09 20 20 20 28 61 newres))... (a
1d30: 70 70 65 6e 64 20 28 72 65 76 65 72 73 65 20 74 ppend (reverse t
1d40: 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 29 29 al) newres))))))
1d50: 29 29 29 0a 20 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d ))). .;;=====
1d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1da0: 3d 0a 3b 3b 20 50 20 4b 20 54 20 53 20 44 20 42 =.;; P K T S D B
1db0: 20 20 20 49 20 4e 20 54 20 45 20 52 20 46 20 41 I N T E R F A
1dc0: 20 43 20 45 0a 3b 3b 0a 3b 3b 20 49 4e 54 45 47 C E.;;.;; INTEG
1dd0: 45 52 2c 20 52 45 41 4c 2c 20 54 45 58 54 0a 3b ER, REAL, TEXT.;
1de0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e20: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 73 70 =======.;;.;; sp
1e30: 65 63 0a 3b 3b 20 20 28 20 28 74 61 62 6c 65 6e ec.;; ( (tablen
1e40: 61 6d 65 31 20 2e 20 28 66 69 65 6c 64 31 6e 61 ame1 . (field1na
1e50: 6d 65 20 4c 31 20 54 59 50 45 29 0a 3b 3b 20 20 me L1 TYPE).;;
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 28 66 69 65 6c 64 32 6e 61 6d 65 20 4c 32 20 54 (field2name L2 T
1e80: 59 50 45 29 20 2e 2e 2e 20 29 0a 3b 3b 20 20 20 YPE) ... ).;;
1e90: 20 28 74 61 62 6c 65 6e 61 6d 65 32 20 2e 2e 2e (tablename2 ...
1ea0: 20 29 29 0a 3b 3b 0a 3b 3b 20 20 45 78 61 6d 70 )).;;.;; Examp
1eb0: 6c 65 3a 20 28 74 65 73 74 73 20 28 74 65 73 74 le: (tests (test
1ec0: 6e 61 6d 65 20 6e 20 54 45 58 54 29 0a 3b 3b 20 name n TEXT).;;
1ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ee0: 20 28 72 75 6e 64 69 72 20 20 20 72 20 54 45 58 (rundir r TEX
1ef0: 54 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 T).;;
1f00: 20 20 20 20 20 20 20 20 2e 2e 2e 20 29 0a 3b 3b ... ).;;
1f10: 0a 3b 3b 20 70 6b 74 20 6b 65 79 73 20 61 72 65 .;; pkt keys are
1f20: 20 74 61 6b 65 6e 20 66 72 6f 6d 20 74 68 65 20 taken from the
1f30: 66 69 72 73 74 20 6c 65 74 74 65 72 2c 20 69 66 first letter, if
1f40: 20 74 68 61 74 20 69 73 20 6e 6f 74 20 75 6e 69 that is not uni
1f50: 71 75 65 0a 3b 3b 20 74 68 65 6e 20 6c 6f 6f 6b que.;; then look
1f60: 20 61 74 20 74 68 65 20 6e 65 78 74 20 6c 65 74 at the next let
1f70: 74 65 72 20 61 6e 64 20 73 6f 20 6f 6e 0a 3b 3b ter and so on.;;
1f80: 0a 0a 3b 3b 20 75 73 65 20 74 68 69 73 20 73 74 ..;; use this st
1f90: 72 75 63 74 20 74 6f 20 68 6f 6c 64 20 74 68 65 ruct to hold the
1fa0: 20 70 6b 74 73 70 65 63 20 61 6e 64 20 74 68 65 pktspec and the
1fb0: 20 64 62 20 68 61 6e 64 6c 65 0a 3b 3b 0a 28 64 db handle.;;.(d
1fc0: 65 66 73 74 72 75 63 74 20 70 6b 74 64 62 0a 20 efstruct pktdb.
1fd0: 20 28 66 6e 61 6d 65 20 20 20 20 20 20 20 23 66 (fname #f
1fe0: 29 0a 20 20 28 70 6b 74 73 64 62 2d 73 70 65 63 ). (pktsdb-spec
1ff0: 20 23 66 29 0a 20 20 28 70 6b 74 73 70 65 63 20 #f). (pktspec
2000: 20 20 20 20 23 66 29 20 20 3b 3b 20 63 61 63 68 #f) ;; cach
2010: 65 20 74 68 65 20 70 6b 74 73 70 65 63 0a 20 20 e the pktspec.
2020: 28 66 69 65 6c 64 2d 6b 65 79 73 20 20 23 66 29 (field-keys #f)
2030: 20 20 3b 3b 20 63 61 63 68 65 20 74 68 65 20 66 ;; cache the f
2040: 69 65 6c 64 2d 3e 6b 65 79 20 6d 61 70 70 69 6e ield->key mappin
2050: 67 20 28 66 69 65 6c 64 31 20 2e 20 6b 31 29 20 g (field1 . k1)
2060: 2e 2e 2e 0a 20 20 28 6b 65 79 2d 66 69 65 6c 64 .... (key-field
2070: 73 20 20 23 66 29 20 20 3b 3b 20 63 61 63 68 65 s #f) ;; cache
2080: 20 74 68 65 20 6b 65 79 2d 3e 66 69 65 6c 64 20 the key->field
2090: 6d 61 70 70 69 6e 67 0a 20 20 28 63 6f 6e 6e 20 mapping. (conn
20a0: 20 20 20 20 20 20 20 23 66 29 0a 20 20 29 0a 0a #f). )..
20b0: 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 54 68 65 72 ;; WARNING: Ther
20c0: 65 20 69 73 20 61 20 73 69 6d 70 6c 69 66 69 63 e is a simplific
20d0: 61 74 69 6f 6e 20 69 6e 20 74 68 65 20 70 6b 74 ation in the pkt
20e0: 73 64 62 20 73 70 65 63 20 77 2e 72 2e 74 2e 20 sdb spec w.r.t.
20f0: 70 6b 74 73 70 65 63 2e 0a 3b 3b 20 20 20 20 20 pktspec..;;
2100: 20 20 20 20 20 54 68 65 20 66 69 65 6c 64 20 73 The field s
2110: 70 65 63 73 20 61 72 65 20 74 68 65 20 63 64 72 pecs are the cdr
2120: 20 6f 66 20 74 68 65 20 74 61 62 6c 65 20 6c 69 of the table li
2130: 73 74 20 2d 20 6e 6f 74 20 61 20 66 75 6c 6c 0a st - not a full.
2140: 3b 3b 20 20 20 20 20 20 20 20 20 20 6c 69 73 74 ;; list
2150: 2e 20 54 68 65 20 65 78 74 72 61 20 6c 69 73 74 . The extra list
2160: 20 6c 65 76 65 6c 20 69 6e 20 70 6b 74 73 70 65 level in pktspe
2170: 63 20 69 73 20 67 72 61 74 75 69 74 6f 75 73 20 c is gratuitous
2180: 61 6e 64 20 73 68 6f 75 6c 64 0a 3b 3b 20 20 20 and should.;;
2190: 20 20 20 20 20 20 20 62 65 20 72 65 6d 6f 76 65 be remove
21a0: 64 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 d..;;.(define (p
21b0: 6b 74 73 64 62 2d 73 70 65 63 2d 3e 70 6b 74 73 ktsdb-spec->pkts
21c0: 70 65 63 20 74 61 62 6c 65 73 2d 73 70 65 63 29 pec tables-spec)
21d0: 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 . (map (lambda
21e0: 28 74 61 62 6c 65 73 70 65 63 29 0a 09 20 28 6c (tablespec).. (l
21f0: 69 73 74 20 28 63 61 72 20 74 61 62 6c 65 73 70 ist (car tablesp
2200: 65 63 29 0a 09 20 20 20 20 20 20 20 28 6d 61 70 ec).. (map
2210: 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d (lambda (field-
2220: 73 70 65 63 29 0a 09 09 20 20 20 20 20 20 28 63 spec)... (c
2230: 6f 6e 73 20 28 63 61 72 20 66 69 65 6c 64 2d 73 ons (car field-s
2240: 70 65 63 29 28 63 61 64 72 20 66 69 65 6c 64 2d pec)(cadr field-
2250: 73 70 65 63 29 29 29 0a 09 09 20 20 20 20 28 63 spec)))... (c
2260: 64 72 20 74 61 62 6c 65 73 70 65 63 29 29 29 29 dr tablespec))))
2270: 0a 20 20 20 20 20 20 20 74 61 62 6c 65 73 2d 73 . tables-s
2280: 70 65 63 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 pec))..(define (
2290: 70 6b 74 73 64 62 2d 6f 70 65 6e 20 64 62 66 6e pktsdb-open dbfn
22a0: 61 6d 65 20 70 6b 74 73 64 62 2d 73 70 65 63 29 ame pktsdb-spec)
22b0: 0a 20 20 28 6c 65 74 2a 20 28 28 70 64 62 20 20 . (let* ((pdb
22c0: 20 20 20 20 28 6d 61 6b 65 2d 70 6b 74 64 62 29 (make-pktdb)
22d0: 29 0a 09 20 28 64 62 65 78 69 73 74 73 20 28 66 ).. (dbexists (f
22e0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 66 6e ile-exists? dbfn
22f0: 61 6d 65 29 29 0a 09 20 28 64 62 20 20 20 20 20 ame)).. (db
2300: 20 20 28 64 62 69 3a 6f 70 65 6e 20 27 73 71 6c (dbi:open 'sql
2310: 69 74 65 33 20 60 28 28 64 62 6e 61 6d 65 20 2e ite3 `((dbname .
2320: 20 2c 64 62 66 6e 61 6d 65 29 29 29 29 29 0a 20 ,dbfname))))).
2330: 20 20 20 28 70 6b 74 64 62 2d 70 6b 74 73 64 62 (pktdb-pktsdb
2340: 2d 73 70 65 63 2d 73 65 74 21 20 70 64 62 20 70 -spec-set! pdb p
2350: 6b 74 73 64 62 2d 73 70 65 63 29 0a 20 20 20 20 ktsdb-spec).
2360: 28 70 6b 74 64 62 2d 70 6b 74 73 70 65 63 2d 73 (pktdb-pktspec-s
2370: 65 74 21 20 20 20 20 20 70 64 62 20 28 70 6b 74 et! pdb (pkt
2380: 73 64 62 2d 73 70 65 63 2d 3e 70 6b 74 73 70 65 sdb-spec->pktspe
2390: 63 20 70 6b 74 73 64 62 2d 73 70 65 63 29 29 0a c pktsdb-spec)).
23a0: 20 20 20 20 28 70 6b 74 64 62 2d 66 6e 61 6d 65 (pktdb-fname
23b0: 2d 73 65 74 21 20 20 20 20 20 20 20 70 64 62 20 -set! pdb
23c0: 64 62 66 6e 61 6d 65 29 0a 20 20 20 20 28 70 6b dbfname). (pk
23d0: 74 64 62 2d 63 6f 6e 6e 2d 73 65 74 21 20 20 20 tdb-conn-set!
23e0: 20 20 20 20 20 70 64 62 20 64 62 29 0a 20 20 20 pdb db).
23f0: 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 69 73 (if (not dbexis
2400: 74 73 29 0a 09 28 70 6b 74 73 64 62 2d 69 6e 69 ts)..(pktsdb-ini
2410: 74 20 70 64 62 29 29 0a 20 20 20 20 70 64 62 29 t pdb)). pdb)
2420: 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 6b 74 73 )..(define (pkts
2430: 64 62 2d 69 6e 69 74 20 70 6b 74 73 64 62 29 0a db-init pktsdb).
2440: 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 (let* ((db
2450: 20 20 20 20 20 20 28 70 6b 74 64 62 2d 63 6f 6e (pktdb-con
2460: 6e 20 70 6b 74 73 64 62 29 29 0a 09 20 28 70 6b n pktsdb)).. (pk
2470: 74 73 64 62 2d 73 70 65 63 20 28 70 6b 74 64 62 tsdb-spec (pktdb
2480: 2d 70 6b 74 73 64 62 2d 73 70 65 63 20 70 6b 74 -pktsdb-spec pkt
2490: 73 64 62 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 sdb))). ;; cr
24a0: 65 61 74 65 20 61 20 74 61 62 6c 65 20 66 6f 72 eate a table for
24b0: 20 74 68 65 20 70 6b 74 73 20 74 68 65 6d 73 65 the pkts themse
24c0: 6c 76 65 73 0a 20 20 20 20 28 64 62 69 3a 65 78 lves. (dbi:ex
24d0: 65 63 20 64 62 20 22 43 52 45 41 54 45 20 54 41 ec db "CREATE TA
24e0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
24f0: 53 20 70 6b 74 73 20 28 69 64 20 49 4e 54 45 47 S pkts (id INTEG
2500: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 ER PRIMARY KEY,
2510: 7a 6b 65 79 20 54 45 58 54 2c 20 72 65 63 6f 72 zkey TEXT, recor
2520: 64 5f 69 64 20 49 4e 54 45 47 45 52 2c 20 70 6b d_id INTEGER, pk
2530: 74 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 28 t TEXT);"). (
2540: 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c for-each. (l
2550: 61 6d 62 64 61 20 28 74 61 62 6c 65 29 0a 20 20 ambda (table).
2560: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 61 62 (let* ((tab
2570: 6c 65 2d 6e 61 6d 65 20 28 63 61 72 20 74 61 62 le-name (car tab
2580: 6c 65 29 29 0a 09 20 20 20 20 20 20 28 66 69 65 le)).. (fie
2590: 6c 64 73 20 20 20 20 20 28 63 64 72 20 74 61 62 lds (cdr tab
25a0: 6c 65 29 29 0a 09 20 20 20 20 20 20 28 73 74 6d le)).. (stm
25b0: 74 20 28 63 6f 6e 63 20 22 43 52 45 41 54 45 20 t (conc "CREATE
25c0: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
25d0: 53 54 53 20 22 0a 09 09 09 20 20 74 61 62 6c 65 STS ".... table
25e0: 2d 6e 61 6d 65 0a 09 09 09 20 20 22 20 28 69 64 -name.... " (id
25f0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
2600: 20 4b 45 59 2c 22 0a 09 09 09 20 20 28 73 74 72 KEY,".... (str
2610: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 0a ing-intersperse.
2620: 09 09 09 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 ... (map (lamb
2630: 64 61 20 28 66 69 65 6c 64 73 70 65 63 29 0a 09 da (fieldspec)..
2640: 09 09 09 20 20 28 63 6f 6e 63 20 28 63 61 72 20 ... (conc (car
2650: 66 69 65 6c 64 73 70 65 63 29 20 22 20 22 0a 09 fieldspec) " "..
2660: 09 09 09 09 28 63 61 64 64 72 20 66 69 65 6c 64 ....(caddr field
2670: 73 70 65 63 29 29 29 0a 09 09 09 09 66 69 65 6c spec))).....fiel
2680: 64 73 29 0a 09 09 09 20 20 20 22 2c 22 29 0a 09 ds).... ",")..
2690: 09 09 20 20 22 29 3b 22 29 29 29 0a 09 20 28 64 .. ");"))).. (d
26a0: 62 69 3a 65 78 65 63 20 64 62 20 73 74 6d 74 29 bi:exec db stmt)
26b0: 29 29 0a 20 20 20 20 20 70 6b 74 73 64 62 2d 73 )). pktsdb-s
26c0: 70 65 63 29 29 29 0a 0a 3b 3b 20 63 72 65 61 74 pec)))..;; creat
26d0: 65 20 70 6b 74 20 66 72 6f 6d 20 74 68 65 20 64 e pkt from the d
26e0: 61 74 61 20 61 6e 64 20 69 6e 73 65 72 74 20 69 ata and insert i
26f0: 6e 74 6f 20 70 6b 74 73 20 74 61 62 6c 65 0a 3b nto pkts table.;
2700: 3b 20 0a 3b 3b 20 64 61 74 61 20 69 73 20 61 73 ; .;; data is as
2710: 73 6f 63 20 6c 69 73 74 20 6f 66 20 28 66 69 65 soc list of (fie
2720: 6c 64 20 2e 20 76 61 6c 75 65 29 20 2e 2e 2e 0a ld . value) ....
2730: 3b 3b 20 74 61 62 6c 65 6e 61 6d 65 20 69 73 20 ;; tablename is
2740: 61 20 73 79 6d 62 6f 6c 20 6d 61 74 63 68 69 6e a symbol matchin
2750: 67 20 74 68 65 20 74 61 62 6c 65 20 6e 61 6d 65 g the table name
2760: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 6b 74 .;;.(define (pkt
2770: 73 64 62 2d 61 64 64 2d 72 65 63 6f 72 64 20 70 sdb-add-record p
2780: 6b 74 73 64 62 20 74 61 62 6c 65 6e 61 6d 65 20 ktsdb tablename
2790: 64 61 74 61 20 23 21 6f 70 74 69 6f 6e 61 6c 20 data #!optional
27a0: 28 70 61 72 65 6e 74 20 23 66 29 29 0a 20 20 28 (parent #f)). (
27b0: 6c 65 74 2a 2d 76 61 6c 75 65 73 20 28 28 28 7a let*-values (((z
27c0: 6b 65 79 20 70 6b 74 29 20 28 61 6c 69 73 74 2d key pkt) (alist-
27d0: 3e 70 6b 74 20 64 61 74 61 20 28 70 6b 74 64 62 >pkt data (pktdb
27e0: 2d 70 6b 74 73 70 65 63 20 70 6b 74 73 64 62 29 -pktspec pktsdb)
27f0: 20 70 74 79 70 65 3a 20 74 61 62 6c 65 6e 61 6d ptype: tablenam
2800: 65 29 29 29 0a 20 20 20 20 3b 3b 20 68 61 76 65 e))). ;; have
2810: 20 74 68 65 20 64 61 74 61 20 61 73 20 61 6c 69 the data as ali
2820: 73 74 20 73 6f 20 69 6e 73 65 72 74 20 69 74 20 st so insert it
2830: 69 6e 74 6f 20 61 70 70 72 6f 70 72 69 61 74 65 into appropriate
2840: 20 74 61 62 6c 65 20 61 6c 73 6f 0a 20 20 20 20 table also.
2850: 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 (let* ((db
2860: 20 20 28 70 6b 74 64 62 2d 63 6f 6e 6e 20 70 6b (pktdb-conn pk
2870: 74 73 64 62 29 29 29 0a 20 20 20 20 20 20 3b 3b tsdb))). ;;
2880: 20 54 4f 44 4f 3a 20 41 64 64 72 65 73 73 20 63 TODO: Address c
2890: 6f 6c 6c 69 73 69 6f 6e 73 0a 20 20 20 20 20 20 ollisions.
28a0: 28 64 62 69 3a 65 78 65 63 20 64 62 20 22 49 4e (dbi:exec db "IN
28b0: 53 45 52 54 20 49 4e 54 4f 20 70 6b 74 73 20 28 SERT INTO pkts (
28c0: 7a 6b 65 79 2c 70 6b 74 2c 72 65 63 6f 72 64 5f zkey,pkt,record_
28d0: 69 64 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c id) VALUES (?,?,
28e0: 3f 29 3b 22 0a 09 09 7a 6b 65 79 20 70 6b 74 20 ?);"...zkey pkt
28f0: 2d 31 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 -1). (let*
2900: 28 3b 3b 20 28 70 6b 74 69 64 20 20 20 20 20 28 (;; (pktid (
2910: 70 6b 74 73 64 62 2d 70 6b 74 6b 65 79 2d 3e 70 pktsdb-pktkey->p
2920: 6b 74 69 64 20 70 6b 74 73 64 62 20 70 6b 74 6b ktid pktsdb pktk
2930: 65 79 29 29 0a 09 20 20 20 20 20 28 72 65 63 6f ey)).. (reco
2940: 72 64 2d 69 64 20 28 70 6b 74 73 64 62 2d 69 6e rd-id (pktsdb-in
2950: 73 65 72 74 20 70 6b 74 73 64 62 20 74 61 62 6c sert pktsdb tabl
2960: 65 6e 61 6d 65 20 64 61 74 61 29 29 29 0a 09 28 ename data)))..(
2970: 64 62 69 3a 65 78 65 63 20 64 62 20 22 55 50 44 dbi:exec db "UPD
2980: 41 54 45 20 70 6b 74 73 20 53 45 54 20 72 65 63 ATE pkts SET rec
2990: 6f 72 64 5f 69 64 3d 3f 20 57 48 45 52 45 20 7a ord_id=? WHERE z
29a0: 6b 65 79 3d 3f 3b 22 0a 09 09 20 20 72 65 63 6f key=?;"... reco
29b0: 72 64 2d 69 64 20 7a 6b 65 79 29 0a 20 20 20 20 rd-id zkey).
29c0: 20 20 29 29 29 29 0a 0a 3b 3b 20 0a 28 64 65 66 ))))..;; .(def
29d0: 69 6e 65 20 28 70 6b 74 73 64 62 2d 69 6e 73 65 ine (pktsdb-inse
29e0: 72 74 20 70 6b 74 73 64 62 20 74 61 62 6c 65 6e rt pktsdb tablen
29f0: 61 6d 65 20 64 61 74 61 29 0a 20 20 28 6c 65 74 ame data). (let
2a00: 2a 20 28 28 64 62 20 28 70 6b 74 64 62 2d 63 6f * ((db (pktdb-co
2a10: 6e 6e 20 70 6b 74 73 64 62 29 29 0a 09 20 28 73 nn pktsdb)).. (s
2a20: 74 6d 74 20 28 63 6f 6e 63 20 22 49 4e 53 45 52 tmt (conc "INSER
2a30: 54 20 49 4e 54 4f 20 22 20 74 61 62 6c 65 6e 61 T INTO " tablena
2a40: 6d 65 0a 09 09 20 20 20 20 20 22 20 28 22 20 28 me... " (" (
2a50: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
2a60: 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 28 6d 61 se (map conc (ma
2a70: 70 20 63 61 72 20 64 61 74 61 29 29 20 22 2c 22 p car data)) ","
2a80: 29 0a 09 09 20 20 20 20 20 22 29 20 56 41 4c 55 )... ") VALU
2a90: 45 53 20 28 27 22 0a 09 09 20 20 20 20 20 3b 3b ES ('"... ;;
2aa0: 20 54 4f 44 4f 3a 20 41 64 64 20 6c 6f 6f 6b 75 TODO: Add looku
2ab0: 70 20 6f 66 20 64 61 74 61 20 74 79 70 65 20 61 p of data type a
2ac0: 6e 64 20 64 6f 20 6e 6f 74 0a 09 09 20 20 20 20 nd do not...
2ad0: 20 3b 3b 20 20 20 20 20 20 20 77 72 61 70 20 69 ;; wrap i
2ae0: 6e 74 65 67 65 72 73 20 77 69 74 68 20 71 75 6f ntegers with quo
2af0: 74 65 73 0a 09 09 20 20 20 20 20 28 73 74 72 69 tes... (stri
2b00: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
2b10: 6d 61 70 20 63 6f 6e 63 20 28 6d 61 70 20 63 64 map conc (map cd
2b20: 72 20 64 61 74 61 29 29 20 22 27 2c 27 22 29 0a r data)) "','").
2b30: 09 09 20 20 20 20 20 22 27 29 3b 22 29 29 29 0a .. "');"))).
2b40: 20 20 20 20 28 70 72 69 6e 74 20 22 73 74 6d 74 (print "stmt
2b50: 3a 20 22 20 73 74 6d 74 29 0a 20 20 20 20 28 64 : " stmt). (d
2b60: 62 69 3a 65 78 65 63 20 64 62 20 73 74 6d 74 29 bi:exec db stmt)
2b70: 0a 20 20 20 20 3b 3b 20 6c 6f 6f 6b 75 70 20 74 . ;; lookup t
2b80: 68 65 20 72 65 63 6f 72 64 2d 69 64 20 61 6e 64 he record-id and
2b90: 20 72 65 74 75 72 6e 20 69 74 0a 20 20 20 20 0a return it. .
2ba0: 20 20 20 20 29 29 0a 20 20 20 20 0a 0a 28 64 65 )). ..(de
2bb0: 66 69 6e 65 20 28 70 6b 74 73 64 62 2d 63 6c 6f fine (pktsdb-clo
2bc0: 73 65 20 70 6b 74 73 64 62 29 0a 20 20 28 64 62 se pktsdb). (db
2bd0: 69 3a 63 6c 6f 73 65 20 28 70 6b 74 64 62 2d 63 i:close (pktdb-c
2be0: 6f 6e 6e 20 70 6b 74 73 64 62 29 29 29 0a 0a 3b onn pktsdb)))..;
2bf0: 3b 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 73 20 ; (let loop ((s
2c00: 22 30 22 29 28 6e 20 30 29 29 28 70 72 69 6e 74 "0")(n 0))(print
2c10: 20 73 29 28 69 66 20 28 3c 20 6e 20 35 30 30 30 s)(if (< n 5000
2c20: 29 28 6c 6f 6f 70 20 28 69 6e 63 72 65 6d 65 6e )(loop (incremen
2c30: 74 2d 73 74 72 69 6e 67 20 73 29 28 2b 20 6e 20 t-string s)(+ n
2c40: 31 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 1))))..;;=======
2c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2c90: 3b 3b 20 43 41 52 44 53 2c 20 4d 49 53 43 20 61 ;; CARDS, MISC a
2ca0: 6e 64 20 55 54 49 4c 0a 3b 3b 3d 3d 3d 3d 3d 3d nd UTIL.;;======
2cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cf0: 0a 0a 3b 3b 20 67 69 76 65 6e 20 73 74 72 69 6e ..;; given strin
2d00: 67 20 28 6c 69 6b 65 6c 79 20 6d 75 6c 74 69 2d g (likely multi-
2d10: 6c 69 6e 65 29 20 22 64 61 74 22 20 72 65 74 75 line) "dat" retu
2d20: 72 6e 20 73 68 61 72 31 20 68 61 73 68 0a 3b 3b rn shar1 hash.;;
2d30: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
2d40: 28 63 61 6c 63 2d 73 68 61 72 31 20 69 6e 73 74 (calc-shar1 inst
2d50: 72 29 0a 20 20 28 6d 65 73 73 61 67 65 2d 64 69 r). (message-di
2d60: 67 65 73 74 2d 73 74 72 69 6e 67 0a 20 20 20 28 gest-string. (
2d70: 73 68 61 31 2d 70 72 69 6d 69 74 69 76 65 29 0a sha1-primitive).
2d80: 20 20 20 69 6e 73 74 72 29 29 0a 0a 3b 3b 20 67 instr))..;; g
2d90: 69 76 65 6e 20 61 20 73 69 6e 67 6c 65 20 63 61 iven a single ca
2da0: 72 64 20 72 65 74 75 72 6e 20 69 74 73 20 74 79 rd return its ty
2db0: 70 65 20 61 6e 64 20 76 61 6c 75 65 0a 3b 3b 0a pe and value.;;.
2dc0: 28 64 65 66 69 6e 65 20 28 63 61 72 64 2d 3e 74 (define (card->t
2dd0: 79 70 65 2f 76 61 6c 75 65 20 63 61 72 64 29 0a ype/value card).
2de0: 20 20 28 6c 65 74 20 28 28 63 74 79 70 65 20 28 (let ((ctype (
2df0: 73 75 62 73 74 72 69 6e 67 20 63 61 72 64 20 30 substring card 0
2e00: 20 31 29 29 0a 09 28 63 76 61 6c 20 20 28 73 75 1))..(cval (su
2e10: 62 73 74 72 69 6e 67 20 63 61 72 64 20 32 20 28 bstring card 2 (
2e20: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 63 61 string-length ca
2e30: 72 64 29 29 29 29 0a 20 20 20 20 28 76 61 6c 75 rd)))). (valu
2e40: 65 73 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 es (string->symb
2e50: 6f 6c 20 63 74 79 70 65 29 20 63 76 61 6c 29 29 ol ctype) cval))
2e60: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
2e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 ===========.;; S
2eb0: 44 41 54 20 70 72 6f 63 73 0a 3b 3b 20 20 73 64 DAT procs.;; sd
2ec0: 61 74 20 69 73 20 6c 65 67 61 63 79 2f 69 6e 74 at is legacy/int
2ed0: 65 72 6e 61 6c 20 75 73 61 67 65 2e 20 49 6e 74 ernal usage. Int
2ee0: 65 6e 74 69 6f 6e 20 69 73 20 74 6f 20 72 65 6d ention is to rem
2ef0: 6f 76 65 20 73 64 61 74 20 63 61 6c 6c 73 20 66 ove sdat calls f
2f00: 72 6f 6d 0a 3b 3b 20 20 74 68 65 20 65 78 70 6f rom.;; the expo
2f10: 73 65 64 20 63 61 6c 6c 73 2e 0a 3b 3b 3d 3d 3d sed calls..;;===
2f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f60: 3d 3d 3d 0a 0a 3b 3b 20 73 6f 72 74 20 6c 69 73 ===..;; sort lis
2f70: 74 20 6f 66 20 63 61 72 64 73 0a 3b 3b 0a 28 64 t of cards.;;.(d
2f80: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 73 6f efine-inline (so
2f90: 72 74 2d 63 61 72 64 73 20 73 64 61 74 29 0a 20 rt-cards sdat).
2fa0: 20 28 73 6f 72 74 20 73 64 61 74 20 73 74 72 69 (sort sdat stri
2fb0: 6e 67 3c 3d 3f 29 29 0a 0a 3b 3b 20 70 6b 74 20 ng<=?))..;; pkt
2fc0: 72 75 6c 65 73 0a 3b 3b 20 31 2e 20 6f 6e 65 20 rules.;; 1. one
2fd0: 63 61 72 64 20 70 65 72 20 6c 69 6e 65 0a 3b 3b card per line.;;
2fe0: 20 32 2e 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 2. at least one
2ff0: 20 63 61 72 64 0a 3b 3b 20 33 2e 20 6e 6f 20 62 card.;; 3. no b
3000: 6c 61 6e 6b 20 6c 69 6e 65 73 0a 0a 3b 3b 20 67 lank lines..;; g
3010: 69 76 65 6e 20 73 64 61 74 2c 20 61 20 6c 69 73 iven sdat, a lis
3020: 74 20 6f 66 20 63 61 72 64 73 20 72 65 74 75 72 t of cards retur
3030: 6e 20 75 75 69 64 2c 20 70 61 63 6b 65 74 20 28 n uuid, packet (
3040: 61 73 20 73 64 61 74 29 0a 3b 3b 0a 28 64 65 66 as sdat).;;.(def
3050: 69 6e 65 20 28 61 64 64 2d 7a 2d 63 61 72 64 20 ine (add-z-card
3060: 73 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 sdat). (let* ((
3070: 73 6f 72 74 65 64 2d 73 64 61 74 20 28 73 6f 72 sorted-sdat (sor
3080: 74 2d 63 61 72 64 73 20 73 64 61 74 29 29 0a 09 t-cards sdat))..
3090: 20 28 64 61 74 20 20 20 20 20 20 20 20 20 28 73 (dat (s
30a0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
30b0: 65 20 73 6f 72 74 65 64 2d 73 64 61 74 20 22 5c e sorted-sdat "\
30c0: 6e 22 29 29 0a 09 20 28 75 75 69 64 20 20 20 20 n")).. (uuid
30d0: 20 20 20 20 28 63 61 6c 63 2d 73 68 61 72 31 20 (calc-shar1
30e0: 64 61 74 29 29 29 0a 20 20 20 20 28 76 61 6c 75 dat))). (valu
30f0: 65 73 0a 20 20 20 20 20 75 75 69 64 0a 20 20 20 es. uuid.
3100: 20 20 28 63 6f 6e 63 0a 20 20 20 20 20 20 64 61 (conc. da
3110: 74 0a 20 20 20 20 20 20 22 5c 6e 5a 20 22 0a 20 t. "\nZ ".
3120: 20 20 20 20 20 75 75 69 64 29 29 29 29 0a 0a 28 uuid))))..(
3130: 64 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 70 6b define (check-pk
3140: 74 20 70 6b 74 29 0a 20 20 28 68 61 6e 64 6c 65 t pkt). (handle
3150: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 -exceptions.
3160: 20 20 65 78 6e 0a 20 20 20 20 20 20 23 66 20 3b exn. #f ;
3170: 3b 20 61 6e 79 74 68 69 6e 67 20 67 6f 65 73 20 ; anything goes
3180: 77 72 6f 6e 67 20 2d 20 63 61 6c 6c 20 69 74 20 wrong - call it
3190: 61 20 63 72 61 70 70 79 20 70 6b 74 0a 20 20 20 a crappy pkt.
31a0: 20 28 6c 65 74 2a 20 28 28 73 64 61 74 20 28 73 (let* ((sdat (s
31b0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 6b 74 20 tring-split pkt
31c0: 22 5c 6e 22 29 29 0a 09 20 20 20 28 72 64 61 74 "\n")).. (rdat
31d0: 20 28 72 65 76 65 72 73 65 20 73 64 61 74 29 29 (reverse sdat))
31e0: 20 3b 3b 20 72 65 76 65 72 73 65 64 0a 09 20 20 ;; reversed..
31f0: 20 28 7a 64 61 74 20 28 63 61 72 20 72 64 61 74 (zdat (car rdat
3200: 29 29 0a 09 20 20 20 28 5a 20 20 20 20 28 63 61 )).. (Z (ca
3210: 64 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 dr (string-split
3220: 20 7a 64 61 74 29 29 29 0a 09 20 20 20 28 63 64 zdat))).. (cd
3230: 61 74 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 at (string-inter
3240: 73 70 65 72 73 65 20 28 72 65 76 65 72 73 65 20 sperse (reverse
3250: 28 63 64 72 20 72 64 61 74 29 29 20 22 5c 6e 22 (cdr rdat)) "\n"
3260: 29 29 29 0a 20 20 20 20 20 20 28 65 71 75 61 6c ))). (equal
3270: 3f 20 5a 20 28 63 61 6c 63 2d 73 68 61 72 31 20 ? Z (calc-shar1
3280: 63 64 61 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d cdat)))))..;;===
3290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32d0: 3d 3d 3d 0a 3b 3b 20 41 50 4b 54 73 0a 3b 3b 3d ===.;; APKTs.;;=
32e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3320: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 63 6f 6e 76 65 72 =====..;; conver
3330: 74 20 61 20 73 64 61 74 20 28 6c 69 73 74 20 6f t a sdat (list o
3340: 66 20 63 61 72 64 73 29 20 74 6f 20 61 6e 20 61 f cards) to an a
3350: 6c 69 73 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 list.;;.(define
3360: 28 73 64 61 74 2d 3e 61 6c 69 73 74 20 73 64 61 (sdat->alist sda
3370: 74 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 t). (let loop (
3380: 28 68 65 64 20 28 63 61 72 20 73 64 61 74 29 29 (hed (car sdat))
3390: 0a 09 20 20 20 20 20 28 74 61 6c 20 28 63 64 72 .. (tal (cdr
33a0: 20 73 64 61 74 29 29 0a 09 20 20 20 20 20 28 72 sdat)).. (r
33b0: 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 6c 65 es '())). (le
33c0: 74 2d 76 61 6c 75 65 73 20 28 28 20 28 63 74 79 t-values (( (cty
33d0: 70 65 20 63 76 61 6c 29 28 63 61 72 64 2d 3e 74 pe cval)(card->t
33e0: 79 70 65 2f 76 61 6c 75 65 20 68 65 64 29 20 29 ype/value hed) )
33f0: 29 0a 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 ). ;; if th
3400: 69 73 20 63 61 72 64 20 69 73 20 6e 6f 74 20 6f is card is not o
3410: 6e 65 20 6f 66 20 74 68 65 20 63 6f 6d 6d 6f 6e ne of the common
3420: 20 6f 6e 65 73 20 74 61 63 6b 20 69 74 20 6f 6e ones tack it on
3430: 20 74 6f 20 72 65 6d 0a 20 20 20 20 20 20 28 6c to rem. (l
3440: 65 74 2a 20 28 28 6f 6c 64 76 61 6c 20 28 61 6c et* ((oldval (al
3450: 69 73 74 2d 72 65 66 20 63 74 79 70 65 20 72 65 ist-ref ctype re
3460: 73 29 29 0a 09 20 20 20 20 20 28 6e 65 77 72 65 s)).. (newre
3470: 73 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 63 74 s (cons (cons ct
3480: 79 70 65 0a 09 09 09 09 20 28 69 66 20 6f 6c 64 ype..... (if old
3490: 76 61 6c 20 3b 3b 20 6c 69 73 74 20 6f 72 20 73 val ;; list or s
34a0: 74 72 69 6e 67 0a 09 09 09 09 20 20 20 20 20 28 tring..... (
34b0: 69 66 20 28 6c 69 73 74 3f 20 6f 6c 64 76 61 6c if (list? oldval
34c0: 29 0a 09 09 09 09 09 20 28 63 6f 6e 73 20 63 76 )...... (cons cv
34d0: 61 6c 20 6f 6c 64 76 61 6c 29 0a 09 09 09 09 09 al oldval)......
34e0: 20 28 63 6f 6e 73 20 63 76 61 6c 20 28 6c 69 73 (cons cval (lis
34f0: 74 20 6f 6c 64 76 61 6c 29 29 29 0a 09 09 09 09 t oldval))).....
3500: 20 20 20 20 20 63 76 61 6c 29 29 0a 09 09 09 20 cval))....
3510: 20 20 72 65 73 29 29 29 0a 09 28 69 66 20 28 6e res)))..(if (n
3520: 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 6e ull? tal).. n
3530: 65 77 72 65 73 0a 09 20 20 20 20 28 6c 6f 6f 70 ewres.. (loop
3540: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
3550: 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 29 29 al) newres))))))
3560: 0a 0a 3b 3b 28 28 61 70 6b 74 20 28 5a 20 2e 20 ..;;((apkt (Z .
3570: 22 37 64 65 38 39 63 30 39 61 63 30 32 34 62 33 "7de89c09ac024b3
3580: 38 33 32 63 39 33 65 31 36 63 64 37 38 64 31 31 832c93e16cd78d11
3590: 65 32 65 32 38 37 33 33 62 22 29 20 20 20 20 20 e2e28733b")
35a0: 3c 3d 20 74 68 69 73 20 69 73 20 61 20 74 68 65 <= this is a the
35b0: 20 61 6c 69 73 74 0a 3b 3b 20 20 20 20 20 20 20 alist.;;
35c0: 28 74 20 2e 20 22 76 31 2e 36 33 2f 74 69 70 2f (t . "v1.63/tip/
35d0: 64 65 76 22 29 0a 3b 3b 20 20 20 20 20 20 20 28 dev").;; (
35e0: 63 20 2e 20 22 51 55 49 43 4b 50 41 54 54 22 29 c . "QUICKPATT")
35f0: 0a 3b 3b 20 20 20 20 20 20 20 28 54 20 2e 20 22 .;; (T . "
3600: 72 75 6e 73 74 61 72 74 22 29 0a 3b 3b 20 20 20 runstart").;;
3610: 20 20 20 20 28 50 20 2e 20 22 33 35 34 65 65 62 (P . "354eeb
3620: 36 37 31 32 30 61 39 32 31 65 33 65 33 33 31 35 67120a921e3e3315
3630: 35 65 63 61 62 31 62 35 32 32 61 63 31 30 62 36 5ecab1b522ac10b6
3640: 62 64 22 29 0a 3b 3b 20 20 20 20 20 20 20 28 44 bd").;; (D
3650: 20 2e 20 22 31 34 38 38 39 39 35 30 39 36 2e 30 . "1488995096.0
3660: 22 29 29 0a 3b 3b 20 20 28 69 64 20 2e 20 38 29 ")).;; (id . 8)
3670: 0a 3b 3b 20 20 28 67 72 6f 75 70 2d 69 64 20 2e .;; (group-id .
3680: 20 30 29 0a 3b 3b 20 20 28 75 75 69 64 20 2e 20 0).;; (uuid .
3690: 22 37 64 65 38 39 63 30 39 61 63 30 32 34 62 33 "7de89c09ac024b3
36a0: 38 33 32 63 39 33 65 31 36 63 64 37 38 64 31 31 832c93e16cd78d11
36b0: 65 32 65 32 38 37 33 33 62 22 29 0a 3b 3b 20 20 e2e28733b").;;
36c0: 28 70 61 72 65 6e 74 20 2e 20 22 22 29 0a 3b 3b (parent . "").;;
36d0: 20 20 28 70 6b 74 2d 74 79 70 65 20 2e 20 22 72 (pkt-type . "r
36e0: 75 6e 73 74 61 72 74 22 29 0a 3b 3b 20 20 28 70 unstart").;; (p
36f0: 6b 74 20 2e 20 22 44 20 31 34 38 38 39 39 35 30 kt . "D 14889950
3700: 39 36 2e 30 5c 6e 50 20 33 35 34 65 65 62 36 37 96.0\nP 354eeb67
3710: 31 32 30 61 39 32 31 65 33 65 33 33 31 35 35 65 120a921e3e33155e
3720: 63 61 62 31 62 35 32 32 61 63 31 30 62 36 62 64 cab1b522ac10b6bd
3730: 5c 6e 54 20 72 75 6e 73 74 61 72 74 5c 6e 63 20 \nT runstart\nc
3740: 51 55 49 43 4b 50 41 54 54 5c 6e 74 20 76 31 2e QUICKPATT\nt v1.
3750: 36 33 2f 74 69 70 2f 64 65 76 5c 6e 5a 20 37 64 63/tip/dev\nZ 7d
3760: 65 38 39 63 30 39 61 63 30 32 34 62 33 38 33 32 e89c09ac024b3832
3770: 63 39 33 65 31 36 63 64 37 38 64 31 31 65 32 65 c93e16cd78d11e2e
3780: 32 38 37 33 33 62 22 29 29 0a 3b 3b 0a 3b 3b 20 28733b")).;;.;;
3790: 70 6b 74 73 70 65 63 20 69 73 20 61 6c 69 73 74 pktspec is alist
37a0: 20 6f 66 20 61 6c 69 73 74 73 20 6d 61 70 70 69 of alists mappi
37b0: 6e 67 20 74 79 70 65 73 20 61 6e 64 20 6e 69 63 ng types and nic
37c0: 65 6b 65 79 73 20 74 6f 20 6b 65 79 73 0a 3b 3b ekeys to keys.;;
37d0: 0a 3b 3b 20 27 28 28 70 6f 73 74 69 6e 67 20 2e .;; '((posting .
37e0: 20 28 28 74 69 74 6c 65 20 2e 20 74 29 0a 3b 3b ((title . t).;;
37f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3800: 75 72 6c 20 20 20 2e 20 75 29 0a 3b 3b 20 20 20 url . u).;;
3810: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 6c 75 (blu
3820: 72 62 20 2e 20 62 29 29 29 0a 3b 3b 20 20 20 28 rb . b))).;; (
3830: 63 6f 6d 6d 65 6e 74 20 2e 20 28 28 63 6f 6d 6d comment . ((comm
3840: 65 6e 74 20 2e 20 63 29 0a 3b 3b 20 20 20 20 20 ent . c).;;
3850: 20 20 20 20 20 20 20 20 20 20 28 73 63 6f 72 65 (score
3860: 20 20 20 2e 20 73 29 29 29 29 0a 0a 3b 3b 20 44 . s))))..;; D
3870: 4f 4e 27 54 20 55 53 45 3f 20 0a 3b 3b 0a 28 64 ON'T USE? .;;.(d
3880: 65 66 69 6e 65 20 28 67 65 74 2d 76 61 6c 75 65 efine (get-value
3890: 20 66 69 65 6c 64 20 64 70 6b 74 20 2e 20 73 70 field dpkt . sp
38a0: 65 63 2d 69 6e 29 0a 20 20 28 69 66 20 28 6e 75 ec-in). (if (nu
38b0: 6c 6c 3f 20 73 70 65 63 2d 69 6e 29 0a 20 20 20 ll? spec-in).
38c0: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 66 69 (alist-ref fi
38d0: 65 6c 64 20 64 70 6b 74 29 0a 20 20 20 20 20 20 eld dpkt).
38e0: 28 6c 65 74 2a 20 28 28 73 70 65 63 20 20 28 63 (let* ((spec (c
38f0: 61 72 20 73 70 65 63 2d 69 6e 29 29 0a 09 20 20 ar spec-in))..
3900: 20 20 20 28 61 70 6b 74 20 20 28 61 6c 69 73 74 (apkt (alist
3910: 2d 72 65 66 20 27 61 70 6b 74 20 64 70 6b 74 29 -ref 'apkt dpkt)
3920: 29 29 20 3b 3b 20 67 65 74 20 74 68 65 20 70 6b )) ;; get the pk
3930: 74 20 61 6c 69 73 74 0a 09 28 69 66 20 28 61 6e t alist..(if (an
3940: 64 20 61 70 6b 74 20 73 70 65 63 29 0a 09 20 20 d apkt spec)..
3950: 20 20 28 6c 65 74 2a 20 28 28 70 74 79 70 65 20 (let* ((ptype
3960: 28 61 6c 69 73 74 2d 72 65 66 20 27 70 6b 74 2d (alist-ref 'pkt-
3970: 74 79 70 65 20 64 70 6b 74 29 29 0a 09 09 20 20 type dpkt))...
3980: 20 28 70 73 70 65 63 20 28 61 6c 69 73 74 2d 72 (pspec (alist-r
3990: 65 66 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 ef (string->symb
39a0: 6f 6c 20 70 74 79 70 65 29 20 73 70 65 63 29 29 ol ptype) spec))
39b0: 29 20 3b 3b 20 64 6f 20 77 65 20 68 61 76 65 20 ) ;; do we have
39c0: 61 20 73 70 65 63 20 66 6f 72 20 74 68 69 73 20 a spec for this
39d0: 74 79 70 65 20 6f 66 20 70 6b 74 0a 09 20 20 20 type of pkt..
39e0: 20 20 20 28 61 6e 64 20 70 73 70 65 63 0a 09 09 (and pspec...
39f0: 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 20 28 61 (let* ((key (a
3a00: 6c 69 73 74 2d 72 65 66 20 66 69 65 6c 64 20 70 list-ref field p
3a10: 73 70 65 63 29 29 29 0a 09 09 20 20 20 20 28 61 spec)))... (a
3a20: 6e 64 20 6b 65 79 20 28 61 6c 69 73 74 2d 72 65 nd key (alist-re
3a30: 66 20 6b 65 79 20 61 70 6b 74 29 29 29 29 29 0a f key apkt))))).
3a40: 09 20 20 20 20 23 66 29 29 29 29 0a 0a 3b 3b 20 . #f))))..;;
3a50: 63 6f 6e 76 65 72 74 20 61 20 64 70 6b 74 20 74 convert a dpkt t
3a60: 6f 20 61 20 70 75 72 65 20 61 6c 69 73 74 20 67 o a pure alist g
3a70: 69 76 65 6e 20 61 20 70 6b 74 73 70 65 63 0a 3b iven a pktspec.;
3a80: 3b 20 74 68 69 73 20 66 6c 61 74 74 65 6e 73 20 ; this flattens
3a90: 6f 75 74 20 74 68 65 20 61 6c 69 73 74 20 74 6f out the alist to
3aa0: 20 69 6e 63 6c 75 64 65 20 74 68 65 20 64 61 74 include the dat
3ab0: 61 20 66 72 6f 6d 0a 3b 3b 20 74 68 65 20 71 75 a from.;; the qu
3ac0: 65 75 65 20 64 61 74 61 62 61 73 65 20 72 65 63 eue database rec
3ad0: 6f 72 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ord.;;.(define (
3ae0: 64 70 6b 74 2d 3e 61 6c 69 73 74 20 64 70 6b 74 dpkt->alist dpkt
3af0: 20 70 6b 74 73 70 65 63 29 0a 20 20 28 6c 65 74 pktspec). (let
3b00: 2a 20 28 28 61 70 6b 74 20 20 20 20 20 20 20 28 * ((apkt (
3b10: 61 6c 69 73 74 2d 72 65 66 20 27 61 70 6b 74 20 alist-ref 'apkt
3b20: 64 70 6b 74 29 29 0a 09 20 28 70 6b 74 2d 74 79 dpkt)).. (pkt-ty
3b30: 70 65 20 20 20 28 6f 72 20 28 61 6c 69 73 74 2d pe (or (alist-
3b40: 72 65 66 20 27 70 6b 74 2d 74 79 70 65 20 64 70 ref 'pkt-type dp
3b50: 6b 74 29 20 3b 3b 20 70 6b 74 2d 74 79 70 65 20 kt) ;; pkt-type
3b60: 69 73 20 66 72 6f 6d 20 74 68 65 20 64 61 74 61 is from the data
3b70: 62 61 73 65 20 66 69 65 6c 64 20 70 6b 74 5f 74 base field pkt_t
3b80: 79 70 65 0a 09 09 09 20 28 61 6c 69 73 74 2d 72 ype.... (alist-r
3b90: 65 66 20 27 54 20 61 70 6b 74 29 29 29 0a 09 20 ef 'T apkt)))..
3ba0: 28 70 6b 74 2d 66 69 65 6c 64 73 20 28 61 6c 69 (pkt-fields (ali
3bb0: 73 74 2d 72 65 66 20 28 73 74 72 69 6e 67 2d 3e st-ref (string->
3bc0: 73 79 6d 62 6f 6c 20 70 6b 74 2d 74 79 70 65 29 symbol pkt-type)
3bd0: 20 70 6b 74 73 70 65 63 29 29 0a 09 20 28 72 65 pktspec)).. (re
3be0: 76 2d 66 69 65 6c 64 73 20 28 69 66 20 70 6b 74 v-fields (if pkt
3bf0: 2d 66 69 65 6c 64 73 0a 09 09 09 20 28 72 65 76 -fields.... (rev
3c00: 65 72 73 65 2d 61 73 70 65 63 20 70 6b 74 2d 66 erse-aspec pkt-f
3c10: 69 65 6c 64 73 29 0a 09 09 09 20 27 28 29 29 29 ields).... '()))
3c20: 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 28 6d ). (append (m
3c30: 61 70 20 28 6c 61 6d 62 64 61 20 28 65 6e 74 72 ap (lambda (entr
3c40: 79 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 y)... (let* ((
3c50: 70 6b 74 2d 6b 65 79 20 28 63 61 72 20 65 6e 74 pkt-key (car ent
3c60: 72 79 29 29 0a 09 09 09 20 20 28 6e 65 77 2d 6b ry)).... (new-k
3c70: 65 79 20 28 6f 72 20 28 61 6c 69 73 74 2d 72 65 ey (or (alist-re
3c80: 66 20 70 6b 74 2d 6b 65 79 20 72 65 76 2d 66 69 f pkt-key rev-fi
3c90: 65 6c 64 73 29 20 70 6b 74 2d 6b 65 79 29 29 29 elds) pkt-key)))
3ca0: 0a 09 09 20 20 20 20 20 60 28 2c 6e 65 77 2d 6b ... `(,new-k
3cb0: 65 79 20 2e 20 2c 28 63 64 72 20 65 6e 74 72 79 ey . ,(cdr entry
3cc0: 29 29 29 29 0a 09 09 20 61 70 6b 74 29 0a 09 20 ))))... apkt)..
3cd0: 20 20 20 64 70 6b 74 29 29 29 0a 0a 3b 3b 20 63 dpkt)))..;; c
3ce0: 6f 6e 76 65 72 74 20 61 20 6c 69 73 74 20 6f 66 onvert a list of
3cf0: 20 64 70 6b 74 73 20 69 6e 74 6f 20 61 20 6c 69 dpkts into a li
3d00: 73 74 20 6f 66 20 61 6c 69 73 74 73 20 75 73 69 st of alists usi
3d10: 6e 67 20 70 6b 74 2d 73 70 65 63 0a 3b 3b 0a 28 ng pkt-spec.;;.(
3d20: 64 65 66 69 6e 65 20 28 64 70 6b 74 73 2d 3e 61 define (dpkts->a
3d30: 6c 69 73 74 73 20 64 70 6b 74 73 20 70 6b 74 2d lists dpkts pkt-
3d40: 73 70 65 63 29 0a 20 20 20 28 6d 61 70 20 28 6c spec). (map (l
3d50: 61 6d 62 64 61 20 28 78 29 0a 09 20 20 28 64 70 ambda (x).. (dp
3d60: 6b 74 2d 3e 61 6c 69 73 74 20 78 20 70 6b 74 2d kt->alist x pkt-
3d70: 73 70 65 63 29 29 0a 09 64 70 6b 74 73 29 29 0a spec))..dpkts)).
3d80: 0a 3b 3b 20 47 65 6e 65 72 69 63 20 66 6c 61 74 .;; Generic flat
3d90: 74 65 6e 65 72 2c 20 6d 61 6b 65 20 74 68 65 20 tener, make the
3da0: 74 75 70 6c 65 20 61 6e 64 20 70 6b 74 20 69 6e tuple and pkt in
3db0: 74 6f 20 61 20 73 69 6e 67 6c 65 20 66 6c 61 74 to a single flat
3dc0: 20 61 6c 69 73 74 0a 3b 3b 0a 3b 3b 20 71 72 79 alist.;;.;; qry
3dd0: 2d 72 65 73 75 6c 74 2d 73 70 65 63 20 69 73 20 -result-spec is
3de0: 61 20 6c 69 73 74 20 6f 66 20 73 79 6d 62 6f 6c a list of symbol
3df0: 73 20 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 s corresponding
3e00: 74 6f 20 65 61 63 68 20 66 69 65 6c 64 0a 3b 3b to each field.;;
3e10: 0a 28 64 65 66 69 6e 65 20 28 66 6c 61 74 74 65 .(define (flatte
3e20: 6e 2d 61 6c 6c 20 69 6e 6c 73 74 20 70 6b 74 73 n-all inlst pkts
3e30: 70 65 63 20 2e 20 71 72 79 2d 72 65 73 75 6c 74 pec . qry-result
3e40: 2d 73 70 65 63 29 0a 20 20 28 6d 61 70 0a 20 20 -spec). (map.
3e50: 20 28 6c 61 6d 62 64 61 20 28 74 75 70 6c 65 29 (lambda (tuple)
3e60: 0a 20 20 20 20 20 28 64 70 6b 74 2d 3e 61 6c 69 . (dpkt->ali
3e70: 73 74 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 st. (apply
3e80: 64 62 6c 73 74 2d 3e 64 70 6b 74 73 20 74 75 70 dblst->dpkts tup
3e90: 6c 65 20 71 72 79 2d 72 65 73 75 6c 74 2d 73 70 le qry-result-sp
3ea0: 65 63 29 0a 20 20 20 20 20 20 70 6b 74 73 70 65 ec). pktspe
3eb0: 63 29 29 0a 20 20 20 69 6e 6c 73 74 29 29 0a 0a c)). inlst))..
3ec0: 3b 3b 20 63 61 6c 6c 20 6c 69 6b 65 20 74 68 69 ;; call like thi
3ed0: 73 3a 0a 3b 3b 20 20 28 63 6f 6e 73 74 72 75 63 s:.;; (construc
3ee0: 74 2d 73 64 61 74 20 27 61 20 22 61 20 64 61 74 t-sdat 'a "a dat
3ef0: 61 22 20 27 53 20 22 53 20 64 61 74 61 22 20 2e a" 'S "S data" .
3f00: 2e 2e 29 0a 3b 3b 20 72 65 74 75 72 6e 73 20 6c ..).;; returns l
3f10: 69 73 74 20 6f 66 20 63 61 72 64 73 0a 3b 3b 20 ist of cards.;;
3f20: 20 28 20 22 41 20 61 20 76 61 6c 75 65 22 20 22 ( "A a value" "
3f30: 44 20 31 32 33 34 35 36 37 38 39 30 30 22 20 2e D 12345678900" .
3f40: 2e 2e 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ..).;;.(define (
3f50: 63 6f 6e 73 74 72 75 63 74 2d 73 64 61 74 20 2e construct-sdat .
3f60: 20 61 6c 6c 64 61 74 29 0a 20 20 28 6c 65 74 20 alldat). (let
3f70: 28 28 68 61 76 65 2d 44 2d 63 61 72 64 20 23 66 ((have-D-card #f
3f80: 29 29 20 3b 3b 20 66 6c 61 67 0a 20 20 20 20 28 )) ;; flag. (
3f90: 69 66 20 28 65 76 65 6e 3f 20 28 6c 65 6e 67 74 if (even? (lengt
3fa0: 68 20 61 6c 6c 64 61 74 29 29 0a 09 28 6c 65 74 h alldat))..(let
3fb0: 20 6c 6f 6f 70 20 28 28 74 79 70 65 20 28 63 61 loop ((type (ca
3fc0: 72 20 61 6c 6c 64 61 74 29 29 0a 09 09 20 20 20 r alldat))...
3fd0: 28 64 61 74 61 20 28 63 61 64 72 20 61 6c 6c 64 (data (cadr alld
3fe0: 61 74 29 29 0a 09 09 20 20 20 28 74 61 69 6c 20 at))... (tail
3ff0: 28 63 64 64 72 20 61 6c 6c 64 61 74 29 29 0a 09 (cddr alldat))..
4000: 09 20 20 20 28 72 65 73 20 20 27 28 29 29 29 0a . (res '())).
4010: 09 20 20 28 69 66 20 28 65 71 3f 20 74 79 70 65 . (if (eq? type
4020: 20 27 44 29 28 73 65 74 21 20 68 61 76 65 2d 44 'D)(set! have-D
4030: 2d 63 61 72 64 20 23 74 29 29 0a 09 20 20 28 69 -card #t)).. (i
4040: 66 20 28 6e 75 6c 6c 3f 20 74 61 69 6c 29 0a 09 f (null? tail)..
4050: 20 20 20 20 20 20 28 69 66 20 68 61 76 65 2d 44 (if have-D
4060: 2d 63 61 72 64 20 3b 3b 20 72 65 74 75 72 6e 20 -card ;; return
4070: 74 68 65 20 63 6f 6e 73 74 72 75 63 74 65 64 20 the constructed
4080: 70 6b 74 2c 20 61 64 64 20 61 20 44 20 63 61 72 pkt, add a D car
4090: 64 20 69 66 20 6e 6f 6e 65 20 66 6f 75 6e 64 0a d if none found.
40a0: 09 09 20 20 28 61 64 64 2d 63 61 72 64 20 72 65 .. (add-card re
40b0: 73 20 74 79 70 65 20 64 61 74 61 29 0a 09 09 20 s type data)...
40c0: 20 28 61 64 64 2d 63 61 72 64 20 0a 09 09 20 20 (add-card ...
40d0: 20 28 61 64 64 2d 63 61 72 64 20 72 65 73 20 27 (add-card res '
40e0: 44 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e D (current-secon
40f0: 64 73 29 29 0a 09 09 20 20 20 74 79 70 65 20 64 ds))... type d
4100: 61 74 61 29 29 0a 09 20 20 20 20 20 20 28 6c 6f ata)).. (lo
4110: 6f 70 20 28 63 61 72 20 74 61 69 6c 29 0a 09 09 op (car tail)...
4120: 20 20 20 20 28 63 61 64 72 20 74 61 69 6c 29 0a (cadr tail).
4130: 09 09 20 20 20 20 28 63 64 64 72 20 74 61 69 6c .. (cddr tail
4140: 29 0a 09 09 20 20 20 20 28 61 64 64 2d 63 61 72 )... (add-car
4150: 64 20 72 65 73 20 74 79 70 65 20 64 61 74 61 29 d res type data)
4160: 29 29 29 0a 09 23 66 29 29 29 20 3b 3b 20 23 66 )))..#f))) ;; #f
4170: 20 6d 65 61 6e 73 20 69 74 20 66 61 69 6c 65 64 means it failed
4180: 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 73 to create the s
4190: 64 61 74 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f dat..(define (co
41a0: 6e 73 74 72 75 63 74 2d 70 6b 74 20 2e 20 61 6c nstruct-pkt . al
41b0: 6c 64 61 74 29 0a 20 20 28 61 64 64 2d 7a 2d 63 ldat). (add-z-c
41c0: 61 72 64 0a 20 20 20 28 61 70 70 6c 79 20 63 6f ard. (apply co
41d0: 6e 73 74 72 75 63 74 2d 73 64 61 74 20 61 6c 6c nstruct-sdat all
41e0: 64 61 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d dat)))..;;======
41f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4230: 0a 3b 3b 20 43 4f 4e 56 45 52 54 45 52 53 0a 3b .;; CONVERTERS.;
4240: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4280: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
4290: 20 28 70 6b 74 2d 3e 73 64 61 74 20 70 6b 74 29 (pkt->sdat pkt)
42a0: 0a 20 20 28 6d 61 70 20 75 6e 65 73 63 61 70 65 . (map unescape
42b0: 2d 64 61 74 61 20 28 73 74 72 69 6e 67 2d 73 70 -data (string-sp
42c0: 6c 69 74 20 70 6b 74 20 22 5c 6e 22 29 29 29 0a lit pkt "\n"))).
42d0: 0a 3b 3b 20 67 69 76 65 6e 20 61 20 70 75 72 65 .;; given a pure
42e0: 20 70 6b 74 20 72 65 74 75 72 6e 20 61 6e 20 61 pkt return an a
42f0: 6c 69 73 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 list.;;.(define
4300: 28 70 6b 74 2d 3e 61 6c 69 73 74 20 70 6b 74 20 (pkt->alist pkt
4310: 23 21 6b 65 79 20 28 70 6b 74 73 70 65 63 20 23 #!key (pktspec #
4320: 66 29 29 0a 20 20 28 6c 65 74 20 28 28 73 64 61 f)). (let ((sda
4330: 74 20 28 63 6f 6e 64 0a 09 20 20 20 20 20 20 20 t (cond..
4340: 28 28 73 74 72 69 6e 67 3f 20 70 6b 74 29 20 20 ((string? pkt)
4350: 28 70 6b 74 2d 3e 73 64 61 74 20 70 6b 74 29 29 (pkt->sdat pkt))
4360: 0a 09 20 20 20 20 20 20 20 28 28 6c 69 73 74 3f .. ((list?
4370: 20 70 6b 74 29 20 20 20 20 70 6b 74 29 0a 09 20 pkt) pkt)..
4380: 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 (else #f))
4390: 29 29 0a 20 20 20 20 28 69 66 20 70 6b 74 0a 09 )). (if pkt..
43a0: 28 69 66 20 70 6b 74 73 70 65 63 0a 09 20 20 20 (if pktspec..
43b0: 20 28 64 70 6b 74 2d 3e 61 6c 69 73 74 20 28 6c (dpkt->alist (l
43c0: 69 73 74 20 28 63 6f 6e 73 20 27 61 70 6b 74 20 ist (cons 'apkt
43d0: 28 73 64 61 74 2d 3e 61 6c 69 73 74 20 73 64 61 (sdat->alist sda
43e0: 74 29 29 29 20 70 6b 74 73 70 65 63 29 0a 09 20 t))) pktspec)..
43f0: 20 20 20 28 73 64 61 74 2d 3e 61 6c 69 73 74 20 (sdat->alist
4400: 73 64 61 74 29 29 0a 09 23 66 29 29 29 0a 0a 3b sdat))..#f)))..;
4410: 3b 20 63 6f 6e 76 65 72 74 20 61 6e 20 61 6c 69 ; convert an ali
4420: 73 74 20 74 6f 20 61 6e 20 73 64 61 74 0a 3b 3b st to an sdat.;;
4430: 20 20 69 6e 3a 20 27 28 28 61 20 2e 20 22 62 6c in: '((a . "bl
4440: 61 68 22 29 28 62 20 2e 20 22 66 6f 6f 22 29 29 ah")(b . "foo"))
4450: 0a 3b 3b 20 6f 75 74 3a 20 27 28 22 61 20 62 6c .;; out: '("a bl
4460: 61 68 22 20 22 62 20 66 6f 6f 22 29 0a 3b 3b 0a ah" "b foo").;;.
4470: 28 64 65 66 69 6e 65 20 28 61 6c 69 73 74 2d 3e (define (alist->
4480: 73 64 61 74 20 61 64 61 74 29 0a 20 20 28 6d 61 sdat adat). (ma
4490: 70 20 28 6c 61 6d 62 64 61 20 28 64 61 74 29 0a p (lambda (dat).
44a0: 09 20 28 63 6f 6e 63 20 28 63 61 72 20 64 61 74 . (conc (car dat
44b0: 29 20 22 20 22 20 28 63 64 72 20 64 61 74 29 29 ) " " (cdr dat))
44c0: 29 0a 20 20 20 20 20 20 20 61 64 61 74 29 29 0a ). adat)).
44d0: 0a 3b 3b 20 61 64 61 74 20 69 73 20 74 68 65 20 .;; adat is the
44e0: 69 6e 63 6f 6d 69 6e 67 20 61 6c 69 73 74 2c 20 incoming alist,
44f0: 61 73 70 65 63 20 69 73 20 74 68 65 20 6d 61 70 aspec is the map
4500: 70 69 6e 67 0a 3b 3b 20 66 72 6f 6d 20 69 6e 63 ping.;; from inc
4510: 6f 6d 69 6e 67 20 6b 65 79 20 74 6f 20 74 68 65 oming key to the
4520: 20 70 6b 74 20 6b 65 79 20 28 75 73 75 61 6c 6c pkt key (usuall
4530: 79 20 6f 6e 65 0a 3b 3b 20 6c 65 74 74 65 72 20 y one.;; letter
4540: 74 6f 20 6b 65 65 70 20 64 61 74 61 20 74 69 67 to keep data tig
4550: 68 74 29 20 73 65 65 20 74 68 65 20 70 6b 74 73 ht) see the pkts
4560: 70 65 63 20 61 74 20 74 68 65 0a 3b 3b 20 74 6f pec at the.;; to
4570: 70 20 6f 66 20 74 68 69 73 20 66 69 6c 65 0a 3b p of this file.;
4580: 3b 0a 3b 3b 20 4e 4f 54 45 3a 20 61 6c 69 73 74 ;.;; NOTE: alist
4590: 73 20 63 61 6e 20 63 6f 6e 74 61 69 6e 20 6d 75 s can contain mu
45a0: 6c 74 69 70 6c 65 20 69 6e 73 74 61 6e 63 65 73 ltiple instances
45b0: 20 6f 66 20 74 68 65 20 73 61 6d 65 20 6b 65 79 of the same key
45c0: 20 28 73 75 70 70 6f 72 74 65 64 20 66 69 6e 65 (supported fine
45d0: 20 62 79 20 70 6b 74 73 29 0a 3b 3b 20 20 20 20 by pkts).;;
45e0: 20 20 20 62 75 74 20 79 6f 75 20 28 6f 62 76 69 but you (obvi
45f0: 6f 75 73 6c 79 20 49 20 73 75 70 70 6f 73 65 29 ously I suppose)
4600: 20 63 61 6e 6e 6f 74 20 75 73 65 20 61 6c 69 73 cannot use alis
4610: 74 2d 72 65 66 20 74 6f 20 61 63 63 65 73 73 20 t-ref to access
4620: 74 68 6f 73 65 20 65 6e 74 72 69 65 73 2e 0a 3b those entries..;
4630: 3b 0a 28 64 65 66 69 6e 65 20 28 61 6c 69 73 74 ;.(define (alist
4640: 2d 3e 70 6b 74 20 61 64 61 74 20 61 73 70 65 63 ->pkt adat aspec
4650: 20 23 21 6b 65 79 20 28 70 74 79 70 65 20 23 66 #!key (ptype #f
4660: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 70 6b 74 )). (let* ((pkt
4670: 2d 74 79 70 65 20 28 6f 72 20 70 74 79 70 65 0a -type (or ptype.
4680: 09 09 20 20 20 20 20 20 20 28 61 6c 69 73 74 2d .. (alist-
4690: 72 65 66 20 27 54 20 61 64 61 74 29 20 3b 3b 20 ref 'T adat) ;;
46a0: 63 61 6e 20 70 72 6f 76 69 64 65 20 69 6e 20 74 can provide in t
46b0: 68 65 20 69 6e 63 6f 6d 69 6e 67 20 61 6c 69 73 he incoming alis
46c0: 74 0a 09 09 20 20 20 20 20 20 20 23 66 29 29 0a t... #f)).
46d0: 09 20 28 70 6b 74 2d 73 70 65 63 20 28 69 66 20 . (pkt-spec (if
46e0: 70 6b 74 2d 74 79 70 65 20 20 20 20 20 20 20 20 pkt-type
46f0: 20 20 20 20 3b 3b 20 61 6c 69 73 74 20 6f 66 20 ;; alist of
4700: 65 78 74 65 72 6e 61 6c 2d 6b 65 79 20 2d 3e 20 external-key ->
4710: 6b 65 79 0a 09 09 20 20 20 20 20 20 20 28 6f 72 key... (or
4720: 20 28 61 6c 69 73 74 2d 72 65 66 20 70 6b 74 2d (alist-ref pkt-
4730: 74 79 70 65 20 61 73 70 65 63 29 20 27 28 29 29 type aspec) '())
4740: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e ... (if (n
4750: 75 6c 6c 3f 20 61 73 70 65 63 29 0a 09 09 09 20 ull? aspec)....
4760: 20 20 27 28 29 0a 09 09 09 20 20 20 28 63 64 61 '().... (cda
4770: 72 20 61 73 70 65 63 29 29 29 29 20 3b 3b 20 64 r aspec)))) ;; d
4780: 65 66 61 75 6c 74 20 74 6f 20 66 69 72 73 74 20 efault to first
4790: 6f 6e 65 20 69 66 20 6e 6f 74 68 69 6e 67 20 73 one if nothing s
47a0: 70 65 63 69 66 69 65 64 0a 09 20 28 6e 65 77 2d pecified.. (new-
47b0: 61 6c 69 73 74 20 28 6d 61 70 20 28 6c 61 6d 62 alist (map (lamb
47c0: 64 61 20 28 64 61 74 29 0a 09 09 09 20 20 20 28 da (dat).... (
47d0: 6c 65 74 2a 20 28 28 6b 65 79 20 20 20 20 28 63 let* ((key (c
47e0: 61 72 20 64 61 74 29 29 0a 09 09 09 09 20 20 28 ar dat))..... (
47f0: 76 61 6c 20 20 20 20 28 63 64 72 20 64 61 74 29 val (cdr dat)
4800: 29 0a 09 09 09 09 20 20 28 6e 65 77 6b 65 79 20 )..... (newkey
4810: 28 6f 72 20 28 61 6c 69 73 74 2d 72 65 66 20 6b (or (alist-ref k
4820: 65 79 20 70 6b 74 2d 73 70 65 63 29 0a 09 09 09 ey pkt-spec)....
4830: 09 09 20 20 20 20 20 20 6b 65 79 29 29 29 0a 09 .. key)))..
4840: 09 09 20 20 20 20 20 28 63 6f 6e 73 20 6e 65 77 .. (cons new
4850: 6b 65 79 20 28 65 73 63 61 70 65 2d 64 61 74 61 key (escape-data
4860: 20 28 63 6f 6e 63 20 76 61 6c 29 29 29 29 29 20 (conc val)))))
4870: 3b 3b 20 63 6f 6e 76 65 72 74 20 61 6c 6c 20 69 ;; convert all i
4880: 6e 63 6f 6d 69 6e 67 20 64 61 74 61 20 28 73 79 ncoming data (sy
4890: 6d 62 6f 6c 73 2c 20 6e 75 6d 62 65 72 73 20 65 mbols, numbers e
48a0: 74 63 2e 29 20 74 6f 20 61 20 73 74 72 69 6e 67 tc.) to a string
48b0: 20 61 6e 64 20 74 68 65 6e 20 65 73 63 61 70 65 and then escape
48c0: 20 6e 65 77 6c 69 6e 65 73 2e 0a 09 09 09 20 61 newlines..... a
48d0: 64 61 74 29 29 0a 09 20 28 6e 65 77 2d 77 69 74 dat)).. (new-wit
48e0: 68 2d 74 79 70 65 20 28 69 66 20 28 61 6c 69 73 h-type (if (alis
48f0: 74 2d 72 65 66 20 27 54 20 6e 65 77 2d 61 6c 69 t-ref 'T new-ali
4900: 73 74 29 0a 09 09 09 20 20 20 20 6e 65 77 2d 61 st).... new-a
4910: 6c 69 73 74 0a 09 09 09 20 20 20 20 28 63 6f 6e list.... (con
4920: 73 20 60 28 54 20 2e 20 2c 70 6b 74 2d 74 79 70 s `(T . ,pkt-typ
4930: 65 29 20 6e 65 77 2d 61 6c 69 73 74 29 29 29 0a e) new-alist))).
4940: 09 20 28 77 69 74 68 2d 64 2d 63 61 72 64 20 20 . (with-d-card
4950: 20 28 69 66 20 28 61 6c 69 73 74 2d 72 65 66 20 (if (alist-ref
4960: 27 44 20 6e 65 77 2d 77 69 74 68 2d 74 79 70 65 'D new-with-type
4970: 29 0a 09 09 09 20 20 20 20 6e 65 77 2d 77 69 74 ).... new-wit
4980: 68 2d 74 79 70 65 0a 09 09 09 20 20 20 20 28 63 h-type.... (c
4990: 6f 6e 73 20 60 28 44 20 2e 20 2c 28 63 75 72 72 ons `(D . ,(curr
49a0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 ent-seconds))...
49b0: 09 09 20 20 6e 65 77 2d 77 69 74 68 2d 74 79 70 .. new-with-typ
49c0: 65 29 29 29 29 0a 20 20 20 20 28 61 64 64 2d 7a e)))). (add-z
49d0: 2d 63 61 72 64 0a 20 20 20 20 20 28 61 6c 69 73 -card. (alis
49e0: 74 2d 3e 73 64 61 74 20 77 69 74 68 2d 64 2d 63 t->sdat with-d-c
49f0: 61 72 64 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ard))))..;;=====
4a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a40: 3d 0a 3b 3b 20 20 44 20 42 20 20 20 51 20 55 20 =.;; D B Q U
4a50: 45 20 55 20 45 20 20 20 49 20 4e 20 54 20 45 20 E U E I N T E
4a60: 52 20 46 20 41 20 43 20 45 0a 3b 3b 3d 3d 3d 3d R F A C E.;;====
4a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ab0: 3d 3d 0a 0a 3b 3b 20 70 6b 74 73 20 28 0a 3b 3b ==..;; pkts (.;;
4ac0: 20 20 20 69 64 20 53 45 52 49 41 4c 20 50 52 49 id SERIAL PRI
4ad0: 4d 41 52 59 20 4b 45 59 2c 0a 3b 3b 20 20 20 75 MARY KEY,.;; u
4ae0: 75 69 64 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c uid TEXT NOT NUL
4af0: 4c 2c 0a 3b 3b 20 20 20 70 61 72 65 6e 74 5f 75 L,.;; parent_u
4b00: 75 69 64 20 54 45 58 54 20 64 65 66 61 75 6c 74 uid TEXT default
4b10: 20 27 27 2c 0a 3b 3b 20 20 20 70 6b 74 5f 74 79 '',.;; pkt_ty
4b20: 70 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 pe INTEGER DEFAU
4b30: 4c 54 20 30 2c 0a 3b 3b 20 20 20 67 72 6f 75 70 LT 0,.;; group
4b40: 5f 69 64 20 49 4e 54 45 47 45 52 20 4e 4f 54 20 _id INTEGER NOT
4b50: 4e 55 4c 4c 2c 0a 3b 3b 20 20 20 70 6b 74 20 54 NULL,.;; pkt T
4b60: 45 58 54 20 4e 4f 54 20 4e 55 4c 4c 0a 0a 3b 3b EXT NOT NULL..;;
4b70: 20 73 63 68 65 6d 61 20 69 73 20 6c 69 73 74 20 schema is list
4b80: 6f 66 20 53 51 4c 20 73 74 61 74 65 6d 65 6e 74 of SQL statement
4b90: 73 20 2d 20 63 61 6e 20 62 65 20 75 73 65 64 20 s - can be used
4ba0: 74 6f 20 65 78 74 65 6e 64 20 64 62 20 77 69 74 to extend db wit
4bb0: 68 20 6d 6f 72 65 20 74 61 62 6c 65 73 0a 3b 3b h more tables.;;
4bc0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 71 .(define (open-q
4bd0: 75 65 75 65 2d 64 62 20 64 62 70 61 74 68 20 64 ueue-db dbpath d
4be0: 62 66 69 6c 65 20 23 21 6b 65 79 20 28 73 63 68 bfile #!key (sch
4bf0: 65 6d 61 20 27 28 29 29 29 0a 20 20 28 6c 65 74 ema '())). (let
4c00: 2a 20 28 28 64 62 66 6e 61 6d 65 20 20 28 63 6f * ((dbfname (co
4c10: 6e 63 20 64 62 70 61 74 68 20 22 2f 22 20 64 62 nc dbpath "/" db
4c20: 66 69 6c 65 29 29 0a 09 20 28 64 62 65 78 69 73 file)).. (dbexis
4c30: 74 73 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 ts (if (file-exi
4c40: 73 74 73 3f 20 64 62 66 6e 61 6d 65 29 20 23 74 sts? dbfname) #t
4c50: 20 28 62 65 67 69 6e 20 28 63 72 65 61 74 65 2d (begin (create-
4c60: 64 69 72 65 63 74 6f 72 79 20 64 62 70 61 74 68 directory dbpath
4c70: 20 23 74 29 20 23 66 29 29 29 0a 09 20 28 64 62 #t) #f))).. (db
4c80: 20 20 20 20 20 20 20 28 64 62 69 3a 6f 70 65 6e (dbi:open
4c90: 20 27 73 71 6c 69 74 65 33 20 28 6c 69 73 74 20 'sqlite3 (list
4ca0: 28 63 6f 6e 73 20 27 64 62 6e 61 6d 65 20 64 62 (cons 'dbname db
4cb0: 66 6e 61 6d 65 29 29 29 29 29 0a 20 20 20 20 3b fname))))). ;
4cc0: 3b 20 28 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 ; (set-busy-hand
4cd0: 6c 65 72 21 20 64 62 20 28 62 75 73 79 2d 74 69 ler! db (busy-ti
4ce0: 6d 65 6f 75 74 20 31 30 30 30 30 29 29 0a 20 20 meout 10000)).
4cf0: 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 69 (if (not dbexi
4d00: 73 74 73 29 20 3b 3b 20 4e 4f 54 45 3a 20 49 6e sts) ;; NOTE: In
4d10: 20 74 68 65 20 61 72 63 68 69 76 65 20 77 65 20 the archive we
4d20: 61 6c 6c 6f 77 20 64 75 70 6c 69 63 61 74 65 73 allow duplicates
4d30: 20 61 6e 64 20 6f 74 68 65 72 20 6d 65 73 73 69 and other messi
4d40: 6e 65 73 73 2e 20 0a 09 28 66 6f 72 2d 65 61 63 ness. ..(for-eac
4d50: 68 0a 09 20 28 6c 61 6d 62 64 61 20 28 73 74 6d h.. (lambda (stm
4d60: 74 29 0a 09 20 20 20 28 64 62 69 3a 65 78 65 63 t).. (dbi:exec
4d70: 20 64 62 20 73 74 6d 74 29 29 0a 09 20 28 63 6f db stmt)).. (co
4d80: 6e 73 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 ns "CREATE TABLE
4d90: 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 70 IF NOT EXISTS p
4da0: 6b 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 kts.
4db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
4dc0: 64 20 20 20 20 20 20 20 20 20 20 20 49 4e 54 45 d INTE
4dd0: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
4de0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4df0: 20 20 20 20 20 20 20 20 20 20 20 20 67 72 6f 75 grou
4e00: 70 5f 69 64 20 20 20 20 20 49 4e 54 45 47 45 52 p_id INTEGER
4e10: 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 NOT NULL,.
4e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e30: 20 20 20 20 20 20 75 75 69 64 20 20 20 20 20 20 uuid
4e40: 20 20 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c 4c TEXT NOT NULL
4e50: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
4e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 72 par
4e70: 65 6e 74 5f 75 75 69 64 20 20 54 45 58 54 20 54 ent_uuid TEXT T
4e80: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
4e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ea0: 20 20 20 20 20 20 20 20 20 20 20 70 6b 74 5f 74 pkt_t
4eb0: 79 70 65 20 20 20 20 20 54 45 58 54 20 4e 4f 54 ype TEXT NOT
4ec0: 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 20 NULL,.
4ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ee0: 20 20 70 6b 74 20 20 20 20 20 20 20 20 20 20 54 pkt T
4ef0: 45 58 54 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 EXT NOT NULL,.
4f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f10: 20 20 20 20 20 20 20 20 20 70 72 6f 63 65 73 73 process
4f20: 65 64 20 20 20 20 49 4e 54 45 47 45 52 20 44 45 ed INTEGER DE
4f30: 46 41 55 4c 54 20 30 29 22 0a 09 09 20 20 20 73 FAULT 0)"... s
4f40: 63 68 65 6d 61 29 29 29 20 3b 3b 20 30 3d 6e 6f chema))) ;; 0=no
4f50: 74 20 70 72 6f 63 65 73 73 65 64 2c 20 31 3d 70 t processed, 1=p
4f60: 72 6f 63 65 73 73 65 64 2c 20 32 2e 2e 2e 20 66 rocessed, 2... f
4f70: 6f 72 20 65 78 70 61 6e 73 69 6f 6e 0a 20 20 20 or expansion.
4f80: 20 64 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 db))..(define (
4f90: 61 64 64 2d 74 6f 2d 71 75 65 75 65 20 64 62 20 add-to-queue db
4fa0: 70 6b 74 20 75 75 69 64 20 70 6b 74 2d 74 79 70 pkt uuid pkt-typ
4fb0: 65 20 70 61 72 65 6e 74 2d 75 75 69 64 20 67 72 e parent-uuid gr
4fc0: 6f 75 70 2d 69 64 29 0a 20 20 28 64 62 69 3a 65 oup-id). (dbi:e
4fd0: 78 65 63 20 64 62 20 22 49 4e 53 45 52 54 20 49 xec db "INSERT I
4fe0: 4e 54 4f 20 70 6b 74 73 20 28 75 75 69 64 2c 70 NTO pkts (uuid,p
4ff0: 61 72 65 6e 74 5f 75 75 69 64 2c 70 6b 74 5f 74 arent_uuid,pkt_t
5000: 79 70 65 2c 70 6b 74 2c 67 72 6f 75 70 5f 69 64 ype,pkt,group_id
5010: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5020: 20 20 20 20 20 56 41 4c 55 45 53 28 3f 2c 3f 2c VALUES(?,?,
5030: 3f 2c 3f 2c 3f 29 3b 22 20 3b 3b 20 24 31 2c 24 ?,?,?);" ;; $1,$
5040: 32 2c 24 33 2c 24 34 2c 24 35 29 3b 22 0a 09 20 2,$3,$4,$5);"..
5050: 20 20 20 75 75 69 64 0a 09 20 20 20 20 28 69 66 uuid.. (if
5060: 20 70 61 72 65 6e 74 2d 75 75 69 64 20 70 61 72 parent-uuid par
5070: 65 6e 74 2d 75 75 69 64 20 22 22 29 3b 3b 20 75 ent-uuid "");; u
5080: 73 65 20 6e 75 6c 6c 20 73 74 72 69 6e 67 20 61 se null string a
5090: 73 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 66 6f s placeholder fo
50a0: 72 20 6e 6f 20 70 61 72 65 6e 74 20 75 75 69 64 r no parent uuid
50b0: 2e 0a 09 20 20 20 20 28 69 66 20 70 6b 74 2d 74 ... (if pkt-t
50c0: 79 70 65 20 28 63 6f 6e 63 20 70 6b 74 2d 74 79 ype (conc pkt-ty
50d0: 70 65 29 20 22 22 29 20 0a 09 20 20 20 20 70 6b pe) "") .. pk
50e0: 74 0a 09 20 20 20 20 67 72 6f 75 70 2d 69 64 29 t.. group-id)
50f0: 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 6c 6c 20 )..;; given all
5100: 6e 65 65 64 65 64 20 70 61 72 61 6d 65 74 65 72 needed parameter
5110: 73 20 63 72 65 61 74 65 20 61 20 70 6b 74 20 61 s create a pkt a
5120: 6e 64 20 73 74 6f 72 65 20 69 74 20 69 6e 20 74 nd store it in t
5130: 68 65 20 71 75 65 75 65 0a 3b 3b 20 20 70 72 6f he queue.;; pro
5140: 63 73 20 69 73 20 61 6e 20 61 6c 69 73 74 20 74 cs is an alist t
5150: 68 61 74 20 6d 61 70 73 20 70 6b 74 2d 74 79 70 hat maps pkt-typ
5160: 65 20 74 6f 20 61 20 66 75 6e 63 74 69 6f 6e 20 e to a function
5170: 74 68 61 74 20 74 61 6b 65 73 20 61 20 6c 69 73 that takes a lis
5180: 74 20 6f 66 20 70 6b 74 20 70 61 72 61 6d 73 0a t of pkt params.
5190: 3b 3b 20 20 69 6e 20 64 61 74 61 20 61 6e 64 20 ;; in data and
51a0: 72 65 74 75 72 6e 73 20 74 68 65 20 75 75 69 64 returns the uuid
51b0: 20 61 6e 64 20 70 6b 74 0a 3b 3b 0a 28 64 65 66 and pkt.;;.(def
51c0: 69 6e 65 20 28 63 72 65 61 74 65 2d 61 6e 64 2d ine (create-and-
51d0: 71 75 65 75 65 20 63 6f 6e 6e 20 70 72 6f 63 73 queue conn procs
51e0: 20 70 6b 74 2d 74 79 70 65 20 70 61 72 65 6e 74 pkt-type parent
51f0: 2d 75 75 69 64 20 67 72 6f 75 70 2d 69 64 20 64 -uuid group-id d
5200: 61 74 61 29 0a 20 20 28 6c 65 74 20 28 28 70 72 ata). (let ((pr
5210: 6f 63 20 28 61 6c 69 73 74 2d 72 65 66 20 70 6b oc (alist-ref pk
5220: 74 2d 74 79 70 65 20 70 72 6f 63 73 29 29 29 0a t-type procs))).
5230: 20 20 20 20 28 69 66 20 70 72 6f 63 0a 09 28 6c (if proc..(l
5240: 65 74 2d 76 61 6c 75 65 73 20 28 28 20 28 75 75 et-values (( (uu
5250: 69 64 20 70 6b 74 29 20 28 70 72 6f 63 20 64 61 id pkt) (proc da
5260: 74 61 29 20 29 29 0a 09 20 20 28 61 64 64 2d 74 ta) )).. (add-t
5270: 6f 2d 71 75 65 75 65 20 63 6f 6e 6e 20 70 6b 74 o-queue conn pkt
5280: 20 75 75 69 64 20 70 6b 74 2d 74 79 70 65 20 70 uuid pkt-type p
5290: 61 72 65 6e 74 2d 75 75 69 64 20 67 72 6f 75 70 arent-uuid group
52a0: 2d 69 64 29 0a 09 20 20 75 75 69 64 29 0a 09 23 -id).. uuid)..#
52b0: 66 29 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 75 f)))..;; given u
52c0: 75 69 64 20 67 65 74 20 70 6b 74 2c 20 69 66 20 uid get pkt, if
52d0: 67 72 6f 75 70 2d 69 64 20 69 73 20 73 70 65 63 group-id is spec
52e0: 69 66 69 65 64 20 75 73 65 20 69 74 20 28 72 65 ified use it (re
52f0: 64 75 63 65 73 20 70 72 6f 62 61 62 6c 69 74 79 duces probablity
5300: 20 6f 66 0a 3b 3b 20 20 20 20 20 62 65 69 6e 67 of.;; being
5310: 20 6d 65 73 73 65 64 20 75 70 20 62 79 20 61 20 messed up by a
5320: 75 75 69 64 20 63 6f 6c 6c 69 73 69 6f 6e 29 0a uuid collision).
5330: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 6f 6f 6b ;;.(define (look
5340: 75 70 2d 62 79 2d 75 75 69 64 20 64 62 20 70 6b up-by-uuid db pk
5350: 74 2d 75 75 69 64 20 67 72 6f 75 70 2d 69 64 29 t-uuid group-id)
5360: 0a 20 20 28 69 66 20 67 72 6f 75 70 2d 69 64 0a . (if group-id.
5370: 20 20 20 20 20 20 28 64 62 69 3a 67 65 74 2d 6f (dbi:get-o
5380: 6e 65 20 64 62 20 22 53 45 4c 45 43 54 20 70 6b ne db "SELECT pk
5390: 74 20 46 52 4f 4d 20 70 6b 74 73 20 57 48 45 52 t FROM pkts WHER
53a0: 45 20 67 72 6f 75 70 5f 69 64 3d 3f 20 41 4e 44 E group_id=? AND
53b0: 20 75 75 69 64 3d 3f 3b 22 20 67 72 6f 75 70 2d uuid=?;" group-
53c0: 69 64 20 70 6b 74 2d 75 75 69 64 29 0a 20 20 20 id pkt-uuid).
53d0: 20 20 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 20 (dbi:get-one
53e0: 64 62 20 22 53 45 4c 45 43 54 20 70 6b 74 20 46 db "SELECT pkt F
53f0: 52 4f 4d 20 70 6b 74 73 20 57 48 45 52 45 20 75 ROM pkts WHERE u
5400: 75 69 64 3d 3f 3b 22 20 70 6b 74 2d 75 75 69 64 uid=?;" pkt-uuid
5410: 29 29 29 0a 20 20 20 20 20 20 0a 3b 3b 20 66 69 ))). .;; fi
5420: 6e 64 20 61 20 70 61 63 6b 65 74 20 62 79 20 69 nd a packet by i
5430: 74 73 20 69 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 ts id.;;.(define
5440: 20 28 6c 6f 6f 6b 75 70 2d 62 79 2d 69 64 20 64 (lookup-by-id d
5450: 62 20 69 64 29 0a 20 20 28 64 62 69 3a 67 65 74 b id). (dbi:get
5460: 2d 6f 6e 65 20 64 62 20 22 53 45 4c 45 43 54 20 -one db "SELECT
5470: 70 6b 74 20 46 52 4f 4d 20 70 6b 74 73 20 57 48 pkt FROM pkts WH
5480: 45 52 45 20 69 64 3d 3f 3b 22 20 69 64 29 29 0a ERE id=?;" id)).
5490: 0a 3b 3b 20 61 70 70 6c 79 20 61 20 70 72 6f 63 .;; apply a proc
54a0: 20 74 6f 20 74 68 65 20 6f 70 65 6e 20 64 62 20 to the open db
54b0: 68 61 6e 64 6c 65 20 66 6f 72 20 61 20 70 6b 74 handle for a pkt
54c0: 20 64 62 20 69 6e 20 70 64 62 70 61 74 68 0a 3b db in pdbpath.;
54d0: 3b 0a 28 64 65 66 69 6e 65 20 28 77 69 74 68 2d ;.(define (with-
54e0: 71 75 65 75 65 2d 64 62 20 70 64 62 70 61 74 68 queue-db pdbpath
54f0: 20 70 72 6f 63 20 23 21 6b 65 79 20 28 73 63 68 proc #!key (sch
5500: 65 6d 61 20 23 66 29 29 0a 20 20 28 63 6f 6e 64 ema #f)). (cond
5510: 0a 20 20 20 28 28 6e 6f 74 20 28 65 71 75 61 6c . ((not (equal
5520: 3f 20 28 66 69 6c 65 2d 6f 77 6e 65 72 20 70 64 ? (file-owner pd
5530: 62 70 61 74 68 29 28 63 75 72 72 65 6e 74 2d 65 bpath)(current-e
5540: 66 66 65 63 74 69 76 65 2d 75 73 65 72 2d 69 64 ffective-user-id
5550: 29 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 ))). (print "
5560: 45 52 52 4f 52 3a 20 64 69 72 65 63 74 6f 72 79 ERROR: directory
5570: 20 22 20 70 64 62 70 61 74 68 20 22 20 69 73 20 " pdbpath " is
5580: 6e 6f 74 20 6f 77 6e 65 64 20 62 79 20 22 20 28 not owned by " (
5590: 63 75 72 72 65 6e 74 2d 65 66 66 65 63 74 69 76 current-effectiv
55a0: 65 2d 75 73 65 72 2d 6e 61 6d 65 29 29 29 0a 20 e-user-name))).
55b0: 20 20 28 65 6c 73 65 0a 20 20 20 20 28 6c 65 74 (else. (let
55c0: 2a 20 28 28 70 64 62 20 20 28 6f 70 65 6e 2d 71 * ((pdb (open-q
55d0: 75 65 75 65 2d 64 62 20 70 64 62 70 61 74 68 20 ueue-db pdbpath
55e0: 22 70 6b 74 73 2e 64 62 22 0a 09 09 09 09 73 63 "pkts.db".....sc
55f0: 68 65 6d 61 3a 20 73 63 68 65 6d 61 29 29 20 3b hema: schema)) ;
5600: 3b 20 20 27 28 22 43 52 45 41 54 45 20 54 41 42 ; '("CREATE TAB
5610: 4c 45 20 67 72 6f 75 70 73 20 28 69 64 20 49 4e LE groups (id IN
5620: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 TEGER PRIMARY KE
5630: 59 2c 67 72 6f 75 70 6e 61 6d 65 20 54 45 58 54 Y,groupname TEXT
5640: 2c 20 43 4f 4e 53 54 52 41 49 4e 54 20 67 72 6f , CONSTRAINT gro
5650: 75 70 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e up_constraint UN
5660: 49 51 55 45 20 28 67 72 6f 75 70 6e 61 6d 65 29 IQUE (groupname)
5670: 29 3b 22 29 29 29 29 0a 09 20 20 20 28 72 65 73 );")))).. (res
5680: 20 20 28 70 72 6f 63 20 70 64 62 29 29 29 0a 20 (proc pdb))).
5690: 20 20 20 20 20 28 64 62 69 3a 63 6c 6f 73 65 20 (dbi:close
56a0: 70 64 62 29 0a 20 20 20 20 20 20 72 65 73 29 29 pdb). res))
56b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 6f 61 ))..(define (loa
56c0: 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 70 6b 74 d-pkts-to-db pkt
56d0: 73 64 69 72 73 20 70 64 62 70 61 74 68 20 23 21 sdirs pdbpath #!
56e0: 6b 65 79 20 28 73 63 68 65 6d 61 20 23 66 29 29 key (schema #f))
56f0: 0a 20 20 28 77 69 74 68 2d 71 75 65 75 65 2d 64 . (with-queue-d
5700: 62 0a 20 20 20 70 64 62 70 61 74 68 0a 20 20 20 b. pdbpath.
5710: 28 6c 61 6d 62 64 61 20 28 70 64 62 29 0a 20 20 (lambda (pdb).
5720: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
5730: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6b 74 73 (lambda (pkts
5740: 64 69 72 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 dir) ;; look at
5750: 61 6c 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 28 6e all..(cond.. ((n
5760: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
5770: 20 70 6b 74 73 64 69 72 29 29 0a 09 20 20 28 70 pktsdir)).. (p
5780: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 70 61 63 rint "ERROR: pac
5790: 6b 65 74 73 20 64 69 72 65 63 74 6f 72 79 20 22 kets directory "
57a0: 20 70 6b 74 73 64 69 72 20 22 20 64 6f 65 73 20 pktsdir " does
57b0: 6e 6f 74 20 65 78 69 73 74 2e 22 29 29 0a 09 20 not exist."))..
57c0: 28 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 79 ((not (directory
57d0: 3f 20 70 6b 74 73 64 69 72 29 29 0a 09 20 20 28 ? pktsdir)).. (
57e0: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 70 61 print "ERROR: pa
57f0: 63 6b 65 74 73 20 64 69 72 65 63 74 6f 72 79 20 ckets directory
5800: 70 61 74 68 20 22 20 70 6b 74 73 64 69 72 20 22 path " pktsdir "
5810: 20 69 73 20 6e 6f 74 20 61 20 64 69 72 65 63 74 is not a direct
5820: 6f 72 79 2e 22 29 29 0a 09 20 28 28 6e 6f 74 20 ory.")).. ((not
5830: 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 (file-read-acces
5840: 73 3f 20 70 6b 74 73 64 69 72 29 29 0a 09 20 20 s? pktsdir))..
5850: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 70 (print "ERROR: p
5860: 61 63 6b 65 74 73 20 64 69 72 65 63 74 6f 72 79 ackets directory
5870: 20 70 61 74 68 20 22 20 70 6b 74 73 64 69 72 20 path " pktsdir
5880: 22 20 69 73 20 6e 6f 74 20 72 65 61 64 61 62 6c " is not readabl
5890: 65 2e 22 29 29 0a 09 20 28 65 6c 73 65 0a 09 20 e.")).. (else..
58a0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 49 4e 46 4f ;; (print "INFO
58b0: 3a 20 4c 6f 61 64 69 6e 67 20 70 61 63 6b 65 74 : Loading packet
58c0: 73 20 66 6f 75 6e 64 20 69 6e 20 22 20 70 6b 74 s found in " pkt
58d0: 73 64 69 72 29 0a 09 20 20 28 6c 65 74 20 28 28 sdir).. (let ((
58e0: 70 6b 74 73 20 28 67 6c 6f 62 20 28 63 6f 6e 63 pkts (glob (conc
58f0: 20 70 6b 74 73 64 69 72 20 22 2f 2a 2e 70 6b 74 pktsdir "/*.pkt
5900: 22 29 29 29 29 0a 09 20 20 20 20 28 66 6f 72 2d ")))).. (for-
5910: 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 6d 62 each.. (lamb
5920: 64 61 20 28 70 6b 74 29 0a 09 20 20 20 20 20 20 da (pkt)..
5930: 20 28 6c 65 74 2a 20 28 28 75 75 69 64 20 20 20 (let* ((uuid
5940: 20 28 63 61 64 72 20 28 73 74 72 69 6e 67 2d 6d (cadr (string-m
5950: 61 74 63 68 20 22 2e 2a 2f 28 5b 30 2d 39 61 2d atch ".*/([0-9a-
5960: 66 5d 2b 29 2e 70 6b 74 22 20 70 6b 74 29 29 29 f]+).pkt" pkt)))
5970: 0a 09 09 20 20 20 20 20 20 28 65 78 69 73 74 73 ... (exists
5980: 20 20 28 6c 6f 6f 6b 75 70 2d 62 79 2d 75 75 69 (lookup-by-uui
5990: 64 20 70 64 62 20 75 75 69 64 20 23 66 29 29 29 d pdb uuid #f)))
59a0: 0a 09 09 20 28 69 66 20 28 6e 6f 74 20 65 78 69 ... (if (not exi
59b0: 73 74 73 29 0a 09 09 20 20 20 20 20 28 6c 65 74 sts)... (let
59c0: 2a 20 28 28 70 6b 74 64 61 74 20 28 73 74 72 69 * ((pktdat (stri
59d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 0a 09 ng-intersperse..
59e0: 09 09 09 20 20 20 20 20 28 77 69 74 68 2d 69 6e ... (with-in
59f0: 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 70 6b put-from-file pk
5a00: 74 20 72 65 61 64 2d 6c 69 6e 65 73 29 0a 09 09 t read-lines)...
5a10: 09 09 20 20 20 20 20 22 5c 6e 22 29 29 0a 09 09 .. "\n"))...
5a20: 09 20 20 20 20 28 61 70 6b 74 20 20 20 28 70 6b . (apkt (pk
5a30: 74 2d 3e 61 6c 69 73 74 20 70 6b 74 64 61 74 29 t->alist pktdat)
5a40: 29 0a 09 09 09 20 20 20 20 28 70 74 79 70 65 20 ).... (ptype
5a50: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 54 20 61 (alist-ref 'T a
5a60: 70 6b 74 29 29 29 0a 09 09 20 20 20 20 20 20 20 pkt)))...
5a70: 28 61 64 64 2d 74 6f 2d 71 75 65 75 65 20 70 64 (add-to-queue pd
5a80: 62 20 70 6b 74 64 61 74 20 75 75 69 64 20 28 6f b pktdat uuid (o
5a90: 72 20 70 74 79 70 65 20 27 63 6d 64 29 20 23 66 r ptype 'cmd) #f
5aa0: 20 30 29 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 0))... ;;
5ab0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
5ac0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
5ad0: 74 2a 20 22 41 64 64 65 64 20 22 20 75 75 69 64 t* "Added " uuid
5ae0: 20 22 20 6f 66 20 74 79 70 65 20 22 20 70 74 79 " of type " pty
5af0: 70 65 20 22 20 74 6f 20 71 75 65 75 65 22 29 29 pe " to queue"))
5b00: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 64 65 ... ;; (de
5b10: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
5b20: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
5b30: 70 6b 74 3a 20 22 20 75 75 69 64 20 22 20 65 78 pkt: " uuid " ex
5b40: 69 73 74 73 2c 20 73 6b 69 70 70 69 6e 67 2e 2e ists, skipping..
5b50: 2e 22 29 0a 09 09 20 20 20 20 20 29 29 29 0a 09 .")... )))..
5b60: 20 20 20 20 20 70 6b 74 73 29 29 29 29 29 0a 20 pkts))))).
5b70: 20 20 20 20 20 70 6b 74 73 64 69 72 73 29 29 29 pktsdirs)))
5b80: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
5b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
5bd0: 50 20 52 20 4f 20 43 20 45 20 53 20 53 20 20 20 P R O C E S S
5be0: 50 20 4b 20 54 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d P K T S.;;======
5bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c30: 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 6c 69 73 ..;; given a lis
5c40: 74 20 6f 66 20 66 69 65 6c 64 20 76 61 6c 75 65 t of field value
5c50: 73 20 70 75 6c 6c 65 64 20 66 72 6f 6d 20 74 68 s pulled from th
5c60: 65 20 71 75 65 75 65 20 64 62 20 67 65 6e 65 72 e queue db gener
5c70: 61 74 65 20 61 20 6c 69 73 74 0a 3b 3b 20 6f 66 ate a list.;; of
5c80: 20 64 70 6b 74 27 73 0a 3b 3b 0a 28 64 65 66 69 dpkt's.;;.(defi
5c90: 6e 65 20 28 64 62 6c 73 74 2d 3e 64 70 6b 74 73 ne (dblst->dpkts
5ca0: 20 6c 73 74 20 2e 20 61 6c 74 6d 61 70 29 0a 20 lst . altmap).
5cb0: 20 28 6c 65 74 2a 20 28 28 6d 61 70 6c 73 74 20 (let* ((maplst
5cc0: 28 69 66 20 28 6e 75 6c 6c 3f 20 61 6c 74 6d 61 (if (null? altma
5cd0: 70 29 0a 09 09 20 20 20 20 20 27 28 69 64 20 67 p)... '(id g
5ce0: 72 6f 75 70 2d 69 64 20 75 75 69 64 20 70 61 72 roup-id uuid par
5cf0: 65 6e 74 20 70 6b 74 2d 74 79 70 65 20 70 6b 74 ent pkt-type pkt
5d00: 20 70 72 6f 63 65 73 73 65 64 29 0a 09 09 20 20 processed)...
5d10: 20 20 20 61 6c 74 6d 61 70 29 29 0a 09 20 28 72 altmap)).. (r
5d20: 65 73 20 28 6d 61 70 20 63 6f 6e 73 20 6d 61 70 es (map cons map
5d30: 6c 73 74 20 6c 73 74 29 29 29 20 3b 3b 20 70 72 lst lst))) ;; pr
5d40: 6f 64 75 63 65 73 20 6c 69 73 74 20 6f 66 20 70 oduces list of p
5d50: 61 69 72 73 2c 20 69 2e 65 20 61 6e 20 61 6c 69 airs, i.e an ali
5d60: 73 74 0a 20 20 20 20 28 63 6f 6e 73 20 60 28 61 st. (cons `(a
5d70: 70 6b 74 20 2e 20 2c 28 70 6b 74 2d 3e 61 6c 69 pkt . ,(pkt->ali
5d80: 73 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 70 st (alist-ref 'p
5d90: 6b 74 20 72 65 73 29 29 29 0a 09 20 20 72 65 73 kt res))).. res
5da0: 29 29 29 0a 0a 3b 3b 20 4e 42 2f 2f 20 70 74 79 )))..;; NB// pty
5db0: 70 65 73 20 69 73 20 61 20 6c 69 73 74 20 6f 66 pes is a list of
5dc0: 20 73 79 6d 62 6f 6c 73 2c 20 27 28 29 20 6f 72 symbols, '() or
5dd0: 20 23 66 20 66 69 6e 64 20 61 6c 6c 20 74 79 70 #f find all typ
5de0: 65 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 67 es.;;.(define (g
5df0: 65 74 2d 64 70 6b 74 73 20 64 62 20 70 74 79 70 et-dpkts db ptyp
5e00: 65 73 20 67 72 6f 75 70 2d 69 64 20 70 61 72 65 es group-id pare
5e10: 6e 74 2d 75 75 69 64 20 23 21 6b 65 79 20 28 75 nt-uuid #!key (u
5e20: 75 69 64 20 23 66 29 29 0a 20 20 28 6c 65 74 2a uid #f)). (let*
5e30: 20 28 28 70 74 79 70 65 2d 71 72 79 20 28 69 66 ((ptype-qry (if
5e40: 20 28 61 6e 64 20 70 74 79 70 65 73 0a 09 09 09 (and ptypes....
5e50: 20 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (not (null?
5e60: 20 70 74 79 70 65 73 29 29 29 0a 09 09 09 28 63 ptypes)))....(c
5e70: 6f 6e 63 20 22 20 49 4e 20 28 27 22 20 28 73 74 onc " IN ('" (st
5e80: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
5e90: 20 28 6d 61 70 20 63 6f 6e 63 20 70 74 79 70 65 (map conc ptype
5ea0: 73 29 20 22 27 2c 27 22 29 20 22 27 29 22 29 0a s) "','") "')").
5eb0: 09 09 09 28 63 6f 6e 63 20 22 20 4c 49 4b 45 20 ...(conc " LIKE
5ec0: 27 25 27 20 22 29 29 29 0a 09 20 28 72 6f 77 73 '%' "))).. (rows
5ed0: 20 20 20 20 20 20 28 64 62 69 3a 67 65 74 2d 72 (dbi:get-r
5ee0: 6f 77 73 0a 09 09 20 20 20 20 20 64 62 0a 09 09 ows... db...
5ef0: 20 20 20 20 20 28 63 6f 6e 63 0a 09 09 20 20 20 (conc...
5f00: 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 67 72 "SELECT id,gr
5f10: 6f 75 70 5f 69 64 2c 75 75 69 64 2c 70 61 72 65 oup_id,uuid,pare
5f20: 6e 74 5f 75 75 69 64 2c 70 6b 74 5f 74 79 70 65 nt_uuid,pkt_type
5f30: 2c 70 6b 74 2c 70 72 6f 63 65 73 73 65 64 20 46 ,pkt,processed F
5f40: 52 4f 4d 20 70 6b 74 73 0a 20 20 20 20 20 20 20 ROM pkts.
5f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f60: 20 20 57 48 45 52 45 20 70 6b 74 5f 74 79 70 65 WHERE pkt_type
5f70: 20 22 20 70 74 79 70 65 2d 71 72 79 20 22 20 41 " ptype-qry " A
5f80: 4e 44 20 67 72 6f 75 70 5f 69 64 3d 3f 0a 20 20 ND group_id=?.
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fa0: 20 20 20 20 20 20 20 41 4e 44 20 70 72 6f 63 65 AND proce
5fb0: 73 73 65 64 3d 30 20 22 0a 09 09 09 20 28 69 66 ssed=0 ".... (if
5fc0: 20 70 61 72 65 6e 74 2d 75 75 69 64 20 28 63 6f parent-uuid (co
5fd0: 6e 63 20 22 41 4e 44 20 70 61 72 65 6e 74 5f 75 nc "AND parent_u
5fe0: 75 69 64 3d 27 22 20 70 61 72 65 6e 74 2d 75 75 uid='" parent-uu
5ff0: 69 64 20 22 27 20 22 29 20 22 22 29 0a 09 09 09 id "' ") "")....
6000: 20 28 69 66 20 75 75 69 64 20 20 20 20 20 20 20 (if uuid
6010: 20 28 63 6f 6e 63 20 22 41 4e 44 20 20 20 20 20 (conc "AND
6020: 20 20 20 75 75 69 64 3d 27 22 20 20 20 20 20 20 uuid='"
6030: 20 20 75 75 69 64 20 22 27 20 22 29 20 22 22 29 uuid "' ") "")
6040: 0a 09 09 09 20 22 4f 52 44 45 52 20 42 59 20 69 .... "ORDER BY i
6050: 64 20 44 45 53 43 3b 22 29 0a 09 09 20 20 20 20 d DESC;")...
6060: 20 67 72 6f 75 70 2d 69 64 29 29 29 0a 20 20 20 group-id))).
6070: 20 28 6d 61 70 20 64 62 6c 73 74 2d 3e 64 70 6b (map dblst->dpk
6080: 74 73 20 28 6d 61 70 20 76 65 63 74 6f 72 2d 3e ts (map vector->
6090: 6c 69 73 74 20 72 6f 77 73 29 29 29 29 0a 0a 3b list rows))))..;
60a0: 3b 20 67 65 74 20 4e 20 70 6b 74 73 20 6e 6f 74 ; get N pkts not
60b0: 20 79 65 74 20 70 72 6f 63 65 73 73 65 64 20 66 yet processed f
60c0: 6f 72 20 67 72 6f 75 70 2d 69 64 0a 3b 3b 0a 28 or group-id.;;.(
60d0: 64 65 66 69 6e 65 20 28 67 65 74 2d 6e 6f 74 2d define (get-not-
60e0: 70 72 6f 63 65 73 73 65 64 2d 70 6b 74 73 20 64 processed-pkts d
60f0: 62 20 67 72 6f 75 70 2d 69 64 20 70 6b 74 2d 74 b group-id pkt-t
6100: 79 70 65 20 6c 69 6d 69 74 20 6f 66 66 73 65 74 ype limit offset
6110: 29 0a 20 20 28 6d 61 70 20 64 62 6c 73 74 2d 3e ). (map dblst->
6120: 64 70 6b 74 73 0a 20 20 20 20 20 20 20 28 6d 61 dpkts. (ma
6130: 70 20 76 65 63 74 6f 72 2d 3e 6c 69 73 74 0a 09 p vector->list..
6140: 20 20 20 20 28 64 62 69 3a 67 65 74 2d 72 6f 77 (dbi:get-row
6150: 73 0a 09 20 20 20 20 20 64 62 0a 09 20 20 20 20 s.. db..
6160: 20 22 53 45 4c 45 43 54 20 69 64 2c 67 72 6f 75 "SELECT id,grou
6170: 70 5f 69 64 2c 75 75 69 64 2c 70 61 72 65 6e 74 p_id,uuid,parent
6180: 5f 75 75 69 64 2c 70 6b 74 5f 74 79 70 65 2c 70 _uuid,pkt_type,p
6190: 6b 74 2c 70 72 6f 63 65 73 73 65 64 20 46 52 4f kt,processed FRO
61a0: 4d 20 70 6b 74 73 0a 20 20 20 20 20 20 20 20 20 M pkts.
61b0: 20 20 20 20 20 20 20 57 48 45 52 45 20 70 6b 74 WHERE pkt
61c0: 5f 74 79 70 65 20 3d 20 3f 20 41 4e 44 20 67 72 _type = ? AND gr
61d0: 6f 75 70 5f 69 64 20 3d 20 3f 20 41 4e 44 20 70 oup_id = ? AND p
61e0: 72 6f 63 65 73 73 65 64 3d 30 0a 20 20 20 20 20 rocessed=0.
61f0: 20 20 20 20 20 20 20 20 20 20 20 4c 49 4d 49 54 LIMIT
6200: 20 3f 20 4f 46 46 53 45 54 20 3f 3b 22 0a 09 20 ? OFFSET ?;"..
6210: 20 20 20 20 28 63 6f 6e 63 20 70 6b 74 2d 74 79 (conc pkt-ty
6220: 70 65 29 20 3b 3b 20 63 6f 6e 76 65 72 74 20 73 pe) ;; convert s
6230: 79 6d 62 6f 6c 73 20 74 6f 20 73 74 72 69 6e 67 ymbols to string
6240: 0a 09 20 20 20 20 20 67 72 6f 75 70 2d 69 64 0a .. group-id.
6250: 09 20 20 20 20 20 6c 69 6d 69 74 0a 09 20 20 20 . limit..
6260: 20 20 6f 66 66 73 65 74 0a 09 20 20 20 20 20 29 offset.. )
6270: 29 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 )))..;; given a
6280: 75 75 69 64 2c 20 67 65 74 20 6e 6f 74 20 70 72 uuid, get not pr
6290: 6f 63 65 73 73 65 64 20 63 68 69 6c 64 20 70 6b ocessed child pk
62a0: 74 73 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ts .;;.(define (
62b0: 67 65 74 2d 72 65 6c 61 74 65 64 20 64 62 20 67 get-related db g
62c0: 72 6f 75 70 2d 69 64 20 75 75 69 64 29 0a 20 20 roup-id uuid).
62d0: 28 6d 61 70 20 64 62 6c 73 74 2d 3e 64 70 6b 74 (map dblst->dpkt
62e0: 73 0a 20 20 20 20 20 20 20 28 64 62 69 3a 67 65 s. (dbi:ge
62f0: 74 2d 72 6f 77 73 0a 09 64 62 0a 09 22 53 45 4c t-rows..db.."SEL
6300: 45 43 54 20 69 64 2c 67 72 6f 75 70 5f 69 64 2c ECT id,group_id,
6310: 75 75 69 64 2c 70 61 72 65 6e 74 5f 75 75 69 64 uuid,parent_uuid
6320: 2c 70 6b 74 5f 74 79 70 65 2c 70 6b 74 2c 70 72 ,pkt_type,pkt,pr
6330: 6f 63 65 73 73 65 64 20 46 52 4f 4d 20 70 6b 74 ocessed FROM pkt
6340: 73 0a 20 20 20 20 20 20 20 20 20 20 20 57 48 45 s. WHE
6350: 52 45 20 70 61 72 65 6e 74 5f 75 75 69 64 3d 3f RE parent_uuid=?
6360: 20 41 4e 44 20 67 72 6f 75 70 5f 69 64 3d 3f 20 AND group_id=?
6370: 41 4e 44 20 70 72 6f 63 65 73 73 65 64 3d 30 3b AND processed=0;
6380: 22 0a 09 75 75 69 64 20 67 72 6f 75 70 2d 69 64 "..uuid group-id
6390: 29 29 29 0a 0a 3b 3b 20 67 65 6e 65 72 69 63 20 )))..;; generic
63a0: 70 6b 74 20 70 72 6f 63 65 73 73 6f 72 0a 3b 3b pkt processor.;;
63b0: 0a 3b 3b 20 66 69 6e 64 20 61 6c 6c 20 70 61 63 .;; find all pac
63c0: 6b 65 74 73 20 69 6e 20 67 72 6f 75 70 2d 69 64 kets in group-id
63d0: 20 6f 66 20 74 79 70 65 20 69 6e 20 70 74 79 70 of type in ptyp
63e0: 65 73 20 61 6e 64 20 61 70 70 6c 79 20 70 72 6f es and apply pro
63f0: 63 20 74 6f 20 70 6b 74 64 61 74 0a 3b 3b 0a 28 c to pktdat.;;.(
6400: 64 65 66 69 6e 65 20 28 70 72 6f 63 65 73 73 2d define (process-
6410: 70 6b 74 73 20 63 6f 6e 6e 20 67 72 6f 75 70 2d pkts conn group-
6420: 69 64 20 70 74 79 70 65 73 20 70 61 72 65 6e 74 id ptypes parent
6430: 2d 75 75 69 64 20 70 72 6f 63 29 0a 20 20 28 6c -uuid proc). (l
6440: 65 74 2a 20 28 28 70 6b 74 73 20 28 67 65 74 2d et* ((pkts (get-
6450: 64 70 6b 74 73 20 63 6f 6e 6e 20 70 74 79 70 65 dpkts conn ptype
6460: 73 20 67 72 6f 75 70 2d 69 64 20 70 61 72 65 6e s group-id paren
6470: 74 2d 75 75 69 64 29 29 29 0a 20 20 20 20 28 6d t-uuid))). (m
6480: 61 70 20 70 72 6f 63 20 70 6b 74 73 29 29 29 0a ap proc pkts))).
6490: 0a 3b 3b 20 63 72 69 74 65 72 69 61 20 69 73 20 .;; criteria is
64a0: 61 6e 20 61 6c 69 73 74 20 28 28 6b 20 2e 20 76 an alist ((k . v
64b0: 61 6c 70 61 74 74 29 20 2e 2e 2e 29 0a 3b 3b 20 alpatt) ...).;;
64c0: 20 20 2d 20 76 61 6c 70 61 74 74 20 69 73 20 61 - valpatt is a
64d0: 20 72 65 67 65 78 0a 3b 3b 20 20 20 2d 20 70 74 regex.;; - pt
64e0: 79 70 65 73 20 69 73 20 61 20 6c 69 73 74 20 6f ypes is a list o
64f0: 66 20 74 79 70 65 73 20 28 73 79 6d 62 6f 6c 73 f types (symbols
6500: 20 65 78 70 65 63 74 65 64 29 0a 3b 3b 20 20 20 expected).;;
6510: 6d 61 74 63 68 2d 74 79 70 65 3a 20 27 61 6e 79 match-type: 'any
6520: 20 6f 72 20 27 61 6c 6c 0a 3b 3b 0a 28 64 65 66 or 'all.;;.(def
6530: 69 6e 65 20 28 66 69 6e 64 2d 70 6b 74 73 20 64 ine (find-pkts d
6540: 62 20 70 74 79 70 65 73 20 63 72 69 74 65 72 69 b ptypes criteri
6550: 61 20 23 21 6b 65 79 20 28 70 72 6f 63 65 73 73 a #!key (process
6560: 65 64 20 23 66 29 28 6d 61 74 63 68 2d 74 79 70 ed #f)(match-typ
6570: 65 20 27 61 6e 79 29 28 70 6b 74 2d 73 70 65 63 e 'any)(pkt-spec
6580: 20 23 66 29 29 20 3b 3b 20 70 72 6f 63 65 73 73 #f)) ;; process
6590: 65 64 3d 23 66 2c 20 64 6f 6e 27 74 20 75 73 65 ed=#f, don't use
65a0: 2c 20 65 6c 73 65 20 75 73 65 0a 20 20 28 6c 65 , else use. (le
65b0: 74 2a 20 28 28 70 6b 74 73 20 28 67 65 74 2d 64 t* ((pkts (get-d
65c0: 70 6b 74 73 20 64 62 20 70 74 79 70 65 73 20 30 pkts db ptypes 0
65d0: 20 23 66 29 29 0a 09 20 28 6d 61 74 63 68 2d 72 #f)).. (match-r
65e0: 75 6c 65 73 20 28 6c 61 6d 62 64 61 20 28 70 6b ules (lambda (pk
65f0: 74 64 61 74 29 20 3b 3b 20 72 65 74 75 72 6e 73 tdat) ;; returns
6600: 20 61 20 6c 69 73 74 20 6f 66 20 6d 61 74 63 68 a list of match
6610: 69 6e 67 20 72 75 6c 65 73 0a 09 09 09 28 66 69 ing rules....(fi
6620: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 63 29 lter (lambda (c)
6630: 0a 09 09 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 ..... ;; (print
6640: 20 22 63 3a 20 22 20 63 29 0a 09 09 09 09 20 20 "c: " c).....
6650: 28 6c 65 74 2a 20 28 28 63 74 79 70 65 20 28 63 (let* ((ctype (c
6660: 61 72 20 63 29 29 20 3b 3b 20 63 61 72 64 20 74 ar c)) ;; card t
6670: 79 70 65 0a 09 09 09 09 09 20 28 72 78 20 20 20 ype...... (rx
6680: 20 28 63 64 72 20 63 29 29 20 3b 3b 20 63 61 72 (cdr c)) ;; car
6690: 64 20 70 61 74 74 65 72 6e 0a 09 09 09 09 09 20 d pattern......
66a0: 3b 3b 20 28 74 20 20 20 20 20 28 61 6c 69 73 74 ;; (t (alist
66b0: 2d 72 65 66 20 27 70 6b 74 2d 74 79 70 65 20 70 -ref 'pkt-type p
66c0: 6b 74 64 61 74 29 29 0a 09 09 09 09 09 20 28 70 ktdat))...... (p
66d0: 6b 74 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 kt (alist-ref
66e0: 27 70 6b 74 20 70 6b 74 64 61 74 29 29 0a 09 09 'pkt pktdat))...
66f0: 09 09 09 20 28 61 70 6b 74 20 20 28 70 6b 74 2d ... (apkt (pkt-
6700: 3e 61 6c 69 73 74 20 70 6b 74 29 29 0a 09 09 09 >alist pkt))....
6710: 09 09 20 28 63 64 61 74 20 20 28 61 6c 69 73 74 .. (cdat (alist
6720: 2d 72 65 66 20 63 74 79 70 65 20 61 70 6b 74 29 -ref ctype apkt)
6730: 29 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 28 70 ))..... ;; (p
6740: 72 69 6e 74 20 22 63 64 61 74 3a 20 22 20 63 64 rint "cdat: " cd
6750: 61 74 29 20 3b 3b 20 22 20 61 70 6b 74 3a 20 22 at) ;; " apkt: "
6760: 20 61 70 6b 74 29 0a 09 09 09 09 20 20 20 20 28 apkt)..... (
6770: 69 66 20 63 64 61 74 0a 09 09 09 09 09 28 73 74 if cdat......(st
6780: 72 69 6e 67 2d 6d 61 74 63 68 20 72 78 20 63 64 ring-match rx cd
6790: 61 74 29 0a 09 09 09 09 09 23 66 29 29 29 0a 09 at)......#f)))..
67a0: 09 09 09 63 72 69 74 65 72 69 61 29 29 29 0a 09 ...criteria)))..
67b0: 20 28 72 65 73 20 20 20 20 20 20 20 20 20 28 66 (res (f
67c0: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 70 ilter (lambda (p
67d0: 6b 74 64 61 74 29 0a 09 09 09 09 28 69 66 20 28 ktdat).....(if (
67e0: 6e 75 6c 6c 3f 20 63 72 69 74 65 72 69 61 29 20 null? criteria)
67f0: 3b 3b 20 6c 6f 6f 6b 69 6e 67 20 66 6f 72 20 61 ;; looking for a
6800: 6c 6c 20 70 6b 74 73 0a 09 09 09 09 20 20 20 20 ll pkts.....
6810: 23 74 0a 09 09 09 09 20 20 20 20 28 63 61 73 65 #t..... (case
6820: 20 6d 61 74 63 68 2d 74 79 70 65 0a 09 09 09 09 match-type.....
6830: 20 20 20 20 20 20 28 28 61 6e 79 29 28 6e 6f 74 ((any)(not
6840: 20 28 6e 75 6c 6c 3f 20 28 6d 61 74 63 68 2d 72 (null? (match-r
6850: 75 6c 65 73 20 70 6b 74 64 61 74 29 29 29 29 0a ules pktdat)))).
6860: 09 09 09 09 20 20 20 20 20 20 28 28 61 6c 6c 29 .... ((all)
6870: 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 28 6d 61 (eq? (length (ma
6880: 74 63 68 2d 72 75 6c 65 73 20 70 6b 74 64 61 74 tch-rules pktdat
6890: 29 29 28 6c 65 6e 67 74 68 20 63 72 69 74 65 72 ))(length criter
68a0: 69 61 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 ia))).....
68b0: 28 65 6c 73 65 0a 09 09 09 09 20 20 20 20 20 20 (else.....
68c0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
68d0: 62 61 64 20 6d 61 74 63 68 20 74 79 70 65 20 22 bad match type "
68e0: 20 6d 61 74 63 68 2d 74 79 70 65 20 22 2c 20 65 match-type ", e
68f0: 78 70 65 63 74 69 6e 67 20 61 6e 79 20 6f 72 20 xpecting any or
6900: 61 6c 6c 2e 22 29 29 29 29 29 0a 09 09 09 20 20 all.")))))....
6910: 20 20 20 20 70 6b 74 73 29 29 29 0a 20 20 20 20 pkts))).
6920: 28 69 66 20 70 6b 74 2d 73 70 65 63 0a 09 28 64 (if pkt-spec..(d
6930: 70 6b 74 73 2d 3e 61 6c 69 73 74 73 20 72 65 73 pkts->alists res
6940: 20 70 6b 74 2d 73 70 65 63 29 0a 09 72 65 73 29 pkt-spec)..res)
6950: 29 29 0a 0a 3b 3b 20 67 65 74 20 64 65 73 63 65 ))..;; get desce
6960: 6e 64 65 6e 74 73 20 6f 66 20 70 61 72 65 6e 74 ndents of parent
6970: 2d 75 75 69 64 0a 3b 3b 0a 3b 3b 20 4e 4f 54 45 -uuid.;;.;; NOTE
6980: 3a 20 53 68 6f 75 6c 64 20 62 65 20 64 6f 69 6e : Should be doin
6990: 67 20 73 6f 6d 65 74 68 69 6e 67 20 6c 69 6b 65 g something like
69a0: 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 3a 0a the following:.
69b0: 3b 3b 0a 3b 3b 20 67 69 76 65 6e 20 61 20 75 75 ;;.;; given a uu
69c0: 69 64 2c 20 67 65 74 20 6e 6f 74 20 70 72 6f 63 id, get not proc
69d0: 65 73 73 65 64 20 63 68 69 6c 64 20 70 6b 74 73 essed child pkts
69e0: 20 0a 3b 3b 20 70 72 6f 63 65 73 73 65 64 3a 0a .;; processed:.
69f0: 3b 3b 20 20 20 20 23 66 20 3d 3e 20 67 65 74 20 ;; #f => get
6a00: 61 6c 6c 0a 3b 3b 20 20 20 20 20 30 20 3d 3e 20 all.;; 0 =>
6a10: 67 65 74 20 6e 6f 74 20 70 72 6f 63 65 73 73 65 get not processe
6a20: 64 0a 3b 3b 20 20 20 20 20 31 20 3d 3e 20 67 65 d.;; 1 => ge
6a30: 74 20 70 72 6f 63 65 73 73 65 64 0a 3b 3b 0a 28 t processed.;;.(
6a40: 64 65 66 69 6e 65 20 28 67 65 74 2d 61 6e 63 65 define (get-ance
6a50: 73 74 6f 72 73 20 64 62 20 67 72 6f 75 70 2d 69 stors db group-i
6a60: 64 20 75 75 69 64 20 23 21 6b 65 79 20 28 70 72 d uuid #!key (pr
6a70: 6f 63 65 73 73 65 64 20 23 66 29 29 0a 20 20 28 ocessed #f)). (
6a80: 6d 61 70 20 64 62 6c 73 74 2d 3e 64 70 6b 74 73 map dblst->dpkts
6a90: 0a 20 20 20 20 20 20 20 28 6d 61 70 20 76 65 63 . (map vec
6aa0: 74 6f 72 2d 3e 6c 69 73 74 0a 09 20 20 20 20 28 tor->list.. (
6ab0: 64 62 69 3a 67 65 74 2d 72 6f 77 73 0a 09 20 20 dbi:get-rows..
6ac0: 20 20 20 64 62 0a 09 20 20 20 20 20 28 63 6f 6e db.. (con
6ad0: 63 0a 09 20 20 20 20 20 20 22 53 45 4c 45 43 54 c.. "SELECT
6ae0: 20 69 64 2c 67 72 6f 75 70 5f 69 64 2c 75 75 69 id,group_id,uui
6af0: 64 2c 70 61 72 65 6e 74 5f 75 75 69 64 2c 70 6b d,parent_uuid,pk
6b00: 74 5f 74 79 70 65 2c 70 6b 74 2c 70 72 6f 63 65 t_type,pkt,proce
6b10: 73 73 65 64 20 0a 20 20 20 20 20 20 20 20 20 20 ssed .
6b20: 20 20 20 20 20 20 46 52 4f 4d 20 70 6b 74 73 0a FROM pkts.
6b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b40: 20 57 48 45 52 45 20 75 75 69 64 20 49 4e 20 0a WHERE uuid IN .
6b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b60: 20 20 20 20 20 28 57 49 54 48 20 52 45 43 55 52 (WITH RECUR
6b70: 53 49 56 45 0a 20 20 20 20 20 20 20 20 20 20 20 SIVE.
6b80: 20 20 20 20 20 20 20 20 20 20 20 20 74 72 65 65 tree
6b90: 28 75 75 69 64 2c 70 61 72 65 6e 74 5f 75 75 69 (uuid,parent_uui
6ba0: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
6bb0: 20 20 20 20 20 20 20 20 20 20 20 41 53 0a 20 20 AS.
6bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6bd0: 20 20 20 20 20 20 28 0a 20 20 20 20 20 20 20 20 (.
6be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6bf0: 20 20 20 53 45 4c 45 43 54 20 75 75 69 64 2c 20 SELECT uuid,
6c00: 70 61 72 65 6e 74 5f 75 75 69 64 0a 20 20 20 20 parent_uuid.
6c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c20: 20 20 20 20 20 20 20 46 52 4f 4d 20 70 6b 74 73 FROM pkts
6c30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6c40: 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 WHER
6c50: 45 20 75 75 69 64 20 3d 20 3f 0a 20 20 20 20 20 E uuid = ?.
6c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c70: 20 20 20 20 20 20 55 4e 49 4f 4e 20 41 4c 4c 0a UNION ALL.
6c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c90: 20 20 20 20 20 20 20 20 20 20 20 53 45 4c 45 43 SELEC
6ca0: 54 20 74 2e 75 75 69 64 2c 20 74 2e 70 61 72 65 T t.uuid, t.pare
6cb0: 6e 74 5f 75 75 69 64 0a 20 20 20 20 20 20 20 20 nt_uuid.
6cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6cd0: 20 20 20 46 52 4f 4d 20 70 6b 74 73 20 74 0a 20 FROM pkts t.
6ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6cf0: 20 20 20 20 20 20 20 20 20 20 4a 4f 49 4e 20 74 JOIN t
6d00: 72 65 65 20 4f 4e 20 74 2e 75 75 69 64 20 3d 20 ree ON t.uuid =
6d10: 74 72 65 65 2e 70 61 72 65 6e 74 5f 75 75 69 64 tree.parent_uuid
6d20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6d30: 20 20 20 20 20 20 20 20 20 29 0a 09 20 20 20 20 )..
6d40: 20 20 20 20 20 20 20 20 20 20 53 45 4c 45 43 54 SELECT
6d50: 20 75 75 69 64 20 46 52 4f 4d 20 74 72 65 65 29 uuid FROM tree)
6d60: 0a 09 20 20 20 20 41 4e 44 20 67 72 6f 75 70 5f .. AND group_
6d70: 69 64 3d 3f 22 20 28 69 66 20 70 72 6f 63 65 73 id=?" (if proces
6d80: 73 65 64 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 sed (conc " AND
6d90: 70 72 6f 63 65 73 73 65 64 3d 22 20 70 72 6f 63 processed=" proc
6da0: 65 73 73 65 64 29 20 22 22 29 20 22 3b 22 29 0a essed) "") ";").
6db0: 09 20 20 20 20 20 75 75 69 64 20 67 72 6f 75 70 . uuid group
6dc0: 2d 69 64 29 29 29 29 0a 0a 3b 3b 20 55 6e 74 65 -id))))..;; Unte
6dd0: 73 74 65 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 sted.;;.(define
6de0: 28 67 65 74 2d 64 65 73 63 65 6e 64 65 6e 74 73 (get-descendents
6df0: 20 64 62 20 67 72 6f 75 70 2d 69 64 20 75 75 69 db group-id uui
6e00: 64 20 23 21 6b 65 79 20 28 70 72 6f 63 65 73 73 d #!key (process
6e10: 65 64 20 23 66 29 29 0a 20 20 28 6d 61 70 20 64 ed #f)). (map d
6e20: 62 6c 73 74 2d 3e 64 70 6b 74 73 0a 20 20 20 20 blst->dpkts.
6e30: 20 20 20 28 6d 61 70 20 76 65 63 74 6f 72 2d 3e (map vector->
6e40: 6c 69 73 74 0a 09 20 20 20 20 28 64 62 69 3a 67 list.. (dbi:g
6e50: 65 74 2d 72 6f 77 73 0a 09 20 20 20 20 20 64 62 et-rows.. db
6e60: 0a 09 20 20 20 20 20 28 63 6f 6e 63 0a 09 20 20 .. (conc..
6e70: 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 67 "SELECT id,g
6e80: 72 6f 75 70 5f 69 64 2c 75 75 69 64 2c 70 61 72 roup_id,uuid,par
6e90: 65 6e 74 5f 75 75 69 64 2c 70 6b 74 5f 74 79 70 ent_uuid,pkt_typ
6ea0: 65 2c 70 6b 74 2c 70 72 6f 63 65 73 73 65 64 20 e,pkt,processed
6eb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6ec0: 20 46 52 4f 4d 20 70 6b 74 73 0a 20 20 20 20 20 FROM pkts.
6ed0: 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 WHER
6ee0: 45 20 75 75 69 64 20 49 4e 20 0a 20 20 20 20 20 E uuid IN .
6ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f00: 28 57 49 54 48 20 52 45 43 55 52 53 49 56 45 0a (WITH RECURSIVE.
6f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f20: 20 20 20 20 20 20 20 74 72 65 65 28 75 75 69 64 tree(uuid
6f30: 2c 70 61 72 65 6e 74 5f 75 75 69 64 29 0a 20 20 ,parent_uuid).
6f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f50: 20 20 20 20 20 20 41 53 0a 20 20 20 20 20 20 20 AS.
6f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f70: 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 (.
6f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 53 45 SE
6f90: 4c 45 43 54 20 75 75 69 64 2c 20 70 61 72 65 6e LECT uuid, paren
6fa0: 74 5f 75 75 69 64 0a 20 20 20 20 20 20 20 20 20 t_uuid.
6fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fc0: 20 20 46 52 4f 4d 20 70 6b 74 73 0a 20 20 20 20 FROM pkts.
6fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fe0: 20 20 20 20 20 20 20 57 48 45 52 45 20 75 75 69 WHERE uui
6ff0: 64 20 3d 20 3f 0a 20 20 20 20 20 20 20 20 20 20 d = ?.
7000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7010: 20 55 4e 49 4f 4e 20 41 4c 4c 0a 20 20 20 20 20 UNION ALL.
7020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7030: 20 20 20 20 20 20 53 45 4c 45 43 54 20 74 2e 75 SELECT t.u
7040: 75 69 64 2c 20 74 2e 70 61 72 65 6e 74 5f 75 75 uid, t.parent_uu
7050: 69 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 id.
7060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 46 52 FR
7070: 4f 4d 20 70 6b 74 73 20 74 0a 20 20 20 20 20 20 OM pkts t.
7080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7090: 20 20 20 20 20 4a 4f 49 4e 20 74 72 65 65 20 4f JOIN tree O
70a0: 4e 20 74 2e 70 61 72 65 6e 74 5f 75 75 69 64 20 N t.parent_uuid
70b0: 3d 20 74 72 65 65 2e 75 75 69 64 0a 20 20 20 20 = tree.uuid.
70c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70d0: 20 20 20 20 29 0a 09 20 20 20 20 20 20 20 20 20 )..
70e0: 20 20 20 20 20 53 45 4c 45 43 54 20 75 75 69 64 SELECT uuid
70f0: 20 46 52 4f 4d 20 74 72 65 65 29 0a 09 20 20 20 FROM tree)..
7100: 20 41 4e 44 20 67 72 6f 75 70 5f 69 64 3d 3f 22 AND group_id=?"
7110: 20 28 69 66 20 70 72 6f 63 65 73 73 65 64 20 28 (if processed (
7120: 63 6f 6e 63 20 22 20 41 4e 44 20 70 72 6f 63 65 conc " AND proce
7130: 73 73 65 64 3d 22 20 70 72 6f 63 65 73 73 65 64 ssed=" processed
7140: 29 20 22 22 29 20 22 3b 22 29 0a 09 20 20 20 20 ) "") ";")..
7150: 20 75 75 69 64 20 67 72 6f 75 70 2d 69 64 29 29 uuid group-id))
7160: 29 29 0a 0a 3b 3b 20 6c 6f 6f 6b 20 75 70 20 64 ))..;; look up d
7170: 65 73 63 65 6e 64 65 6e 74 73 20 62 61 73 65 64 escendents based
7180: 20 6f 6e 20 67 69 76 65 6e 20 69 6e 66 6f 20 75 on given info u
7190: 6e 6c 65 73 73 20 70 61 73 73 65 64 20 69 6e 20 nless passed in
71a0: 61 20 6c 69 73 74 20 76 69 61 20 69 6e 6c 73 74 a list via inlst
71b0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 67 65 74 .;;.(define (get
71c0: 2d 6c 61 73 74 2d 64 65 73 63 65 6e 64 65 6e 74 -last-descendent
71d0: 20 64 62 20 67 72 6f 75 70 2d 69 64 20 75 75 69 db group-id uui
71e0: 64 20 23 21 6b 65 79 20 28 70 72 6f 63 65 73 73 d #!key (process
71f0: 65 64 20 23 66 29 28 69 6e 6c 73 74 20 23 66 29 ed #f)(inlst #f)
7200: 29 0a 20 20 28 6c 65 74 20 28 28 64 65 73 63 65 ). (let ((desce
7210: 6e 64 65 6e 74 73 20 28 6f 72 20 69 6e 6c 73 74 ndents (or inlst
7220: 20 28 67 65 74 2d 64 65 73 63 65 6e 64 65 6e 74 (get-descendent
7230: 73 20 64 62 20 67 72 6f 75 70 2d 69 64 20 75 75 s db group-id uu
7240: 69 64 20 70 72 6f 63 65 73 73 65 64 3a 20 70 72 id processed: pr
7250: 6f 63 65 73 73 65 64 29 29 29 29 0a 20 20 20 20 ocessed)))).
7260: 28 69 66 20 28 6e 75 6c 6c 3f 20 64 65 73 63 65 (if (null? desce
7270: 6e 64 65 6e 74 73 29 0a 09 23 66 0a 09 28 6c 61 ndents)..#f..(la
7280: 73 74 20 64 65 73 63 65 6e 64 65 6e 74 73 29 29 st descendents))
7290: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
72a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
72e0: 20 41 20 52 20 43 20 48 20 49 20 56 20 45 20 53 A R C H I V E S
72f0: 20 2d 20 61 6c 77 61 79 73 20 74 6f 20 61 20 73 - always to a s
7300: 71 6c 69 74 65 33 20 64 62 20 0a 3b 3b 3d 3d 3d qlite3 db .;;===
7310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7350: 3d 3d 3d 0a 0a 3b 3b 20 6f 70 65 6e 20 61 6e 20 ===..;; open an
7360: 61 72 63 68 69 76 65 20 64 62 0a 3b 3b 20 70 61 archive db.;; pa
7370: 74 68 3a 20 61 72 63 68 69 76 65 2d 64 69 72 2f th: archive-dir/
7380: 3c 79 65 61 72 3e 2f 6d 6f 6e 74 68 2e 64 62 0a <year>/month.db.
7390: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 72 63 68 ;;.(define (arch
73a0: 69 76 65 2d 6f 70 65 6e 2d 64 62 20 61 72 63 68 ive-open-db arch
73b0: 69 76 65 2d 64 69 72 29 0a 20 20 28 6c 65 74 2a ive-dir). (let*
73c0: 20 28 28 63 75 72 72 2d 74 69 6d 65 20 28 73 65 ((curr-time (se
73d0: 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d conds->local-tim
73e0: 65 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e e (current-secon
73f0: 64 73 29 29 29 0a 09 20 28 64 62 70 61 74 68 20 ds))).. (dbpath
7400: 20 20 20 28 63 6f 6e 63 20 61 72 63 68 69 76 65 (conc archive
7410: 2d 64 69 72 20 22 2f 22 20 28 74 69 6d 65 2d 3e -dir "/" (time->
7420: 73 74 72 69 6e 67 20 63 75 72 72 2d 74 69 6d 65 string curr-time
7430: 20 22 25 59 22 29 29 29 0a 09 20 28 64 62 66 69 "%Y"))).. (dbfi
7440: 6c 65 20 20 20 20 28 63 6f 6e 63 20 64 62 70 61 le (conc dbpa
7450: 74 68 20 22 2f 22 20 28 74 69 6d 65 2d 3e 73 74 th "/" (time->st
7460: 72 69 6e 67 20 63 75 72 72 2d 74 69 6d 65 20 22 ring curr-time "
7470: 25 6d 22 29 20 22 2e 64 62 22 29 29 0a 09 20 28 %m") ".db")).. (
7480: 64 62 65 78 69 73 74 73 20 28 69 66 20 28 66 69 dbexists (if (fi
7490: 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 66 69 6c le-exists? dbfil
74a0: 65 29 20 23 74 20 28 62 65 67 69 6e 20 28 63 72 e) #t (begin (cr
74b0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 64 eate-directory d
74c0: 62 70 61 74 68 20 23 74 29 20 23 66 29 29 29 29 bpath #t) #f))))
74d0: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 28 . (let ((db (
74e0: 64 62 69 3a 6f 70 65 6e 20 27 73 71 6c 69 74 65 dbi:open 'sqlite
74f0: 33 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 27 64 3 (list (cons 'd
7500: 62 6e 61 6d 65 20 64 62 66 69 6c 65 29 29 29 29 bname dbfile))))
7510: 29 0a 20 20 20 20 20 20 3b 3b 20 28 73 65 74 2d ). ;; (set-
7520: 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 busy-handler! db
7530: 20 28 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 31 (busy-timeout 1
7540: 30 30 30 30 29 29 0a 20 20 20 20 20 20 28 69 66 0000)). (if
7550: 20 28 6e 6f 74 20 64 62 65 78 69 73 74 73 29 20 (not dbexists)
7560: 3b 3b 20 4e 4f 54 45 3a 20 49 6e 20 74 68 65 20 ;; NOTE: In the
7570: 61 72 63 68 69 76 65 20 77 65 20 61 6c 6c 6f 77 archive we allow
7580: 20 64 75 70 6c 69 63 61 74 65 73 20 61 6e 64 20 duplicates and
7590: 6f 74 68 65 72 20 6d 65 73 73 69 6e 65 73 73 2e other messiness.
75a0: 20 0a 09 20 20 28 64 62 69 3a 65 78 65 63 20 64 .. (dbi:exec d
75b0: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 b "CREATE TABLE
75c0: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 70 6b IF NOT EXISTS pk
75d0: 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ts.
75e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 64 (id
75f0: 20 20 20 20 20 20 20 20 20 20 20 49 4e 54 45 47 INTEG
7600: 45 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 ER,.
7610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 g
7620: 72 6f 75 70 5f 69 64 20 20 20 20 20 49 4e 54 45 roup_id INTE
7630: 47 45 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 GER,.
7640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7650: 75 75 69 64 20 20 20 20 20 20 20 20 20 54 45 58 uuid TEX
7660: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
7670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 pa
7680: 72 65 6e 74 5f 75 75 69 64 20 20 54 45 58 54 2c rent_uuid TEXT,
7690: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
76a0: 20 20 20 20 20 20 20 20 20 20 20 20 70 6b 74 5f pkt_
76b0: 74 79 70 65 20 20 20 20 20 54 45 58 54 2c 0a 20 type TEXT,.
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 20 20 20 20 20 20 20 20 20 70 6b 74 20 20 20 pkt
76e0: 20 20 20 20 20 20 20 54 45 58 54 2c 0a 20 20 20 TEXT,.
76f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7700: 20 20 20 20 20 20 20 20 70 72 6f 63 65 73 73 65 processe
7710: 64 20 20 20 20 49 4e 54 45 47 45 52 20 44 45 46 d INTEGER DEF
7720: 41 55 4c 54 20 30 29 22 29 29 0a 20 20 20 20 20 AULT 0)")).
7730: 20 64 62 29 29 29 0a 0a 3b 3b 20 74 75 72 6e 20 db)))..;; turn
7740: 6f 6e 20 74 72 61 6e 73 61 63 74 69 6f 6e 73 21 on transactions!
7750: 20 6f 74 68 65 72 77 69 73 65 20 74 68 69 73 20 otherwise this
7760: 77 69 6c 6c 20 62 65 20 70 61 69 6e 66 75 6c 6c will be painfull
7770: 79 20 73 6c 6f 77 0a 3b 3b 0a 28 64 65 66 69 6e y slow.;;.(defin
7780: 65 20 28 77 72 69 74 65 2d 61 72 63 68 69 76 65 e (write-archive
7790: 2d 70 6b 74 73 20 73 72 63 2d 64 62 20 64 62 20 -pkts src-db db
77a0: 70 6b 74 2d 69 64 73 29 0a 20 20 28 6c 65 74 20 pkt-ids). (let
77b0: 28 28 70 6b 74 73 20 28 64 62 69 3a 67 65 74 2d ((pkts (dbi:get-
77c0: 72 6f 77 73 0a 09 20 20 20 20 20 20 20 73 72 63 rows.. src
77d0: 2d 64 62 0a 09 20 20 20 20 20 20 20 28 63 6f 6e -db.. (con
77e0: 63 20 22 53 45 4c 45 43 54 20 69 64 2c 67 72 6f c "SELECT id,gro
77f0: 75 70 5f 69 64 2c 75 75 69 64 2c 70 61 72 65 6e up_id,uuid,paren
7800: 74 5f 75 75 69 64 2c 70 6b 74 5f 74 79 70 65 2c t_uuid,pkt_type,
7810: 70 6b 74 20 46 52 4f 4d 20 70 6b 74 73 20 57 48 pkt FROM pkts WH
7820: 45 52 45 20 69 64 20 49 4e 20 28 22 0a 09 09 20 ERE id IN ("...
7830: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
7840: 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 6f 6e rsperse (map con
7850: 63 20 70 6b 74 2d 69 64 73 29 20 22 2c 22 29 20 c pkt-ids) ",")
7860: 22 29 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 ")")))). ;; (
7870: 64 62 69 3a 77 69 74 68 2d 74 72 61 6e 73 61 63 dbi:with-transac
7880: 74 69 6f 6e 0a 20 20 20 20 3b 3b 20 20 64 62 0a tion. ;; db.
7890: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
78a0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
78b0: 0a 09 28 6c 61 6d 62 64 61 20 28 70 6b 74 29 0a ..(lambda (pkt).
78c0: 09 20 20 28 61 70 70 6c 79 20 64 62 69 3a 65 78 . (apply dbi:ex
78d0: 65 63 20 20 64 62 20 22 49 4e 53 45 52 54 20 49 ec db "INSERT I
78e0: 4e 54 4f 20 70 6b 74 73 20 28 69 64 2c 67 72 6f NTO pkts (id,gro
78f0: 75 70 5f 69 64 2c 75 75 69 64 2c 70 61 72 65 6e up_id,uuid,paren
7900: 74 5f 75 75 69 64 2c 70 6b 74 5f 74 79 70 65 2c t_uuid,pkt_type,
7910: 70 6b 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 pkt).
7920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7930: 20 20 20 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c VALUES (?,?,
7940: 3f 2c 3f 2c 3f 2c 3f 29 22 0a 09 09 20 70 6b 74 ?,?,?,?)"... pkt
7950: 29 29 0a 09 70 6b 74 73 29 29 29 29 20 3b 3b 20 ))..pkts)))) ;;
7960: 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 6c 69 )..;; given a li
7970: 73 74 20 6f 66 20 75 75 69 64 73 20 61 6e 64 20 st of uuids and
7980: 6c 69 73 74 73 20 6f 66 20 75 75 69 64 73 20 6d lists of uuids m
7990: 6f 76 65 20 61 6c 6c 20 74 6f 0a 3b 3b 20 74 68 ove all to.;; th
79a0: 65 20 73 71 6c 69 74 65 33 20 64 62 20 66 6f 72 e sqlite3 db for
79b0: 20 74 68 65 20 63 75 72 72 65 6e 74 20 61 72 63 the current arc
79c0: 68 69 76 65 20 70 65 72 69 6f 64 0a 3b 3b 0a 28 hive period.;;.(
79d0: 64 65 66 69 6e 65 20 28 61 72 63 68 69 76 65 2d define (archive-
79e0: 70 6b 74 73 20 63 6f 6e 6e 20 70 6b 74 2d 69 64 pkts conn pkt-id
79f0: 73 20 61 72 63 68 69 76 65 2d 64 69 72 29 0a 20 s archive-dir).
7a00: 20 28 6c 65 74 20 28 28 64 62 20 28 61 72 63 68 (let ((db (arch
7a10: 69 76 65 2d 6f 70 65 6e 2d 64 62 20 61 72 63 68 ive-open-db arch
7a20: 69 76 65 2d 64 69 72 29 29 29 0a 20 20 20 20 28 ive-dir))). (
7a30: 77 72 69 74 65 2d 61 72 63 68 69 76 65 2d 70 6b write-archive-pk
7a40: 74 73 20 63 6f 6e 6e 20 64 62 20 70 6b 74 2d 69 ts conn db pkt-i
7a50: 64 73 29 0a 20 20 20 20 28 64 62 69 3a 63 6c 6f ds). (dbi:clo
7a60: 73 65 20 64 62 29 29 0a 20 20 3b 3b 20 28 70 67 se db)). ;; (pg
7a70: 3a 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f :with-transactio
7a80: 6e 0a 20 20 3b 3b 20 20 63 6f 6e 6e 0a 20 20 3b n. ;; conn. ;
7a90: 3b 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 ; (lambda ().
7aa0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each.
7ab0: 20 20 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 09 (lambda (id)..
7ac0: 28 64 62 69 3a 67 65 74 2d 6f 6e 65 0a 09 20 63 (dbi:get-one.. c
7ad0: 6f 6e 6e 0a 09 20 22 44 45 4c 45 54 45 20 46 52 onn.. "DELETE FR
7ae0: 4f 4d 20 70 6b 74 73 20 57 48 45 52 45 20 69 64 OM pkts WHERE id
7af0: 3d 3f 22 20 69 64 29 29 0a 20 20 20 20 20 20 70 =?" id)). p
7b00: 6b 74 2d 69 64 73 29 29 20 3b 3b 20 29 29 0a 0a kt-ids)) ;; ))..
7b10: 3b 3b 20 67 69 76 65 6e 20 61 20 6c 69 73 74 20 ;; given a list
7b20: 6f 66 20 69 64 73 20 6d 61 72 6b 20 61 6c 6c 20 of ids mark all
7b30: 61 73 20 70 72 6f 63 65 73 73 65 64 0a 3b 3b 0a as processed.;;.
7b40: 28 64 65 66 69 6e 65 20 28 6d 61 72 6b 2d 70 72 (define (mark-pr
7b50: 6f 63 65 73 73 65 64 20 63 6f 6e 6e 20 70 6b 74 ocessed conn pkt
7b60: 2d 69 64 73 29 0a 20 20 3b 3b 20 28 70 67 3a 77 -ids). ;; (pg:w
7b70: 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e 0a ith-transaction.
7b80: 20 20 20 3b 3b 20 63 6f 6e 6e 0a 20 20 20 3b 3b ;; conn. ;;
7b90: 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
7ba0: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
7bb0: 20 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 09 28 (lambda (id)..(
7bc0: 64 62 69 3a 67 65 74 2d 6f 6e 65 0a 09 20 63 6f dbi:get-one.. co
7bd0: 6e 6e 0a 09 20 22 55 50 44 41 54 45 20 70 6b 74 nn.. "UPDATE pkt
7be0: 73 20 53 45 54 20 70 72 6f 63 65 73 73 65 64 3d s SET processed=
7bf0: 31 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 69 1 WHERE id=?;" i
7c00: 64 29 29 0a 20 20 20 20 20 20 70 6b 74 2d 69 64 d)). pkt-id
7c10: 73 29 29 20 3b 3b 20 78 29 29 0a 0a 3b 3b 20 61 s)) ;; x))..;; a
7c20: 20 67 65 6e 65 72 69 63 20 70 6b 74 20 67 65 74 generic pkt get
7c30: 74 65 72 2c 20 67 65 74 73 20 66 72 6f 6d 20 74 ter, gets from t
7c40: 68 65 20 70 6b 74 73 20 64 62 0a 3b 3b 0a 28 64 he pkts db.;;.(d
7c50: 65 66 69 6e 65 20 28 67 65 74 2d 70 6b 74 73 20 efine (get-pkts
7c60: 63 6f 6e 6e 20 70 74 79 70 65 73 29 0a 20 20 28 conn ptypes). (
7c70: 6c 65 74 2a 20 28 28 70 74 79 70 65 73 2d 73 74 let* ((ptypes-st
7c80: 72 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 r (if (null?
7c90: 70 74 79 70 65 73 29 0a 09 09 09 20 20 20 20 22 ptypes).... "
7ca0: 22 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 20 22 ".... (conc "
7cb0: 20 57 48 45 52 45 20 70 6b 74 5f 74 79 70 65 20 WHERE pkt_type
7cc0: 49 4e 20 28 27 22 20 28 73 74 72 69 6e 67 2d 69 IN ('" (string-i
7cd0: 6e 74 65 72 73 70 65 72 73 65 20 70 74 79 70 65 ntersperse ptype
7ce0: 73 20 22 2c 22 29 20 22 27 29 20 22 29 29 29 0a s ",") "') "))).
7cf0: 09 20 28 71 72 79 2d 73 74 72 20 20 20 20 20 20 . (qry-str
7d00: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 (conc "SELECT i
7d10: 64 2c 67 72 6f 75 70 5f 69 64 2c 75 75 69 64 2c d,group_id,uuid,
7d20: 70 61 72 65 6e 74 5f 75 75 69 64 2c 70 6b 74 5f parent_uuid,pkt_
7d30: 74 79 70 65 2c 70 6b 74 2c 70 72 6f 63 65 73 73 type,pkt,process
7d40: 65 64 20 46 52 4f 4d 20 70 6b 74 73 22 20 70 74 ed FROM pkts" pt
7d50: 79 70 65 73 2d 73 74 72 29 29 29 0a 20 20 20 20 ypes-str))).
7d60: 28 6d 61 70 20 76 65 63 74 6f 72 2d 3e 6c 69 73 (map vector->lis
7d70: 74 20 28 64 62 69 3a 67 65 74 2d 72 6f 77 73 20 t (dbi:get-rows
7d80: 63 6f 6e 6e 20 71 72 79 2d 73 74 72 29 29 29 29 conn qry-str))))
7d90: 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 65 70 6f ..;; make a repo
7da0: 72 74 20 6f 66 20 74 68 65 20 70 6b 74 73 20 69 rt of the pkts i
7db0: 6e 20 74 68 65 20 64 62 0a 3b 3b 20 70 74 79 70 n the db.;; ptyp
7dc0: 65 73 20 6f 66 20 27 28 29 20 67 65 74 73 20 61 es of '() gets a
7dd0: 6c 6c 20 70 6b 74 73 0a 3b 3b 20 64 69 73 70 6c ll pkts.;; displ
7de0: 61 79 2d 66 69 65 6c 64 73 0a 3b 3b 0a 28 64 65 ay-fields.;;.(de
7df0: 66 69 6e 65 20 28 6d 61 6b 65 2d 72 65 70 6f 72 fine (make-repor
7e00: 74 20 64 65 73 74 20 63 6f 6e 6e 20 70 6b 74 73 t dest conn pkts
7e10: 70 65 63 20 64 69 73 70 6c 61 79 2d 66 69 65 6c pec display-fiel
7e20: 64 73 20 2e 20 70 74 79 70 65 73 29 0a 20 20 28 ds . ptypes). (
7e30: 6c 65 74 2a 20 28 3b 3b 20 28 63 6f 6e 6e 20 20 let* (;; (conn
7e40: 20 20 20 20 20 20 20 20 28 64 62 69 3a 64 62 2d (dbi:db-
7e50: 63 6f 6e 6e 20 28 73 3a 64 62 29 29 29 0a 09 20 conn (s:db)))..
7e60: 28 61 6c 6c 2d 72 6f 77 73 20 20 20 20 20 20 28 (all-rows (
7e70: 67 65 74 2d 70 6b 74 73 20 63 6f 6e 6e 20 70 74 get-pkts conn pt
7e80: 79 70 65 73 29 29 0a 09 20 28 61 6c 6c 2d 70 6b ypes)).. (all-pk
7e90: 74 73 20 20 20 20 20 20 28 66 6c 61 74 74 65 6e ts (flatten
7ea0: 2d 61 6c 6c 0a 09 09 09 20 61 6c 6c 2d 72 6f 77 -all.... all-row
7eb0: 73 0a 09 09 09 20 70 6b 74 73 70 65 63 0a 09 09 s.... pktspec...
7ec0: 09 20 27 69 64 20 27 67 72 6f 75 70 2d 69 64 20 . 'id 'group-id
7ed0: 27 75 75 69 64 20 27 70 61 72 65 6e 74 20 27 70 'uuid 'parent 'p
7ee0: 6b 74 2d 74 79 70 65 20 27 70 6b 74 20 27 70 72 kt-type 'pkt 'pr
7ef0: 6f 63 65 73 73 65 64 29 29 0a 09 20 28 62 79 2d ocessed)).. (by-
7f00: 75 75 69 64 20 20 20 20 20 20 20 28 6c 65 74 20 uuid (let
7f10: 28 28 68 74 20 28 6d 61 6b 65 2d 68 61 73 68 2d ((ht (make-hash-
7f20: 74 61 62 6c 65 29 29 29 0a 09 09 09 20 20 28 66 table))).... (f
7f30: 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 20 28 6c or-each.... (l
7f40: 61 6d 62 64 61 20 28 70 6b 74 29 0a 09 09 09 20 ambda (pkt)....
7f50: 20 20 20 20 28 6c 65 74 20 28 28 75 75 69 64 20 (let ((uuid
7f60: 28 61 6c 69 73 74 2d 72 65 66 20 27 75 75 69 64 (alist-ref 'uuid
7f70: 20 70 6b 74 29 29 29 0a 09 09 09 20 20 20 20 20 pkt)))....
7f80: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
7f90: 74 21 20 68 74 20 75 75 69 64 20 70 6b 74 29 29 t! ht uuid pkt))
7fa0: 29 0a 09 09 09 20 20 20 61 6c 6c 2d 70 6b 74 73 ).... all-pkts
7fb0: 29 0a 09 09 09 20 20 68 74 29 29 0a 09 20 28 62 ).... ht)).. (b
7fc0: 79 2d 70 61 72 65 6e 74 20 20 20 20 20 28 6c 65 y-parent (le
7fd0: 74 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 61 73 t ((ht (make-has
7fe0: 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 20 20 h-table)))....
7ff0: 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 20 (for-each....
8000: 28 6c 61 6d 62 64 61 20 28 70 6b 74 29 0a 09 09 (lambda (pkt)...
8010: 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 61 72 . (let ((par
8020: 65 6e 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 ent (alist-ref '
8030: 70 61 72 65 6e 74 20 70 6b 74 29 29 29 0a 09 09 parent pkt)))...
8040: 09 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 . (hash-ta
8050: 62 6c 65 2d 73 65 74 21 20 68 74 20 70 61 72 65 ble-set! ht pare
8060: 6e 74 20 28 63 6f 6e 73 20 70 6b 74 20 28 68 61 nt (cons pkt (ha
8070: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
8080: 61 75 6c 74 20 68 74 20 70 61 72 65 6e 74 20 27 ault ht parent '
8090: 28 29 29 29 29 29 29 0a 09 09 09 20 20 20 61 6c ()))))).... al
80a0: 6c 2d 70 6b 74 73 29 0a 09 09 09 20 20 20 20 68 l-pkts).... h
80b0: 74 29 29 0a 09 20 28 6f 75 70 20 20 20 20 20 20 t)).. (oup
80c0: 20 20 20 20 20 28 69 66 20 64 65 73 74 20 28 6f (if dest (o
80d0: 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 pen-output-file
80e0: 64 65 73 74 29 20 28 63 75 72 72 65 6e 74 2d 6f dest) (current-o
80f0: 75 74 70 75 74 2d 70 6f 72 74 29 29 29 29 0a 20 utput-port)))).
8100: 20 20 20 0a 20 20 20 20 28 77 69 74 68 2d 6f 75 . (with-ou
8110: 74 70 75 74 2d 74 6f 2d 70 6f 72 74 0a 09 6f 75 tput-to-port..ou
8120: 70 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 p. (lambda
8130: 28 29 0a 09 28 70 72 69 6e 74 20 22 64 69 67 72 ()..(print "digr
8140: 61 70 68 20 6d 65 67 61 74 65 73 74 5f 73 74 61 aph megatest_sta
8150: 74 65 5f 73 74 61 74 75 73 20 7b 0a 20 20 2f 2f te_status {. //
8160: 20 72 61 6e 6b 73 65 70 3d 30 2e 30 35 0a 20 20 ranksep=0.05.
8170: 72 61 6e 6b 64 69 72 3d 4c 52 3b 0a 20 20 6e 6f rankdir=LR;. no
8180: 64 65 20 5b 73 68 61 70 65 3d 5c 22 62 6f 78 5c de [shape=\"box\
8190: 22 5d 3b 0a 22 29 0a 09 3b 3b 20 66 69 72 73 74 "];.")..;; first
81a0: 20 61 6c 6c 20 74 68 65 20 6e 61 6d 65 73 0a 09 all the names..
81b0: 28 66 6f 72 2d 65 61 63 68 0a 09 20 28 6c 61 6d (for-each.. (lam
81c0: 62 64 61 20 28 70 6b 74 29 0a 09 20 20 20 28 6c bda (pkt).. (l
81d0: 65 74 2a 20 28 28 75 75 69 64 20 20 20 20 20 20 et* ((uuid
81e0: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 75 75 (alist-ref 'uu
81f0: 69 64 20 70 6b 74 29 29 0a 09 09 20 20 28 73 68 id pkt))... (sh
8200: 6f 72 74 75 75 69 64 20 20 20 28 73 75 62 73 74 ortuuid (subst
8210: 72 69 6e 67 20 75 75 69 64 20 30 20 34 29 29 0a ring uuid 0 4)).
8220: 09 09 20 20 28 74 79 70 65 20 20 20 20 20 20 20 .. (type
8230: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 70 6b 74 (alist-ref 'pkt
8240: 2d 74 79 70 65 20 70 6b 74 29 29 0a 09 09 20 20 -type pkt))...
8250: 28 70 72 6f 63 65 73 73 65 64 20 20 20 28 61 6c (processed (al
8260: 69 73 74 2d 72 65 66 20 27 70 72 6f 63 65 73 73 ist-ref 'process
8270: 65 64 20 70 6b 74 29 29 29 0a 09 20 20 20 20 20 ed pkt)))..
8280: 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 5c .. (print "\
8290: 22 22 20 75 75 69 64 20 22 5c 22 20 5b 6c 61 62 "" uuid "\" [lab
82a0: 65 6c 3d 5c 22 22 20 73 68 6f 72 74 75 75 69 64 el=\"" shortuuid
82b0: 20 22 2c 20 28 22 0a 09 09 20 20 20 20 74 79 70 ", ("... typ
82c0: 65 20 22 2c 20 22 0a 09 09 20 20 20 20 28 69 66 e ", "... (if
82d0: 20 70 72 6f 63 65 73 73 65 64 20 22 70 72 6f 63 processed "proc
82e0: 65 73 73 65 64 22 20 22 6e 6f 74 20 70 72 6f 63 essed" "not proc
82f0: 65 73 73 65 64 22 29 20 22 29 22 29 0a 09 20 20 essed") ")")..
8300: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 (for-each..
8310: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 (lambda (key
8320: 2d 66 69 65 6c 64 29 0a 09 09 28 6c 65 74 20 28 -field)...(let (
8330: 28 76 61 6c 20 28 61 6c 69 73 74 2d 72 65 66 20 (val (alist-ref
8340: 6b 65 79 2d 66 69 65 6c 64 20 70 6b 74 29 29 29 key-field pkt)))
8350: 0a 09 09 20 20 28 69 66 20 76 61 6c 0a 09 09 20 ... (if val...
8360: 20 20 20 20 20 28 70 72 69 6e 74 20 6b 65 79 2d (print key-
8370: 66 69 65 6c 64 20 22 3d 22 20 76 61 6c 29 29 29 field "=" val)))
8380: 29 0a 09 20 20 20 20 20 20 64 69 73 70 6c 61 79 ).. display
8390: 2d 66 69 65 6c 64 73 29 0a 09 20 20 20 20 20 28 -fields).. (
83a0: 70 72 69 6e 74 20 22 5c 22 20 5d 3b 22 29 29 29 print "\" ];")))
83b0: 0a 09 20 61 6c 6c 2d 70 6b 74 73 29 0a 09 3b 3b .. all-pkts)..;;
83c0: 20 6e 6f 77 20 66 6f 72 20 70 61 72 65 6e 74 2d now for parent-
83d0: 63 68 69 6c 64 20 72 65 6c 61 74 69 6f 6e 73 68 child relationsh
83e0: 69 70 73 0a 09 28 66 6f 72 2d 65 61 63 68 0a 09 ips..(for-each..
83f0: 20 28 6c 61 6d 62 64 61 20 28 70 6b 74 29 0a 09 (lambda (pkt)..
8400: 20 20 20 28 6c 65 74 20 28 28 75 75 69 64 20 20 (let ((uuid
8410: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 75 75 69 (alist-ref 'uui
8420: 64 20 70 6b 74 29 29 0a 09 09 20 28 70 61 72 65 d pkt))... (pare
8430: 6e 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 70 nt (alist-ref 'p
8440: 61 72 65 6e 74 20 70 6b 74 29 29 29 0a 09 20 20 arent pkt)))..
8450: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ
8460: 61 6c 3f 20 70 61 72 65 6e 74 20 22 22 29 29 0a al? parent "")).
8470: 09 09 20 28 70 72 69 6e 74 20 22 5c 22 22 20 70 .. (print "\"" p
8480: 61 72 65 6e 74 20 22 5c 22 20 2d 3e 20 5c 22 22 arent "\" -> \""
8490: 20 75 75 69 64 22 5c 22 3b 22 29 29 29 29 0a 09 uuid"\";"))))..
84a0: 20 61 6c 6c 2d 70 6b 74 73 29 0a 0a 09 28 70 72 all-pkts)...(pr
84b0: 69 6e 74 20 22 7d 22 29 0a 09 29 29 0a 20 20 20 int "}")..)).
84c0: 20 28 69 66 20 64 65 73 74 0a 09 28 62 65 67 69 (if dest..(begi
84d0: 6e 0a 09 20 20 28 63 6c 6f 73 65 2d 6f 75 74 70 n.. (close-outp
84e0: 75 74 2d 70 6f 72 74 20 6f 75 70 29 0a 09 20 20 ut-port oup)..
84f0: 28 73 79 73 74 65 6d 20 22 64 6f 74 20 2d 54 70 (system "dot -Tp
8500: 64 66 20 6f 75 74 2e 64 6f 74 20 2d 6f 20 6f 75 df out.dot -o ou
8510: 74 2e 70 64 66 22 29 29 29 0a 20 20 20 20 0a 20 t.pdf"))). .
8520: 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ))..;;=======
8530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
8570: 3b 3b 20 52 65 61 64 20 72 65 66 20 70 6b 74 73 ;; Read ref pkts
8580: 20 69 6e 74 6f 20 61 20 76 65 63 74 6f 72 20 3c into a vector <
8590: 20 6c 61 73 74 73 74 72 20 68 61 73 68 20 74 61 laststr hash ta
85a0: 62 6c 65 20 3e 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ble > .;;=======
85b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
85c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
85d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
85e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
85f0: 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ...;;===========
8600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R
8640: 65 61 64 2f 77 72 69 74 65 20 70 61 63 6b 65 74 ead/write packet
8650: 73 20 74 6f 20 66 69 6c 65 73 20 28 63 6f 6e 76 s to files (conv
8660: 69 65 6e 63 65 20 66 75 6e 63 74 69 6f 6e 73 29 ience functions)
8670: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
86a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
86b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 77 72 =========..;; wr
86c0: 69 74 65 20 61 6c 69 73 74 20 74 6f 20 61 20 70 ite alist to a p
86d0: 6b 74 20 66 69 6c 65 0a 3b 3b 0a 28 64 65 66 69 kt file.;;.(defi
86e0: 6e 65 20 28 77 72 69 74 65 2d 61 6c 69 73 74 2d ne (write-alist-
86f0: 3e 70 6b 74 20 74 61 72 67 64 69 72 20 64 61 74 >pkt targdir dat
8700: 20 23 21 6b 65 79 20 28 70 6b 74 73 70 65 63 20 #!key (pktspec
8710: 27 28 29 29 28 70 74 79 70 65 20 23 66 29 29 0a '())(ptype #f)).
8720: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
8730: 28 75 75 69 64 20 70 6b 74 29 28 61 6c 69 73 74 (uuid pkt)(alist
8740: 2d 3e 70 6b 74 20 64 61 74 20 70 6b 74 73 70 65 ->pkt dat pktspe
8750: 63 20 70 74 79 70 65 3a 20 70 74 79 70 65 29 29 c ptype: ptype))
8760: 29 0a 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 ). (with-outp
8770: 75 74 2d 74 6f 2d 66 69 6c 65 20 28 63 6f 6e 63 ut-to-file (conc
8780: 20 74 61 72 67 64 69 72 20 22 2f 22 20 75 75 69 targdir "/" uui
8790: 64 20 22 2e 70 6b 74 22 29 0a 20 20 20 20 20 20 d ".pkt").
87a0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 70 72 69 (lambda ()..(pri
87b0: 6e 74 20 70 6b 74 29 29 29 0a 20 20 20 20 75 75 nt pkt))). uu
87c0: 69 64 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 74 id)) ;; return t
87d0: 68 65 20 75 75 69 64 0a 0a 3b 3b 20 72 65 61 64 he uuid..;; read
87e0: 20 70 6b 74 20 69 6e 74 6f 20 61 6c 69 73 74 0a pkt into alist.
87f0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 65 61 64 ;;.(define (read
8800: 2d 70 6b 74 2d 3e 61 6c 69 73 74 20 70 6b 74 2d -pkt->alist pkt-
8810: 66 69 6c 65 20 23 21 6b 65 79 20 28 70 6b 74 73 file #!key (pkts
8820: 70 65 63 20 23 66 29 29 0a 20 20 28 70 6b 74 2d pec #f)). (pkt-
8830: 3e 61 6c 69 73 74 20 28 77 69 74 68 2d 69 6e 70 >alist (with-inp
8840: 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 0a 09 09 20 ut-from-file...
8850: 20 70 6b 74 2d 66 69 6c 65 0a 09 09 72 65 61 64 pkt-file...read
8860: 2d 73 74 72 69 6e 67 29 0a 09 20 20 20 20 20 20 -string)..
8870: 70 6b 74 73 70 65 63 3a 20 70 6b 74 73 70 65 63 pktspec: pktspec
8880: 29 29 0a 0a 0a 29 20 3b 3b 20 6d 6f 64 75 6c 65 ))...) ;; module
8890: 20 70 6b 74 73 0a pkts.