;-*-MIDAS-*-
	TITLE MINI SERVER

;MODIFIED FOR ITS FTP.  MINIC
;Server for Lisp machine miniature Chaosnet

;Contact name is MINIC
;
;Protocol:  (all you can do is read files)
;  User to server:
;    200 ascii open, contents is file name
;    201 binary open, contents is file name
;  Server to user:
;    202 win, contents is file-id (fn2 space cdate space ctime)
;    203 lose, contents is error message
;    200 ascii data
;    300 binary data
;    eof end of file, user can then ask for another

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

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

DEBUG:	0

PDL:	-20,,.
	BLOCK 22

.INSRT SYSTEM;CHSDEF >

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

PKTBUF:	BLOCK %CPMXW+%CPKDT
BUF1==PKTBUF
BUF1L==<%CPMXW+%CPKDT>*5
BUF2:	BLOCK <BUF1L+3>/4

FN1:	0
FN2:	0
SNM:	0
DEV:	0

GO:	.CLOSE 1,		;Close load channel
	MOVE P,PDL
	MOVEI T,TSINT
	MOVEM T,42
	.SUSET [.SMASK,,[%PIIOC]]
	.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/MINIC/]
	MOVEI D,1
	PUSHJ P,NETWRK"CHALSN
	 JSR LOSE
	.SUSET [.SSNAME,,[SIXBIT/MINI/]] ;Give peekers a clue
NXTFIL:	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHIC ? SETZI PKTBUF]
	 JSR LOSE
	LDB A,[$CPKOP+PKTBUF]
	CAIE A,200
	 CAIN A,201
	  JRST OPEN
	JSR LOSE

OPEN:	SETZM ASCMOD'
	CAIE A,201
	 SETOM ASCMOD
	LDB B,[$CPKNB+PKTBUF]
	MOVE C,[440800,,%CPKDT+PKTBUF]
	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
	MOVSI A,-3
	SKIPE FN1(A)
	 AOBJN A,.-1
	MOVEM D,FN1(A)
FNR2A:	JUMPL B,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
FNRX:	MOVSI A,'DSK
	SKIPN DEV
	 MOVEM A,DEV
	MOVSI A,(SIXBIT/>/)
	SKIPN FN2
	 MOVEM A,FN2
	MOVSI A,.UAI
	SKIPN ASCMOD
	 MOVSI A,.UII
	HRRI A,DKIC
	.CALL [	SETZ ? SIXBIT/OPEN/ ? A ? DEV ? FN1 ? FN2 ? SETZ SNM ]
	 JRST OPENLS
;SUCCESS, RETURN FILE-ID
	MOVEI A,202
	DPB A,[$CPKOP+PKTBUF]
	SETZM OUTCNT'
	MOVE C,[440800,,%CPKDT+PKTBUF]
	MOVEM C,OUTBP'
	.CALL [ SETZ ? 'RFNAME ? MOVEI DKIC ? MOVEM TT ? MOVEM T ? SETZM TT] ;FN2
	 .LOSE %LSFIL
	.SUSET [.SWHO2,,T]	;FN1
	.SUSET [.SWHO3,,TT]	;FN2
;Send the second filename in ascii.	
	MOVE A,[440600,,TT]
	MOVEI B,6
SNDFN2:	ILDB T,A
	CAIN T,0
	 JRST SNDVR2
	ADDI T,40
	PUSHJ P,CHOUT
	SOJG B,SNDFN2
SNDVR2:	MOVEI T,40
	PUSHJ P,CHOUT
	.CALL [ SETZ ? 'RFDATE ? MOVEI DKIC ? SETZM A]	;DATE/TIME
	 MOVEI A,0
	PUSH P,A
	PUSHJ P,DATASC		;CREATION DATE
	MOVEI T,40
	PUSHJ P,CHOUT
	POP P,A
	PUSHJ P,TIMASC		;CREATION TIME
	MOVE A,OUTCNT
	DPB A,[$CPKNB+PKTBUF]
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHOC ? SETZI PKTBUF]
	 JSR LOSE
;NOW TRANSMIT THE FILE
	SKIPE ASCMOD
	 JRST XMITA
XMITB:	MOVE A,[444400,,%CPKDT+PKTBUF]
	MOVEI B,%CPMXC/4
	MOVE C,B
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI DKIC ? A ? SETZ B]
	 .LOSE %LSFIL
	SUB C,B
	JUMPE C,XMTEOF
	IMULI C,4
	DPB C,[$CPKNB+PKTBUF]
	MOVEI A,300
	DPB A,[$CPKOP+PKTBUF]
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHOC ? SETZI PKTBUF]
	 JSR LOSE
	JUMPE B,XMITB
XMTEOF:	MOVSI B,(<.BYTE 8 ? %COEOF ? 0>)
	MOVEM B,PKTBUF
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHOC ? SETZI PKTBUF]
	 JSR LOSE
	.CLOSE DKIC,
	JRST NXTFIL

XMITA:	MOVE A,[440700,,BUF1]	;HAVE TO DELETE ^C'S AND ^L'S AT EOF
	MOVEI B,5		;GET BUFFERED-BACK WORD
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI DKIC ? A ? SETZ B]
	 .LOSE %LSFIL
XMITA0:	MOVE A,[440700,,BUF1+1]
	MOVEI B,BUF1L-5
	MOVE C,B
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI DKIC ? A ? SETZ B]
	 .LOSE %LSFIL
	PUSH P,C
	IDIVI B,5		;ROUND TO WORD BOUNDARY
	IMULI B,5
	JUMPG C,[ MOVEI D,0	;IF PARTIAL WORD TRANSFER, MAKE SURE FILLED WITH NULLS
		  IDPB D,A
		  SOJA C,. ]
	POP P,C
	SUB C,B
	JUMPE C,XMITA9		;NOTHING TRANSFERRED, EOF
XMITA3:	MOVE A,[440700,,BUF1]	;NOW MOVE AND CONVERT BYTE-SIZE.  DON'T MOVE LAST 5 CHARS
	MOVE E,[440800,,BUF2]	
	MOVEI D,0
ZIPCO:	ILDB T,A
;	XCT AS2LM(T)		;CONVERT CHAR CODE
	IDPB T,E
	ADDI D,1
XMITA2:	SOJG C,ZIPCO
	MOVE A,[440800,,BUF2]
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI CHOC ? A ? SETZ D]
	 JSR LOSE
XMITA9:	JUMPL B,XMITA7		;HERE B HAS NUMBER CHARS NOT XFERRED LAST SIOT OR -1 FLAG
	MOVEI C,BUF1L-5
	SUB C,B
	ADDI C,4
	IDIVI C,5		;NUMBER OF VALID WORDS IN BUFFER (NOT COUNTING FIRST ONE)
	MOVE D,BUF1(C)		;MOVE LAST WORD UP TO FIRST POSITION (REST HAVE BEEN XMTED)
	MOVEM D,BUF1
	JUMPE B,XMITA0		;NO EOF YET
	;D HAS LAST WORD IN FILE, COUNT VALID CHARS
	MOVEI C,5
	LSH D,-1
XMITA8:	MOVE A,D
	ANDI A,177
	JUMPE A,.+3	;Nulls appear from someplace
	CAIE A,^C
	 CAIN A,^L
	  SOJG C,[ LSH D,-7 ? JRST XMITA8]
	SETO B,
	JUMPN C,XMITA3		;GO TRANSMIT LAST WORD, SUCH AS IT IS
XMITA7:	.CALL [ SETZ ? SIXBIT/FORCE/ ? SETZI CHOC]
	 JSR LOSE
	JRST XMTEOF

TSINT:	0 ? 0
	JSR LOSE

LOSE:	0
	SKIPE DEBUG
	 .VALUE
	.LOGOUT
	JRST .-2

;FAILURE, RETURN ERROR MESSAGE

OPENLS:	MOVEI A,203
	DPB A,[$CPKOP+PKTBUF]
	.CALL [ SETZ ? SIXBIT/OPEN/ ? [.UAI,,ERRC] ? [SIXBIT/ERR/] ? MOVEI 1 ? SETZI 0]
	 .LOSE %LSFIL
	MOVE A,[440800,,%CPKDT+PKTBUF]
	MOVEI B,%CPMXC
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI ERRC ? A ? SETZ B]
	 .LOSE %LSFIL
	MOVEI B,0
	IDPB B,A
OPENL1:	MOVE A,[440800,,%CPKDT+PKTBUF]
OPENL2:	ILDB TT,A
	CAIL TT,40
	 AOJA B,OPENL2
	DPB B,[$CPKNB+PKTBUF]
	.CALL [ SETZ ? 'PKTIOT ? MOVEI CHOC ? SETZI PKTBUF]
	 JSR LOSE
	JRST NXTFIL

;DATE, TIME, NUMBER CONVERSION ROUTINES (LIFTED BODILY FROM FILE JOB)

TM%SEC== 777776    ; 2.9-1.2	0-131K	seconds	0-86399.
TM%DAY==     37,,0 ; 3.5-3.1	0-31	days	1-31
TM%MON==    740,,0 ; 3.9-3.6	0-15	months	1-12
TM%YR==  177000,,0 ; 4.7-4.1	0-127	years	0-127 relative to 1900 (1900-2027)

TM$SEC==(.BP TM%SEC,)	; Define BP LH's into each field.
TM$DAY==(.BP TM%DAY,)
TM$MON==(.BP TM%MON,)
TM$YR== (.BP TM%YR,)
	
; DATASC - Deposit MM/DD/YY using CHOUT
;	Takes time wd in A

DATASC:	PUSH P,B
	PUSH P,C
	PUSH P,E
	SKIPA E,[-3,,[	TM$MON,,A
			TM$DAY,,A
			TM$YR,,A ] ]
TMDT2:	 PUSHJ P,CHOUT
	LDB B,(E)		; Get numerical value into B.
	IDIVI B,10.		; Divide into 2 digits.
	MOVEI T,"0(B)
	PUSHJ P,CHOUT		; Output first,
	MOVEI T,"0(C)
	PUSHJ P,CHOUT		; and second.
	MOVEI T,"/		; Set up separator, in case looping again.
	AOBJN E,TMDT2
TIMTMX:	POP P,E
	POP P,C
	POP P,B
	POPJ P,

; TIMASC - Deposit HH:MM:SS using CHOUT given a time word in A.
;	Takes time wd in A.

TIMASC:	PUSH P,B
	PUSH P,C
	PUSH P,E
	HRRZ B,A		; For storage of hr, min, sec.
	LSH B,-1
	IDIVI B,60.		; Get secs
	PUSH P,C		; save
	IDIVI B,60.		; Get hr and mins
	PUSH P,C		; Save mins too.
	MOVSI E,-3
	JRST TMTM3

TMTM2:	PUSHJ P,CHOUT
	POP P,B			; Get numerical value into B.
TMTM3:	IDIVI B,10.		; Divide into 2 digits.
	MOVEI T,"0(B)
	PUSHJ P,CHOUT		; Output first,
	MOVEI T,"0(C)
	PUSHJ P,CHOUT		; and second.
	MOVEI T,":		; Set up separator, in case looping again.
	AOBJN E,TMTM2
	JRST TIMTMX

;CONVERT NUMBER IN A TO DECIMAL, THROUGH CHOUT
NUMASC:	IDIVI A,10.
	JUMPE A,NUMAS1
	PUSH P,B
	PUSHJ P,NUMASC
	POP P,B
NUMAS1:	MOVEI T,"0(B)
	PUSHJ P,CHOUT
	POPJ P,

CHOUT:	IDPB T,OUTBP
	AOSA OUTCNT
POPJ1:	 AOS (P)
CPOPJ:	POPJ P,

SIXOUT:	SETZ T,
	LSHC T,6
	ADDI T,40
	PUSHJ P,CHOUT
	JUMPN TT,SIXOUT
	POPJ P,

;ASCII TO LISP-MACHINE CODE-CONVERSION XCT TABLE
AS2LM:	REPEAT 10,JFCL		;0-7
	MOVEI T,210		;BS
	MOVEI T,211		;TAB
	JRST XMITA2		;FLUSH LF'S
	JFCL			;13
	MOVEI T,214		;FORM
	MOVEI T,215		;CR
	REPEAT 177-16,JFCL	;16-176
	.VALUE			;177 I don't know how to handle escapes
IFN .-AS2LM-200, .ERR AS2LM TABLE WRONG SIZE

	END GO