;PFUUTL.MAC;4     4-NOV-79 12:40:18    EDIT BY TAFT
; Restore "Sender" property
;PFUUTL.MAC;3     2-SEP-79 15:57:50    EDIT BY TAFT
;PFUUTL.MAC;2     3-JUN-77 11:03:04    EDIT BY TAFT
; Remove dummy "Sender" and "Distribution" property parsers
;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,,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 
	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 ,1
	CAIN A,OPNX4
	 ERROR ,1
	CAIN A,OPNX6
	 ERROR ,1
	CAIE A,OPNX5
	CAIN A,OPNX13
	 ERROR ,1
	CAIN A,OPNX23
	 ERROR ,1
	CAIN A,OPNX9
	 ERROR ,1
	CAIN A,OPNX10
	 ERROR ,1
	CAIN A,SFBSX2
	 ERROR ,1
	ERROR ,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 
	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 
	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 	; No, print command if debugging
	JRST SKPRET##		; Return +2

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

; Here if command undefined
GETCME:	TYPE 

; 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 	; No
	SKIPGE MRKNAM##(A)
	 DTYPE  %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, , 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