;<PUP>PUPFTS.MAC;56    14-MAY-83 15:45:15    EDIT BY TAFT
;<PUP>PUPFTS.MAC;55    13-JAN-83 14:19:36    EDIT BY TAFT
;<PUP>PUPFTS.MAC;54     8-NOV-82 16:33:00    EDIT BY TAFT
;<PUP>PUPFTS.MAC;53     4-OCT-82 16:28:45    EDIT BY TAFT
; Bug fix in GFNPRP
;<PUP>PUPFTS.MAC;51    26-SEP-82 15:14:10    EDIT BY TAFT
; Implement New-enumerate
; Observe Desired-property requests
;<PUP>PUPFTS.MAC;49    10-AUG-81 18:00:30    EDIT BY TAFT
; Time zones in Retrieve date properties.
;<PUP>PUPFTS.MAC;47    18-MAY-81 11:41:48    EDIT BY TAFT
;<PUP>PUPFTS.MAC;46    24-APR-81 21:26:29    EDIT BY TAFT
; Include time zone in date properties
;<PUP>PUPFTS.MAC;45    16-JAN-81 10:41:07    EDIT BY TAFT
; Strip "↑.registry" if present in distribution list name.
; Suppress trailing "." in Name-body if filename extension is blank.
;<PUP>PUPFTS.MAC;44     2-DEC-80 09:17:45    EDIT BY TAFT
; Fix bug in handling of connect name in LOGCHK.
;<PUP>PUPFTS.MAC;43    29-AUG-80 13:43:23    EDIT BY TAFT
; Add FRNHAD
;<PUP>PUPFTS.MAC;42    26-AUG-80 11:11:23    EDIT BY TAFT
; Generate full property list in Delete
;<PUP>PUPFTS.MAC;41    15-AUG-80 18:38:29    EDIT BY TAFT
; Call RECPAS from LOGCHK
;<PUP>PUPFTS.MAC;40    22-JUL-80 19:16:04    EDIT BY TAFT
; Do an automatic Expunge if "directory full" error occurs during Store
; CKRPAR generate No rather than Comment for errors in single-file retrieves
;<PUP>PUPFTS.MAC;39     2-FEB-80 18:00:31    EDIT BY TAFT
; Send Size property in Retrieve property list
;<PUP>PUPFTS.MAC;38    20-JAN-80 17:42:05    EDIT BY TAFT
; FTPM does not attempt to send if receive connection closes in midstream.
;<PUP>PUPFTS.MAC;37    28-NOV-79 11:36:13    EDIT BY TAFT
; Add checks to distinguish between FTP and Mail server functions.
; Add code for anonymous distribution list retrieval in Mail server.
;<PUP>PUPFTS.MAC;36     4-NOV-79 12:24:55    EDIT BY TAFT
; Set creation date during [Store] if present in property list
;<PUP>PUPFTS.MAC;35     2-SEP-79 15:59:33    EDIT BY TAFT
;<PUP>PUPFTS.MAC;34    16-JAN-79 14:26:59    EDIT BY TAFT
;<PUP>PUPFTS.MAC;33     8-OCT-78 19:49:40    EDIT BY TAFT
; Rejuvenate watchdog timer in REFILL procedure so we don't get
; nailed while processing long mail distribution lists
;<PUP>PUPFTS.MAC;32     4-SEP-78 13:05:01    EDIT BY TAFT
; Add Rename error code 112
;<PUP>PUPFTS.MAC;31     4-JUL-78 16:41:36    EDIT BY TAFT
; Fix bug in Rename failure code
;<PUP>PUPFTS.MAC;30    24-MAY-78 18:26:44    EDIT BY TAFT
; Add [New-store] command
;<PUP>PUPFTS.MAC;29     3-FEB-78 19:46:55    EDIT BY TAFT
; Add distinct error code for file busy
;<PUP>PUPFTS.MAC;28    16-SEP-77 10:14:14    EDIT BY TAFT
;<PUP>PUPFTS.MAC;27     1-SEP-77 15:54:44    EDIT BY TAFT
; Make a few things internal for the mail server
;<PUP>PUPFTS.MAC;26    26-JUL-77 14:58:18    EDIT BY TAFT
; "Directory" defaults server filename to *.*;*
; Reset watchdog timer in appropriate places
;<PUP>PUPFTS.MAC;25     3-JUN-77 13:09:16    EDIT BY TAFT
; Add "Rename" command
;<PUP>PUPFTS.MAC;24    15-APR-77 09:55:20    EDIT BY TAFT
; Move some flag bits to avoid conflict with PUPDEF
; Default version to lowest in "Delete"
;<PUP>PUPFTS.MAC;23     7-APR-77 17:42:08    EDIT BY TAFT
; Zero memory cells holding JFNs when they are closed or released.
;<PUP>PUPFTS.MAC;22    31-MAR-77 21:10:00    EDIT BY TAFT
; Add hooks for mail server
;<PUP>PUPFTS.MAC;20    19-MAR-77 20:05:57    EDIT BY TAFT
; Add "Delete" command
;<PUP>PUPFTS.MAC;19    19-MAR-77 13:39:42    EDIT BY TAFT
; Fix bugs in Tenex-paged stuff
;<PUP>PUPFTS.MAC;18    18-MAR-77 19:13:59    EDIT BY TAFT
; Add REFILL procedure for property list parser
;<PUP>PUPFTS.MAC;16    18-MAR-77 17:41:10    EDIT BY TAFT
; Rip out property list parser and data transfer code --
; now share these modules with PUPFTP.
; Add checks for Tenex-paged type.
;<PUP>PUPFTS.MAC;14    17-OCT-76 00:41:41    EDIT BY TAFT
; Permit retrieving a 36-bit file with any byte size, but
; generate a suitable warning message
;<PUP>PUPFTS.MAC;13    30-JUN-76 17:21:38    EDIT BY TAFT
; Remove various utility routines to PUPUTL.MAC
;<PUP>PUPFTS.MAC;11     1-JUN-76 19:41:50    EDIT BY TAFT
; Change FIXNAM to apply generic filename properties as defaults
;<PUP>PUPFTS.MAC;8     1-JUN-76 16:43:58    EDIT BY TAFT
; "Directory" returns properties as separate commands for each file
;<PUP>PUPFTS.MAC;7    31-MAY-76 19:13:49    EDIT BY TAFT
; Include dates in retrieve property lists
;<PUP>PUPFTS.MAC;5    14-MAY-76 20:07:10    EDIT BY TAFT
; Add code to handle CLOSF failure at FTPEND
;<PUP>PUPFTS.MAC;4    27-MAR-76 18:01:12    EDIT BY TAFT
; Straighten out defaulting of account during store
;<PUP>PUPFTS.MAC;3    26-MAR-76 02:12:08    EDIT BY TAFT
; Convert lower-case password properties to upper-case

; Copyright 1979, 1980 by Xerox Corporation

	TITLE PUPFTS -- FTP SERVER FORK OF PUP SERVER
	SUBTTL E. A. Taft / October, 1975

	SEARCH PUPDEF,PSVDEF,STENEX
	USEVAR FTPVAR,FTPPVR


; Parameters

; Herald for version reply
VERTXT:	ASCIZ /1.38 14-May-83/
FTPVER==1		; Protocol version implemented


; Local flags

LOGCKF==1B27		; Login parameters have been checked
ACTCKF==1B28		; Account has been checked
CONCKF==1B29		; Connect parameters have been checked
DSKDVF==1B30		; Current file is on disk

; Assemble main command dispatch table

DEFINE XN(SYM,TYPE,NAME,FLAGS) <
REPEAT TYPE-<.-MRKDSP>,<0>
IF2,<IFNDEF C.'SYM,<EXTERN C.'SYM>>
	0 ,, C.'SYM
>
DEFINE XS(SYM,TYPE,NAME,FLAGS) <
REPEAT TYPE-<.-MRKDSP>,<0>
IF2,<IFNDEF C.'SYM,<EXTERN C.'SYM>>
	0 ,, C.'SYM
>

MRKDSP::MARKS


; Assemble Mark names and flags

DEFINE XN(SYM,TYPE,NAME,FLAGS) <
REPEAT TYPE-<.-MRKNAM>,<0>
	FLAGS + [ASCIZ /NAME/]
>
DEFINE XS(SYM,TYPE,NAME,FLAGS) <
REPEAT TYPE-<.-MRKNAM>,<0>
	1B0+FLAGS + [ASCIZ /NAME/]
>

MRKNAM::MARKS

NMARKS==.-MRKNAM

; -----------------------------------------------------------------
;	Initialization, Main Loop, Termination
; -----------------------------------------------------------------

; Server fork started here
; Initialize

FTPFRK::JSYS FRKINI##		; Initialize ac's and stuff
	HRRZ SV,SERVX		; Service table index in RH only
	MOVEI A,400000		; Initialize psi system
	MOVE B,[LEVTAB##,,CHNTAB]
	SIR
	EIR
	MOVE B,[ACTCHN]		; Activate channels
	AIC

	HRRZ A,FRKJFN(FX)	; Get address of foreign port
	MOVE C,[1,,FRNHAD]
	GDSTS
	HRROI A,FRNHNM		; Get foreign host name
	MOVE B,[1B1+1B2+C]
	MOVE C,FRNHAD
	SETZ D,
	PUPNM
	 PUSHJ P,SCREWUP##

; Main command loop
COMLP:	PUSHJ P,GETCMD		; Get next command
	 JRST FTPEND		; End received, close connection
	MOVE C,MRKNAM(A)	; Check for command allowed in this server
	CAIN SV,SV.MAI
	 TLZA C,(NOTFTS)	; We are a mail server
	 TLZ C,(NOTMLS)		; We are an FTP server
	TLNE C,(NOTFTS+NOTMLS)
	 JRST [	HRRO A,MRKNAM(A)
		HLRO B,SRVDSP##(SV)
		FTPM(NO,3,<Command [%1S] not permitted in %2S server>)
		JRST COMLP]
	MOVE P1,MRKDSP(A)	; Get dispatch
	PUSHJ P,0(P1)		; Process the command
	JRST COMLP		; Repeat for next

; Here when End received
FTPEND::HLRZ A,FRKJFN(FX)	; Get Pup input JFN
	CLOSF			; Close it
	 PUSHJ P,SCREWUP##
	HRRZS A,FRKJFN(FX)	; Now same for output JFN
	CLOSF
	 JRST [	ELOG <Connection closed uncleanly%/ - %1J>
		HRRZ A,FRKJFN(FX)  ; Should work a second time
		CLOSF
		 HALTF
		JRST .+1]
	SETZM FRKJFN(FX)	; Note that no JFNs exist now
	HALTF			; Terminate normally

; -----------------------------------------------------------------
;	Individual command handlers
; -----------------------------------------------------------------

; "End-Of-Command"

C.EOC:	FTPM(EOC,,,1)		; Just send answering EOC


; "Version"

C.VERS:	HRROI A,VERTXT		; Give version string for text
	HRROI B,LCLHNM##	; Local host name string
	HLRO C,SRVDSP##(SV)	; Server type name
	FTPM(VERS,FTPVER,<%2S Pup %3S Server %1S>,1)



; Commands that should never be received at top level

C.YES:				; "Yes"
C.NO:				; "No"
C.FILE:				; "Here-is-file"
C.PLST:				; "Here-is-property-list"
	DTYPE <  - Unexpected command%/>

; Commands that are ignored

C.ABOR:				; "Abort" (no-op at top level)
C.COMM:	POPJ P,			; "Comment"

; "Retrieve"

C.RETR:	SETZM FILPRP		; Clear out property list
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Set pointer to argument string
	MOVEI B,FILPRP		; File property list
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	MOVEI A,FILPRP
	MOVEI B,LOGCHK		; Normal login check
	CAIN SV,SV.MAI		; Mail server?
	 MOVEI B,ANOLOG		; Yes, anonymous login
	PUSHJ P,0(B)		; Check login/connect parameters
	 POPJ P,		; Failed
	MOVEI A,TEMP		; Where to build GTJFN command list
	MOVEI B,FILPRP		; Where property list is now
	PUSHJ P,FIXNAM		; Fix args, build command list
	MOVSI C,(1B2+1B11)	; Old file, permit "*"
	HLLM C,TEMP
	GTJFN			; Lookup the Server-Filename string
	 JRST RGJFER		; Failed, give reason and quit
	MOVEM A,SRCJFN##	; Ok, save source JFN and flags
	HRRZS A
	PUSHJ P,CHKDSK		; Check device type
	HRRZ A,FILPRP+P.TYPE	; Get transfer type
	CAIN A,3		; Paged?
	TRNE F,DSKDVF		; Yes, device other than disk?
	 JRST C.RET1		; No, ok
	HRRZ A,SRCJFN##		; Yes, release JFN
	RLJFN
	 PUSHJ P,SCREWUP##
	SETZM SRCJFN##
	FTPM(NO,15,<Type Tenex-Paged illegal for non-disk files>,1)

; Now have JFN (possibly indexable)
; Back here for each file referenced by the JFN
C.RET1:	MOVE A,[FILPRP,,TMPPRP]	; Copy supplied property list
	BLT A,TMPPRP+PLSIZE-1	;  into temps for this retrieval
	MOVE A,SRCJFN##		; Get file JFN, including left half bits
	MOVEI B,TMPPRP		; Set pointer to property list
	PUSHJ P,CKRPAR		; Check retrieval parameters
	 JRST C.RET8		; Bad, bypass this file
	PUSHJ P,GNRPRP		; Generate property list reply

; Await "Yes" or "No" from user
C.RET2:	PUSHJ P,GETCMD		; Get next command
	 JRST [	HRRZ A,SRCJFN##	; Connection closed, release JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM SRCJFN##
		JRST FTPEND]	; Handle EOF normally
	CAIN A,MKNO		; Check command
	 JRST C.RET8		; "No", skip this file
	CAIN A,MKYES
	 JRST C.RET6		; "Yes", send this file
	MOVE C,MRKNAM(A)	; Not one of those, get dispatch
	TLNN C,(OKRETR)		; Command ok in this context?
	 JRST [	HRRZ A,SRCJFN##	; No, flush file JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM SRCJFN##
		HRROS C		; Make string ptr to command name
		FTPM(NO,3,<Command [%3S] out of sequence during Retrieve>,1)]
	MOVE C,MRKDSP(A)	; Ok, get command dispatch
	PUSHJ P,0(C)		; Do the command
	JRST C.RET2		; Look for another

; "Retrieve" (cont'd)

; Here when "Yes" encountered.  Now send the file.
C.RET6:	PUSHJ P,OPNRET		; Open file for retrieve
	 JRST C.RET8		; Failed
	HRRZ A,SRCJFN##		; Ok, get file JFN
	LOG <Retrieve %1F>	; Make log entry
	MOVEI A,MKFILE		; Insert "Here-Is-File" mark
	SETZ B,
	PUSHJ P,BEGCMD
	HRRZ A,FRKJFN(FX)	; Destination is net
	MOVEM A,DSTJFN##
	MOVEI A,TMPPRP		; Property list
	PUSHJ P,SNDDAT##	; Do the retrieval
	 JRST [	HRRZ A,SRCJFN##	; Data error, get JFN
		FTPM(NO,103,<Data error in %1F, Retrieve aborted>)
		JRST C.RET7]
	HRRZ A,SRCJFN##
	FTPM(YES,0,<Retrieve of %1F completed>)
C.RET7:	HRLI A,400000		; Close file, don't release JFN
	CLOSF
	 PUSHJ P,SCREWUP##

; Here when done retrieval of one file.  Check for more to do
C.RET8:	SETZM DSTJFN##
	MOVE A,SRCJFN##		; Get JFN with flags
	GNJFN			; Step to next file if any
	 JRST [	SETZM SRCJFN##	; No more, done (JFN released)
		POPJ P,]
	JRST C.RET1		; Another, go retrieve it



; "Retrieve" subroutines ...

; Check and/or default parameters for "Retrieve" command
;	A/ JFN for file being retrieved -- including left-half bits
;	B/ Pointer to property list
; Returns +1:  Error, reply message already generated (as either Comment
;		or No, depending on whether or not the JFN is indexable --
;		i.e., whether or not successor files are possible)
;	+2:  Ok, type and byte size filled in appropriately
; Clobbers B-D

CKRPAR:	PUSHJ P,SAVE1##		; Preserve another ac
	MOVE P1,B		; Put the plist pointer there
	SETZ B,			; Assume don't know byte size
	TRNN F,DSKDVF		; Retrieving from disk?
	 JRST CKRPA2		; No
	MOVE B,[1,,11]		; Yes, read byte size from FDB
	MOVEI C,C		; Put it here
	PUSH P,A
	HRRZS A
	GTFDB
	POP P,A
	LDB B,[POINT 6,C,11]	; Extract byte size
CKRPA2:	HRRZ C,P.TYPE(P1)	; Get specified transfer type
	HRRZ D,P.BYTE(P1)	; Get specified byte size
	JRST @[	RTYUNS		; Dispatch on type:  Unspecified
		RTYTXT		; Text
		RTYBIN		; Binary
		RTYPAG](C)	; Paged

; CKRPAR (cont'd)

; Here for type unspecified
RTYUNS:	SKIPN D,B		; File byte size known?
	 JRST [	TLNE A,(77B5)	; Indexable JFN?
		 FTPM(COMM,,<Type specification required to retrieve %1F>,1)
		FTPM(NO,,<Type specification required to retrieve %1F>,1)]
	MOVEI C,2		; Assume binary
	CAIN B,7		; 7-bit file?
	 MOVEI C,1		; Yes, assume text
	JRST CKRPA4		; Go set parameters

; Here for type Text
RTYTXT:	SKIPE D,B		; File byte size known?
	CAIN D,↑D36		; Yes, 36 bit words?
	 MOVEI D,7		; Not known or 36, assume 7 bit
	CAIE D,7		; Legal byte size?
	CAIN D,8
	 JRST CKRPA4		; Yes
	TLNE A,(77B5)		; Indexable JFN?
	 FTPM(COMM,,<Type Text inconsistent with byte size %4D of file %1F>,1)
	FTPM(NO,,<Type Text inconsistent with byte size %4D of file %1F>,1)

; Here for type Binary
RTYBIN:	JUMPN D,.+3		; Transfer byte size specified?
	SKIPN D,B		; No, substitute file byte size
	 JRST [	TLNE A,(77B5)	; Indexable JFN?
	 	 FTPM(COMM,,<Byte size specification required to retrieve %1F>,1)
	 	FTPM(NO,,<Byte size specification required to retrieve %1F>,1)]
	JUMPE B,CKRPA4		; Ok if file byte size unknown
	CAMN B,D		; Both known, consistent?
	 JRST CKRPA4		; Yes
	CAIE B,↑D36		; No, allow only if file byte size is 36
	 JRST [	TLNE A,(77B5)	; Indexable JFN?
	 	 FTPM(COMM,,<File %1F not retrieved:
 requested byte size = %4D but actual file byte size = %2D>,1)
		 FTPM(NO,,<File %1F not retrieved:
 requested byte size = %4D but actual file byte size = %2D>,1)]
	FTPM(COMM,,<File %1F byte size = %2D being retrieved
 with byte size = %4D.  This may be incorrect -- beware!>)
	JRST CKRPA4

; Here for type Tenex-Paged
RTYPAG:	TRNN F,DSKDVF		; Is local file on disk?
	 PUSHJ P,SCREWUP##	; No (should not get here)
	MOVEI D,↑D36		; Set local byte size to 36

; All cases converge here
; C/ Transfer type, D/ Transfer byte size
CKRPA4:	MOVEM C,P.TYPE(P1)	; Store type and byte size
	MOVEM D,P.BYTE(P1)
	JRST SKPRET##		; Return +2

; "Retrieve" subroutines ...

; Generate retrieval property list reply
; Specifically, generate Here-is-Property-List command
; Assumes TMPPRP contains Type/Byte-size properties for this file,
;	FILPRP contains Desired-property property from user request,
;	SRCJFN setup
; Returns +1
; Clobbers A-D

GNRPRP:	PUSHJ P,SAVE1##
	MOVE P1,FILPRP+P.DPRP
	HRROI A,NETBUF		; Where to buffer property list
	HRRZ B,SRCJFN##		; Get file JFN
	MOVE C,FILPRP+P.DPRP
	PUSHJ P,GFNPRP		; Generate filename properties
	HRRZ B,TMPPRP+P.TYPE	; Get type
	HRRZ C,TMPPRP+P.BYTE	; Get byte size
	TXNE P1,1B<X.TYPE>+1B<X.BYTE> ; Type and/or Byte-size requested?
	 XCT [			; Append properties as appropriate
		WRITE <(Type Text)>
		WRITE <(Type Binary)(Byte-Size %3D)>
		WRITE <(Type Tenex-Paged)>
	    ]-1(B)
	TXNE P1,1B<X.SIZE>+1B<X.CDAT>+1B<X.WDAT>+1B<X.RDAT> ; Want these props?
	TRNN F,DSKDVF		; Is file on disk?
	 JRST GNRPR2		; No, omit remaining properties
	PUSH P,D+1
	PUSH P,A		; Yes, save dest designator
	HRRZ A,SRCJFN##		; Get file JFN
	MOVE B,[4,,12]		; Read FDBSIZ FDBCRE, FDBWRT, FDBRED
	MOVEI C,B		; Put them in B, C, D, D+1
	GTFDB
	POP P,A			; Restore dest designator
	TXNE P1,1B<X.SIZE>	; Output whatever was requested
	 WRITE <(Size %2D)>
	TXNE P1,1B<X.CDAT>
	 WRITE <(Creation-date %3Z)>
	TXNE P1,1B<X.WDAT>
	 WRITE <(Write-date %4Z)>
	JUMPE D+1,.+3		; Skip if never read
	TXNE P1,1B<X.RDAT>
	 WRITE <(Read-date %5Z)>
	POP P,D+1
GNRPR2:	HRROI A,NETBUF		; Make ptr to property list
	FTPM(PLST,,<(%1S)>,1)	; Send off command and return


; Open file for retrieval
; Assumes file JFN is in SRCJFN
; and that transfer parameters are in TMPPRP
; Returns +1:  Failed, "No" reply already generated
;	+2:  Succeeded, file open
; Clobbers A-D

OPNRET:	TRNN F,DSKDVF		; Is file on disk?
	 JRST OPNRT1		; No, bypass extension check
	HRROI A,TEMP		; Yes, buffer file extension here
	SETZM TEMP
	HRRZ B,SRCJFN##
	MOVSI C,(1B11)		; Get extension only
	JFNS
	MOVEI B,1B19+1B25	; Assume want to open thawed
	MOVE A,TEMP		; Get the extension
	CAME A,[ASCII /SAV/]	; Leave thawed if .SAV
OPNRT1:	MOVEI B,1B19		; Open in frozen mode
	MOVE A,TMPPRP+P.BYTE	; Get transfer byte size
	DPB A,[POINT 6,B,5]	; Put in position
	HRRZ A,SRCJFN##		; Setup JFN
	OPENF			; Attempt to open
	 JRST [	TRC B,1B25	; Failed, try flipping thawed bit
		HRRZ A,SRCJFN##
		OPENF
		 JRST ROPNER	; Failed again, give error
		JRST .+1]	; Succeeded, continue
	JRST SKPRET##		; Return +2

; "New-store"

C.NSTO:	HRROS 0(P)		; Signal that this is a new-store
	JRST .+2

; "Store"

C.STOR:	HRRZS 0(P)		; Signal that this is an old-store
	SETZM FILPRP		; Clear out property list
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Set pointer to argument string
	MOVEI B,FILPRP		; File property list
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	MOVEI A,FILPRP
	PUSHJ P,LOGCHK		; Check login/connect parameters
	 POPJ P,		; Failed
	MOVEI A,TEMP		; Where to build GTJFN command list
	MOVEI B,FILPRP		; Where property list is
	PUSHJ P,FIXNAM		; Fix args, build command list
	MOVE D,B		; Save main string ptr
	MOVSI C,(1B0)		; For output use
	HLLM C,TEMP
	MOVE C,C.UACT		; Current user account designator
	MOVEM C,TEMP+7
	GTJFN			; Get a JFN for the file
	 JRST [	CAIE A,GJFX23	; Failed, directory full?
		 JRST SGJFER	; Other error, fail
		MOVE A,C.UNAM	; Yes, expunge login and connected dirs --
		DELDF		;  too hard to figure out exactly what dir
		MOVE A,C.CNAM	;  is involved, and login and connected dirs
		CAME A,C.UNAM	;  are the only ones we can expunge anyway
		 DELDF
		MOVEI A,TEMP	; Try again
		MOVE B,D
		GTJFN
		 JRST SGJFER	; Still failed
		JRST .+1]
	MOVEM A,DSTJFN##	; Ok, save destination JFN

	MOVE B,[FILPRP,,TMPPRP]	; Copy supplied property list
	BLT B,TMPPRP+PLSIZE-1	;  into temps for this Store
	PUSHJ P,CHKDSK		; Check device type
	MOVEI B,TMPPRP		; Set pointer to property list
	PUSHJ P,CKSPAR		; Check store parameters
	 JRST C.STO8		; Bad, quit
	PUSHJ P,OPNSTO		; Open file for store
	 JRST C.STO8		; Failed

; Set file creation date to the date supplied in the property list
	SKIPE C,TMPPRP+P.CDAT	; Date present in property list?
	TRNN F,DSKDVF		; File on disk?
	 JRST C.STO2		; No
	HRRZ A,DSTJFN##		; Yes, set creation date
	HRLI A,13
	SETO B,
	CHFDB

; Store (cont'd)

; Now that we have the file open, generate the positive reply
;  and then await the "Here-is-file" command and file data
C.STO2:	SKIPGE 0(P)		; Which kind of store?
	 JRST [	HRROI A,NETBUF	; New, buffer property list here
		HRRZ B,DSTJFN##
		MOVE C,FILPRP+P.DPRP
		PUSHJ P,GFNPRP	; Generate filename properties
		HRROI A,NETBUF	; Send Here-is-property-list reply
		FTPM(PLST,,<(%1S)>)
		JRST C.STO3]
	HRRZ A,DSTJFN##		; Get JFN for use in message
	FTPM(YES,0,<File %1F open, ready for data>)

C.STO3:	PUSHJ P,GETCMD		; Get next command
	 JRST STOEND		; End received
	CAIN A,MKFILE		; "Here-is-file"?
	 JRST C.STO7		; Yes, go receive file
	CAIN A,MKNO		; "No"? (i.e. abort)
	 JRST [	HRRZ A,DSTJFN##	; Yes, report abortion
		LOG <Store of %1F aborted>
		JRST KILFIL]	; Flush output file and return
	MOVE C,MRKNAM(A)	; No, get dispatch
	TLNN C,(OKSTOR)		; Command ok during "Store"?
	 JRST [	HRRO C,MRKNAM(A)  ; No, make ptr to command name
		FTPM(NO,3,<Command [%3S] out of sequence during Store>)
		JRST KILFIL]	; Flush output file and return
	MOVE C,MRKDSP(A)	; Ok, get dispatch
	PUSHJ P,0(C)		; Do the command
	JRST C.STO3		; Look for another

; Here when "Here-is-file" command encountered
C.STO7:	HRRZ A,DSTJFN		; Get file JFN
	LOG <Store %1F>		; Make log entry
	HLRZ A,FRKJFN(FX)	; Source is net
	MOVEM A,SRCJFN##
	MOVEI A,TMPPRP		; Property list being used
	PUSHJ P,RECDAT##	; Do the store
	 JRST [	PUSHJ P,GETCMD	; Failed, suck up next command
		 JRST STOEND	; End received
		HRRZ A,DSTJFN##	; Report failure
		LOG <Data error during Store of %1F>
		FTPM(NO,103,<Data error during Store of %1F>)
		SETZM SRCJFN##
		JRST KILFIL]	; Flush output file and return
	SETZM SRCJFN##
	PUSHJ P,GETCMD		; Done, get next command
	 JRST STOEND		; End received
	CAIN A,MKNO		; Terminated by "No"?
	 JRST [	HRRZ A,DSTJFN##	; Report abortion
		LOG <Store of %1F aborted>
		FTPM(NO,106,<Store of %1F not completed>)
		JRST KILFIL]	; Flush output file and return
	CAIE A,MKYES		; Terminated by "Yes"?
	 JRST [	HRRO C,MRKNAM(A)  ; No, make ptr to command name
		FTPM(NO,3,<Command [%3S] out of sequence during Store>)
		JRST KILFIL]	; Flush output file and return
	HRRZ A,DSTJFN##		; Transfer ok
	FTPM(YES,0,<Store of %1F completed>)
	CLOSF			; Close file
	 ELOG <Unlikely CLOSF error: %1J%/>
	SETZM DSTJFN##
	POPJ P,			; Done

; Store (cont'd)

; Here to give up before opening file
C.STO8:	HRRZ A,DSTJFN##		; Just release JFN
	RLJFN
	 PUSHJ P,SCREWUP
	SETZM DSTJFN##
	POPJ P,			; Done

; Here when End received in the middle of a Store
STOEND:	HRRZ A,DSTJFN##		; Report abortion
	LOG <Store of %1F aborted>
	PUSHJ P,KILFIL		; Delete output file if possible
	JRST FTPEND		; Handle EOF normally



; "Store" subroutines ...

; Check and/or default parameters for "Store" command
;	A/ JFN for file being stored
;	B/ Pointer to property list
; Returns +1:  Error, reply message already generated
;	+2:  Ok, type and byte size filled in appropriately
; Clobbers B-D

CKSPAR:	HRRZ D,P.BYTE(B)	; Get bytesize specification
	HRRZ C,P.TYPE(B)	; Dispatch on type
	JRST @[	STYUNS		; Unspecified
		STYTXT		; Text
		STYBIN		; Binary
		STYPAG](C)	; Paged

STYUNS:	FTPM(NO,102,<Type specification required to store %1F>,1)

STYPAG:	TRNN F,DSKDVF		; Paged, devide disk?
	 FTPM(NO,15,<Type Tenex-Paged illegal for non-disk files>,1)
	MOVEI D,↑D36		; Byte size is 36
	JRST .+2

STYTXT:	MOVEI D,7		; Text, use byte size 7
STYBIN:	SKIPN D			; Ensure have byte size
	 FTPM(NO,102,<Byte size specification required to store %1F>,1)
	HRRM D,P.BYTE(B)	; Store byte size in property list
	JRST SKPRET##		; Return +2


; Open file for store
; Assumes file JFN is in DSTJFN
; and that transfer parameters are in TMPPRP
; Returns +1:  Failed, reply already generated
;	+2:  Succeeded, file open
; Clobbers A-D

OPNSTO:	MOVE B,TMPPRP+P.BYTE	; Get transfer byte size
	ROT B,-6		; Put in position
	HRRI B,1B20		; Say opening for writing
	HRRZ A,DSTJFN##		; Setup JFN
	OPENF			; Attempt to open
	 JRST SOPNER		; Failed, give error
	JRST SKPRET##		; Succeeded, return +2

; "New-enumerate"

C.NENU:	HRROS 0(P)		; Set flag to denote new protocol
	JRST .+2

; "Enumerate"

C.ENUM:	HRRZS 0(P)
	SETZM FILPRP		; Clear out property list
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Set pointer to argument string
	MOVEI B,FILPRP		; File property list
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	MOVEI A,FILPRP
	PUSHJ P,LOGCHK		; Check login/connect parameters
	 POPJ P,		; Failed
	MOVEI A,TEMP		; Where to build GTJFN command list
	MOVEI B,FILPRP		; Where property list is now
	PUSHJ P,FIXNAM		; Fix args, build command list
	SKIPN C,0(A)		; Version specified?
	 MOVEI C,-3		; No, default to *
	HRLI C,(1B2+1B11)	; Old file, permit "*"
	MOVEM C,0(A)
	HRROI C,[ASCIZ /*/]	; Default name and extension to *
	MOVEM C,4(A)
	MOVEM C,5(A)
	GTJFN			; Lookup the Server-Filename string
	 JRST RGJFER		; Failed, give reason and quit
	MOVEM A,SRCJFN##	; Ok, save JFN and flags
	SKIPL 0(P)		; New protocol?
	 JRST C.ENU2		; No
	MOVEI A,MKPLST		; Yes, begin the (single) reply
	SETZ B,
	PUSHJ P,BEGCMD

; Loop to generate file property list(s)
C.ENU2:	PUSHJ P,SETWDT##	; Reset watchdog timer
	HRRZ A,SRCJFN##		; Get JFN for file
	PUSHJ P,CHKDSK		; Check device type
	HRROI A,NETBUF		; Buffer the property list here
	HRRZ B,SRCJFN##		; File JFN
	MOVE C,FILPRP+P.DPRP
	PUSHJ P,GENPRP		; Generate property list for file
	HRROI B,NETBUF
	SKIPGE 0(P)		; Which protocol?
	 JRST [	DTYPE <%2S>
		HRRZ A,FRKJFN(FX) ; New, just send property list itself
		SETZ C,
		SOUT
		JRST .+2]
	FTPM(PLST,0,<%2S>)	; Old, send entire Here-is-property-list response
	MOVE A,SRCJFN##		; Recover JFN and flags
	GNJFN			; Step to next if any
	 JRST [	SETZM SRCJFN##	; No more, done
		SKIPL 0(P)
		 POPJ P,	; Old protocol
		PUSHJ P,ENDCMD	; New protocol, force byte stream
		DTYPE <%/>
		POPJ P,]
	JRST C.ENU2		; More, repeat

; Generate complete file property list for supplied JFN
;	A/ Destination designator
;	B/ JFN
;	C/ Desired-property flags
; Returns +1 always:  A/ Designator (updated if string ptr)
; Clobbers B-D

GENPRP:	PUSHJ P,SAVE1##
	MOVE P1,C		; Preserve Desired-property flags
	HRLM B,0(P)		; Preserve file JFN
	WRITE <(>		; Start property list
	PUSHJ P,GFNPRP		; Generate filename properties
	MOVE D,A		; Move designator to D
	TXNE P1,1B<X.TYPE>+1B<X.BYTE>+1B<X.SIZE>+1B<X.CDAT>+1B<X.WDAT>+1B<X.RDAT>+1B<X.AUTH>
				; Want any of these properties?
	TRNN F,DSKDVF		; Is file on disk?
	 JRST GENPR9		; No, no more attributes

; For disk, output all interesting things in the FDB
	HLRZ A,0(P)
	MOVE B,[25,,0]		; Read entire FDB
	MOVEI C,TEMP		; Put it here
	GTFDB
	TXNN P1,1B<X.TYPE>+1B<X.BYTE>  ; Want Type and/or Byte-size?
	 JRST GENPR2		; No
	LDB B,[POINT 6,TEMP+11,11]  ; Get byte size
	JUMPE B,GENPR2		; Jump if unknown
	CAIN B,7		; Say Text if byte size 7
	 WRITE D,<(Type Text)>
	CAIE B,7		; Binary for anything else
	 WRITE D,<(Type Binary)(Byte-size %2D)>
GENPR2:	MOVE B,TEMP+12		; Get file length
	TXNE P1,1B<X.SIZE>	; Want Size property?
	 WRITE D,<(Size %2D)>
	MOVE B,TEMP+13		; Get creation date
	TXNE P1,1B<X.CDAT>	; Want Creation-date property?
	 WRITE D,<(Creation-date %2Z)>
	MOVE B,TEMP+14		; Get write date
	TXNE P1,1B<X.WDAT>	; Want Write-date property?
	 WRITE D,<(Write-date %2Z)>
	TXNN P1,1B<X.RDAT>	; Want Read-date property?
	 JRST .+3
	SKIPE B,TEMP+15		; Get read date if there is one
	 WRITE D,<(Read-date %2Z)>
	TXNN P1,1B<X.AUTH>	; Want Author property?
	 JRST .+4
	HLRZ B,TEMP+6		; Get author
	SKIPE B			; Output if present
	 WRITE D,<(Author %2U)>

GENPR9:	MOVE A,D		; Destination designator back to A
	WRITE <)>		; End property list
	POPJ P,			; Done

; "Delete"

C.DELE:	SETZM FILPRP		; Clear out property list
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	HRROI A,NETBUF		; Set pointer to argument string
	MOVEI B,FILPRP		; File property list
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	MOVEI A,FILPRP
	PUSHJ P,LOGCHK		; Check login/connect parameters
	 POPJ P,		; Failed
	MOVEI A,TEMP		; Where to build GTJFN command list
	MOVEI B,FILPRP		; Where property list is now
	PUSHJ P,FIXNAM		; Fix args, build command list
	SKIPN C,0(A)		; Was version specified?
	 MOVEI C,-2		; No, default to lowest
	HRLI C,(1B2+1B11)	; Old file, permit "*"
	MOVEM C,0(A)
	GTJFN			; Lookup the Server-Filename string
	 JRST RGJFER		; Failed, give reason and quit
	MOVEM A,SRCJFN##	; Ok, save source JFN and flags
	HRRZS A
	PUSHJ P,CHKDSK		; Check device type

; Now have JFN (possibly indexable)
; Back here for each file referenced by the JFN
C.DEL1:	PUSHJ P,SETWDT##	; Reset watchdog timer
	HRROI A,NETBUF		; Where to buffer property list
	HRRZ B,SRCJFN##		; Get file JFN
	MOVE C,FILPRP+P.DPRP
	PUSHJ P,GENPRP		; Generate full property list
	HRROI A,NETBUF		; Make ptr to property list
	FTPM(PLST,,<%1S>)	; Send it off

; Await "Yes" or "No" from user
C.DEL2:	PUSHJ P,GETCMD		; Get next command
	 JRST [	HRRZ A,SRCJFN##	; Connection closed, release JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM SRCJFN##
		JRST FTPEND]	; Handle EOF normally
	CAIN A,MKNO		; Check command
	 JRST C.DEL8		; "No", skip this file
	CAIN A,MKYES
	 JRST C.DEL6		; "Yes", delete this file
	MOVE C,MRKNAM(A)	; Not one of those, get dispatch
	TLNN C,(OKRETR)		; Command ok in this context?
	 JRST [	HRRZ A,SRCJFN##	; No, flush file JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM SRCJFN##
		HRROS C		; Make string ptr to command name
		FTPM(NO,3,<Command [%3S] out of sequence during Delete>,1)]
	MOVE C,MRKDSP(A)	; Ok, get command dispatch
	PUSHJ P,0(C)		; Do the command
	JRST C.DEL2		; Look for another

; Here when "Yes" encountered.  Now delete the file.
C.DEL6:	HRRZ A,SRCJFN##		; Get file JFN
	LOG <Delete %1F>	; Make log entry
	HRLI A,400000		; Don't release JFN
	DELF			; Delete file
	 JRST [	LOG <Delete failed - %1J>
		PUSHJ P,DELERR	; Report reason
		JRST C.DEL8]	; On to next
	HRRZ A,SRCJFN##		; Succeeded, report
	FTPM(YES,0,<File %1F deleted>)

; Here when done deleting one file.  Check for more to do
C.DEL8:	MOVE A,SRCJFN##		; Get JFN with flags
	GNJFN			; Step to next file if any
	 JRST [	SETZM SRCJFN##	; No more, done (JFN released)
		POPJ P,]
	JRST C.DEL1		; Another, go delete it

; "Rename"

C.RENA:	SETZM FILPRP		; Clear out property list
	MOVE A,[FILPRP,,FILPRP+1]
	BLT A,FILPRP+PLSIZE-1
	SETZM TMPPRP		; Clear out another property list
	MOVE A,[TMPPRP,,TMPPRP+1]
	BLT A,TMPPRP+PLSIZE-1
	HRROI A,NETBUF		; Set pointer to argument string
	MOVEI B,FILPRP		; Where to put properties
	PUSHJ P,SCNPRP##	; Scan property list
	 POPJ P,		; Failed
	MOVEI B,TMPPRP
	PUSHJ P,SCNPRP##	; Scan second property list
	 POPJ P,
	MOVEI A,FILPRP
	PUSHJ P,LOGCHK		; Check login/connect parameters
	 POPJ P,		; Failed
	MOVEI A,TEMP		; Where to build GTJFN command list
	MOVEI B,FILPRP		; Where "old" property list is now
	PUSHJ P,FIXNAM		; Fix args, build command list
	MOVSI C,(1B2)		; Old file required
	IORM C,0(A)
	GTJFN			; Lookup the "old" server filename
	 JRST RGJFER		; Failed, give reason and quit
	MOVEM A,SRCJFN##	; Ok, save JFN
	MOVEI A,TEMP		; Where to build GTJFN command list
	MOVEI B,TMPPRP		; Where "new" property list is now
	PUSHJ P,FIXNAM		; Fix args, build command list
	MOVSI C,(1B0+1B1)	; Output use, new file only
	IORM C,0(A)
	GTJFN			; Get JFN for new file
	 JRST [	PUSHJ P,RENGJF	; Failed, give reason
		HRRZ A,SRCJFN##	; Release old JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		SETZM SRCJFN##
		POPJ P,]
	MOVE B,A		; Ok, get new JFN
	MOVE A,SRCJFN##		; Old JFN
	RNAMF			; Attempt rename
	 JRST [	PUSHJ P,RENERR	; Failed, give reason
		HRRZ A,SRCJFN##	; Release old JFN
		RLJFN
		 PUSHJ P,SCREWUP##
		JRST .+2]
	FTPM(YES,0,<Rename to %2F successful>)
	SETZM SRCJFN##		; Old JFN now released
	MOVE A,B		; Release new JFN
	RLJFN
	 PUSHJ P,SCREWUP##
	POPJ P,			; Done

; Generate filename properties given JFN
;	A/ Destination designator
;	B/ JFN
;	C/ Desired-property flags
; Assumes DSKDVF set properly
; Returns +1 always:  A/ Designator (updated if string ptr)
; Generates Device, Directory, Name-Body, Version, and
; Server-Filename properties as appropriate
; Clobbers B-D

GFNPRP:	PUSHJ P,SAVE1##
	MOVE P1,C		; Preserve flags
	HRLM B,0(P)		; Preserve file JFN
	MOVE D,A		; Put dest designator in D
	TXNE P1,1B<X.DEVI>	; Want Device property?
	TRNE F,DSKDVF		; Device disk?
	 JRST GFNPR1		; Yes, omit device property
	MOVSI C,(1B2)		; Print just device
	PUSHJ P,DOJFNS		; Convert device name to string
	WRITE D,<(Device %2S)>	; Generate property
GFNPR1:	TXNE P1,1B<X.DIRE>	; Want Directory property?
	TRNN F,DSKDVF		; Device disk?
	 JRST GFNPR2		; No, omit directory
	HLRZ B,0(P)		; Yes, get file JFN
	MOVSI C,(1B5)		; Want just directory
	PUSHJ P,DOJFNS		; Convert directory to string
	WRITE D,<(Directory %2S)>; Generate property
GFNPR2:	TXNN P1,1B<X.NAMB>	; Want Name-body property?
	 JRST GFNPR5		; No
	HLRZ B,0(P)		; Get file JFN
	MOVE C,[1B8+1B11+1B35]	; Want name and ext, punctuated
	PUSHJ P,DOJFNS		; Convert to string
	PUSH P,B		; See if it ends in "."
GFNPR4:	ILDB C,B
	CAIN C,"."
	 JRST [	MOVE C,B
		ILDB C,C
		JUMPN C,GFNPR4
		DPB C,B		; Yes, strip off trailing "."
		JRST .+2]
	JUMPN C,GFNPR4
	POP P,B
	WRITE D,<(Name-Body %2S)>; Generate property
GFNPR5:	TXNE P1,1B<X.VERS>	; Want Version property?
	TRNN F,DSKDVF		; Device disk?
	 JRST GFNPR3		; No, omit version
	HLRZ B,0(P)		; Yes, get file JFN
	MOVSI C,(1B14)		; Want just version
	PUSHJ P,DOJFNS		; Convert version to string
	WRITE D,<(Version %2S)>	; Generate property
GFNPR3:	TXNN P1,1B<X.SFIL>	; Want Server-filename property?
	 JRST GFNPR6		; No
	HLRZ B,0(P)		; Get file JFN
	TRNN F,DSKDVF		; Device disk?
	 TDZA C,C		; No, print in default format
	 MOVE C,[2B2+1B5+1B8+1B11+1B14+1B21+1B35] ; Yes, force dir
	PUSHJ P,DOJFNS		; Convert filename to string
	WRITE D,<(Server-Filename %2S)>; Generate property
GFNPR6:	MOVE A,D		; Put designator back in A
	POPJ P,			; Done

; Do JFNS with output suitable for inclusion in property list
;	B/ File JFN
;	C/ JFNS flags
; Returns +1:
;	B/ String ptr to JFNS text
; Clobbers A-C

DOJFNS:	MOVE A,[POINT 7,TEMP]	; Where to put temp text
	JFNS			; Convert to string
	MOVE A,[POINT 7,TEMP]	; Source string
	MOVE B,[POINT 7,TEMP+100]  ; Destination string
DOJFN1:	ILDB C,A		; Get a char
	CAIN C,"V"-100		; Tenex filename quote?
	 JRST DOJFN1		; Yes, flush it
	CAIE C,"("		; Character need to be quoted?
	CAIN C,")"
	 JRST .+3		; Yes
	CAIE C,PQUOTE
	 JRST DOJFN2		; No
	MOVEI C,PQUOTE		; Yes, insert quote character
	IDPB C,B
	LDB C,A			; Recover character
DOJFN2:	IDPB C,B		; Store the character
	JUMPN C,DOJFN1		; Repeat if not at end
	MOVE B,[POINT 7,TEMP+100]  ; Where result string is now
	POPJ P,			; Done

; Here to handle GTJFN errors peculiar to "Retrieve"
RGJFER::CAIL A,GJFX18		; File not found errors
	CAILE A,GJFX21
	 CAIN A,GJFX24
	  FTPM(NO,100,<No such file exists>,1)
	JRST GJFERR		; Handle rest same as Store

; GTJFN errors peculiar to "Rename"
RENGJF:	CAIE A,GJFX27		; New file only
	CAIN A,GJFX20		; No such version (?? -- really flakey)
	 FTPM(NO,112,<Rename "to" file already exists>,1)

; GTJFN errors peculiar to "Store"
SGJFER:	CAIL A,GJFX18		; File not found errors
	CAILE A,GJFX21		; Really mean can't create file
	 CAIN A,GJFX24
	  FTPM(NO,101,<No access to create that file>,1)

; Here for errors common to "Retrieve" and "Store"
GJFERR:	CAIL A,GJFX4		; Illegal format errors
	CAILE A,GJFX15
	 CAIN A,GJFX31
	  FTPM(NO,11,<Illegal filename>,1)
	CAIE A,GJFX33		; More illegal format errors
	CAIN A,GJFX34
	 FTPM(NO,11,<Illegal filename>,1)
	CAIN A,GJFX16		; More file not found errors
	 FTPM(NO,100,<No such device exists>,1)
	CAIN A,GJFX17
	 FTPM(NO,100,<No such directory exists>,1)
	CAIN A,GJFX32
	 FTPM(NO,100,<No such file exists>,1)
	FTPM(NO,0,<Filename error: %1J>,1)  ; All others


; Here to handle OPENF errors peculiar to "Retrieve"
ROPNER::HRRZ C,SRCJFN##		; Setup JFN for reply message
	JRST OPNERR		; Join common code

; Here to handle OPENF errors peculiar to "Store"
SOPNER:	HRRZ C,DSTJFN##		; Setup JFN for message

; OPENF failure code common to "Retrieve" and "Store"
OPNERR:	CAIL A,OPNX3		; Check for protection errors
	CAILE A,OPNX6
	 CAIN A,OPNX13
	  FTPM(NO,101,<Access denied to file %3F>,1)
	CAIN A,OPNX23
	 FTPM(NO,101,<Access denied to directory containing %3F>,1)
	CAIN A,OPNX9		; File busy error
	 FTPM(NO,111,<File %3F busy>,1)
	CAIN A,OPNX10		; Disk full error
	 FTPM(NO,104,<No room for file %3F>,1)
	CAIN A,SFBSX2		; Byte size error
	 FTPM(NO,102,<Illegal byte size for file %3F>,1)
	FTPM(NO,0,<File open error: %1J for file %3F>,1)  ; Other


; "Delete" errors
DELERR:	HRRZ C,SRCJFN##
	CAIN A,DELFX1
	 FTPM(NO,101,<Delete access denied to file %3F>,1)
	FTPM(NO,0,<Delete error: %1J for file %3F>,1)


; "Rename" errors
RENERR:	HRRZ C,SRCJFN##		; Get "from" JFN
	CAIN A,RNAMX3
	 FTPM(NO,101,<Access denied to new file %2F>,1)
	CAIN A,RNAMX5
	 FTPM(NO,111,<File %2F busy>,1)
	CAIN A,RNAMX8
	 FTPM(NO,101,<Access denied to existing file %3F>,1)
	CAIN A,RNMX10
	 FTPM(NO,101,<File %3F busy>,1)
	FTPM(NO,0,<Rename %3F to %2F failed: %1J>,1)

; -----------------------------------------------------------------
;	File system utilities
; -----------------------------------------------------------------

; Check for device disk
;	A/ JFN for file being retrieved or stored
; Returns +1 always
; Sets DSKDVF flag appropriately
; Clobbers B, C

CHKDSK:	PUSH P,A		; Save JFN
	DVCHR			; Get device characteristics
	POP P,A			; Restore JFN
	TLNN B,377		; Check device type
	 TROA F,DSKDVF		; Device is a disk
	 TRZ F,DSKDVF		; Device is not a disk
	POPJ P,


; "Kill" destination file, i.e. delete all its pages and
; try very hard to make it go away (works only for disk).
; Assumes DSTJFN contains open output JFN and that DSKDVF
; has already been set appropriately.
; Returns +1 always
; Closes and releases JFN
; Clobbers A-D

KILFIL::HRRZ A,DSTJFN##		; Get destination JFN
	DELF			; First attempt to delete file
	 JRST KILFI5		; Non-directory or no access, stop
	TRNN F,DSKDVF		; Output to disk?
	 JRST KILFI5		; No, just close file
	MOVE B,[1,,1]		; Yes, get FDBCTL word
	MOVEI C,C
	GTFDB
	TLNN C,(1B4)		; FDBNXF set?
	 JRST KILFI5		; No, file previously existed
	PUSHJ P,DELPGS		; Yes, delete all pages in file
	HRRZ A,DSTJFN##		; Close the file
	HRLI A,400000		;  but don't release JFN
	CLOSF
	 POPJ P,		; Failed?  give up
	HRLI A,1		; Now set FDBNXF to make the
	MOVSI B,(1B4)		;  file look invisible
	MOVSI C,(1B4)
	CHFDB
	HRRZ A,DSTJFN##		; Release JFN
	RLJFN
	 CAI
	SETZM DSTJFN##
	POPJ P,			; Done

; Here to just close file
KILFI5:	HRRZ A,DSTJFN##
	CLOSF
	 CAI
	SETZM DSTJFN##
	POPJ P,


; Delete all pages in a disk file
; Assumes file open for writing
;	A/ JFN
; Returns +1 always
; Clobbers A, B

DELPGS::HRLZ A,A		; Make designator for file page 0
	SETO B,			; Set arg for deleting pages
DELPG1:	FFUFP			; Find next existing page
	 POPJ P,		; No more, done
	EXCH A,B		; Found one, delete it
	PMAP
	EXCH A,B
	AOJA A,DELPG1		; On to next

; Fix up filename strings for Retrieve, Store, etc.
;	A/ Where to build command list for GTJFN
;	B/ Property list pointer
; Specifically, if a Server-Filename was not supplied, construct
; one from the Name-Body property.  Then setup the remaining
; properties (if any) as defaults.
; Returns +1:
;	A/ unchanged
;	B/ main string pointer (for GTJFN)
; Clobbers B, C

FIXNAM:	HRRZ C,P.VERS(B)	; Default version
	MOVEM C,0(A)
	MOVE C,[377777,,377777]	; No file i/o for GTJFN
	MOVEM C,1(A)
	SKIPE C,P.DEVI(B)	; Device supplied?
	 HRROI C,P.DEVI(B)	; Yes, set default device
	MOVEM C,2(A)
	SKIPE C,P.DIRE(B)	; Directory supplied?
	 HRROI C,P.DIRE(B)	; Yes, set default directory
	MOVEM C,3(A)
	SETZM 4(A)		; No default name
	SETZM 5(A)		; No default extension
	SETZM 6(A)		; No default protection
	SETZM 7(A)		; No default account
	MOVEI B,P.SFIL(B)	; Make string ptr to server name
	HRLI B,(POINT 7)
	SKIPN 0(B)		; Is there one?
	 HRRI B,P.NAMB-P.SFIL(B)  ; No, use name body
	CAIE SV,SV.MAI		; Done if not a mail server
	POPJ P,

; Can get here only during Retrieve command issued to Mail server.
; Force the directory to be <Secretary> and the extension to be .DL,
; and explicitly concatenate them to the main name string (rather than
; supplying them as defaults) so that they cannot be overridden by the user.
	SETZM 2(A)		; No default device or directory
	SETZM 3(A)
	PUSH P,A
	PUSH P,B
	ILDB A,B		; Scan name string for "↑"
	CAIE A,"↑"
	 JUMPN A,.-2
	SETZ A,			; Truncate string at that point
	DPB A,B
	POP P,B
	HRROI A,TEMP+20		; Buffer new name here
	WRITE <<SECRETARY>%2S.DL>
	HRROI B,TEMP+20		; Return that name instead
	POP P,A
	POPJ P,

; Anonymous login (permitted only for mail server .DL retrieval).

ANOLOG:	SKIPN C.UNAM		; Currently logged in?
	 JRST SKPRET##		; No, proceed using PUPSRV capabilities
; If already logged in, check login/connect parameters as usual.


; Check and apply login/connect parameters
;	A/ Property list pointer
; Returns +1:  Incorrect, reply already generated
;	+2:  Parameters correct
; Updates flags LOGCKF, ACTCKF, and CONCKF appropriately
; Clobbers A-D

LOGCHK::PUSHJ P,SAVE1##		; Save P1
	MOVE P1,A		; Setup property list pointer

; Check login directory # and password
	SKIPN A,P.UNAM(P1)	; Setup supplied dir #
	 FTPM(NO,2,<User-Name and Password required>,1)
	CAME A,C.UNAM		; Same as current?
	 JRST LOGCH1		; No, have to re-check
	HRROI A,P.UPSW(P1)	; Same password?
	HRROI B,C.UPSW
	PUSHJ P,STRCMP##
LOGCH1:	 TRZ F,LOGCKF+ACTCKF+CONCKF  ; No, invalidate parameters
	TRNE F,LOGCKF		; Need to check name/password?
	 JRST LOGCH2		; No, bypass

; Name and/or password not the same as before (or not logged in
; previously).  "Log in" this fork as specified.
	HRRZ A,P.UNAM(P1)	; Get dir #
	HRLI A,(1B1)		; Want proxy login
	HRROI B,P.UPSW(P1)	; String ptr to password
	CNDIR			; Do login of fork group
	 JRST [	CAIN A,CNDIX1	; Failed, check error
		 FTPM(NO,21,<User-Password incorrect>,1)
		FTPM(NO,20,<Login failure: %1J>,1)]
; *** Explicitly verify password, since it's not checked if
; logging in under the "current" login directory (e.g. SYSTEM)
	HRLI A,(1B0)		; Say check password
	CNDIR
	 FTPM(NO,21,<User-Password incorrect>,1)
; ***

; Now successfully "logged in".  Record successful name/password
; combination for future checks.
	HRRZ B,P.UNAM(P1)	; Ok, record current user name
	MOVEM B,C.UNAM
	MOVEM B,C.CNAM		; Now connected to that dir also
	MOVSI A,P.UPSW(P1)	; Record successful password
	HRRI A,C.UPSW
	BLT A,C.UPSW+USRSTL/5
	TRO F,LOGCKF+CONCKF	; Say logged in and connected ok
	LOG <Login as user %2U>	; Make log entry
	HRROI A,C.UACT+1	; Where to put default acct string
	GDACC			; Get default account
	 SETZ A,		; None, remember so
	MOVEM A,C.UACT		; Store account designator
IFN RECPWF,<
	MOVE A,C.UNAM
	HRROI B,C.UPSW
	PUSHJ P,RECPAS##
>

; LOGCHK (cont'd)

; See whether account is same as before.
LOGCH2:	SKIPN B,C.UACT		; Get current account designator
	 JRST LOGCH3		; None, force check of new one
	SKIPE A,P.UACT(P1)	; Get specified account designator
	CAMN A,B		; Numeric and same as current?
	 JRST LOGCH4		; Yes (or none), don't force check
	TLC A,(5B2)		; Zero B0-2 if numeric
	TLC B,(5B2)
	TLNE A,(7B2)		; Both string?
	TLNN B,(7B2)
	 JRST LOGCH3		; No, need to re-check
	TLC A,(5B2)		; Yes, fix string pointers
	TLC B,(5B2)
	PUSHJ P,STRCMP##	; Compare strings
LOGCH3:	 TRZ F,ACTCKF		; Not equal, force check
LOGCH4:	TRNE F,ACTCKF		; Need to check account?
	 JRST LOGCH6		; No

; Account different from before, check new one.
	HRRZ A,C.UNAM		; Yes, setup dir # of user
	SKIPN B,P.UACT(P1)	; Get account designator if given
	SKIPE B,C.UACT		; Default if not given
	 VACCT			; Verify account
	  FTPM(NO,22,<User-Account invalid>,1)

; New account is ok.  Remember it for future checks.
	SKIPN A,P.UACT(P1)	; Get supplied designator
	 JRST LOGCH5		; Not supplied, remember default
	MOVSI B,P.UACT(P1)	; Copy string if there is one
	HRRI B,C.UACT
	BLT B,C.UACT+USRSTL/5+1
	HRROI B,C.UACT+1	; Make string ptr
	TLC A,(5B2)		; Is designator numeric?
	TLNE A,(7B2)
	 MOVEM B,C.UACT		; No, store string ptr
LOGCH5:	TRO F,ACTCKF		; Note that acct has been checked

; See whether connected dir # and password are same as before
LOGCH6:	SKIPN A,P.CNAM(P1)	; Get specified connected dir #
	 MOVE A,C.UNAM		; None, assume same as login
	CAME A,C.CNAM		; Same as current?
	 JRST LOGCH7		; No, have to re-check
	HRROI A,P.CPSW(P1)	; Same password?
	HRROI B,C.CPSW
	PUSHJ P,STRCMP##
LOGCH7:	 TRZ F,CONCKF		; No, invalidate parameters
	TRNE F,CONCKF		; Need to check name/password?
	 JRST SKPRET##		; No, done, return +2

; Not the same, do new "connect" of fork to dir.
	SKIPN A,P.CNAM(P1)	; Get connect dir #
	 MOVE A,C.UNAM		; None, use login dir #
	HRROI B,P.CPSW(P1)	; Password
	CNDIR			; Connect to directory
	 JRST [	CAIN A,CNDIX1	; Failed, check error code
		 FTPM(NO,24,<Connect-Password incorrect>,1)
		FTPM(NO,23,<Connect failure: %1J>,1)]
	HRRZM A,C.CNAM		; Succeeded, save current dir #
	MOVSI A,P.CPSW(P1)	; Record successful password
	HRRI A,C.CPSW
	BLT A,C.CPSW+USRSTL/5
	TRO F,CONCKF		; Say connected ok
	JRST SKPRET##		; Done, return +2

; -----------------------------------------------------------------
;	Subroutines
; -----------------------------------------------------------------
; Get next command
; Returns +1:  End received
;	+2:  Ok, A/ Mark type, B/ Subcommand byte (if any)
; Clobbers A-D

; Check status to distinguish between Mark and End
GETCMD::PUSHJ P,SETWDT##	; Reset watchdog timer
	HLRZ A,FRKJFN(FX)	; Get input JFN
	SETZ C,			; Don't want address stuff
	GDSTS			; Get status
	TLNE B,(1B5)		; End received?
	 POPJ P,		; Yes, fail return
	TLZN B,(1B4)		; Mark received?
	 JRST GETCM4		; No, go flush extraneous data

; Got Mark, prepare to process command
	SDSTS			; Clear flag
	MOVEI B,23		; Get the Mark byte
	MTOPR
	CAIGE C,NMARKS		; Mark byte in range?
	SKIPN D,MRKNAM(C)	; Yes, fetch name pointer
	 JRST GETCME		; No or undefined
	PUSH P,C		; Save Mark byte
	TLNE D,(NFETCH)		; Want to pre-fetch command text?
	 JRST GETCM2		; No
	HRROI B,NETBUF		; Yes, buffer as 7-bit ASCII
	MOVNI C,5000		; Max # bytes in buffer
	SIN
	SETZ A,
	SKIPGE C		; Unless completely filled buffer,
	 IDPB A,B		; Put null on end
	SKIPA D,[POINT 7,NETBUF]  ; Init string ptr
GETCM2:	 SETZB D,NETBUF		; Here if no text
	POP P,A			; Recover Mark byte
	HRRO C,MRKNAM(A)	; Get name string
	SKIPGE MRKNAM(A)	; Does command have subcommands?
	 JRST GETCM3		; Yes
	DTYPE <U: [%3S] %4S%/>	; No, print command if debugging
	JRST SKPRET##		; Return +2

GETCM3:	ILDB B,D		; Get subcommand
	DTYPE <U: [%3S] <%2O> %4S%/>; Print command if debugging
	JRST SKPRET##		; Return +2

; Here if command undefined
GETCME:	FTPM(NO,1,<Undefined command [%3O]>)

; Flush byte stream data to next Mark
GETCM4:	HLRZ A,FRKJFN(FX)	; Get input JFN
	MOVE B,[POINT 8,NETBUF]	; Byte ptr to buffer
	MOVNI C,4000		; # bytes in buffer
	SIN			; Suck bytes from net
	JUMPGE C,GETCM4		; Repeat if didn't get it all
	JRST GETCMD		; Go look again for Mark

; Refill the command buffer if necessary
;	A/ used string pointer into NETBUF
; Returns +1:
;	A/ updated string pointer
; Clobbers B-D

REFILL::TRNN A,400		; Have we read half the buffer?
	 POPJ P,		; No, nothing to do
	MOVE B,[NETBUF+400,,NETBUF]  ; Yes, move upper half down
	BLT B,NETBUF+377
	SUBI A,400		; Fix pointer
	PUSH P,A		; Save it
	HLRZ A,FRKJFN(FX)	; Get net input JFN
	HRROI B,NETBUF+400	; Where to put more input
	MOVNI C,400*5		; Max # chars
	SIN			; Get more input
	SETZ A,
	SKIPGE C		; Unless buffer filled,
	 IDPB A,B		; Put null on end
	PUSHJ P,SETWDT##	; Reset watchdog timer
	POP P,A			; Restore byte ptr
	POPJ P,

; FTPM (mark type, sub-code, <string>, pop count)
; UUO to generate FTP reply message

%UFTPM::PUSH P,@40		; Preserve control word
	AOS 40			; Advance to start of string
	PUSHJ P,FORMAT##	; Call UUO output formatter
	 HRROI A,TEMP+600	; Setup -- buffer reply here
	 PUSHJ P,UFTPM2		; Completion -- send off reply
	HRLS 0(P)		; Put pop count (+1) in both halves
	SUB P,0(P)		; Pop stack appropriately
	POPJ P,			; Return from UUO (or from caller)

; FTPM completion
UFTPM2:	SETZ B,			; Terminate string with null
	IDPB B,A

; If an End has been encountered on the receive connection, do not
; send any replies: the user is attempting to shut down the connection
; in the middle of a command, and sending any data may cause a deadlock.
	HLRZ A,FRKJFN(FX)
	SETZ C,
	GDSTS
	TLNE B,(1B5)		; End received?
	 POPJ P,		; Yes, do nothing
	LDB A,[POINT 8,-6(P),7]	; Get Mark type
	LDB C,[POINT 8,-6(P),15]  ; Get subcommand code if any
	HRROI B,TEMP+600	; Point to buffered reply
;	JRST SNDCMD		; Send off the command and return


; Send a command
;	A/ Command number (Mark type)
;	B/ String ptr to command text (0 => none)
;	C/ Subcommand (iff command requires one)
; Returns +1
; Clobbers A-D

SNDCMD:	PUSHJ P,BEGCMD		; Do the work
	JRST ENDCMD		; Force transmission

; Begin command, i.e. do all the output but don't force
; transmission.  Calling sequence same as SNDCMD

BEGCMD::HRRO D,MRKNAM(A)	; Get string ptr to command name
	SKIPL MRKNAM(A)		; Does command have subcommands?
	 DTYPE <S: [%4S] %2S%/>	; No
	SKIPGE MRKNAM(A)
	 DTYPE <S: [%4S] <%3O> %2S%/>; Yes
	MOVE D,B		; Save string ptr
	HRLM C,0(P)		; Save subcommand if any
	MOVE C,A		; Copy command number
	HRRZ A,FRKJFN(FX)	; Get output JFN
	MOVEI B,3		; Send Mark
	MTOPR
	HLRZ B,0(P)		; Get subcommand if any
	SKIPGE MRKNAM(C)	; Does command have subcommands?
	 BOUT			; Yes, send subcommand code
	SETZ C,
	SKIPE B,D		; Is there a string?
	 SOUT			; Yes, send it
	POPJ P,			; Done

; End command by forcing the byte stream
; Returns +1
; Clobbers A, B

ENDCMD:	HRRZ A,FRKJFN(FX)	; Get output JFN
	MOVEI B,21		; Force transmission
	MTOPR
	POPJ P,

; PSI channel definitions

DEFINE PSI(CH,LEV,DISP) <
	ACTCHN==ACTCHN!1B<CH>
RELOC CHNTAB+↑D<CH>
	LEV ,, DISP
>

	ACTCHN==0

CHNTAB:	PSI(9,1,PDLOVF##)	; Pushdown overflow
	PSI(11,1,FTSDTE)	; Data error
	PSI(15,1,ILLINS##)	; Illegal instruction
	PSI(16,1,ILLRED##)	; Illegal read
	PSI(17,1,ILLWRT##)	; Illegal write
	PSI(18,1,ILLXCT##)	; Illegal execute
	PSI(20,1,ILLSIZ##)	; Machine size exceeded

RELOC CHNTAB+↑D36

; Handling for data error in FTP server fork
FTSDTE:	PUSH P,A		; Save an ac
	SKIPL A,SRCDSP		; Check for error dispatches
	SKIPGE A,DSTDSP
	 TRNN A,-1		; Both specified and armed?
	  JRST DATERR##		; No, treat as fatal error
	HRRZM A,CH1PC		; Armed, clobber interrupt pc
	SETZM SRCDSP		; Disarm errors
	SETZM DSTDSP
	POP P,A
	MOVE P,ERRPDP		; Go to correct stack level
	DEBRK			; Break to error dispatch

; Storage

LSP NETBUF,1		; Network I/O buffer
LSP FILBUF,1		; Local file buffer

LS ERRPDP		; Stack pointer to restore on data error
LS SRCDSP		; Source file data error dispatch
LS DSTDSP		; Destination file data error dispatch

LS C.UNAM		; Current login dir #
LS C.UPSW,USRSTL/5+1	; Current login password
LS C.UACT,USRSTL/5+2	; Current account designator
LS C.CNAM		; Current connected dir #
LS C.CPSW,USRSTL/5+1	; Current connect password

LS FILPRP,PLSIZE	; File property list (Store/Retrieve)
LS TMPPRP,PLSIZE	; Temp property list (for one transfer)

LS FRNHAD		; Foreign host address (net,,host)
LS FRNHNM,10		; Foreign host name as a string


	END