Artifact
bb858ca5c83f339f52d84a78bb688c86bab6d137:
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 33 2c 20 4d 61 74 74 68 65 77 06-2013, 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 0a 28 75 73 65 20 64 nses/>....(use d
0300: 65 66 73 74 72 75 63 74 29 0a 0a 3b 3b 20 28 75 efstruct)..;; (u
0310: 73 65 20 73 73 61 78 29 0a 3b 3b 20 28 75 73 65 se ssax).;; (use
0320: 20 73 78 6d 6c 2d 73 65 72 69 61 6c 69 7a 65 72 sxml-serializer
0330: 29 0a 3b 3b 20 28 75 73 65 20 73 78 6d 6c 2d 6d ).;; (use sxml-m
0340: 6f 64 69 66 69 63 61 74 69 6f 6e 73 29 0a 3b 3b odifications).;;
0350: 20 28 75 73 65 20 72 65 67 65 78 29 0a 3b 3b 20 (use regex).;;
0360: 28 75 73 65 20 73 72 66 69 2d 36 39 29 0a 3b 3b (use srfi-69).;;
0370: 20 28 75 73 65 20 72 65 67 65 78 2d 63 61 73 65 (use regex-case
0380: 29 0a 3b 3b 20 28 75 73 65 20 70 6f 73 69 78 29 ).;; (use posix)
0390: 0a 3b 3b 20 28 75 73 65 20 6a 73 6f 6e 29 0a 3b .;; (use json).;
03a0: 3b 20 28 75 73 65 20 63 73 76 29 0a 28 75 73 65 ; (use csv).(use
03b0: 20 73 72 66 69 2d 31 38 29 0a 28 75 73 65 20 66 srfi-18).(use f
03c0: 6f 72 6d 61 74 29 0a 0a 28 72 65 71 75 69 72 65 ormat)..(require
03d0: 2d 6c 69 62 72 61 72 79 20 69 6e 69 2d 66 69 6c -library ini-fil
03e0: 65 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 e).(import (pref
03f0: 69 78 20 69 6e 69 2d 66 69 6c 65 20 69 6e 69 3a ix ini-file ini:
0400: 29 29 0a 0a 28 75 73 65 20 73 71 6c 2d 64 65 2d ))..(use sql-de-
0410: 6c 69 74 65 20 73 72 66 69 2d 31 20 70 6f 73 69 lite srfi-1 posi
0420: 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 x regex regex-ca
0430: 73 65 20 73 72 66 69 2d 36 39 29 0a 3b 3b 20 28 se srfi-69).;; (
0440: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 import (prefix s
0450: 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 qlite3 sqlite3:)
0460: 29 0a 3b 3b 20 0a 28 64 65 63 6c 61 72 65 20 28 ).;; .(declare (
0470: 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 0a 3b uses configf)).;
0480: 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ; (declare (uses
0490: 20 74 72 65 65 29 29 0a 28 64 65 63 6c 61 72 65 tree)).(declare
04a0: 20 28 75 73 65 73 20 6d 61 72 67 73 29 29 0a 3b (uses margs)).;
04b0: 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ; (declare (uses
04c0: 20 64 63 6f 6d 6d 6f 6e 29 29 0a 3b 3b 20 28 64 dcommon)).;; (d
04d0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 eclare (uses lau
04e0: 6e 63 68 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 nch)).;; (declar
04f0: 65 20 28 75 73 65 73 20 67 75 74 69 6c 73 29 29 e (uses gutils))
0500: 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 .;; (declare (us
0510: 65 73 20 64 62 29 29 0a 3b 3b 20 28 64 65 63 6c es db)).;; (decl
0520: 61 72 65 20 28 75 73 65 73 20 73 79 6e 63 68 61 are (uses syncha
0530: 73 68 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 sh)).;; (declare
0540: 20 28 75 73 65 73 20 73 65 72 76 65 72 29 29 0a (uses server)).
0550: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
0560: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
0570: 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 ).;; (declare (u
0580: 73 65 73 20 74 62 64 29 29 0a 0a 28 69 6e 63 6c ses tbd))..(incl
0590: 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d 66 6f ude "megatest-fo
05a0: 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a ssil-hash.scm").
05b0: 0a 3b 3b 0a 3b 3b 20 47 4c 4f 42 41 4c 53 0a 3b .;;.;; GLOBALS.;
05c0: 3b 0a 28 64 65 66 69 6e 65 20 2a 73 70 75 62 6c ;.(define *spubl
05d0: 69 73 68 3a 63 75 72 72 65 6e 74 2d 74 61 62 2d ish:current-tab-
05e0: 6e 75 6d 62 65 72 2a 20 30 29 0a 28 64 65 66 69 number* 0).(defi
05f0: 6e 65 20 2a 61 72 67 73 2d 68 61 73 68 2a 20 28 ne *args-hash* (
0600: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0610: 29 0a 28 64 65 66 69 6e 65 20 73 70 75 62 6c 69 ).(define spubli
0620: 73 68 3a 68 65 6c 70 20 28 63 6f 6e 63 20 22 55 sh:help (conc "U
0630: 73 61 67 65 3a 20 73 70 75 62 6c 69 73 68 20 5b sage: spublish [
0640: 61 63 74 69 6f 6e 20 5b 70 61 72 61 6d 73 20 2e action [params .
0650: 2e 2e 5d 5d 0a 0a 20 20 6c 73 20 20 20 20 20 20 ..]].. ls
0660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0670: 3a 20 6c 69 73 74 20 63 6f 6e 74 65 6e 74 73 20 : list contents
0680: 6f 66 20 74 61 72 67 65 74 20 61 72 65 61 0a 20 of target area.
0690: 20 63 70 7c 70 75 62 6c 69 73 68 20 3c 73 72 63 cp|publish <src
06a0: 20 66 69 6c 65 3e 20 3c 72 65 6c 61 74 69 76 65 file> <relative
06b0: 20 64 65 73 74 3e 20 20 20 20 20 20 3a 20 63 6f dest> : co
06c0: 70 79 20 66 69 6c 65 20 74 6f 20 74 61 72 67 65 py file to targe
06d0: 74 20 61 72 65 61 0a 20 20 6d 6b 64 69 72 20 3c t area. mkdir <
06e0: 64 69 72 20 6e 61 6d 65 3e 20 20 20 20 20 20 20 dir name>
06f0: 20 3a 20 6d 61 6b 65 73 20 64 69 72 65 63 74 6f : makes directo
0700: 72 79 20 69 6e 20 74 61 72 67 65 74 20 61 72 65 ry in target are
0710: 61 20 20 0a 20 20 72 6d 20 3c 66 69 6c 65 3e 20 a . rm <file>
0720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0730: 72 65 6d 6f 76 65 20 66 69 6c 65 20 3c 66 69 6c remove file <fil
0740: 65 3e 20 66 72 6f 6d 20 74 61 72 67 65 74 20 61 e> from target a
0750: 72 65 61 0a 20 20 6c 6e 20 3c 74 61 72 67 65 74 rea. ln <target
0760: 3e 20 3c 6c 69 6e 6b 20 6e 61 6d 65 3e 20 3a 20 > <link name> :
0770: 63 72 65 61 74 65 73 20 61 20 73 79 6d 6c 69 6e creates a symlin
0780: 6b 0a 20 20 6c 6f 67 20 20 20 20 20 20 20 20 20 k. log
0790: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 0a 0a : ..
07a0: 20 20 6f 70 74 69 6f 6e 73 3a 0a 0a 20 20 20 20 options:..
07b0: 2d 6d 20 5c 22 6d 65 73 73 61 67 65 5c 22 20 20 -m \"message\"
07c0: 20 20 20 20 20 20 3a 20 64 65 73 63 72 69 62 65 : describe
07d0: 20 77 68 61 74 20 77 61 73 20 64 6f 6e 65 0a 0a what was done..
07e0: 50 61 72 74 20 6f 66 20 74 68 65 20 4d 65 67 61 Part of the Mega
07f0: 74 65 73 74 20 74 6f 6f 6c 20 73 75 69 74 65 2e test tool suite.
0800: 0a 4c 65 61 72 6e 20 6d 6f 72 65 20 61 74 20 68 .Learn more at h
0810: 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 ttp://www.kiatoa
0820: 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 .com/fossils/meg
0830: 61 74 65 73 74 0a 0a 56 65 72 73 69 6f 6e 3a 20 atest..Version:
0840: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
0850: 6c 2d 68 61 73 68 29 29 20 3b 3b 20 22 0a 0a 3b l-hash)) ;; "..;
0860: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
0870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08a0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 45 43 4f 52 =======.;; RECOR
08b0: 44 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d DS.;;===========
08c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d ===========..;;=
0900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0940: 3d 3d 3d 3d 3d 0a 3b 3b 20 44 42 0a 3b 3b 3d 3d =====.;; DB.;;==
0950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0990: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 73 ====..(define (s
09a0: 70 75 62 6c 69 73 68 3a 69 6e 69 74 69 61 6c 69 publish:initiali
09b0: 7a 65 2d 64 62 20 64 62 29 0a 20 20 28 66 6f 72 ze-db db). (for
09c0: 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 -each. (lambda
09d0: 20 28 71 72 79 29 0a 20 20 20 20 20 28 65 78 65 (qry). (exe
09e0: 63 20 28 73 71 6c 20 64 62 20 71 72 79 29 29 29 c (sql db qry)))
09f0: 0a 20 20 20 28 6c 69 73 74 20 0a 20 20 20 20 22 . (list . "
0a00: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
0a10: 4e 4f 54 20 45 58 49 53 54 53 20 61 63 74 69 6f NOT EXISTS actio
0a20: 6e 73 0a 20 20 20 20 20 20 20 20 20 28 69 64 20 ns. (id
0a30: 20 20 20 20 20 20 20 20 20 20 49 4e 54 45 47 45 INTEGE
0a40: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
0a50: 20 20 20 20 20 20 20 20 20 61 63 74 69 6f 6e 20 action
0a60: 20 20 20 20 20 20 54 45 58 54 20 4e 4f 54 20 4e TEXT NOT N
0a70: 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 73 ULL,. s
0a80: 75 62 6d 69 74 74 65 72 20 20 20 20 54 45 58 54 ubmitter TEXT
0a90: 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 NOT NULL,.
0aa0: 20 20 20 20 20 64 61 74 65 74 69 6d 65 20 20 20 datetime
0ab0: 20 20 54 49 4d 45 53 54 41 4d 50 20 44 45 46 41 TIMESTAMP DEFA
0ac0: 55 4c 54 20 28 73 74 72 66 74 69 6d 65 28 27 25 ULT (strftime('%
0ad0: 73 27 2c 27 6e 6f 77 27 29 29 2c 0a 20 20 20 20 s','now')),.
0ae0: 20 20 20 20 20 20 73 72 63 70 61 74 68 20 20 20 srcpath
0af0: 20 20 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c 4c TEXT NOT NULL
0b00: 2c 0a 20 20 20 20 20 20 20 20 20 20 63 6f 6d 6d ,. comm
0b10: 65 6e 74 20 20 20 20 20 20 54 45 58 54 20 44 45 ent TEXT DE
0b20: 46 41 55 4c 54 20 27 27 20 4e 4f 54 20 4e 55 4c FAULT '' NOT NUL
0b30: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 73 74 61 L,. sta
0b40: 74 65 20 20 20 20 20 20 20 20 54 45 58 54 20 44 te TEXT D
0b50: 45 46 41 55 4c 54 20 27 6e 65 77 27 29 3b 22 0a EFAULT 'new');".
0b60: 20 20 20 20 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))..(define
0b70: 20 28 73 70 75 62 6c 69 73 68 3a 72 65 67 69 73 (spublish:regis
0b80: 74 65 72 2d 61 63 74 69 6f 6e 20 64 62 20 61 63 ter-action db ac
0b90: 74 69 6f 6e 20 73 75 62 6d 69 74 74 65 72 20 73 tion submitter s
0ba0: 6f 75 72 63 65 2d 70 61 74 68 20 63 6f 6d 6d 65 ource-path comme
0bb0: 6e 74 29 0a 20 20 28 65 78 65 63 20 28 73 71 6c nt). (exec (sql
0bc0: 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f db "INSERT INTO
0bd0: 20 61 63 74 69 6f 6e 73 20 28 61 63 74 69 6f 6e actions (action
0be0: 2c 73 75 62 6d 69 74 74 65 72 2c 73 72 63 70 61 ,submitter,srcpa
0bf0: 74 68 2c 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 th,comment).
0c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 56 41 4c VAL
0c10: 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 29 22 29 0a 09 UES(?,?,?,?)")..
0c20: 61 63 74 69 6f 6e 0a 09 73 75 62 6d 69 74 74 65 action..submitte
0c30: 72 0a 09 73 6f 75 72 63 65 2d 70 61 74 68 0a 09 r..source-path..
0c40: 63 6f 6d 6d 65 6e 74 29 29 0a 0a 3b 3b 20 28 63 comment))..;; (c
0c50: 61 6c 6c 2d 77 69 74 68 2d 64 61 74 61 62 61 73 all-with-databas
0c60: 65 0a 3b 3b 20 20 28 6c 61 6d 62 64 61 20 28 64 e.;; (lambda (d
0c70: 62 29 0a 3b 3b 20 20 20 28 73 65 74 2d 62 75 73 b).;; (set-bus
0c80: 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 28 62 y-handler! db (b
0c90: 75 73 79 2d 74 69 6d 65 6f 75 74 20 31 30 30 30 usy-timeout 1000
0ca0: 30 29 29 20 3b 20 31 30 20 73 65 63 6f 6e 64 20 0)) ; 10 second
0cb0: 74 69 6d 65 6f 75 74 0a 3b 3b 20 20 20 2e 2e 2e timeout.;; ...
0cc0: 29 29 0a 0a 3b 3b 20 43 72 65 61 74 65 20 74 68 ))..;; Create th
0cd0: 65 20 73 71 6c 69 74 65 20 64 62 0a 28 64 65 66 e sqlite db.(def
0ce0: 69 6e 65 20 28 73 70 75 62 6c 69 73 68 3a 64 62 ine (spublish:db
0cf0: 2d 64 6f 20 63 6f 6e 66 69 67 64 61 74 20 70 72 -do configdat pr
0d00: 6f 63 29 20 0a 20 20 28 6c 65 74 20 28 28 70 61 oc) . (let ((pa
0d10: 74 68 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b th (configf:look
0d20: 75 70 20 63 6f 6e 66 69 67 64 61 74 20 22 64 61 up configdat "da
0d30: 74 61 62 61 73 65 22 20 22 6c 6f 63 61 74 69 6f tabase" "locatio
0d40: 6e 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e n"))). (if (n
0d50: 6f 74 20 70 61 74 68 29 0a 09 28 62 65 67 69 6e ot path)..(begin
0d60: 0a 09 20 20 28 70 72 69 6e 74 20 22 5b 64 61 74 .. (print "[dat
0d70: 61 62 61 73 65 5d 5c 6e 6c 6f 63 61 74 69 6f 6e abase]\nlocation
0d80: 20 2f 73 6f 6d 65 2f 70 61 74 68 5c 6e 5c 6e 20 /some/path\n\n
0d90: 49 73 20 6d 69 73 73 69 6e 67 20 66 72 6f 6d 20 Is missing from
0da0: 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 21 the config file!
0db0: 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 ").. (exit 1)))
0dc0: 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 70 61 . (if (and pa
0dd0: 74 68 0a 09 20 20 20 20 20 28 64 69 72 65 63 74 th.. (direct
0de0: 6f 72 79 3f 20 70 61 74 68 29 0a 09 20 20 20 20 ory? path)..
0df0: 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 (file-read-acce
0e00: 73 73 3f 20 70 61 74 68 29 29 0a 09 28 6c 65 74 ss? path))..(let
0e10: 2a 20 28 28 64 62 70 61 74 68 20 20 20 20 28 63 * ((dbpath (c
0e20: 6f 6e 63 20 70 61 74 68 20 22 2f 73 70 75 62 6c onc path "/spubl
0e30: 69 73 68 2e 64 62 22 29 29 0a 09 20 20 20 20 20 ish.db"))..
0e40: 20 20 28 77 72 69 74 65 61 62 6c 65 20 28 66 69 (writeable (fi
0e50: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
0e60: 20 64 62 70 61 74 68 29 29 0a 09 20 20 20 20 20 dbpath))..
0e70: 20 20 28 64 62 65 78 69 73 74 73 20 20 28 66 69 (dbexists (fi
0e80: 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 70 61 74 le-exists? dbpat
0e90: 68 29 29 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d h))).. (handle-
0ea0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 exceptions.. e
0eb0: 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 xn.. (begin..
0ec0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0ed0: 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
0ee0: 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 70 72 port* "ERROR: pr
0ef0: 6f 62 6c 65 6d 20 61 63 63 65 73 73 69 6e 67 20 oblem accessing
0f00: 64 62 20 22 20 64 62 70 61 74 68 0a 09 09 09 20 db " dbpath....
0f10: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
0f20: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
0f30: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
0f40: 6e 29 29 0a 09 20 20 20 20 20 28 65 78 69 74 20 n)).. (exit
0f50: 31 29 29 0a 09 20 20 20 28 63 61 6c 6c 2d 77 69 1)).. (call-wi
0f60: 74 68 2d 64 61 74 61 62 61 73 65 0a 20 20 20 20 th-database.
0f70: 20 20 20 20 20 20 20 20 64 62 70 61 74 68 0a 09 dbpath..
0f80: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 29 (lambda (db)
0f90: 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e .. ;; (prin
0fa0: 74 20 22 63 61 6c 6c 69 6e 67 20 70 72 6f 63 20 t "calling proc
0fb0: 22 20 70 72 6f 63 20 22 20 6f 6e 20 64 62 20 22 " proc " on db "
0fc0: 20 64 62 29 0a 09 20 20 20 20 20 20 28 73 65 74 db).. (set
0fd0: 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 -busy-handler! d
0fe0: 62 20 28 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 b (busy-timeout
0ff0: 31 30 30 30 30 29 29 20 3b 3b 20 31 30 20 73 65 10000)) ;; 10 se
1000: 63 20 74 69 6d 65 6f 75 74 0a 09 20 20 20 20 20 c timeout..
1010: 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 69 73 (if (not dbexis
1020: 74 73 29 28 73 70 75 62 6c 69 73 68 3a 69 6e 69 ts)(spublish:ini
1030: 74 69 61 6c 69 7a 65 2d 64 62 20 64 62 29 29 0a tialize-db db)).
1040: 09 20 20 20 20 20 20 28 70 72 6f 63 20 64 62 29 . (proc db)
1050: 29 29 29 29 0a 09 28 70 72 69 6e 74 20 22 45 52 ))))..(print "ER
1060: 52 4f 52 3a 20 69 6e 76 61 6c 69 64 20 70 61 74 ROR: invalid pat
1070: 68 20 66 6f 72 20 73 74 6f 72 69 6e 67 20 64 61 h for storing da
1080: 74 61 62 61 73 65 3a 20 22 20 70 61 74 68 29 29 tabase: " path))
1090: 29 29 0a 0a 3b 3b 20 63 6f 70 79 20 69 6e 20 66 ))..;; copy in f
10a0: 69 6c 65 20 74 6f 20 64 65 73 74 2c 20 76 61 6c ile to dest, val
10b0: 69 64 61 74 69 6f 6e 20 69 73 20 64 6f 6e 65 20 idation is done
10c0: 42 45 46 4f 52 45 20 63 61 6c 6c 69 6e 67 20 74 BEFORE calling t
10d0: 68 69 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 his.;;.(define (
10e0: 73 70 75 62 6c 69 73 68 3a 63 70 20 63 6f 6e 66 spublish:cp conf
10f0: 69 67 64 61 74 20 73 75 62 6d 69 74 74 65 72 20 igdat submitter
1100: 73 6f 75 72 63 65 2d 70 61 74 68 20 74 61 72 67 source-path targ
1110: 65 74 2d 64 69 72 20 74 61 72 67 2d 66 69 6c 65 et-dir targ-file
1120: 20 64 65 73 74 2d 64 69 72 20 63 6f 6d 6d 65 6e dest-dir commen
1130: 74 29 0a 20 20 28 6c 65 74 20 28 28 64 65 73 74 t). (let ((dest
1140: 2d 64 69 72 2d 70 61 74 68 20 28 63 6f 6e 63 20 -dir-path (conc
1150: 74 61 72 67 65 74 2d 64 69 72 20 22 2f 22 20 64 target-dir "/" d
1160: 65 73 74 2d 64 69 72 29 29 0a 20 20 20 20 20 20 est-dir)).
1170: 20 20 28 74 61 72 67 2d 70 61 74 68 20 28 63 6f (targ-path (co
1180: 6e 63 20 74 61 72 67 65 74 2d 64 69 72 20 22 2f nc target-dir "/
1190: 22 20 64 65 73 74 2d 64 69 72 20 22 2f 22 20 74 " dest-dir "/" t
11a0: 61 72 67 2d 66 69 6c 65 29 29 29 0a 20 20 20 20 arg-file))).
11b0: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
11c0: 3f 20 74 61 72 67 2d 70 61 74 68 29 0a 09 28 62 ? targ-path)..(b
11d0: 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 egin.. (print "
11e0: 45 52 52 4f 52 3a 20 74 61 72 67 65 74 20 66 69 ERROR: target fi
11f0: 6c 65 20 61 6c 72 65 61 64 79 20 65 78 69 73 74 le already exist
1200: 73 2c 20 72 65 6d 6f 76 65 20 69 74 20 62 65 66 s, remove it bef
1210: 6f 72 65 20 72 65 2d 70 75 62 6c 69 73 68 69 6e ore re-publishin
1220: 67 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 g").. (exit 1))
1230: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f ). (if (no
1240: 74 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 t(file-exists? d
1250: 65 73 74 2d 64 69 72 2d 70 61 74 68 29 29 0a 09 est-dir-path))..
1260: 28 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 (begin.. (print
1270: 20 22 45 52 52 4f 52 3a 20 74 61 72 67 65 74 20 "ERROR: target
1280: 64 69 72 65 63 74 6f 72 79 20 22 20 20 74 61 72 directory " tar
1290: 67 65 74 2d 64 69 72 20 22 20 64 6f 65 73 20 6e get-dir " does n
12a0: 6f 74 20 65 78 69 73 74 73 2e 22 20 29 0a 09 20 ot exists." )..
12b0: 20 28 65 78 69 74 20 31 29 29 29 0a 0a 20 20 20 (exit 1)))..
12c0: 20 28 73 70 75 62 6c 69 73 68 3a 64 62 2d 64 6f (spublish:db-do
12d0: 0a 20 20 20 20 20 63 6f 6e 66 69 67 64 61 74 0a . configdat.
12e0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 (lambda (db
12f0: 29 0a 20 20 20 20 20 20 20 28 73 70 75 62 6c 69 ). (spubli
1300: 73 68 3a 72 65 67 69 73 74 65 72 2d 61 63 74 69 sh:register-acti
1310: 6f 6e 20 64 62 20 22 63 70 22 20 73 75 62 6d 69 on db "cp" submi
1320: 74 74 65 72 20 73 6f 75 72 63 65 2d 70 61 74 68 tter source-path
1330: 20 63 6f 6d 6d 65 6e 74 29 29 29 0a 20 20 20 20 comment))).
1340: 28 6c 65 74 2a 20 28 3b 3b 20 28 74 61 72 67 65 (let* (;; (targe
1350: 74 2d 70 61 74 68 20 28 63 6f 6e 66 69 67 66 3a t-path (configf:
1360: 6c 6f 6f 6b 75 70 20 22 73 65 74 74 69 6e 67 73 lookup "settings
1370: 22 20 22 74 61 72 67 65 74 2d 70 61 74 68 22 29 " "target-path")
1380: 29 0a 09 20 20 20 28 74 68 31 20 20 20 20 20 20 ).. (th1
1390: 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a (make-thread.
13a0: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 ... (lambda ()..
13b0: 09 09 20 20 20 28 66 69 6c 65 2d 63 6f 70 79 20 .. (file-copy
13c0: 73 6f 75 72 63 65 2d 70 61 74 68 20 74 61 72 67 source-path targ
13d0: 2d 70 61 74 68 20 23 74 29 29 0a 20 20 20 20 20 -path #t)).
13e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f0: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 (print "
1400: 2e 2e 2e 20 66 69 6c 65 20 22 20 74 61 72 67 2d ... file " targ-
1410: 70 61 74 68 20 22 20 63 6f 70 69 65 64 20 74 6f path " copied to
1420: 22 20 74 61 72 67 2d 70 61 74 68 29 0a 09 09 09 " targ-path)....
1430: 20 3b 3b 20 28 6c 65 74 20 28 28 70 69 64 20 28 ;; (let ((pid (
1440: 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 63 70 22 process-run "cp"
1450: 20 28 6c 69 73 74 20 73 6f 75 72 63 65 2d 70 61 (list source-pa
1460: 74 68 20 74 61 72 67 65 74 2d 64 69 72 29 29 29 th target-dir)))
1470: 29 0a 09 09 09 20 3b 3b 20 20 20 28 70 72 6f 63 ).... ;; (proc
1480: 65 73 73 2d 77 61 69 74 20 70 69 64 29 29 29 0a ess-wait pid))).
1490: 09 09 09 20 22 63 6f 70 79 20 74 68 72 65 61 64 ... "copy thread
14a0: 22 29 29 0a 09 20 20 20 28 74 68 32 20 20 20 20 ")).. (th2
14b0: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
14c0: 64 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 29 d.... (lambda ()
14d0: 0a 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 .... (let loop
14e0: 20 28 29 0a 09 09 09 20 20 20 20 20 28 74 68 72 ().... (thr
14f0: 65 61 64 2d 73 6c 65 65 70 21 20 31 35 29 0a 09 ead-sleep! 15)..
1500: 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 .. (display
1510: 22 2e 22 29 0a 09 09 09 20 20 20 20 20 28 66 6c ".").... (fl
1520: 75 73 68 2d 6f 75 74 70 75 74 29 0a 09 09 09 20 ush-output)....
1530: 20 20 20 20 28 6c 6f 6f 70 29 29 29 0a 09 09 09 (loop)))....
1540: 20 22 61 63 74 69 6f 6e 20 69 73 20 68 61 70 70 "action is happ
1550: 65 6e 69 6e 67 20 74 68 72 65 61 64 22 29 29 29 ening thread")))
1560: 0a 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
1570: 74 61 72 74 21 20 74 68 31 29 0a 20 20 20 20 20 tart! th1).
1580: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
1590: 74 68 32 29 0a 20 20 20 20 20 20 28 74 68 72 65 th2). (thre
15a0: 61 64 2d 6a 6f 69 6e 21 20 74 68 31 29 29 0a 20 ad-join! th1)).
15b0: 20 20 20 28 63 6f 6e 73 20 23 74 20 22 53 75 63 (cons #t "Suc
15c0: 63 65 73 73 66 75 6c 6c 79 20 73 61 76 65 64 20 cessfully saved
15d0: 64 61 74 61 22 29 29 29 0a 0a 28 64 65 66 69 6e data")))..(defin
15e0: 65 20 28 73 70 75 62 6c 69 73 68 3a 76 61 6c 69 e (spublish:vali
15f0: 64 61 74 65 20 74 61 72 67 65 74 2d 64 69 72 20 date target-dir
1600: 74 61 72 67 2d 6d 6b 29 0a 20 20 28 6c 65 74 2a targ-mk). (let*
1610: 20 28 28 6e 6f 72 6d 61 6c 2d 70 61 74 68 20 28 ((normal-path (
1620: 6e 6f 72 6d 61 6c 69 7a 65 2d 70 61 74 68 6e 61 normalize-pathna
1630: 6d 65 20 74 61 72 67 2d 6d 6b 29 29 0a 20 20 20 me targ-mk)).
1640: 20 20 20 20 20 28 74 61 72 67 2d 70 61 74 68 20 (targ-path
1650: 28 63 6f 6e 63 20 74 61 72 67 65 74 2d 64 69 72 (conc target-dir
1660: 20 22 2f 22 20 6e 6f 72 6d 61 6c 2d 70 61 74 68 "/" normal-path
1670: 29 29 29 0a 20 20 20 20 28 69 66 20 28 73 74 72 ))). (if (str
1680: 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 20 20 6e ing-contains n
1690: 6f 72 6d 61 6c 2d 70 61 74 68 20 22 2e 2e 22 29 ormal-path "..")
16a0: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
16b0: 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a (print "ERROR:
16c0: 20 50 61 74 68 20 20 22 20 74 61 72 67 2d 6d 6b Path " targ-mk
16d0: 20 22 20 72 65 73 6f 6c 76 65 64 20 6f 75 74 73 " resolved outs
16e0: 69 64 65 20 74 61 72 67 65 74 20 61 72 65 61 20 ide target area
16f0: 22 20 20 74 61 72 67 65 74 2d 64 69 72 20 29 0a " target-dir ).
1700: 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 (exit 1)))
1710: 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
1720: 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 string-contains
1730: 74 61 72 67 2d 70 61 74 68 20 74 61 72 67 65 74 targ-path target
1740: 2d 64 69 72 29 29 0a 20 20 20 20 28 62 65 67 69 -dir)). (begi
1750: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 n. (print "
1760: 45 52 52 4f 52 3a 20 59 6f 75 20 63 61 6e 6e 6f ERROR: You canno
1770: 74 20 75 70 64 61 74 65 20 64 61 74 61 20 6f 75 t update data ou
1780: 74 73 69 64 65 20 22 20 74 61 72 67 65 74 2d 64 tside " target-d
1790: 69 72 20 22 2e 22 29 0a 20 20 20 20 20 20 28 65 ir "."). (e
17a0: 78 69 74 20 31 29 29 29 0a 20 20 20 20 28 70 72 xit 1))). (pr
17b0: 69 6e 74 20 22 50 61 74 68 20 22 20 74 61 72 67 int "Path " targ
17c0: 2d 6d 6b 20 22 20 69 73 20 76 61 6c 69 64 2e 22 -mk " is valid."
17d0: 29 20 20 20 0a 20 29 29 0a 3b 3b 20 6d 61 6b 65 ) . )).;; make
17e0: 20 64 69 72 65 63 74 6f 72 79 20 69 6e 20 64 65 directory in de
17f0: 73 74 0a 3b 3b 0a 0a 28 64 65 66 69 6e 65 20 28 st.;;..(define (
1800: 73 70 75 62 6c 69 73 68 3a 6d 6b 64 69 72 20 63 spublish:mkdir c
1810: 6f 6e 66 69 67 64 61 74 20 73 75 62 6d 69 74 74 onfigdat submitt
1820: 65 72 20 74 61 72 67 65 74 2d 64 69 72 20 74 61 er target-dir ta
1830: 72 67 2d 6d 6b 20 63 6f 6d 6d 65 6e 74 29 0a 20 rg-mk comment).
1840: 20 28 6c 65 74 20 28 28 74 61 72 67 2d 70 61 74 (let ((targ-pat
1850: 68 20 28 63 6f 6e 63 20 74 61 72 67 65 74 2d 64 h (conc target-d
1860: 69 72 20 22 2f 22 20 74 61 72 67 2d 6d 6b 29 29 ir "/" targ-mk))
1870: 29 0a 20 20 20 20 0a 20 20 20 20 28 69 66 20 28 ). . (if (
1880: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 61 72 file-exists? tar
1890: 67 2d 70 61 74 68 29 0a 09 28 62 65 67 69 6e 0a g-path)..(begin.
18a0: 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 . (print "ERROR
18b0: 3a 20 74 61 72 67 65 74 20 44 69 72 65 63 74 6f : target Directo
18c0: 72 79 20 22 20 74 61 72 67 2d 70 61 74 68 20 22 ry " targ-path "
18d0: 20 61 6c 72 65 61 64 79 20 65 78 69 73 74 21 21 already exist!!
18e0: 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 ").. (exit 1)))
18f0: 0a 20 20 20 20 28 73 70 75 62 6c 69 73 68 3a 64 . (spublish:d
1900: 62 2d 64 6f 0a 20 20 20 20 20 63 6f 6e 66 69 67 b-do. config
1910: 64 61 74 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 dat. (lambda
1920: 20 28 64 62 29 0a 20 20 20 20 20 20 20 28 73 70 (db). (sp
1930: 75 62 6c 69 73 68 3a 72 65 67 69 73 74 65 72 2d ublish:register-
1940: 61 63 74 69 6f 6e 20 64 62 20 22 6d 6b 64 69 72 action db "mkdir
1950: 22 20 73 75 62 6d 69 74 74 65 72 20 74 61 72 67 " submitter targ
1960: 2d 6d 6b 20 63 6f 6d 6d 65 6e 74 29 29 29 0a 20 -mk comment))).
1970: 20 20 20 28 6c 65 74 2a 20 28 28 74 68 31 20 20 (let* ((th1
1980: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 (make-thr
1990: 65 61 64 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 ead.... (lambda
19a0: 28 29 0a 09 09 09 20 20 20 28 63 72 65 61 74 65 ().... (create
19b0: 2d 64 69 72 65 63 74 6f 72 79 20 74 61 72 67 2d -directory targ-
19c0: 70 61 74 68 20 23 74 29 0a 09 09 09 20 20 20 28 path #t).... (
19d0: 70 72 69 6e 74 20 22 20 2e 2e 2e 20 64 69 72 20 print " ... dir
19e0: 22 20 74 61 72 67 2d 70 61 74 68 20 22 20 63 72 " targ-path " cr
19f0: 65 61 74 65 64 22 29 29 0a 09 09 09 20 22 6d 6b eated")).... "mk
1a00: 64 69 72 20 74 68 72 65 61 64 22 29 29 0a 09 20 dir thread"))..
1a10: 20 20 28 74 68 32 20 20 20 20 20 20 20 20 20 28 (th2 (
1a20: 6d 61 6b 65 2d 74 68 72 65 61 64 0a 09 09 09 20 make-thread....
1a30: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 (lambda ()....
1a40: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 09 09 (let loop ()...
1a50: 09 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c . (thread-sl
1a60: 65 65 70 21 20 31 35 29 0a 09 09 09 20 20 20 20 eep! 15)....
1a70: 20 28 64 69 73 70 6c 61 79 20 22 2e 22 29 0a 09 (display ".")..
1a80: 09 09 20 20 20 20 20 28 66 6c 75 73 68 2d 6f 75 .. (flush-ou
1a90: 74 70 75 74 29 0a 09 09 09 20 20 20 20 20 28 6c tput).... (l
1aa0: 6f 6f 70 29 29 29 0a 09 09 09 20 22 61 63 74 69 oop))).... "acti
1ab0: 6f 6e 20 69 73 20 68 61 70 70 65 6e 69 6e 67 20 on is happening
1ac0: 74 68 72 65 61 64 22 29 29 29 0a 20 20 20 20 20 thread"))).
1ad0: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
1ae0: 74 68 31 29 0a 20 20 20 20 20 20 28 74 68 72 65 th1). (thre
1af0: 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 20 ad-start! th2).
1b00: 20 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 (thread-joi
1b10: 6e 21 20 74 68 31 29 29 0a 20 20 20 20 28 63 6f n! th1)). (co
1b20: 6e 73 20 23 74 20 22 53 75 63 63 65 73 73 66 75 ns #t "Successfu
1b30: 6c 6c 79 20 73 61 76 65 64 20 64 61 74 61 22 29 lly saved data")
1b40: 29 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 ))..;; create a
1b50: 73 79 6d 6c 69 6e 6b 20 69 6e 20 64 65 73 74 0a symlink in dest.
1b60: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 73 70 75 62 ;;.(define (spub
1b70: 6c 69 73 68 3a 6c 6e 20 63 6f 6e 66 69 67 64 61 lish:ln configda
1b80: 74 20 73 75 62 6d 69 74 74 65 72 20 74 61 72 67 t submitter targ
1b90: 65 74 2d 64 69 72 20 74 61 72 67 2d 6c 69 6e 6b et-dir targ-link
1ba0: 20 6c 69 6e 6b 2d 6e 61 6d 65 20 63 6f 6d 6d 65 link-name comme
1bb0: 6e 74 29 0a 20 20 28 6c 65 74 20 28 28 74 61 72 nt). (let ((tar
1bc0: 67 2d 70 61 74 68 20 28 63 6f 6e 63 20 74 61 72 g-path (conc tar
1bd0: 67 65 74 2d 64 69 72 20 22 2f 22 20 6c 69 6e 6b get-dir "/" link
1be0: 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 69 66 -name))). (if
1bf0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 (file-exists? t
1c00: 61 72 67 2d 70 61 74 68 29 0a 09 28 62 65 67 69 arg-path)..(begi
1c10: 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 n.. (print "ERR
1c20: 4f 52 3a 20 74 61 72 67 65 74 20 66 69 6c 65 20 OR: target file
1c30: 22 20 74 61 72 67 2d 70 61 74 68 20 22 20 61 6c " targ-path " al
1c40: 72 65 61 64 79 20 65 78 69 73 74 21 21 22 29 0a ready exist!!").
1c50: 09 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 . (exit 1))).
1c60: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c (if (not (fil
1c70: 65 2d 65 78 69 73 74 73 3f 20 74 61 72 67 2d 6c e-exists? targ-l
1c80: 69 6e 6b 20 29 29 0a 09 28 62 65 67 69 6e 0a 09 ink ))..(begin..
1c90: 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a (print "ERROR:
1ca0: 20 74 61 72 67 65 74 20 66 69 6c 65 20 22 20 74 target file " t
1cb0: 61 72 67 2d 6c 69 6e 6b 20 22 20 64 6f 65 73 20 arg-link " does
1cc0: 6e 6f 74 20 65 78 69 73 74 21 21 22 29 0a 09 20 not exist!!")..
1cd0: 20 28 65 78 69 74 20 31 29 29 29 0a 20 0a 20 20 (exit 1))). .
1ce0: 20 20 28 73 70 75 62 6c 69 73 68 3a 64 62 2d 64 (spublish:db-d
1cf0: 6f 0a 20 20 20 20 20 63 6f 6e 66 69 67 64 61 74 o. configdat
1d00: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 . (lambda (d
1d10: 62 29 0a 20 20 20 20 20 20 20 28 73 70 75 62 6c b). (spubl
1d20: 69 73 68 3a 72 65 67 69 73 74 65 72 2d 61 63 74 ish:register-act
1d30: 69 6f 6e 20 64 62 20 22 6c 6e 22 20 73 75 62 6d ion db "ln" subm
1d40: 69 74 74 65 72 20 6c 69 6e 6b 2d 6e 61 6d 65 20 itter link-name
1d50: 63 6f 6d 6d 65 6e 74 29 29 29 0a 20 20 20 20 28 comment))). (
1d60: 6c 65 74 2a 20 28 28 74 68 31 20 20 20 20 20 20 let* ((th1
1d70: 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a (make-thread.
1d80: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 ... (lambda ()..
1d90: 09 09 20 20 20 28 63 72 65 61 74 65 2d 73 79 6d .. (create-sym
1da0: 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 61 72 67 2d bolic-link targ-
1db0: 6c 69 6e 6b 20 74 61 72 67 2d 70 61 74 68 20 20 link targ-path
1dc0: 29 0a 09 09 09 20 20 20 28 70 72 69 6e 74 20 22 ).... (print "
1dd0: 20 2e 2e 2e 20 6c 69 6e 6b 20 22 20 74 61 72 67 ... link " targ
1de0: 2d 70 61 74 68 20 22 20 63 72 65 61 74 65 64 22 -path " created"
1df0: 29 29 0a 09 09 09 20 22 73 79 6d 6c 69 6e 6b 20 )).... "symlink
1e00: 74 68 72 65 61 64 22 29 29 0a 09 20 20 20 28 74 thread")).. (t
1e10: 68 32 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 h2 (make
1e20: 2d 74 68 72 65 61 64 0a 09 09 09 20 28 6c 61 6d -thread.... (lam
1e30: 62 64 61 20 28 29 0a 09 09 09 20 20 20 28 6c 65 bda ().... (le
1e40: 74 20 6c 6f 6f 70 20 28 29 0a 09 09 09 20 20 20 t loop ()....
1e50: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
1e60: 20 31 35 29 0a 09 09 09 20 20 20 20 20 28 64 69 15).... (di
1e70: 73 70 6c 61 79 20 22 2e 22 29 0a 09 09 09 20 20 splay ".")....
1e80: 20 20 20 28 66 6c 75 73 68 2d 6f 75 74 70 75 74 (flush-output
1e90: 29 0a 09 09 09 20 20 20 20 20 28 6c 6f 6f 70 29 ).... (loop)
1ea0: 29 29 0a 09 09 09 20 22 61 63 74 69 6f 6e 20 69 )).... "action i
1eb0: 73 20 68 61 70 70 65 6e 69 6e 67 20 74 68 72 65 s happening thre
1ec0: 61 64 22 29 29 29 0a 20 20 20 20 20 20 28 74 68 ad"))). (th
1ed0: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1)
1ee0: 0a 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
1ef0: 74 61 72 74 21 20 74 68 32 29 0a 20 20 20 20 20 tart! th2).
1f00: 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 (thread-join! t
1f10: 68 31 29 29 0a 20 20 20 20 28 63 6f 6e 73 20 23 h1)). (cons #
1f20: 74 20 22 53 75 63 63 65 73 73 66 75 6c 6c 79 20 t "Successfully
1f30: 73 61 76 65 64 20 64 61 74 61 22 29 29 29 0a 0a saved data")))..
1f40: 0a 3b 3b 20 72 65 6d 6f 76 65 20 63 6f 70 79 20 .;; remove copy
1f50: 6f 66 20 66 69 6c 65 20 69 6e 20 64 65 73 74 0a of file in dest.
1f60: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 73 70 75 62 ;;.(define (spub
1f70: 6c 69 73 68 3a 72 6d 20 63 6f 6e 66 69 67 64 61 lish:rm configda
1f80: 74 20 73 75 62 6d 69 74 74 65 72 20 74 61 72 67 t submitter targ
1f90: 65 74 2d 64 69 72 20 74 61 72 67 2d 66 69 6c 65 et-dir targ-file
1fa0: 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 6c 65 74 comment). (let
1fb0: 20 28 28 74 61 72 67 2d 70 61 74 68 20 28 63 6f ((targ-path (co
1fc0: 6e 63 20 74 61 72 67 65 74 2d 64 69 72 20 22 2f nc target-dir "/
1fd0: 22 20 74 61 72 67 2d 66 69 6c 65 29 29 29 0a 20 " targ-file))).
1fe0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c (if (not (fil
1ff0: 65 2d 65 78 69 73 74 73 3f 20 74 61 72 67 2d 70 e-exists? targ-p
2000: 61 74 68 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 ath))..(begin..
2010: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
2020: 74 61 72 67 65 74 20 66 69 6c 65 20 22 20 74 61 target file " ta
2030: 72 67 2d 70 61 74 68 20 22 20 6e 6f 74 20 66 6f rg-path " not fo
2040: 75 6e 64 2c 20 6e 6f 74 68 69 6e 67 20 74 6f 20 und, nothing to
2050: 72 65 6d 6f 76 65 2e 22 29 0a 09 20 20 28 65 78 remove.").. (ex
2060: 69 74 20 31 29 29 29 0a 20 20 20 20 28 73 70 75 it 1))). (spu
2070: 62 6c 69 73 68 3a 64 62 2d 64 6f 0a 20 20 20 20 blish:db-do.
2080: 20 63 6f 6e 66 69 67 64 61 74 0a 20 20 20 20 20 configdat.
2090: 28 6c 61 6d 62 64 61 20 28 64 62 29 0a 20 20 20 (lambda (db).
20a0: 20 20 20 20 28 73 70 75 62 6c 69 73 68 3a 72 65 (spublish:re
20b0: 67 69 73 74 65 72 2d 61 63 74 69 6f 6e 20 64 62 gister-action db
20c0: 20 22 72 6d 22 20 73 75 62 6d 69 74 74 65 72 20 "rm" submitter
20d0: 74 61 72 67 2d 66 69 6c 65 20 63 6f 6d 6d 65 6e targ-file commen
20e0: 74 29 29 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 t))). (let* (
20f0: 28 74 68 31 20 20 20 20 20 20 20 20 20 28 6d 61 (th1 (ma
2100: 6b 65 2d 74 68 72 65 61 64 0a 09 09 09 20 28 6c ke-thread.... (l
2110: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 28 ambda ().... (
2120: 64 65 6c 65 74 65 2d 66 69 6c 65 20 74 61 72 67 delete-file targ
2130: 2d 70 61 74 68 29 0a 09 09 09 20 20 20 28 70 72 -path).... (pr
2140: 69 6e 74 20 22 20 2e 2e 2e 20 66 69 6c 65 20 22 int " ... file "
2150: 20 74 61 72 67 2d 70 61 74 68 20 22 20 72 65 6d targ-path " rem
2160: 6f 76 65 64 22 29 29 0a 09 09 09 20 22 72 6d 20 oved")).... "rm
2170: 74 68 72 65 61 64 22 29 29 0a 09 20 20 20 28 74 thread")).. (t
2180: 68 32 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 h2 (make
2190: 2d 74 68 72 65 61 64 0a 09 09 09 20 28 6c 61 6d -thread.... (lam
21a0: 62 64 61 20 28 29 0a 09 09 09 20 20 20 28 6c 65 bda ().... (le
21b0: 74 20 6c 6f 6f 70 20 28 29 0a 09 09 09 20 20 20 t loop ()....
21c0: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
21d0: 20 31 35 29 0a 09 09 09 20 20 20 20 20 28 64 69 15).... (di
21e0: 73 70 6c 61 79 20 22 2e 22 29 0a 09 09 09 20 20 splay ".")....
21f0: 20 20 20 28 66 6c 75 73 68 2d 6f 75 74 70 75 74 (flush-output
2200: 29 0a 09 09 09 20 20 20 20 20 28 6c 6f 6f 70 29 ).... (loop)
2210: 29 29 0a 09 09 09 20 22 61 63 74 69 6f 6e 20 69 )).... "action i
2220: 73 20 68 61 70 70 65 6e 69 6e 67 20 74 68 72 65 s happening thre
2230: 61 64 22 29 29 29 0a 20 20 20 20 20 20 28 74 68 ad"))). (th
2240: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1)
2250: 0a 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
2260: 74 61 72 74 21 20 74 68 32 29 0a 20 20 20 20 20 tart! th2).
2270: 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 (thread-join! t
2280: 68 31 29 29 0a 20 20 20 20 28 63 6f 6e 73 20 23 h1)). (cons #
2290: 74 20 22 53 75 63 63 65 73 73 66 75 6c 6c 79 20 t "Successfully
22a0: 73 61 76 65 64 20 64 61 74 61 22 29 29 29 0a 0a saved data")))..
22b0: 28 64 65 66 69 6e 65 20 28 73 70 75 62 6c 69 73 (define (spublis
22c0: 68 3a 62 61 63 6b 75 70 2d 6d 6f 76 65 20 70 61 h:backup-move pa
22d0: 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 72 th). (let* ((tr
22e0: 61 73 68 64 69 72 20 20 28 63 6f 6e 63 20 28 70 ashdir (conc (p
22f0: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
2300: 79 20 70 61 74 68 29 20 22 2f 2e 74 72 61 73 68 y path) "/.trash
2310: 22 29 29 0a 09 20 28 74 72 61 73 68 66 69 6c 65 ")).. (trashfile
2320: 20 28 63 6f 6e 63 20 74 72 61 73 68 64 69 72 20 (conc trashdir
2330: 22 2f 22 20 28 63 75 72 72 65 6e 74 2d 73 65 63 "/" (current-sec
2340: 6f 6e 64 73 29 20 22 2d 22 20 28 70 61 74 68 6e onds) "-" (pathn
2350: 61 6d 65 2d 66 69 6c 65 20 70 61 74 68 29 29 29 ame-file path)))
2360: 29 0a 20 20 20 20 28 63 72 65 61 74 65 2d 64 69 ). (create-di
2370: 72 65 63 74 6f 72 79 20 74 72 61 73 68 64 69 72 rectory trashdir
2380: 20 23 74 29 0a 20 20 20 20 28 69 66 20 28 64 69 #t). (if (di
2390: 72 65 63 74 6f 72 79 3f 20 70 61 74 68 29 0a 09 rectory? path)..
23a0: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d (system (conc "m
23b0: 76 20 22 20 70 61 74 68 20 22 20 22 20 74 72 61 v " path " " tra
23c0: 73 68 66 69 6c 65 29 29 0a 09 28 66 69 6c 65 2d shfile))..(file-
23d0: 6d 6f 76 65 20 70 61 74 68 20 74 72 61 73 68 2d move path trash-
23e0: 66 69 6c 65 29 29 29 29 0a 0a 0a 28 64 65 66 69 file))))...(defi
23f0: 6e 65 20 28 73 70 75 62 6c 69 73 68 3a 6c 73 74 ne (spublish:lst
2400: 2d 3e 70 61 74 68 20 70 61 74 68 6c 73 74 29 0a ->path pathlst).
2410: 20 20 28 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 (conc "/" (str
2420: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
2430: 28 6d 61 70 20 63 6f 6e 63 20 70 61 74 68 6c 73 (map conc pathls
2440: 74 29 20 22 2f 22 29 29 29 0a 0a 28 64 65 66 69 t) "/")))..(defi
2450: 6e 65 20 28 73 70 75 62 6c 69 73 68 3a 70 61 74 ne (spublish:pat
2460: 68 2d 3e 6c 73 74 20 70 61 74 68 29 0a 20 20 28 h->lst path). (
2470: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 61 74 string-split pat
2480: 68 20 22 2f 22 29 29 0a 0a 28 64 65 66 69 6e 65 h "/"))..(define
2490: 20 28 73 70 75 62 6c 69 73 68 3a 70 61 74 68 64 (spublish:pathd
24a0: 61 74 2d 61 70 70 6c 79 2d 68 65 75 72 69 73 74 at-apply-heurist
24b0: 69 63 73 20 63 6f 6e 66 69 67 64 61 74 20 70 61 ics configdat pa
24c0: 74 68 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 th). (cond. (
24d0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 61 (file-exists? pa
24e0: 74 68 29 20 22 66 6f 75 6e 64 22 29 0a 20 20 20 th) "found").
24f0: 28 65 6c 73 65 20 28 63 6f 6e 63 20 70 61 74 68 (else (conc path
2500: 20 22 20 6e 6f 74 20 69 6e 73 74 61 6c 6c 65 64 " not installed
2510: 22 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d "))))..;;=======
2520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2560: 3b 3b 20 4d 49 53 43 0a 3b 3b 3d 3d 3d 3d 3d 3d ;; MISC.;;======
2570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25b0: 0a 0a 28 64 65 66 69 6e 65 20 28 73 70 75 62 6c ..(define (spubl
25c0: 69 73 68 3a 64 6f 2d 61 73 2d 63 61 6c 6c 69 6e ish:do-as-callin
25d0: 67 2d 75 73 65 72 20 70 72 6f 63 29 0a 20 20 28 g-user proc). (
25e0: 6c 65 74 20 28 28 65 69 64 20 28 63 75 72 72 65 let ((eid (curre
25f0: 6e 74 2d 65 66 66 65 63 74 69 76 65 2d 75 73 65 nt-effective-use
2600: 72 2d 69 64 29 29 0a 20 20 20 20 20 20 20 20 28 r-id)). (
2610: 63 69 64 20 28 63 75 72 72 65 6e 74 2d 75 73 65 cid (current-use
2620: 72 2d 69 64 29 29 29 0a 20 20 20 20 28 69 66 20 r-id))). (if
2630: 28 6e 6f 74 20 28 65 71 3f 20 65 69 64 20 63 69 (not (eq? eid ci
2640: 64 29 29 20 3b 3b 20 72 75 6e 6e 69 6e 67 20 73 d)) ;; running s
2650: 75 69 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 uid.
2660: 28 73 65 74 21 20 28 63 75 72 72 65 6e 74 2d 65 (set! (current-e
2670: 66 66 65 63 74 69 76 65 2d 75 73 65 72 2d 69 64 ffective-user-id
2680: 29 20 63 69 64 29 29 0a 20 20 20 20 3b 3b 20 28 ) cid)). ;; (
2690: 70 72 69 6e 74 20 22 72 75 6e 6e 69 6e 67 20 61 print "running a
26a0: 73 20 22 20 28 63 75 72 72 65 6e 74 2d 65 66 66 s " (current-eff
26b0: 65 63 74 69 76 65 2d 75 73 65 72 2d 69 64 29 29 ective-user-id))
26c0: 0a 20 20 20 20 28 70 72 6f 63 29 0a 20 20 20 20 . (proc).
26d0: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 65 69 (if (not (eq? ei
26e0: 64 20 63 69 64 29 29 0a 20 20 20 20 20 20 20 20 d cid)).
26f0: 28 73 65 74 21 20 28 63 75 72 72 65 6e 74 2d 65 (set! (current-e
2700: 66 66 65 63 74 69 76 65 2d 75 73 65 72 2d 69 64 ffective-user-id
2710: 29 20 65 69 64 29 29 29 29 0a 0a 28 64 65 66 69 ) eid))))..(defi
2720: 6e 65 20 28 73 70 75 62 6c 69 73 68 3a 66 69 6e ne (spublish:fin
2730: 64 20 6e 61 6d 65 20 70 61 74 68 73 29 0a 20 20 d name paths).
2740: 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 74 68 73 (if (null? paths
2750: 29 0a 20 20 20 20 20 20 23 66 0a 20 20 20 20 20 ). #f.
2760: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
2770: 20 28 63 61 72 20 70 61 74 68 73 29 29 0a 09 09 (car paths))...
2780: 20 28 74 61 6c 20 28 63 64 72 20 70 61 74 68 73 (tal (cdr paths
2790: 29 29 29 0a 09 28 69 66 20 28 66 69 6c 65 2d 65 )))..(if (file-e
27a0: 78 69 73 74 73 3f 20 28 63 6f 6e 63 20 68 65 64 xists? (conc hed
27b0: 20 22 2f 22 20 6e 61 6d 65 29 29 0a 09 20 20 20 "/" name))..
27c0: 20 68 65 64 0a 09 20 20 20 20 28 69 66 20 28 6e hed.. (if (n
27d0: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 23 66 0a 09 ull? tal)...#f..
27e0: 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 .(loop (car tal)
27f0: 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 0a (cdr tal))))))).
2800: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 41 49 =========.;; MAI
2850: 4e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d N.;;============
2860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
28a0: 69 6e 65 20 28 73 70 75 62 6c 69 73 68 3a 6c 6f ine (spublish:lo
28b0: 61 64 2d 63 6f 6e 66 69 67 20 65 78 65 2d 64 69 ad-config exe-di
28c0: 72 20 65 78 65 2d 6e 61 6d 65 29 0a 20 20 28 6c r exe-name). (l
28d0: 65 74 2a 20 28 28 66 6e 61 6d 65 20 20 20 28 63 et* ((fname (c
28e0: 6f 6e 63 20 65 78 65 2d 64 69 72 20 22 2f 2e 22 onc exe-dir "/."
28f0: 20 65 78 65 2d 6e 61 6d 65 20 22 2e 63 6f 6e 66 exe-name ".conf
2900: 69 67 22 29 29 29 0a 20 20 20 20 28 69 6e 69 3a ig"))). (ini:
2910: 70 72 6f 70 65 72 74 79 2d 73 65 70 61 72 61 74 property-separat
2920: 6f 72 2d 70 61 74 74 20 22 20 2a 20 20 2a 22 29 or-patt " * *")
2930: 0a 20 20 20 20 28 69 6e 69 3a 70 72 6f 70 65 72 . (ini:proper
2940: 74 79 2d 73 65 70 61 72 61 74 6f 72 20 23 5c 73 ty-separator #\s
2950: 70 61 63 65 29 0a 20 20 20 20 28 69 66 20 28 66 pace). (if (f
2960: 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d ile-exists? fnam
2970: 65 29 0a 09 3b 3b 20 28 69 6e 69 3a 72 65 61 64 e)..;; (ini:read
2980: 2d 69 6e 69 20 66 6e 61 6d 65 29 0a 09 28 72 65 -ini fname)..(re
2990: 61 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 ad-config fname
29a0: 23 66 20 23 74 29 0a 09 28 6d 61 6b 65 2d 68 61 #f #t)..(make-ha
29b0: 73 68 2d 74 61 62 6c 65 29 29 29 29 0a 0a 28 64 sh-table))))..(d
29c0: 65 66 69 6e 65 20 28 73 70 75 62 6c 69 73 68 3a efine (spublish:
29d0: 70 72 6f 63 65 73 73 2d 61 63 74 69 6f 6e 20 63 process-action c
29e0: 6f 6e 66 69 67 64 61 74 20 61 63 74 69 6f 6e 20 onfigdat action
29f0: 2e 20 61 72 67 73 29 0a 20 20 28 6c 65 74 2a 20 . args). (let*
2a00: 28 28 74 61 72 67 65 74 2d 64 69 72 20 20 20 20 ((target-dir
2a10: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
2a20: 63 6f 6e 66 69 67 64 61 74 20 22 73 65 74 74 69 configdat "setti
2a30: 6e 67 73 22 20 22 74 61 72 67 65 74 2d 64 69 72 ngs" "target-dir
2a40: 22 29 29 0a 09 20 28 75 73 65 72 20 20 20 20 20 ")).. (user
2a50: 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 75 73 (current-us
2a60: 65 72 2d 6e 61 6d 65 29 29 0a 09 20 28 61 6c 6c er-name)).. (all
2a70: 6f 77 65 64 2d 75 73 65 72 73 20 28 73 74 72 69 owed-users (stri
2a80: 6e 67 2d 73 70 6c 69 74 0a 09 09 09 20 28 6f 72 ng-split.... (or
2a90: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
2aa0: 20 63 6f 6e 66 69 67 64 61 74 20 22 73 65 74 74 configdat "sett
2ab0: 69 6e 67 73 22 20 22 61 6c 6c 6f 77 65 64 2d 75 ings" "allowed-u
2ac0: 73 65 72 73 22 29 0a 09 09 09 20 20 20 20 20 22 sers").... "
2ad0: 22 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e ")))). (if (n
2ae0: 6f 74 20 74 61 72 67 65 74 2d 64 69 72 29 0a 09 ot target-dir)..
2af0: 28 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 (begin.. (print
2b00: 20 22 5b 73 65 74 74 69 6e 67 73 5d 5c 6e 74 61 "[settings]\nta
2b10: 72 67 65 74 2d 64 69 72 20 2f 73 6f 6d 65 2f 70 rget-dir /some/p
2b20: 61 74 68 5c 6e 5c 6e 20 49 73 20 4d 49 53 53 49 ath\n\n Is MISSI
2b30: 4e 47 20 66 72 6f 6d 20 74 68 65 20 63 6f 6e 66 NG from the conf
2b40: 69 67 20 66 69 6c 65 21 22 29 0a 09 20 20 28 65 ig file!").. (e
2b50: 78 69 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 xit))). (if (
2b60: 6e 75 6c 6c 3f 20 61 6c 6c 6f 77 65 64 2d 75 73 null? allowed-us
2b70: 65 72 73 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 ers)..(begin..
2b80: 28 70 72 69 6e 74 20 22 5b 73 65 74 69 6e 67 73 (print "[setings
2b90: 5d 5c 6e 61 6c 6c 6f 77 65 64 2d 75 73 65 72 73 ]\nallowed-users
2ba0: 20 75 73 65 72 31 20 75 73 65 72 32 20 2e 2e 2e user1 user2 ...
2bb0: 5c 6e 5c 6e 20 49 73 20 4d 49 53 53 49 4e 47 20 \n\n Is MISSING
2bc0: 66 72 6f 6d 20 74 68 65 20 63 6f 6e 66 69 67 20 from the config
2bd0: 66 69 6c 65 21 22 29 0a 09 20 20 28 65 78 69 74 file!").. (exit
2be0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ))). (if (not
2bf0: 20 28 6d 65 6d 62 65 72 20 75 73 65 72 20 61 6c (member user al
2c00: 6c 6f 77 65 64 2d 75 73 65 72 73 29 29 0a 09 28 lowed-users))..(
2c10: 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 begin.. (print
2c20: 22 55 73 65 72 20 5c 22 22 20 28 63 75 72 72 65 "User \"" (curre
2c30: 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 22 5c nt-user-name) "\
2c40: 22 20 64 6f 65 73 20 6e 6f 74 20 68 61 76 65 20 " does not have
2c50: 61 63 63 65 73 73 2e 20 45 78 69 74 69 6e 67 22 access. Exiting"
2c60: 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 0a ).. (exit 1))).
2c70: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
2c80: 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 6f 6e g->symbol action
2c90: 29 0a 20 20 20 20 20 20 28 28 63 70 20 70 75 62 ). ((cp pub
2ca0: 6c 69 73 68 29 0a 20 20 20 20 20 20 20 28 69 66 lish). (if
2cb0: 20 28 3c 20 28 6c 65 6e 67 74 68 20 61 72 67 73 (< (length args
2cc0: 29 20 32 29 0a 09 20 20 20 28 62 65 67 69 6e 20 ) 2).. (begin
2cd0: 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 .. (print "E
2ce0: 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 61 72 RROR: Missing ar
2cf0: 67 75 6d 65 6e 74 73 3b 20 22 20 28 73 74 72 69 guments; " (stri
2d00: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 ng-intersperse a
2d10: 72 67 73 20 22 2c 20 22 29 29 0a 09 20 20 20 20 rgs ", "))..
2d20: 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
2d30: 20 20 20 28 6c 65 74 2a 20 28 28 72 65 6d 61 72 (let* ((remar
2d40: 67 73 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 gs (args:get
2d50: 2d 61 72 67 73 20 61 72 67 73 20 27 28 22 2d 6d -args args '("-m
2d60: 22 29 20 27 28 29 20 61 72 67 73 3a 61 72 67 2d ") '() args:arg-
2d70: 68 61 73 68 20 30 29 29 0a 20 20 20 20 20 20 20 hash 0)).
2d80: 20 20 20 20 20 20 20 28 64 65 73 74 2d 64 69 72 (dest-dir
2d90: 20 28 63 61 64 72 20 61 72 67 73 29 29 0a 20 20 (cadr args)).
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 63 (src
2db0: 2d 70 61 74 68 2d 69 6e 20 28 63 61 72 20 61 72 -path-in (car ar
2dc0: 67 73 29 29 0a 09 20 20 20 20 20 20 28 73 72 63 gs)).. (src
2dd0: 2d 70 61 74 68 20 20 20 20 28 77 69 74 68 2d 69 -path (with-i
2de0: 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 70 65 0a 09 nput-from-pipe..
2df0: 09 09 20 20 20 20 28 63 6f 6e 63 20 22 72 65 61 .. (conc "rea
2e00: 64 6c 69 6e 6b 20 2d 66 20 22 20 73 72 63 2d 70 dlink -f " src-p
2e10: 61 74 68 2d 69 6e 29 0a 09 09 09 20 20 20 20 28 ath-in).... (
2e20: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 lambda ()....
2e30: 20 20 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 (read-line)))
2e40: 29 0a 09 20 20 20 20 20 20 28 6d 73 67 20 20 20 ).. (msg
2e50: 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
2e60: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 22 22 get-arg "-m") ""
2e70: 29 29 0a 09 20 20 20 20 20 20 28 74 61 72 67 2d )).. (targ-
2e80: 66 69 6c 65 20 20 20 28 70 61 74 68 6e 61 6d 65 file (pathname
2e90: 2d 73 74 72 69 70 2d 64 69 72 65 63 74 6f 72 79 -strip-directory
2ea0: 20 73 72 63 2d 70 61 74 68 29 29 29 0a 09 20 28 src-path))).. (
2eb0: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 72 65 if (not (file-re
2ec0: 61 64 2d 61 63 63 65 73 73 3f 20 73 72 63 2d 70 ad-access? src-p
2ed0: 61 74 68 29 29 0a 09 20 20 20 20 20 28 62 65 67 ath)).. (beg
2ee0: 69 6e 0a 09 20 20 20 20 20 20 20 28 70 72 69 6e in.. (prin
2ef0: 74 20 22 45 52 52 4f 52 3a 20 73 6f 75 72 63 65 t "ERROR: source
2f00: 20 66 69 6c 65 20 6e 6f 74 20 72 65 61 64 61 62 file not readab
2f10: 6c 65 3a 20 22 20 73 72 63 2d 70 61 74 68 29 0a le: " src-path).
2f20: 09 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 . (exit 1)
2f30: 29 29 0a 09 20 28 69 66 20 28 64 69 72 65 63 74 )).. (if (direct
2f40: 6f 72 79 3f 20 73 72 63 2d 70 61 74 68 29 0a 09 ory? src-path)..
2f50: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 (begin..
2f60: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
2f70: 52 3a 20 73 6f 75 72 63 65 20 66 69 6c 65 20 69 R: source file i
2f80: 73 20 61 20 64 69 72 65 63 74 6f 72 79 2c 20 74 s a directory, t
2f90: 68 69 73 20 69 73 20 6e 6f 74 20 73 75 70 70 6f his is not suppo
2fa0: 72 74 65 64 20 79 65 74 2e 22 29 0a 09 20 20 20 rted yet.")..
2fb0: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 (exit 1)))..
2fc0: 20 28 70 72 69 6e 74 20 22 70 75 62 6c 69 73 68 (print "publish
2fd0: 69 6e 67 20 22 20 73 72 63 2d 70 61 74 68 2d 69 ing " src-path-i
2fe0: 6e 20 22 20 74 6f 20 22 20 74 61 72 67 65 74 2d n " to " target-
2ff0: 64 69 72 29 0a 20 20 20 20 20 20 20 20 20 28 73 dir). (s
3000: 70 75 62 6c 69 73 68 3a 76 61 6c 69 64 61 74 65 publish:validate
3010: 20 20 20 20 20 74 61 72 67 65 74 2d 64 69 72 20 target-dir
3020: 64 65 73 74 2d 64 69 72 29 0a 09 20 28 73 70 75 dest-dir).. (spu
3030: 62 6c 69 73 68 3a 63 70 20 63 6f 6e 66 69 67 64 blish:cp configd
3040: 61 74 20 75 73 65 72 20 73 72 63 2d 70 61 74 68 at user src-path
3050: 20 74 61 72 67 65 74 2d 64 69 72 20 74 61 72 67 target-dir targ
3060: 2d 66 69 6c 65 20 64 65 73 74 2d 64 69 72 20 6d -file dest-dir m
3070: 73 67 29 29 29 0a 20 20 20 20 20 20 28 28 6d 6b sg))). ((mk
3080: 64 69 72 29 0a 20 20 20 20 20 20 20 20 28 69 66 dir). (if
3090: 20 28 3c 20 28 6c 65 6e 67 74 68 20 61 72 67 73 (< (length args
30a0: 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 28 ) 1). (
30b0: 62 65 67 69 6e 20 0a 09 20 20 20 20 20 28 70 72 begin .. (pr
30c0: 69 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 int "ERROR: Miss
30d0: 69 6e 67 20 61 72 67 75 6d 65 6e 74 73 3b 20 22 ing arguments; "
30e0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
30f0: 65 72 73 65 20 61 72 67 73 20 22 2c 20 22 29 29 erse args ", "))
3100: 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
3110: 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ). (let*
3120: 28 28 74 61 72 67 2d 6d 6b 20 28 63 61 72 20 61 ((targ-mk (car a
3130: 72 67 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 rgs)).
3140: 20 20 20 20 20 28 6d 73 67 20 20 20 20 20 20 20 (msg
3150: 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
3160: 61 72 67 20 22 2d 6d 22 29 20 22 22 29 29 29 20 arg "-m") "")))
3170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3180: 28 70 72 69 6e 74 20 22 61 74 74 65 6d 70 74 69 (print "attempti
3190: 6e 67 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 ng to create dir
31a0: 65 63 74 6f 72 79 20 22 20 74 61 72 67 2d 6d 6b ectory " targ-mk
31b0: 20 22 20 69 6e 20 22 20 74 61 72 67 65 74 2d 64 " in " target-d
31c0: 69 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ir).
31d0: 20 20 20 28 73 70 75 62 6c 69 73 68 3a 76 61 6c (spublish:val
31e0: 69 64 61 74 65 20 20 20 20 20 74 61 72 67 65 74 idate target
31f0: 2d 64 69 72 20 74 61 72 67 2d 6d 6b 29 0a 20 20 -dir targ-mk).
3200: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 70 (sp
3210: 75 62 6c 69 73 68 3a 6d 6b 64 69 72 20 63 6f 6e ublish:mkdir con
3220: 66 69 67 64 61 74 20 75 73 65 72 20 74 61 72 67 figdat user targ
3230: 65 74 2d 64 69 72 20 74 61 72 67 2d 6d 6b 20 6d et-dir targ-mk m
3240: 73 67 29 29 29 0a 0a 20 20 20 20 20 20 28 28 6c sg))).. ((l
3250: 6e 29 20 0a 20 20 20 20 20 20 20 20 28 69 66 20 n) . (if
3260: 28 3c 20 28 6c 65 6e 67 74 68 20 61 72 67 73 29 (< (length args)
3270: 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 28 62 2). (b
3280: 65 67 69 6e 20 0a 09 20 20 20 20 20 28 70 72 69 egin .. (pri
3290: 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 nt "ERROR: Missi
32a0: 6e 67 20 61 72 67 75 6d 65 6e 74 73 3b 20 22 20 ng arguments; "
32b0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
32c0: 72 73 65 20 61 72 67 73 20 22 2c 20 22 29 29 0a rse args ", ")).
32d0: 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 . (exit 1)))
32e0: 0a 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 . (let* (
32f0: 28 74 61 72 67 2d 6c 69 6e 6b 20 28 63 61 72 20 (targ-link (car
3300: 61 72 67 73 29 29 0a 20 20 20 20 20 20 20 20 20 args)).
3310: 20 20 20 20 20 20 28 6c 69 6e 6b 2d 6e 61 6d 65 (link-name
3320: 20 28 63 61 64 72 20 61 72 67 73 29 29 20 20 0a (cadr args)) .
3330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3340: 73 75 62 2d 70 61 74 68 20 28 73 74 72 69 6e 67 sub-path (string
3350: 2d 72 65 76 65 72 73 65 20 28 73 74 72 69 6e 67 -reverse (string
3360: 2d 6a 6f 69 6e 20 28 63 64 72 20 28 73 74 72 69 -join (cdr (stri
3370: 6e 67 2d 73 70 6c 69 74 20 28 73 74 72 69 6e 67 ng-split (string
3380: 2d 72 65 76 65 72 73 65 20 6c 69 6e 6b 2d 6e 61 -reverse link-na
3390: 6d 65 29 20 22 2f 22 29 29 20 22 2f 22 29 29 29 me) "/")) "/")))
33a0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
33b0: 20 28 6d 73 67 20 20 20 20 20 20 20 20 20 28 6f (msg (o
33c0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
33d0: 22 2d 6d 22 29 20 22 22 29 29 29 0a 20 20 20 20 "-m") ""))).
33e0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 28 6e (if(n
33f0: 6f 74 20 28 65 71 75 61 6c 3f 20 73 75 62 2d 70 ot (equal? sub-p
3400: 61 74 68 20 6c 69 6e 6b 2d 6e 61 6d 65 29 29 0a ath link-name)).
3410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3420: 28 62 65 67 69 6e 20 0a 20 20 20 20 20 20 20 20 (begin .
3430: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
3440: 20 22 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 "attempting to
3450: 63 72 65 61 74 65 20 64 69 72 65 63 74 6f 72 79 create directory
3460: 20 22 20 73 75 62 2d 70 61 74 68 20 22 20 69 6e " sub-path " in
3470: 20 22 20 74 61 72 67 65 74 2d 64 69 72 29 0a 20 " target-dir).
3480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3490: 20 20 20 28 73 70 75 62 6c 69 73 68 3a 76 61 6c (spublish:val
34a0: 69 64 61 74 65 20 20 20 20 20 74 61 72 67 65 74 idate target
34b0: 2d 64 69 72 20 73 75 62 2d 70 61 74 68 29 0a 20 -dir sub-path).
34c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
34d0: 20 20 20 28 73 70 75 62 6c 69 73 68 3a 6d 6b 64 (spublish:mkd
34e0: 69 72 20 63 6f 6e 66 69 67 64 61 74 20 75 73 65 ir configdat use
34f0: 72 20 74 61 72 67 65 74 2d 64 69 72 20 73 75 62 r target-dir sub
3500: 2d 70 61 74 68 20 6d 73 67 29 29 29 0a 0a 20 20 -path msg)))..
3510: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
3520: 69 6e 74 20 22 61 74 74 65 6d 70 74 69 6e 67 20 int "attempting
3530: 74 6f 20 63 72 65 61 74 65 20 6c 69 6e 6b 20 22 to create link "
3540: 20 6c 69 6e 6b 2d 6e 61 6d 65 20 22 20 69 6e 20 link-name " in
3550: 22 20 74 61 72 67 65 74 2d 64 69 72 29 0a 20 20 " target-dir).
3560: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 70 (sp
3570: 75 62 6c 69 73 68 3a 6c 6e 20 63 6f 6e 66 69 67 ublish:ln config
3580: 64 61 74 20 75 73 65 72 20 74 61 72 67 65 74 2d dat user target-
3590: 64 69 72 20 74 61 72 67 2d 6c 69 6e 6b 20 6c 69 dir targ-link li
35a0: 6e 6b 2d 6e 61 6d 65 20 6d 73 67 29 29 29 0a 0a nk-name msg)))..
35b0: 20 20 20 20 20 20 28 28 72 6d 29 0a 20 20 20 20 ((rm).
35c0: 20 20 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 (if (< (lengt
35d0: 68 20 61 72 67 73 29 20 31 29 0a 09 20 20 20 28 h args) 1).. (
35e0: 62 65 67 69 6e 20 0a 09 20 20 20 20 20 28 70 72 begin .. (pr
35f0: 69 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 int "ERROR: Miss
3600: 69 6e 67 20 61 72 67 75 6d 65 6e 74 73 3b 20 22 ing arguments; "
3610: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
3620: 65 72 73 65 20 61 72 67 73 20 22 2c 20 22 29 29 erse args ", "))
3630: 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
3640: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ). (let* (
3650: 28 74 61 72 67 2d 66 69 6c 65 20 28 63 61 72 20 (targ-file (car
3660: 61 72 67 73 29 29 0a 09 20 20 20 20 20 20 28 6d args)).. (m
3670: 73 67 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 sg (or (
3680: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
3690: 22 29 20 22 22 29 29 29 0a 09 20 28 70 72 69 6e ") ""))).. (prin
36a0: 74 20 22 61 74 74 65 6d 70 74 69 6e 67 20 74 6f t "attempting to
36b0: 20 72 65 6d 6f 76 65 20 22 20 74 61 72 67 2d 66 remove " targ-f
36c0: 69 6c 65 20 22 20 66 72 6f 6d 20 22 20 74 61 72 ile " from " tar
36d0: 67 65 74 2d 64 69 72 29 0a 20 20 20 20 20 20 20 get-dir).
36e0: 20 20 20 20 28 73 70 75 62 6c 69 73 68 3a 76 61 (spublish:va
36f0: 6c 69 64 61 74 65 20 20 20 20 20 74 61 72 67 65 lidate targe
3700: 74 2d 64 69 72 20 74 61 72 67 2d 66 69 6c 65 29 t-dir targ-file)
3710: 0a 0a 09 20 28 73 70 75 62 6c 69 73 68 3a 72 6d ... (spublish:rm
3720: 20 63 6f 6e 66 69 67 64 61 74 20 75 73 65 72 20 configdat user
3730: 74 61 72 67 65 74 2d 64 69 72 20 74 61 72 67 2d target-dir targ-
3740: 66 69 6c 65 20 6d 73 67 29 29 29 0a 20 20 20 20 file msg))).
3750: 20 20 28 28 70 75 62 6c 69 73 68 29 0a 20 20 20 ((publish).
3760: 20 20 20 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 (if (< (leng
3770: 74 68 20 61 72 67 73 29 20 33 29 0a 09 20 20 20 th args) 3)..
3780: 28 62 65 67 69 6e 20 0a 09 20 20 20 20 20 28 70 (begin .. (p
3790: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 rint "ERROR: Mis
37a0: 73 69 6e 67 20 61 72 67 75 6d 65 6e 74 73 3b 20 sing arguments;
37b0: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
37c0: 70 65 72 73 65 20 61 72 67 73 20 22 2c 20 22 29 perse args ", ")
37d0: 29 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 29 ).. (exit 1)
37e0: 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 73 72 ).. (let* ((sr
37f0: 63 70 61 74 68 20 20 28 6c 69 73 74 2d 72 65 66 cpath (list-ref
3800: 20 61 72 67 73 20 30 29 29 0a 09 09 20 20 28 61 args 0))... (a
3810: 72 65 61 6e 61 6d 65 20 28 6c 69 73 74 2d 72 65 reaname (list-re
3820: 66 20 61 72 67 73 20 31 29 29 0a 09 09 20 20 28 f args 1))... (
3830: 76 65 72 73 69 6f 6e 20 20 28 6c 69 73 74 2d 72 version (list-r
3840: 65 66 20 61 72 67 73 20 32 29 29 0a 09 09 20 20 ef args 2))...
3850: 28 72 65 6d 61 72 67 73 20 20 28 61 72 67 73 3a (remargs (args:
3860: 67 65 74 2d 61 72 67 73 20 28 64 72 6f 70 20 61 get-args (drop a
3870: 72 67 73 20 32 29 0a 09 09 09 09 09 20 20 20 27 rgs 2)...... '
3880: 28 22 2d 74 79 70 65 22 20 3b 3b 20 6c 69 6e 6b ("-type" ;; link
3890: 20 6f 72 20 63 6f 70 79 20 28 64 65 66 61 75 6c or copy (defaul
38a0: 74 20 69 73 20 63 6f 70 79 29 0a 09 09 09 09 09 t is copy)......
38b0: 20 20 20 20 20 22 2d 6d 22 29 0a 09 09 09 09 09 "-m")......
38c0: 20 20 20 27 28 29 0a 09 09 09 09 09 20 20 20 61 '()...... a
38d0: 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 09 rgs:arg-hash....
38e0: 09 09 20 20 20 30 29 29 0a 09 09 20 20 28 70 75 .. 0))... (pu
38f0: 62 6c 69 73 68 2d 74 79 70 65 20 28 69 66 20 28 blish-type (if (
3900: 65 71 75 61 6c 3f 20 28 61 72 67 73 3a 67 65 74 equal? (args:get
3910: 2d 61 72 67 20 22 2d 74 79 70 65 22 29 20 22 6c -arg "-type") "l
3920: 69 6e 6b 22 29 20 27 6c 69 6e 6b 20 27 63 6f 70 ink") 'link 'cop
3930: 79 29 29 0a 09 09 20 20 28 63 6f 6d 6d 65 6e 74 y))... (comment
3940: 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
3950: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 22 22 get-arg "-m") ""
3960: 29 29 0a 09 09 20 20 28 73 75 62 6d 69 74 74 65 ))... (submitte
3970: 72 20 20 20 20 28 63 75 72 72 65 6e 74 2d 75 73 r (current-us
3980: 65 72 2d 6e 61 6d 65 29 29 0a 09 09 20 20 28 71 er-name))... (q
3990: 75 61 6c 69 74 79 20 20 20 20 20 20 28 61 72 67 uality (arg
39a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 71 75 61 6c s:get-arg "-qual
39b0: 69 74 79 22 29 29 0a 09 09 20 20 28 70 75 62 6c ity"))... (publ
39c0: 69 73 68 2d 72 65 73 20 20 28 73 70 75 62 6c 69 ish-res (spubli
39d0: 73 68 3a 70 75 62 6c 69 73 68 20 63 6f 6e 66 69 sh:publish confi
39e0: 67 64 61 74 20 70 75 62 6c 69 73 68 2d 74 79 70 gdat publish-typ
39f0: 65 20 61 72 65 61 6e 61 6d 65 20 76 65 72 73 69 e areaname versi
3a00: 6f 6e 20 63 6f 6d 6d 65 6e 74 20 73 72 63 70 61 on comment srcpa
3a10: 74 68 20 73 75 62 6d 69 74 74 65 72 20 71 75 61 th submitter qua
3a20: 6c 69 74 79 29 29 29 0a 09 20 20 20 20 20 28 69 lity))).. (i
3a30: 66 20 28 6e 6f 74 20 28 63 61 72 20 70 75 62 6c f (not (car publ
3a40: 69 73 68 2d 72 65 73 29 29 0a 09 09 20 28 62 65 ish-res))... (be
3a50: 67 69 6e 0a 09 09 20 20 20 28 70 72 69 6e 74 20 gin... (print
3a60: 22 45 52 52 4f 52 3a 20 22 20 28 63 64 72 20 70 "ERROR: " (cdr p
3a70: 75 62 6c 69 73 68 2d 72 65 73 29 29 0a 09 09 20 ublish-res))...
3a80: 20 20 28 65 78 69 74 20 31 29 29 29 29 29 29 0a (exit 1)))))).
3a90: 20 20 20 20 20 20 28 28 6c 69 73 74 2d 76 65 72 ((list-ver
3aa0: 73 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 28 6c sions). (l
3ab0: 65 74 20 28 28 61 72 65 61 2d 6e 61 6d 65 20 28 et ((area-name (
3ac0: 63 61 72 20 61 72 67 73 29 29 20 3b 3b 20 20 20 car args)) ;;
3ad0: 20 20 20 76 65 72 73 69 6f 6e 20 70 61 74 74 20 version patt
3ae0: 20 20 66 75 6c 6c 20 70 72 69 6e 74 0a 09 20 20 full print..
3af0: 20 20 20 28 72 65 6d 61 72 67 73 20 20 20 28 61 (remargs (a
3b00: 72 67 73 3a 67 65 74 2d 61 72 67 73 20 61 72 67 rgs:get-args arg
3b10: 73 20 27 28 22 2d 76 70 61 74 74 22 29 20 27 28 s '("-vpatt") '(
3b20: 22 2d 66 75 6c 6c 22 29 20 61 72 67 73 3a 61 72 "-full") args:ar
3b30: 67 2d 68 61 73 68 20 30 29 29 0a 09 20 20 20 20 g-hash 0))..
3b40: 20 28 64 62 20 20 20 20 20 20 20 20 28 73 70 75 (db (spu
3b50: 62 6c 69 73 68 3a 6f 70 65 6e 2d 64 62 20 63 6f blish:open-db co
3b60: 6e 66 69 67 64 61 74 29 29 0a 09 20 20 20 20 20 nfigdat))..
3b70: 28 76 65 72 73 69 6f 6e 73 20 20 28 73 70 75 62 (versions (spub
3b80: 6c 69 73 68 3a 67 65 74 2d 76 65 72 73 69 6f 6e lish:get-version
3b90: 73 2d 66 6f 72 2d 61 72 65 61 20 64 62 20 28 63 s-for-area db (c
3ba0: 61 72 20 61 72 67 73 29 20 76 65 72 73 69 6f 6e ar args) version
3bb0: 2d 70 61 74 74 3a 20 28 61 72 67 73 3a 67 65 74 -patt: (args:get
3bc0: 2d 61 72 67 20 22 2d 76 70 61 74 74 22 29 29 29 -arg "-vpatt")))
3bd0: 29 0a 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 61 ).. ;; (print "a
3be0: 72 65 61 2d 6e 61 6d 65 3d 22 20 61 72 65 61 2d rea-name=" area-
3bf0: 6e 61 6d 65 20 22 20 61 72 67 73 3d 22 20 61 72 name " args=" ar
3c00: 67 73 20 22 20 2a 61 72 67 73 2d 68 61 73 68 2a gs " *args-hash*
3c10: 3d 22 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e =" (hash-table->
3c20: 61 6c 69 73 74 20 2a 61 72 67 73 2d 68 61 73 68 alist *args-hash
3c30: 2a 29 29 0a 09 20 28 6d 61 70 20 28 6c 61 6d 62 *)).. (map (lamb
3c40: 64 61 20 28 78 29 0a 09 09 28 69 66 20 28 61 72 da (x)...(if (ar
3c50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 75 6c gs:get-arg "-ful
3c60: 6c 22 29 0a 09 09 20 20 20 20 28 66 6f 72 6d 61 l")... (forma
3c70: 74 20 23 74 20 0a 09 09 09 20 20 20 20 22 7e 31 t #t .... "~1
3c80: 30 61 7e 31 30 61 7e 34 61 7e 32 37 61 7e 33 30 0a~10a~4a~27a~30
3c90: 61 5c 6e 22 0a 09 09 09 20 20 20 20 28 76 65 63 a\n".... (vec
3ca0: 74 6f 72 2d 72 65 66 20 78 20 30 29 0a 09 09 09 tor-ref x 0)....
3cb0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
3cc0: 78 20 31 29 20 0a 09 09 09 20 20 20 20 28 76 65 x 1) .... (ve
3cd0: 63 74 6f 72 2d 72 65 66 20 78 20 32 29 20 0a 09 ctor-ref x 2) ..
3ce0: 09 09 20 20 20 20 28 63 6f 6e 63 20 22 5c 22 22 .. (conc "\""
3cf0: 20 28 74 69 6d 65 2d 3e 73 74 72 69 6e 67 20 28 (time->string (
3d00: 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 seconds->local-t
3d10: 69 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ime (vector-ref
3d20: 78 20 33 29 29 29 20 22 5c 22 22 29 0a 09 09 09 x 3))) "\"")....
3d30: 20 20 20 20 28 63 6f 6e 63 20 22 5c 22 22 20 28 (conc "\"" (
3d40: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 34 29 20 vector-ref x 4)
3d50: 22 5c 22 22 29 29 0a 09 09 20 20 20 20 28 70 72 "\""))... (pr
3d60: 69 6e 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 int (vector-ref
3d70: 78 20 30 29 29 29 29 0a 09 20 20 20 20 20 20 76 x 0)))).. v
3d80: 65 72 73 69 6f 6e 73 29 29 29 0a 20 20 20 20 20 ersions))).
3d90: 20 28 65 6c 73 65 20 28 70 72 69 6e 74 20 22 55 (else (print "U
3da0: 6e 72 65 63 6f 67 6e 69 73 65 64 20 63 6f 6d 6d nrecognised comm
3db0: 61 6e 64 20 22 20 61 63 74 69 6f 6e 29 29 29 29 and " action))))
3dc0: 29 0a 20 20 0a 3b 3b 20 65 61 73 65 20 64 65 62 ). .;; ease deb
3dd0: 75 67 67 69 6e 67 20 62 79 20 6c 6f 61 64 69 6e ugging by loadin
3de0: 67 20 7e 2f 2e 64 61 73 68 62 6f 61 72 64 72 63 g ~/.dashboardrc
3df0: 20 2d 20 52 45 4d 4f 56 45 20 46 52 4f 4d 20 50 - REMOVE FROM P
3e00: 52 4f 44 55 43 54 49 4f 4e 21 0a 3b 3b 20 28 6c RODUCTION!.;; (l
3e10: 65 74 20 28 28 64 65 62 75 67 63 6f 6e 74 72 6f et ((debugcontro
3e20: 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e lf (conc (get-en
3e30: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
3e40: 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f 2e 73 70 le "HOME") "/.sp
3e50: 75 62 6c 69 73 68 72 63 22 29 29 29 0a 3b 3b 20 ublishrc"))).;;
3e60: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
3e70: 74 73 3f 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c ts? debugcontrol
3e80: 66 29 0a 3b 3b 20 20 20 20 20 20 20 28 6c 6f 61 f).;; (loa
3e90: 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 d debugcontrolf)
3ea0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 69 ))..(define (mai
3eb0: 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 72 67 n). (let* ((arg
3ec0: 73 20 20 20 20 20 20 28 61 72 67 76 29 29 0a 09 s (argv))..
3ed0: 20 28 70 72 6f 67 20 20 20 20 20 20 28 63 61 72 (prog (car
3ee0: 20 61 72 67 73 29 29 0a 09 20 28 72 65 6d 61 20 args)).. (rema
3ef0: 20 20 20 20 20 28 63 64 72 20 61 72 67 73 29 29 (cdr args))
3f00: 0a 09 20 28 65 78 65 2d 6e 61 6d 65 20 20 28 70 .. (exe-name (p
3f10: 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 28 63 61 athname-file (ca
3f20: 72 20 28 61 72 67 76 29 29 29 29 0a 09 20 28 65 r (argv)))).. (e
3f30: 78 65 2d 64 69 72 20 20 20 28 6f 72 20 28 70 61 xe-dir (or (pa
3f40: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
3f50: 20 70 72 6f 67 29 0a 09 09 09 28 73 70 75 62 6c prog)....(spubl
3f60: 69 73 68 3a 66 69 6e 64 20 65 78 65 2d 6e 61 6d ish:find exe-nam
3f70: 65 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 e (string-split
3f80: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
3f90: 2d 76 61 72 69 61 62 6c 65 20 22 50 41 54 48 22 -variable "PATH"
3fa0: 29 20 22 3a 22 29 29 29 29 0a 09 20 28 63 6f 6e ) ":")))).. (con
3fb0: 66 69 67 64 61 74 20 28 73 70 75 62 6c 69 73 68 figdat (spublish
3fc0: 3a 6c 6f 61 64 2d 63 6f 6e 66 69 67 20 65 78 65 :load-config exe
3fd0: 2d 64 69 72 20 65 78 65 2d 6e 61 6d 65 29 29 29 -dir exe-name)))
3fe0: 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
3ff0: 3b 3b 20 6f 6e 65 2d 77 6f 72 64 20 63 6f 6d 6d ;; one-word comm
4000: 61 6e 64 73 0a 20 20 20 20 20 28 28 65 71 3f 20 ands. ((eq?
4010: 28 6c 65 6e 67 74 68 20 72 65 6d 61 29 20 31 29 (length rema) 1)
4020: 0a 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 . (case (st
4030: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 63 61 ring->symbol (ca
4040: 72 20 72 65 6d 61 29 29 0a 09 28 28 68 65 6c 70 r rema))..((help
4050: 20 2d 68 20 2d 68 65 6c 70 20 2d 2d 68 20 2d 2d -h -help --h --
4060: 68 65 6c 70 29 0a 09 20 28 70 72 69 6e 74 20 73 help).. (print s
4070: 70 75 62 6c 69 73 68 3a 68 65 6c 70 29 29 0a 09 publish:help))..
4080: 28 28 6c 69 73 74 2d 76 61 72 73 29 20 3b 3b 20 ((list-vars) ;;
4090: 70 72 69 6e 74 20 6f 75 74 20 74 68 65 20 69 6e print out the in
40a0: 69 20 66 69 6c 65 0a 09 20 28 6d 61 70 20 70 72 i file.. (map pr
40b0: 69 6e 74 20 28 73 70 75 62 6c 69 73 68 3a 67 65 int (spublish:ge
40c0: 74 2d 61 72 65 61 73 20 63 6f 6e 66 69 67 64 61 t-areas configda
40d0: 74 29 29 29 0a 09 28 28 6c 73 29 0a 09 20 28 6c t)))..((ls).. (l
40e0: 65 74 20 28 28 74 61 72 67 65 74 2d 64 69 72 20 et ((target-dir
40f0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
4100: 63 6f 6e 66 69 67 64 61 74 20 22 73 65 74 74 69 configdat "setti
4110: 6e 67 73 22 20 22 74 61 72 67 65 74 2d 64 69 72 ngs" "target-dir
4120: 22 29 29 29 0a 09 20 20 20 28 70 72 69 6e 74 20 "))).. (print
4130: 22 46 69 6c 65 73 20 69 6e 20 22 20 74 61 72 67 "Files in " targ
4140: 65 74 2d 64 69 72 29 0a 09 20 20 20 28 73 79 73 et-dir).. (sys
4150: 74 65 6d 20 28 63 6f 6e 63 20 22 6c 73 20 22 20 tem (conc "ls "
4160: 74 61 72 67 65 74 2d 64 69 72 29 29 29 29 0a 09 target-dir))))..
4170: 28 28 6c 6f 67 29 0a 09 20 28 73 70 75 62 6c 69 ((log).. (spubli
4180: 73 68 3a 64 62 2d 64 6f 20 63 6f 6e 66 69 67 64 sh:db-do configd
4190: 61 74 20 28 6c 61 6d 62 64 61 20 28 64 62 29 0a at (lambda (db).
41a0: 09 09 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 .... (print
41b0: 22 4c 69 73 74 69 6e 67 20 61 63 74 69 6f 6e 73 "Listing actions
41c0: 22 29 0a 09 09 09 09 20 20 20 20 20 28 71 75 65 ")..... (que
41d0: 72 79 20 28 66 6f 72 2d 65 61 63 68 2d 72 6f 77 ry (for-each-row
41e0: 0a 09 09 09 09 09 20 20 20 20 20 28 6c 61 6d 62 ...... (lamb
41f0: 64 61 20 28 72 6f 77 29 0a 09 09 09 09 09 20 20 da (row)......
4200: 20 20 20 20 20 28 61 70 70 6c 79 20 70 72 69 6e (apply prin
4210: 74 20 28 69 6e 74 65 72 73 70 65 72 73 65 20 72 t (intersperse r
4220: 6f 77 20 22 20 7c 20 22 29 29 29 29 0a 09 09 09 ow " | "))))....
4230: 09 09 20 20 20 20 28 73 71 6c 20 64 62 20 22 53 .. (sql db "S
4240: 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20 61 63 74 ELECT * FROM act
4250: 69 6f 6e 73 22 29 29 29 29 29 0a 09 28 65 6c 73 ions")))))..(els
4260: 65 0a 09 20 28 70 72 69 6e 74 20 22 45 52 52 4f e.. (print "ERRO
4270: 52 3a 20 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 R: Unrecognised
4280: 63 6f 6d 6d 61 6e 64 2e 20 54 72 79 20 5c 22 73 command. Try \"s
4290: 70 75 62 6c 69 73 68 20 68 65 6c 70 5c 22 22 29 publish help\"")
42a0: 29 29 29 0a 20 20 20 20 20 3b 3b 20 6d 75 6c 74 ))). ;; mult
42b0: 69 2d 77 6f 72 64 20 63 6f 6d 6d 61 6e 64 73 0a i-word commands.
42c0: 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 72 65 6d ((null? rem
42d0: 61 29 28 70 72 69 6e 74 20 73 70 75 62 6c 69 73 a)(print spublis
42e0: 68 3a 68 65 6c 70 29 29 0a 20 20 20 20 20 28 28 h:help)). ((
42f0: 3e 3d 20 28 6c 65 6e 67 74 68 20 72 65 6d 61 29 >= (length rema)
4300: 20 32 29 0a 20 20 20 20 20 20 28 61 70 70 6c 79 2). (apply
4310: 20 73 70 75 62 6c 69 73 68 3a 70 72 6f 63 65 73 spublish:proces
4320: 73 2d 61 63 74 69 6f 6e 20 63 6f 6e 66 69 67 64 s-action configd
4330: 61 74 20 28 63 61 72 20 72 65 6d 61 29 28 63 64 at (car rema)(cd
4340: 72 20 72 65 6d 61 29 29 29 0a 20 20 20 20 20 28 r rema))). (
4350: 65 6c 73 65 20 28 70 72 69 6e 74 20 22 45 52 52 else (print "ERR
4360: 4f 52 3a 20 55 6e 72 65 63 6f 67 6e 69 73 65 64 OR: Unrecognised
4370: 20 63 6f 6d 6d 61 6e 64 2e 20 54 72 79 20 5c 22 command. Try \"
4380: 73 70 75 62 6c 69 73 68 20 68 65 6c 70 5c 22 22 spublish help\""
4390: 29 29 29 29 29 0a 0a 28 6d 61 69 6e 29 0a )))))..(main).