TITLE EVENT SERVER	;-*-MIDAS-*-

;Record events in response to single packets that do not get answered.
;Send an RFC packet that contains "EVENT filename<Return>text".

A=1
B=2
C=3
D=4
E=5
T=6
TT=7
P=17

CHIC=10
CHOC=11
DKOC=12
ERRC=13

DEBUG:	0

PDL:	-20,,.
	BLOCK 22

.INSRT SYSTEM;CHSDEF >

$$CHAOS==1
$$CONNECT==1
.INSRT SYSENG;NETWRK >

PKTBUF:	BLOCK %CPMXW+%CPKDT

FN1:	0
FN2:	0
SNM:	0
DEV:	0

GO:	.CLOSE 1,		;Close load channel
	MOVE P,PDL
	.SUSET [.SWHO1,,[166_10.+1,,66_12.]]	;2 sixbit words in who-line, space between
	.SUSET [.SWHO2,,[0]]
	.SUSET [.SWHO3,,[0]]
	MOVEI A,CHIC
	MOVEI B,0
	MOVEI C,[ASCIZ/EVENT/]
	MOVEI D,1
	PUSHJ P,CHALSN
	.SUSET [.SSNAME,,[SIXBIT/EVENT/]] ;Give peekers a clue
OPEN:	LDB B,[$CPKNB+PKTBUF]
	MOVE C,[440800,,%CPKDT+PKTBUF]
SKPCTN:	ILDB A,C		;Skip past the contact name.
	SOS B
	CAIE A,40
	 JRST SKPCTN
	SETZM FN1
	SETZM FN2
	SETZM SNM
	SETZM DEV
FNR0:	MOVEI D,0
	MOVE E,[440600,,D]
FNR1:	SOJL B,FNR2
	ILDB A,C
	CAILE A,40
	 CAIL A,200
	  JRST FNR2
	CAIN A,";
	 JRST FNR3
	CAIN A,":
	 JRST FNR4
	CAIGE A,140
	 SUBI A,40
	TLNE E,770000
	 IDPB A,E
	JRST FNR1

FNR2:	JUMPE D,FNR2A
	PUSH P,A
	MOVSI A,-3
	SKIPE FN1(A)
	 AOBJN A,.-1
	MOVEM D,FN1(A)
	POP P,A
FNR2A:	JUMPL B,FNRX
	CAIE A,^M
	 CAIN A,215
	  JRST FNRX
	JRST FNR0

FNR3:	MOVEM D,SNM
	JRST FNR0

FNR4:	MOVEM D,DEV
	JRST FNR0

;HERE ON OPEN COMMAND AFTER PARSING FILE NAME INTO FN1, FN2, SNM, DEV
;C HAS THE BP TO THE EVENT DESCRIPTION TEXT AND B HAS ITS LENGTH.
FNRX:	MOVSI A,'DSK
	SKIPN DEV
	 MOVEM A,DEV
	MOVSI A,(SIXBIT/>/)
	SKIPN FN2
	 MOVEM A,FN2
	.CALL [	SETZ ? SIXBIT/OPEN/ ? [100000+.UAO,,DKOC] ? DEV ? FN1 ? FN2 ? SETZ SNM ]
	 JSR LOSE
	.CALL [ SETZ ? SIXBIT/FILLEN/ ? %CLIMM,,DKOC ? %CLOUT,,A ((SETZ))]
	 .LOSE %LSFIL
	.ACCES DKOC,A
CHRLUP:	SOJL B,CLOS
	ILDB A,C
	ANDI A,177
	.IOT DKOC,A
	CAIN A,^M
	 .IOT DKOC,[^J]
	JRST CHRLUP

CLOS:	.IOT DKOC,[^M]
	.IOT DKOC,[^J]
	.CLOSE DKOC,
	.LOGOUT 1,

LOSE:	0
	SKIPE DEBUG
	 .VALUE
	.LOGOUT
	JRST .-2

CHALSN: MOVEI TT,%COLSN
	PUSHJ P,NETWRK"CHACN0		;Start things up
	 JSR LOSE
	CAIE TT,%CSRFC		;Should be RFC into LSN
	 JSR LOSE
	.CALL [ SETZ ? SIXBIT /PKTIOT/ ? %CLIMM,,(A) ? %CLIMM,,PKTBUF ((SETZ))]	;Get the RFC packet
	 .LOSE %LSFIL
	POPJ P,		

	END GO