Artifact
8d256e62d77abcfb276d97347f493a716d6df0cb:
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d 3d 3d 3d nses/>...;;=====
0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0340: 3d 0a 3b 3b 20 43 20 4c 20 49 20 45 20 4e 20 54 =.;; C L I E N T
0350: 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;===========
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
03a0: 65 20 73 72 66 69 2d 31 38 20 65 78 74 72 61 73 e srfi-18 extras
03b0: 20 74 63 70 20 73 31 31 6e 20 73 72 66 69 2d 31 tcp s11n srfi-1
03c0: 20 70 6f 73 69 78 20 72 65 67 65 78 20 73 72 66 posix regex srf
03d0: 69 2d 36 39 20 68 6f 73 74 69 6e 66 6f 20 6d 64 i-69 hostinfo md
03e0: 35 0a 20 20 20 20 20 6d 65 73 73 61 67 65 2d 64 5. message-d
03f0: 69 67 65 73 74 20 6d 61 74 63 68 61 62 6c 65 20 igest matchable
0400: 73 70 69 66 66 79 20 75 72 69 2d 63 6f 6d 6d 6f spiffy uri-commo
0410: 6e 20 69 6e 74 61 72 77 65 62 20 68 74 74 70 2d n intarweb http-
0420: 63 6c 69 65 6e 74 0a 20 20 20 20 20 73 70 69 66 client. spif
0430: 66 79 2d 72 65 71 75 65 73 74 2d 76 61 72 73 20 fy-request-vars
0440: 75 72 69 2d 63 6f 6d 6d 6f 6e 20 69 6e 74 61 72 uri-common intar
0450: 77 65 62 20 64 69 72 65 63 74 6f 72 79 2d 75 74 web directory-ut
0460: 69 6c 73 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 ils)..(declare (
0470: 75 6e 69 74 20 63 6c 69 65 6e 74 29 29 0a 0a 28 unit client))..(
0480: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
0490: 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 mmon)).(declare
04a0: 28 75 73 65 73 20 64 62 29 29 0a 28 64 65 63 6c (uses db)).(decl
04b0: 61 72 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 are (uses tasks)
04c0: 29 20 3b 3b 20 74 61 73 6b 73 20 61 72 65 20 77 ) ;; tasks are w
04d0: 68 65 72 65 20 73 74 75 66 66 20 69 73 20 6d 61 here stuff is ma
04e0: 69 6e 74 61 69 6e 65 64 20 61 62 6f 75 74 20 77 intained about w
04f0: 68 61 74 20 69 73 20 72 75 6e 6e 69 6e 67 2e 0a hat is running..
0500: 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f .(include "commo
0510: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a n_records.scm").
0520: 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 (include "db_rec
0530: 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 63 ords.scm")..;; c
0540: 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61 74 lient:get-signat
0550: 75 72 65 0a 28 64 65 66 69 6e 65 20 28 63 6c 69 ure.(define (cli
0560: 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 ent:get-signatur
0570: 65 29 0a 20 20 28 69 66 20 2a 6d 79 2d 63 6c 69 e). (if *my-cli
0580: 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 2a 20 2a ent-signature* *
0590: 6d 79 2d 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 my-client-signat
05a0: 75 72 65 2a 0a 20 20 20 20 20 20 28 6c 65 74 20 ure*. (let
05b0: 28 28 73 69 67 20 28 63 6f 6e 63 20 28 67 65 74 ((sig (conc (get
05c0: 2d 68 6f 73 74 2d 6e 61 6d 65 29 20 22 20 22 20 -host-name) " "
05d0: 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 (current-process
05e0: 2d 69 64 29 29 29 29 0a 09 28 73 65 74 21 20 2a -id))))..(set! *
05f0: 6d 79 2d 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 my-client-signat
0600: 75 72 65 2a 20 73 69 67 29 0a 09 2a 6d 79 2d 63 ure* sig)..*my-c
0610: 6c 69 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 2a lient-signature*
0620: 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 63 )))...(define (c
0630: 6c 69 65 6e 74 3a 73 65 74 75 70 20 61 72 65 61 lient:setup area
0640: 70 61 74 68 20 23 21 6b 65 79 20 28 72 65 6d 61 path #!key (rema
0650: 69 6e 69 6e 67 2d 74 72 69 65 73 20 31 30 30 29 ining-tries 100)
0660: 20 28 66 61 69 6c 65 64 2d 63 6f 6e 6e 65 63 74 (failed-connect
0670: 73 20 30 29 29 0a 20 20 28 63 6c 69 65 6e 74 3a s 0)). (client:
0680: 73 65 74 75 70 2d 68 74 74 70 20 61 72 65 61 70 setup-http areap
0690: 61 74 68 20 72 65 6d 61 69 6e 69 6e 67 2d 74 72 ath remaining-tr
06a0: 69 65 73 3a 20 72 65 6d 61 69 6e 69 6e 67 2d 74 ies: remaining-t
06b0: 72 69 65 73 20 66 61 69 6c 65 64 2d 63 6f 6e 6e ries failed-conn
06c0: 65 63 74 73 3a 20 66 61 69 6c 65 64 2d 63 6f 6e ects: failed-con
06d0: 6e 65 63 74 73 29 29 0a 0a 3b 3b 20 44 6f 20 61 nects))..;; Do a
06e0: 6c 6c 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f ll the connectio
06f0: 6e 20 77 6f 72 6b 2c 20 6c 6f 6f 6b 20 75 70 20 n work, look up
0700: 74 68 65 20 74 72 61 6e 73 70 6f 72 74 20 74 79 the transport ty
0710: 70 65 20 61 6e 64 20 73 65 74 20 75 70 20 74 68 pe and set up th
0720: 65 0a 3b 3b 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 e.;; connection
0730: 69 66 20 72 65 71 75 69 72 65 64 2e 0a 3b 3b 0a if required..;;.
0740: 3b 3b 20 54 68 65 72 65 20 61 72 65 20 74 77 6f ;; There are two
0750: 20 73 63 65 6e 61 72 69 6f 73 2e 20 0a 3b 3b 20 scenarios. .;;
0760: 20 20 31 2e 20 57 65 20 61 72 65 20 61 20 74 65 1. We are a te
0770: 73 74 20 6d 61 6e 61 67 65 72 20 61 6e 64 20 77 st manager and w
0780: 65 20 72 65 63 65 69 76 65 64 20 2a 74 72 61 6e e received *tran
0790: 73 70 6f 72 74 2d 74 79 70 65 2a 20 61 6e 64 20 sport-type* and
07a0: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 76 69 61 20 *runremote* via
07b0: 63 6d 64 6c 69 6e 65 0a 3b 3b 20 20 20 32 2e 20 cmdline.;; 2.
07c0: 57 65 20 61 72 65 20 61 20 72 75 6e 20 74 65 73 We are a run tes
07d0: 74 73 2c 20 6c 69 73 74 20 72 75 6e 73 20 6f 72 ts, list runs or
07e0: 20 6f 74 68 65 72 20 69 6e 74 65 72 61 63 74 69 other interacti
07f0: 76 65 20 70 72 6f 63 65 73 73 20 61 6e 64 20 77 ve process and w
0800: 65 20 6d 75 73 74 20 66 69 67 75 72 65 20 6f 75 e must figure ou
0810: 74 0a 3b 3b 20 20 20 20 20 20 2a 74 72 61 6e 73 t.;; *trans
0820: 70 6f 72 74 2d 74 79 70 65 2a 20 61 6e 64 20 2a port-type* and *
0830: 72 75 6e 72 65 6d 6f 74 65 2a 20 66 72 6f 6d 20 runremote* from
0840: 74 68 65 20 6d 6f 6e 69 74 6f 72 2e 64 62 0a 3b the monitor.db.;
0850: 3b 0a 3b 3b 20 63 6c 69 65 6e 74 3a 73 65 74 75 ;.;; client:setu
0860: 70 0a 3b 3b 0a 3b 3b 20 6c 6f 6f 6b 75 70 5f 73 p.;;.;; lookup_s
0870: 65 72 76 65 72 2c 20 6e 65 65 64 20 74 6f 20 72 erver, need to r
0880: 65 6d 6f 76 65 20 2a 72 75 6e 72 65 6d 6f 74 65 emove *runremote
0890: 2a 20 73 74 75 66 66 0a 3b 3b 0a 0a 28 64 65 66 * stuff.;;..(def
08a0: 69 6e 65 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 ine (client:setu
08b0: 70 2d 68 74 74 70 20 61 72 65 61 70 61 74 68 20 p-http areapath
08c0: 23 21 6b 65 79 20 28 72 65 6d 61 69 6e 69 6e 67 #!key (remaining
08d0: 2d 74 72 69 65 73 20 31 30 30 29 20 28 66 61 69 -tries 100) (fai
08e0: 6c 65 64 2d 63 6f 6e 6e 65 63 74 73 20 30 29 28 led-connects 0)(
08f0: 61 72 65 61 2d 64 61 74 20 23 66 29 29 0a 20 20 area-dat #f)).
0900: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
0910: 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 2 *default-log
0920: 2d 70 6f 72 74 2a 20 22 63 6c 69 65 6e 74 3a 73 -port* "client:s
0930: 65 74 75 70 20 72 65 6d 61 69 6e 69 6e 67 2d 74 etup remaining-t
0940: 72 69 65 73 3d 22 20 72 65 6d 61 69 6e 69 6e 67 ries=" remaining
0950: 2d 74 72 69 65 73 29 0a 20 20 28 73 65 72 76 65 -tries). (serve
0960: 72 3a 73 74 61 72 74 2d 61 6e 64 2d 77 61 69 74 r:start-and-wait
0970: 20 61 72 65 61 70 61 74 68 29 0a 20 20 28 69 66 areapath). (if
0980: 20 28 3c 3d 20 72 65 6d 61 69 6e 69 6e 67 2d 74 (<= remaining-t
0990: 72 69 65 73 20 30 29 0a 20 20 20 20 20 20 28 62 ries 0). (b
09a0: 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 egin..(debug:pri
09b0: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
09c0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 ult-log-port* "f
09d0: 61 69 6c 65 64 20 74 6f 20 73 74 61 72 74 20 6f ailed to start o
09e0: 72 20 63 6f 6e 6e 65 63 74 20 74 6f 20 73 65 72 r connect to ser
09f0: 76 65 72 22 29 0a 09 28 65 78 69 74 20 31 29 29 ver")..(exit 1))
0a00: 0a 20 20 20 20 20 20 3b 3b 0a 20 20 20 20 20 20 . ;;.
0a10: 3b 3b 20 41 6c 74 65 72 6e 61 74 69 76 65 6c 79 ;; Alternatively
0a20: 20 68 65 72 65 2c 20 77 65 20 63 61 6e 20 67 65 here, we can ge
0a30: 74 20 74 68 65 20 6c 69 73 74 20 6f 66 20 63 61 t the list of ca
0a40: 6e 64 69 64 61 74 65 20 73 65 72 76 65 72 73 20 ndidate servers
0a50: 61 6e 64 20 77 6f 72 6b 20 6f 75 72 20 77 61 79 and work our way
0a60: 0a 20 20 20 20 20 20 3b 3b 20 74 68 72 6f 75 67 . ;; throug
0a70: 68 20 74 68 65 6d 20 73 65 61 72 63 68 69 6e 67 h them searching
0a80: 20 66 6f 72 20 61 20 67 6f 6f 64 20 6f 6e 65 2e for a good one.
0a90: 0a 20 20 20 20 20 20 3b 3b 0a 20 20 20 20 20 20 . ;;.
0aa0: 28 6c 65 74 2a 20 28 28 73 65 72 76 65 72 2d 64 (let* ((server-d
0ab0: 61 74 20 28 73 65 72 76 65 72 3a 67 65 74 2d 72 at (server:get-r
0ac0: 61 6e 64 2d 62 65 73 74 20 61 72 65 61 70 61 74 and-best areapat
0ad0: 68 29 29 20 3b 3b 20 28 73 65 72 76 65 72 3a 67 h)) ;; (server:g
0ae0: 65 74 2d 66 69 72 73 74 2d 62 65 73 74 20 61 72 et-first-best ar
0af0: 65 61 70 61 74 68 29 29 0a 09 20 20 20 20 20 28 eapath)).. (
0b00: 72 75 6e 72 65 6d 6f 74 65 20 20 28 6f 72 20 61 runremote (or a
0b10: 72 65 61 2d 64 61 74 20 2a 72 75 6e 72 65 6d 6f rea-dat *runremo
0b20: 74 65 2a 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 te*)))..(if (not
0b30: 20 73 65 72 76 65 72 2d 64 61 74 29 20 3b 3b 20 server-dat) ;;
0b40: 6e 6f 20 73 65 72 76 65 72 20 66 6f 75 6e 64 0a no server found.
0b50: 09 20 20 20 20 28 63 6c 69 65 6e 74 3a 73 65 74 . (client:set
0b60: 75 70 2d 68 74 74 70 20 61 72 65 61 70 61 74 68 up-http areapath
0b70: 20 72 65 6d 61 69 6e 69 6e 67 2d 74 72 69 65 73 remaining-tries
0b80: 3a 20 28 2d 20 72 65 6d 61 69 6e 69 6e 67 2d 74 : (- remaining-t
0b90: 72 69 65 73 20 31 29 29 0a 09 20 20 20 20 28 6c ries 1)).. (l
0ba0: 65 74 20 28 28 68 6f 73 74 20 20 28 63 61 64 72 et ((host (cadr
0bb0: 20 20 73 65 72 76 65 72 2d 64 61 74 29 29 0a 09 server-dat))..
0bc0: 09 20 20 28 70 6f 72 74 20 20 28 63 61 64 64 72 . (port (caddr
0bd0: 20 73 65 72 76 65 72 2d 64 61 74 29 29 0a 20 20 server-dat)).
0be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bf0: 28 73 65 72 76 65 72 2d 69 64 20 28 63 61 64 64 (server-id (cadd
0c00: 72 20 28 63 64 64 72 20 73 65 72 76 65 72 2d 64 r (cddr server-d
0c10: 61 74 29 29 29 29 0a 09 20 20 20 20 20 20 28 64 at)))).. (d
0c20: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
0c30: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
0c40: 6f 72 74 2a 20 22 63 6c 69 65 6e 74 3a 73 65 74 ort* "client:set
0c50: 75 70 20 73 65 72 76 65 72 2d 64 61 74 3d 22 20 up server-dat="
0c60: 73 65 72 76 65 72 2d 64 61 74 20 22 2c 20 72 65 server-dat ", re
0c70: 6d 61 69 6e 69 6e 67 2d 74 72 69 65 73 3d 22 20 maining-tries="
0c80: 72 65 6d 61 69 6e 69 6e 67 2d 74 72 69 65 73 29 remaining-tries)
0c90: 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
0ca0: 20 28 6e 6f 74 20 61 72 65 61 2d 64 61 74 29 0a (not area-dat).
0cb0: 09 09 20 20 20 20 20 20 20 28 6e 6f 74 20 2a 72 .. (not *r
0cc0: 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 20 20 20 20 unremote*)).
0cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
0ce0: 65 67 69 6e 20 20 20 20 20 20 20 0a 09 09 20 20 egin ...
0cf0: 20 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f (set! *runremo
0d00: 74 65 2a 20 28 6d 61 6b 65 2d 72 65 6d 6f 74 65 te* (make-remote
0d10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0d20: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 (let* ((s
0d30: 65 72 76 65 72 2d 69 6e 66 6f 20 28 72 65 6d 6f erver-info (remo
0d40: 74 65 2d 73 65 72 76 65 72 2d 69 6e 66 6f 20 2a te-server-info *
0d50: 72 75 6e 72 65 6d 6f 74 65 2a 29 29 29 20 0a 20 runremote*))) .
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 20 28 69 66 20 73 65 72 76 65 72 2d (if server-
0d80: 69 6e 66 6f 0a 20 20 20 20 20 20 20 20 20 20 20 info.
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
0da0: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
0dc0: 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 72 6c emote-server-url
0dd0: 2d 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 -set! *runremote
0de0: 2a 20 28 73 65 72 76 65 72 3a 72 65 63 6f 72 64 * (server:record
0df0: 2d 3e 75 72 6c 20 73 65 72 76 65 72 2d 69 6e 66 ->url server-inf
0e00: 6f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 o)).
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
0e20: 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 69 64 2d emote-server-id-
0e30: 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a set! *runremote*
0e40: 20 28 73 65 72 76 65 72 3a 72 65 63 6f 72 64 2d (server:record-
0e50: 3e 69 64 20 73 65 72 76 65 72 2d 69 6e 66 6f 29 >id server-info)
0e60: 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 )))))).. (i
0e70: 66 20 28 61 6e 64 20 68 6f 73 74 20 70 6f 72 74 f (and host port
0e80: 20 73 65 72 76 65 72 2d 69 64 29 0a 09 09 09 09 server-id).....
0e90: 20 20 20 20 20 20 28 28 68 74 74 70 29 28 68 74 ((http)(ht
0ea0: 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 69 tp-transport:cli
0eb0: 65 6e 74 2d 63 6f 6e 6e 65 63 74 20 68 6f 73 74 ent-connect host
0ec0: 20 70 6f 72 74 20 73 65 72 76 65 72 2d 69 64 29 port server-id)
0ed0: 29 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 61 )))... (if (a
0ee0: 6e 64 20 73 74 61 72 74 2d 72 65 73 0a 09 09 09 nd start-res....
0ef0: 20 20 20 20 20 70 69 6e 67 2d 72 65 73 29 0a 09 ping-res)..
0f00: 09 09 28 6c 65 74 20 28 28 72 75 6e 72 65 6d 6f ..(let ((runremo
0f10: 74 65 20 28 6f 72 20 61 72 65 61 2d 64 61 74 20 te (or area-dat
0f20: 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 29 20 3b *runremote*))) ;
0f30: 3b 20 69 74 20 6d 69 67 68 74 20 68 61 76 65 20 ; it might have
0f40: 62 65 65 6e 20 67 65 6e 65 72 61 74 65 64 20 6f been generated o
0f50: 6e 6c 79 20 61 20 66 65 77 20 73 74 61 74 65 6d nly a few statem
0f60: 65 6e 74 73 20 61 67 6f 0a 09 09 09 20 20 28 72 ents ago.... (r
0f70: 65 6d 6f 74 65 2d 63 6f 6e 6e 64 61 74 2d 73 65 emote-conndat-se
0f80: 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 73 74 61 t! runremote sta
0f90: 72 74 2d 72 65 73 29 20 3b 3b 20 28 68 61 73 68 rt-res) ;; (hash
0fa0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 75 6e 72 -table-set! runr
0fb0: 65 6d 6f 74 65 20 72 75 6e 2d 69 64 20 73 74 61 emote run-id sta
0fc0: 72 74 2d 72 65 73 29 0a 09 09 09 20 20 28 64 65 rt-res).... (de
0fd0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
0fe0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
0ff0: 72 74 2a 20 22 63 6f 6e 6e 65 63 74 65 64 20 74 rt* "connected t
1000: 6f 20 22 20 28 68 74 74 70 2d 74 72 61 6e 73 70 o " (http-transp
1010: 6f 72 74 3a 73 65 72 76 65 72 2d 64 61 74 2d 6d ort:server-dat-m
1020: 61 6b 65 2d 75 72 6c 20 73 74 61 72 74 2d 72 65 ake-url start-re
1030: 73 29 29 0a 09 09 09 20 20 73 74 61 72 74 2d 72 s)).... start-r
1040: 65 73 29 0a 09 09 09 28 62 65 67 69 6e 20 20 20 es)....(begin
1050: 20 3b 3b 20 6c 6f 67 69 6e 20 66 61 69 6c 65 64 ;; login failed
1060: 20 62 75 74 20 68 61 76 65 20 61 20 73 65 72 76 but have a serv
1070: 65 72 20 72 65 63 6f 72 64 2c 20 63 6c 65 61 6e er record, clean
1080: 20 6f 75 74 20 74 68 65 20 72 65 63 6f 72 64 20 out the record
1090: 61 6e 64 20 74 72 79 20 61 67 61 69 6e 0a 09 09 and try again...
10a0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
10b0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
10c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6c 69 65 6e log-port* "clien
10d0: 74 3a 73 65 74 75 70 2c 20 6c 6f 67 69 6e 20 75 t:setup, login u
10e0: 6e 73 75 63 63 65 73 73 66 75 6c 2c 20 77 69 6c nsuccessful, wil
10f0: 6c 20 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 l attempt to sta
1100: 72 74 20 73 65 72 76 65 72 20 2e 2e 2e 20 73 74 rt server ... st
1110: 61 72 74 2d 72 65 73 3d 22 20 73 74 61 72 74 2d art-res=" start-
1120: 72 65 73 20 22 2c 20 73 65 72 76 65 72 2d 64 61 res ", server-da
1130: 74 3d 22 20 73 65 72 76 65 72 2d 64 61 74 29 20 t=" server-dat)
1140: 3b 3b 20 68 61 64 20 72 75 6e 69 64 2e 20 20 46 ;; had runid. F
1150: 69 78 65 73 20 70 61 72 74 20 6f 66 20 52 61 6e ixes part of Ran
1160: 64 79 3b 73 20 74 69 63 6b 65 74 20 31 34 30 35 dy;s ticket 1405
1170: 37 31 37 33 33 32 0a 09 09 09 20 20 28 68 74 74 717332.... (htt
1180: 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c 6f 73 p-transport:clos
1190: 65 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 29 0a 09 e-connections)..
11a0: 09 09 20 20 28 72 65 6d 6f 74 65 2d 63 6f 6e 6e .. (remote-conn
11b0: 64 61 74 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f dat-set! runremo
11c0: 74 65 20 23 66 29 20 20 3b 3b 20 28 68 61 73 68 te #f) ;; (hash
11d0: 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 72 -table-delete! r
11e0: 75 6e 72 65 6d 6f 74 65 20 72 75 6e 2d 69 64 29 unremote run-id)
11f0: 0a 09 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c .... (thread-sl
1200: 65 65 70 21 20 31 29 0a 09 09 09 20 20 28 63 6c eep! 1).... (cl
1210: 69 65 6e 74 3a 73 65 74 75 70 2d 68 74 74 70 20 ient:setup-http
1220: 61 72 65 61 70 61 74 68 20 72 65 6d 61 69 6e 69 areapath remaini
1230: 6e 67 2d 74 72 69 65 73 3a 20 28 2d 20 72 65 6d ng-tries: (- rem
1240: 61 69 6e 69 6e 67 2d 74 72 69 65 73 20 31 29 29 aining-tries 1))
1250: 0a 09 09 09 20 20 29 29 29 0a 09 09 20 20 28 62 .... )))... (b
1260: 65 67 69 6e 20 20 20 20 3b 3b 20 6e 6f 20 73 65 egin ;; no se
1270: 72 76 65 72 20 72 65 67 69 73 74 65 72 65 64 0a rver registered.
1280: 09 09 20 20 20 20 3b 3b 20 28 73 65 72 76 65 72 .. ;; (server
1290: 3a 6b 69 6e 64 2d 72 75 6e 20 61 72 65 61 70 61 :kind-run areapa
12a0: 74 68 29 0a 09 09 20 20 20 20 28 73 65 72 76 65 th)... (serve
12b0: 72 3a 73 74 61 72 74 2d 61 6e 64 2d 77 61 69 74 r:start-and-wait
12c0: 20 61 72 65 61 70 61 74 68 29 0a 09 09 20 20 20 areapath)...
12d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
12e0: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
12f0: 67 2d 70 6f 72 74 2a 20 22 63 6c 69 65 6e 74 3a g-port* "client:
1300: 73 65 74 75 70 2c 20 6e 6f 20 73 65 72 76 65 72 setup, no server
1310: 20 72 65 67 69 73 74 65 72 65 64 2c 20 72 65 6d registered, rem
1320: 61 69 6e 69 6e 67 2d 74 72 69 65 73 3d 22 20 72 aining-tries=" r
1330: 65 6d 61 69 6e 69 6e 67 2d 74 72 69 65 73 29 0a emaining-tries).
1340: 09 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c .. (thread-sl
1350: 65 65 70 21 20 31 29 20 3b 3b 20 28 2b 20 35 20 eep! 1) ;; (+ 5
1360: 28 72 61 6e 64 6f 6d 20 28 2d 20 32 30 20 72 65 (random (- 20 re
1370: 6d 61 69 6e 69 6e 67 2d 74 72 69 65 73 29 29 29 maining-tries)))
1380: 29 20 20 3b 3b 20 67 69 76 65 20 73 65 72 76 65 ) ;; give serve
1390: 72 20 61 20 6c 69 74 74 6c 65 20 74 69 6d 65 20 r a little time
13a0: 74 6f 20 73 74 61 72 74 20 75 70 2c 20 72 61 6e to start up, ran
13b0: 64 6f 6d 69 7a 65 20 61 20 6c 69 74 74 6c 65 20 domize a little
13c0: 74 6f 20 61 76 6f 69 64 20 73 74 61 72 74 20 73 to avoid start s
13d0: 74 6f 72 6d 73 2e 0a 09 09 20 20 20 20 28 63 6c torms.... (cl
13e0: 69 65 6e 74 3a 73 65 74 75 70 2d 68 74 74 70 20 ient:setup-http
13f0: 61 72 65 61 70 61 74 68 20 72 65 6d 61 69 6e 69 areapath remaini
1400: 6e 67 2d 74 72 69 65 73 3a 20 28 2d 20 72 65 6d ng-tries: (- rem
1410: 61 69 6e 69 6e 67 2d 74 72 69 65 73 20 31 29 29 aining-tries 1))
1420: 29 29 29 29 29 29 29 0a 0a )))))))..