;<PUP>PFUUTL.MAC;4     4-NOV-79 12:40:18    EDIT BY TAFT
; Restore "Sender" property
;<PUP>PFUUTL.MAC;3     2-SEP-79 15:57:50    EDIT BY TAFT
;<PUP>PFUUTL.MAC;2     3-JUN-77 11:03:04    EDIT BY TAFT
; Remove dummy "Sender" and "Distribution" property parsers
;<PUP>PFUUTL.MAC;1     2-JUN-77 21:35:25    EDIT BY TAFT
; Split out from PUPFTP.MAC

; Copyright 1979 by Xerox Corporation

	TITLE PFUUTL -- PUP FTP USER UTILITIES
	SUBTTL E. A. Taft / June, 1977

	SEARCH PUPDEF,PFUDEF,STENEX
	USEVAR FTPVAR,FTPPVR


; 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


; Send login parameters (previously buffered in USRNAM, etc.)
;	A/ Destination designator
; Returns +1
;	A/ Destination designator (updated if string ptr)
; Clobbers B

SNDLGN::SKIPN USRNAM##		; Is there a user name?
	 JRST SNDLG1		; No, skip this
	HRROI B,USRNAM##	; Yes, make string ptr to it
	WRITE <(User-Name %2S)>	; Send it off
	HRROI B,USRPSW##	; Make string ptr to password
	SKIPE USRPSW##		; Is there one?
	 WRITE <(User-Password %2S)>; Yes, send it
	HRROI B,USRACT##	; Make string ptr to account
	SKIPE USRACT##		; Is there one?
	 WRITE <(User-Account %2S)>; Yes, send it
SNDLG1:	SKIPN CONNAM##		; Is there a connect name?
	 JRST SNDLG2		; No, skip this
	HRROI B,CONNAM##	; Yes, make string ptr to it
	WRITE <(Connect-Name %2S)>; Send it off
	HRROI B,CONPSW##	; Make string ptr to password
	SKIPE CONPSW##		; Is there one?
	 WRITE <(Connect-Password %2S)>; Yes, send it
SNDLG2:	HRROI B,DEFPRP##+P.DIRE	; String ptr to default directory
	SKIPE DEFPRP##+P.DIRE	; Is there one?
	 WRITE <(Directory %2S)>; Yes, send it
	POPJ P,			; Done

; Fix up filename strings for Retrieve, Store, etc.
;	A/ Property list pointer
; Specifically, if a Server-Filename was not supplied, construct
; one from Device, Directory, Name-Body, and Version properties.
; Returns +1
; Clobbers B, C

FIXNAM::SKIPE P.SFIL(A)		; Server-Filename specified?
	 POPJ P,		; Yes, nothing to do
	HRROI B,P.SFIL(A)	; No, start string pointer to cell
	HRROI C,P.DEVI(A)	; Get Device string ptr
	SKIPE P.DEVI(A)		; Device specified?
	 WRITE B,<%3S:>		; Yes, prefix it
	SKIPE C,P.DIRE(A)	; Directory specified?
	 WRITE B,<<%3U>>	; Yes, expand into string
	HRROI C,P.NAMB(A)	; Append Name-Body string
	WRITE B,<%3S>
	SKIPE C,P.VERS(A)	; Version specified?
	 WRITE B,<;%3D>		; Yes, append it
	POPJ P,


; Generate transfer properties (Type, bytesize, eol convention)
;	A/ Destination designator
;	B/ Property list pointer
; Returns +1 always
;	A/ Destination designator (updated if string ptr)
; Clobbers C

GNTPAR::HRRZ C,P.TYPE(B)	; Get type
	JRST @[	CPOPJ##		; Unspecified
		GNTTXT		; Text
		GNTBIN		; Binary
		GNTPAG](C)	; Paged

GNTTXT:	WRITE <(Type Text)>
	SKIPE C,P.EOLC(B)	; Output eol convention if given
	 XCT [	WRITE <(End-of-Line-Convention CRLF)>
		WRITE <(End-of-Line-Convention Transparent)>
	     ]-1(C)
	POPJ P,

GNTBIN:	WRITE <(Type Binary)>
	SKIPE C,P.BYTE(B)	; Output byte size if given
	 WRITE <(Byte-Size %3D)>
	POPJ P,

GNTPAG:	WRITE <(Type Tenex-Paged)>
	POPJ P,


; Procedure called from PUPXFR -- not used in PUPFTP user
SETWDT::POPJ P,

; Dummy parsers for mail-related properties (should never happen)
PPMLBX::
PPSNDR::
	FTPM(NO,10,<Property out of context>,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
	POPJ P,			; Done

; Here to just close file
KILFI5:	HRRZ A,DSTJFN##
	CLOSF
	 CAI
	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

; Do GTJFN using current command word and capturing terminator
;	A/ LH bits for GTJFN (long mode)
; Returns +1:  GTJFN failed, A/ error code
;	+2:  Succeeded, A/ JFN
; In both cases, D/ Attribute bits for terminator
; In the success case, the filename and the terminating
;  character are appended to the command string.
; Clobbers A-D

GETJFN::MOVEM A,TEMP##		; Store bits in long GTJFN block
	MOVE A,[100,,101]	; I/O to terminal
	MOVEM A,TEMP##+1
	SETZM TEMP##+2		; No other defaults
	MOVE A,[TEMP##+2,,TEMP##+3]
	BLT A,TEMP##+7
	MOVEI A,TEMP##		; Set pointer to block
	MOVE B,WRDBYT##		; Use last word as main string
	GTJFN			; Do it
	 JRST GETTRM		; Failed, get terminator, return +1
	MOVE B,WRDBYT##		; Succeeded, get ptr to word start
	WRITE B,<%1F>		; Overwrite with complete filename
	PUSHJ P,GETTRM		; Get terminator
	IDPB C,B		; Append it
	MOVEM B,CMDBYT##	; Update current byte ptr
	JRST SKPRET##		; Return +2


; Get terminator character (for GTJFN)
; Returns +1:  C/ character, D/ attributes
; If char is Escape, it is replaced by space and ESCAPF set
; If a line-delete character, the appropriate response printed
; Clobbers C and D only

GETTRM::MOVE C,A		; Preserve A
	MOVEI A,100		; Backup terminal input
	BKJFN
	 PUSHJ P,SCREWUP##
	PBIN			; Get the terminator
	EXCH C,A		; Terminator to C, restore A
	CAIN C,33		; Escape?
	 TRO F,ESCAPF		; Yes, remember so
	MOVE D,CHRTAB##(C)	; Return attributes of terminator
	TLNN D,(C.CDEL)		; Command delete char?
	 POPJ P,		; No
	CAIN C,177		; Yes, print appropriate response
	 TYPE <XXX%/>
	CAIE C,177
	 TYPE <←←←%/>
	POPJ P,

; Routines to print error messages for OPENF
;	A/ Error code
; Assume JFN is in SRCJFN or DSTJFN as appropriate
; Return +1
; Clobber C

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

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

; OPENF failure code common to "Retrieve" and "Store"
OPNERR:	CAIN A,OPNX3
	 ERROR <Read access denied to file %3F%/>,1
	CAIN A,OPNX4
	 ERROR <Write access denied to file %3F%/>,1
	CAIN A,OPNX6
	 ERROR <Append access denied to file %3F%/>,1
	CAIE A,OPNX5
	CAIN A,OPNX13
	 ERROR <Access denied to file %3F%/>,1
	CAIN A,OPNX23
	 ERROR <Access denied to directory containing %3F%/>,1
	CAIN A,OPNX9
	 ERROR <File %3F busy%/>,1
	CAIN A,OPNX10
	 ERROR <No room for file %3F%/>,1
	CAIN A,SFBSX2
	 ERROR <Illegal byte size for file %3F%/>,1
	ERROR <File open error: %1J for file %3F%/>,1  ; Other

; -----------------------------------------------------------------
;	Subroutines
; -----------------------------------------------------------------

; Get "Yes" or "No" response
; Returns +1:  End received
;	+2:  EOC encountered
;	+3:  "Yes"
;	+4:  "No"
; On +3 and +4 returns, A/ Mark type, B/ Subcommand byte,
;	D/ String pointer to text
; All other responses are processed internally
; The text of a "No" is printed out
; Clobbers A-D

GYESNO::PUSHJ P,GETRSP		; Get response
	 POPJ P,		; End
	 JRST SKPRET##		; EOC
	CAIN A,MKYES		; Yes?
	 JRST SK2RET##		; Give +3 return
	CAIN A,MKNO		; No?
	 JRST [	TLNN F,(DEBUGF)	; Already typed if debugging
		 TYPE( <%4S%/)  ; Type text of "No" reply
		JRST SK3RET##]	; Return +4
	HRRO C,MRKNAM##(A)	; Other, give error message
	TYPE <Improper server response "[%3S] %4S" while Yes/No expected%/>
	JRST GYESNO		; Ignore, get another


; Process "No" response for file transfer operations.
; Gets the necessary parameters to retry operation, if possible.
;	B/ The "No" subcommand byte
; Returns +1:  The attempt should be abandoned, B/ unchanged
;	+2:  The attempt should be retried
; Clobbers A-D

PROCNO::CAIL B,20		; User name or password problem?
	CAILE B,22
	 POPJ P,		; No, fail
	HRLM B,0(P)		; Yes, save error code
PROCN1:	PUSHJ P,CRIF##		; Make sure at left margin
	PUSHJ P,INIEDT##	; Initialize editor
	PROMPT < LOGIN >	; Prompt for login
	MOVSI D,(C.CEOL)	; Pretend EOL terminated last input
	PUSHJ P,C.LOGI##	; Call "Login" command
	 JRST [	TLNN D,(C.CDEL)	; Failed, line delete?
		 JRST PROCN1	; Other error, try again
		HLRZ B,0(P)	; Delete, recover code and fail
		POPJ P,]
	JRST SKPRET##		; Successful, return +2

; Scan for and flush EOC
; Returns +1:  End received
;	+2:  Normal
; Clobbers A-D

FLSEOC::PUSHJ P,GETRSP		; Get response
	 POPJ P,		; End
	 JRST SKPRET##		; EOC, return +2
	HRRO C,MRKNAM##(A)	; Other, give error message
	TYPE <Improper server response "[%3S] %4S" when EOC expected%/>
	JRST FLSEOC		; Ignore, get another


; Get response from previous command
; Returns +1:  End received
;	+2:  EOC encountered
;	+3:  Normal, A/ Mark type, B/ Subcommand byte (if any)
;		D/ String pointer to text
; "Comment" responses are processed internally
; Clobbers A-D

GETRSP::PUSHJ P,GETCMD		; Get next command from server
	 POPJ P,		; End
	CAIN A,MKEOC		; EOC?
	 JRST SKPRET##		; Yes, return +2
	CAIN A,MKCOMM		; Comment?
	 JRST [	TLNN F,(DEBUGF)	; Already typed if debugging
		 TYPE( <%4S%/)  ; Type text of comment
		JRST GETRSP]	; Ignore, back for next
	JRST SK2RET##		; No, return +3

; Get next command (i.e. reply from server)
; Returns +1:  End received
;	+2:  Ok, A/ Mark type, B/ Subcommand byte (if any)
;		D/ String pointer to text
; Clobbers A-D

; Check status to distinguish between Mark and End
GETCMD::HLRZ A,CONJFN##		; 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 <S: [%3S] %4S%/>	; No, print command if debugging
	JRST SKPRET##		; Return +2

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

; Here if command undefined
GETCME:	TYPE <Undefined command [%3O]%/>

; Flush byte stream data to next Mark
GETCM4:	HLRZ A,CONJFN##		; 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,CONJFN##		; 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
	POP P,A			; Restore byte ptr
	POPJ P,

; 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 <U: [%4S] %2S%/>	; No
	SKIPGE MRKNAM##(A)
	 DTYPE <U: [%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,CONJFN##		; 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,CONJFN##		; Get output JFN
	MOVEI B,21		; Force transmission
	MTOPR
	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
	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
	PUSHJ P,SNDCMD		; Send off the command
	MOVEI A,MKEOC		; Set to append EOC
	SETZB B,C
	MOVE D,-6(P)		; Want to terminate with EOC?
	TLNE D,(1B16)
	 PUSHJ P,SNDCMD		; Yes, do so
	POPJ P,


	END