;PUPFTP.MAC;30 26-SEP-82 15:24:36 EDIT BY TAFT ; Change DIR to ENUM. ; Note: still using old protocol for Store and Enumerate -- ; should change this someday. ;PUPFTP.MAC;29 26-APR-81 14:55:35 EDIT BY TAFT ; Send Creation-Date property during Store. ;PUPFTP.MAC;28 16-JAN-81 11:12:21 EDIT BY TAFT ; Strip trailing "." in Name-body if local filename has blank extension ;PUPFTP.MAC;27 24-OCT-80 09:59:05 EDIT BY TAFT ; Permit storing a 36-bit file with any byte size, but ; give a warning message. ;PUPFTP.MAC;26 4-NOV-79 12:35:06 EDIT BY TAFT ; Revise MAXTAB ; Set file creation date from incoming property list during Retrieve ;PUPFTP.MAC;25 2-SEP-79 16:00:11 EDIT BY TAFT ;PUPFTP.MAC;24 28-AUG-77 17:39:38 EDIT BY TAFT ; Fix "Rename" to send default directory in both property lists ;PUPFTP.MAC;23 24-JUL-77 16:52:33 EDIT BY TAFT ; Repair buggy NOUT in List command ;PUPFTP.MAC;22 3-JUN-77 11:23:07 EDIT BY TAFT ; Add "List" and "Rename" commands ;PUPFTP.MAC;19 2-JUN-77 19:16:37 EDIT BY TAFT ; Split out some subroutines into separate module PFUUTL.MAC ;PUPFTP.MAC;18 12-APR-77 10:39:42 EDIT BY TAFT ; Move VERTXT here ; Add "Exec" and "Halt" commands ;PUPFTP.MAC;17 2-APR-77 16:49:49 EDIT BY TAFT ; Add dummy routines for mail-related properties ;PUPFTP.MAC;16 19-MAR-77 20:04:57 EDIT BY TAFT ; Add "Delete" command ; Add "Preserve Version" ; Add "No" prefix for "Debug" and "Preserve" ; Straighten out who clobbers what property lists. ;PUPFTP.MAC;14 19-MAR-77 13:46:36 EDIT BY TAFT ; Fix crash caused by typing in ";?" ;PUPFTP.MAC;13 18-MAR-77 18:09:13 EDIT BY TAFT ; Add REFILL procedure for property list parser ;PUPFTP.MAC;12 18-MAR-77 17:18:12 EDIT BY TAFT ; Just send EOC when SCNPRP fails since SCNPRP now generates the ; appropriate "No" response internally. ;PUPFTP.MAC;11 15-MAR-77 19:25:28 EDIT BY TAFT ; Change "Selective" to "Automatic", add "List" and "Version". ; "Quit" now closes connection. ; Call "Login" command automatically in appropriate places. ; Default user name in "Login". ; Add Tenex-paged type ; Add kludge to make Tenex-paged the default when connect to Maxc ;PUPFTP.MAC;8 10-MAR-77 14:37:48 EDIT BY TAFT ; Break out major pieces of the program: ; PUPDEF.MAC -- definitions shared by PUPFTP and PUPSRV ; PFUDEF.MAC -- definitions specific to PUPFTP ; PFUCMD.MAC -- keyboard command interpreter ; PFUPRP.MAC -- property list parser ; PUPXFR.MAC -- data transfer routines, shared with PUPSRV ; PUPUUO.MAC -- UUO handler, shared with PUPSRV ; What remain are the top-level command handlers and various ; subroutines. ;PUPFTP.MAC;5 8-APR-76 01:53:54 EDIT BY TAFT ; Make "Debug" toggle the debug flag on and off ; Add command for setting eol convention ; Add common procedure GNTPAR for generating type, byte size, eol ; convention properties ;PUPFTP.MAC;3 25-MAR-76 22:38:34 EDIT BY TAFT ; Add "Close" command (equivalent to "Disconnect") ;PUPFTP.MAC;2 25-MAR-76 00:56:33 EDIT BY TAFT ; Send Type and Byte-Size in "Retrieve" property list if we have them ; Properly handle error returns from INKEY ; Copyright 1979 by Xerox Corporation TITLE PUPFTP -- PUP FTP USER PROGRAM SUBTTL E. A. Taft / January, 1976 SEARCH PUPDEF,PFUDEF,STENEX USEVAR FTPVAR,FTPPVR VERTXT: ASCIZ /1.14 26-Sep-82/ ; 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 ; Assemble command dispatch tables DEFINE X(NAME,HELP,FLAGS) < [ASCIZ /NAME/] ,, C.'NAME > CMDDSP: COMMANDS NCMDS==.-CMDDSP ; Length of main command table AUTDSP: AUTCMDS NAUTCM==.-AUTDSP ; Length of "Automatic" command table NODSP: NOCMDS NNOCMD==.-NODSP ; Length of "No" command table ; Assemble flags and help table DEFINE X(NAME,HELP,FLAGS) < + [ASCIZ /HELP/] > CMDHLP: COMMANDS ; ----------------------------------------------------------------- ; Main loop and user command handling ; ----------------------------------------------------------------- ; Start of program PUPFTP::RESET MOVE P,[IOWD STKLEN,STACK] ; Setup stack SETZ F, ; Clear flags MOVSI D,-/1000 ; Set count of storage pages SETO A, ; Delete page MOVSI B,400000 ; This fork HRRI B,ILSLOC/1000(D) ; Unmap and delete storage page PMAP AOBJN D,.-2 MOVEI A,400000 ; Get capabilities RPCAP TRNE C,1B18+1B19 ; Wheel or operator? TLO F,(ENABLF) ; Yes, remember so GJINF HRRZ B,A ; Login directory number HRROI A,USRNAM ; Generate default user name DIRST PUSHJ P,SCREWUP PUSHJ P,INIPSI ; Initialize psi system MOVEI A,100 ; Get terminator of command used BKJFN ; to start subsystem JRST COMLP PBIN CAIE A," " ; Space? JRST COMLP ; No, prompt for first command PUSHJ P,INIEDT## ; Yes, omit prompt, init editor PUSHJ P,C.OPE0 ; Fake "Open" command ; Main command loop COMLP: PUSHJ P,CRIF## ; Go to left margin PUSHJ P,INIEDT## ; Initialize command editor PROMPT <*> ; Print prompt HRRI F,0 ; Clear temporary flags MOVE A,[-NCMDS,,CMDDSP] ; Setup ptr to dispatch table PUSHJ P,INKEY## ; Input and lookup command keyword JRST COMLP2 ; None found or other error ; Found command. Check flags before dispatching MOVE P1,0(A) ; Get dispatch word MOVE C,CMDHLP-CMDDSP(A) ; Get flags and help string TLNE C,(SPCREQ) ; Space required after command? TLNE D,(C.SPAC) ; Yes, was there one? CAIA ; Yes or not needed JRST COMLP3 ; No and needed, give error TLNE C,(CONREQ) ; Required to have connection open? TLNE F,(CONOPF) ; Yes, is it? CAIA ; No or not needed JRST [ ERROR <%/Please "Open" a connection first> JRST COMLP] TLNN C,(PRECNF) ; Confirm command before dispatch? JRST .+3 ; No PUSHJ P,CONFRM## ; Yes, await confirming EOL JRST COMLP ; Not confirmed PUSHJ P,0(P1) ; Dispatch to command handler CAI ; Some handlers return +2 JRST COMLP ; Back to top ; Here if command not found or other error COMLP2: TLNE D,(C.CDEL) ; Command delete? JRST COMLP ; Yes, just give another prompt SKIPE WRDLEN## ; Null word input? JRST COMLP4 ; No TLNE D,(C.CEOL) ; Yes, followed by eol? JRST COMLP ; Yes, just prompt for more input LDB A,CMDBYT## ; No, get terminator CAIN A,";" ; Start of comment? JRST [ MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC+C.CTRL) ; Yes HRROI A,[ASCIZ /Comment/] PUSHJ P,INWORD## ; Input and discard rest of line JRST COMLP ; Line delete JRST COMLP] ; Normal (must be eol), done COMLP3: ERROR < ? > ; Not legal syntax, complain JRST COMLP ; Prompt for more input ; Finally, try to parse first word as a host name COMLP4: TLNE F,(CONOPF) ; Is there already a connection? JRST COMLP3 ; Yes, don't try to parse host name PUSHJ P,[ ; Get stack level right MOVEM P,WRDPDP## ; Fake up INWORD state to look MOVEI C,C.OPE1 ; like it was called from C.OPEN MOVEM C,WRDXIT## MOVSI C,(C.ALPH+C.NUM+C.HSTC) MOVEM C,WRDATR## LDB A,CMDBYT## ; Recover terminator TLNN D,(C.HSTC) ; Was it punct legal inside name? JRST C.OPE2 ; No, enter "Open" code IBP CMDBYT## ; Yes, include char in word AOS WRDLEN## JRST APWORD##] ; Get more input from user JRST COMLP ; When done, resume main loop ; Here for command error if delete not typed DELERR: TLNE D,(C.CDEL) POPJ P, ; Here for garden-variety command errors from routines called ; from the main loop CERR: ERROR < ? >,1 ; "Help" -- print out more detailed help message C.HELP: PUSHJ P,CRIF## ; Go to left margin MOVSI A,-NCMDS ; Init table counter C.HEL1: HLRO B,CMDDSP(A) ; Get command name HRRO C,CMDHLP(A) ; Get help text TYPE < %2S %3S%/> ; Print both AOBJN A,C.HEL1 ; Repeat for all commands TYPE < host-name%/ ; comment%/>; Additional info POPJ P, ; "Quit" C.QUIT: TLNE F,(CONOPF) ; Connection open? PUSHJ P,C.DIS1 ; Yes, close it ; "Halt" C.HALT: HALTF ; Exit PUPFTP POPJ P, ; Back to command loop if resumed ; "Debug" -- turn on verbose printouts and other information C.DEBU: NOISE PUSHJ P,CONFRM## ; Request confirmation POPJ P, ; Forget it TRNE F,NOPREF ; Ok, prefixed by "No"? TLZA F,(DEBUGF) ; Yes, turn debugging off TLO F,(DEBUGF) ; No, turn it on POPJ P, ; "Version" C.VERS: PUSHJ P,CRIF## HRROI A,VERTXT TYPE < Tenex Pup FTP User %1S> POPJ P, ; "Exec" C.EXEC: MOVSI A,(1B2+1B17) ; Old file HRROI B,[ASCIZ /EXEC.SAV/] GTJFN ERROR ,1 MOVE B,A ; Save jfn MOVSI A,(1B1) ; Transmit capabilities CFORK JRST [ ERROR <%1J> MOVE A,B RLJFN PUSHJ P,SCREWUP POPJ P,] MOVSI A,(A) ; Get fork,,jfn HRRI A,(B) GET ; Get file into fork HLRZ A,A ; Fork handle SETZ B, ; Entry point 0 SFRKV ; Start fork WFORK ; Wait for it to terminate KFORK ; Kill it POPJ P, ; "No" prefix for other commands C.NO: MOVE A,[-NNOCMD,,NODSP] ; Setup ptr to dispatch table PUSHJ P,INKEY## ; Input following keyword JRST DELERR ; Line delete or error TRO F,NOPREF ; Ok, set "No" prefix flag MOVE D,0(A) ; Get dispatch JRST 0(D) ; Enter regular command handler ; Unimplemented commands UNIMP: ERROR <%/Not implemented yet>,1 ; "Disconnect" C.CLOS: NOISE JRST .+2 C.DISC: NOISE PUSHJ P,CONFRM## ; Confirm command POPJ P, ; Not confirmed JRST C.DIS1 ; Here from most other places when "End" encountered DISCON: TYPE JRST C.DIS1 ; Go disconnect ; Here to handle EOC syncronization error UNSEOC: TYPE HRRZ A,CONJFN ; Abort the connection MOVEI B,25 SETZ C, HRROI D,[ASCIZ /FTP sequence error/] MTOPR C.DIS1: HRRZ A,CONJFN ; Get output JFN CLOSF ; Close connection JRST [ TYPE HRRZ A,CONJFN ; Failed, probably timeout SETZ B, ; Clear error flags SDSTS CLOSF ; Try again PUSHJ P,SCREWUP JRST .+1] HLRZ A,CONJFN ; Now close input JFN CLOSF PUSHJ P,SCREWUP ; Can't fail SETZM CONJFN ; Forget JFNs TLZ F,(CONOPF) ; Say no connection open POPJ P, ; "Preserve" ; At present only "Preserve Version (numbers)" is implemented C.PRES: HRROI A,[[ASCIZ /VERSION/],,0] PUSHJ P,INKEY## ; Input following keyword JRST DELERR ; Line delete or error NOISE PUSHJ P,CONFRM## ; Input confirmation POPJ P, ; Forget it TRNE F,NOPREF ; Ok, have "No" prefix? TLZA F,(PREVRF) ; Yes, turn off preserving versions TLO F,(PREVRF) ; No, turn it on POPJ P, ; "Byte" -- supply byte size for unknown cases C.BYTE: NOISE HRROI A,[ASCIZ /Decimal number 0-36/] MOVSI B,(C.NUM) ; Allow numbers only PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete MOVE A,WRDBYT## ; Get string ptr to word MOVEI C,^D10 ; Decimal radix NIN ; Convert to number JRST CERR CAIL B,0 ; Ensure in range CAILE B,^D36 JRST CERR HRLM B,0(P) ; Ok, save it PUSHJ P,CONFRM## ; Confirm command POPJ P, ; Line delete HLRZ B,0(P) ; Ok, recover byte size MOVEM B,DEFPRP+P.BYTE ; Set default byte size POPJ P, ; "Type" -- supply type for unknown cases C.TYPE: MOVE A,[-4,,TYPDSP] ; Set ptr to keyword table PUSHJ P,INKEY## ; Input following keyword JRST DELERR ; Line delete or error HRRZ A,0(A) ; Got it, get type code HRLM A,0(P) ; Save it PUSHJ P,CONFRM## ; Confirm command POPJ P, ; Line delete HLRZ A,0(P) ; Ok, recover type code MOVEM A,DEFPRP+P.TYPE ; Set default type POPJ P, TYPDSP: [ASCIZ /BINARY/],,2 [ASCIZ /PAGED/],,3 [ASCIZ /TEXT/],,1 [ASCIZ /UNSPECIFIED/],,0 ; "EOL" -- supply end of line convention for unknown cases C.EOL: NOISE MOVE A,[-3,,EOLDSP] ; Set ptr to keyword table PUSHJ P,INKEY## ; Input following keyword JRST DELERR ; Line delete or error HRRZ A,0(A) ; Got it, get eol code HRLM A,0(P) ; Save it PUSHJ P,CONFRM## ; Confirm command POPJ P, ; Line delete HLRZ A,0(P) ; Ok, recover eol code MOVEM A,DEFPRP+P.EOLC ; Set default eol convention POPJ P, EOLDSP: [ASCIZ /CR/],,0 [ASCIZ /CRLF/],,1 [ASCIZ /TRANSPARENT/],,2 ; "Open" -- initiate connection to foreign port C.OPEN: TLNE F,(CONOPF) ; Is there already a connection? ERROR ,1 NOISE C.OPE0: HRROI A,[ASCIZ /Remote host name/] MOVSI B,(C.ALPH+C.NUM+C.HSTC) ; Terminate on non-alphanumerics PUSHJ P,INWORD## ; Input a word C.OPE1: POPJ P, ; Line delete JUMPE C,CERR ; Fail if no input C.OPE2: TLNN D,(C.SPAC+C.CEOL+C.ESC+C.HSTP) ; Good terminator? JRST CERR ; No, reject HRLM A,0(P) ; Save terminator SETZ A, TLNE D,(C.SPAC+C.CEOL+C.ESC) ; Terminated by space or EOL? DPB A,CMDBYT## ; Yes, replace terminator with null MOVE A,WRDBYT## ; Get string ptr to start of word MOVE B,[1B0+100B17+TEMP] ; Buffer net addresses here TRNE F,ESCAPF ; Terminated by Escape? TLO B,(1B1) ; Yes, permit recognition PUPNM ; Attempt to parse as net address JRST [ CAIN A,PUPNX2 ; Failed, ambiguous? JRST [ ERROR <>; Yes, ring bell to say want more JRST APWORD##] ; Resume input CAIE A,PUPNX1 ; Name not found? TLNE D,(C.SPAC+C.CEOL+C.ESC) ; Completed input? JRST CERR ; Yes, treat as command error IBP CMDBYT## ; No, include terminator in word AOS WRDLEN## ; Include in count JRST APWORD##] ; Resume INWORD for more input TRNN F,ESCAPF ; Were we recognizing? JRST C.OPE4 ; No PUSHJ P,BAKBYT## ; Yes, make string ptr to tail TYPE <%1S> ; Print tail if any C.OPE3: ILDB A,CMDBYT## ; Look for new end JUMPE A,APWORD## ; Resume INWORD when get there AOS WRDLEN## ; Count extra characters JRST C.OPE3 C.OPE4: HLRZ A,0(P) ; Recover terminator DPB A,CMDBYT## ; Put it back on end of input TLNE D,(C.PUNC) ; Punctuation? JRST [ IBP CMDBYT## ; Yes, advance past it AOS WRDLEN## ; Include in count JRST APWORD##] ; Resume INWORD for more input MOVE A,TEMP ; Got space or EOL, get net/host TLNE A,-1 ; Ensure we have sufficient input TRNN A,-1 ERROR ,1 HRROI A,HSTNAM ; Ok, build string for GTJFN PUSHJ P,CPYWRD## ; Foreign port name SKIPN TEMP+1 ; Foreign socket specified? WRITE <+FTP> ; No, append to specification PUSHJ P,CONFRM## ; Confirm command POPJ P, ; Line delete PUSHJ P,OPNCON ; Open the connection POPJ P, ; Failed (message already typed) ; "Open" (cont'd) ; Now do version handshake HRROI A,VERTXT ; Ok, set ptr to version text FTPM(VERS,FTPVER,,,EOC) ; Send it C.OPE5: PUSHJ P,GETRSP## ; Get response JRST DISCON ; End JRST UNSEOC ; EOC CAIE A,MKVERS ; Correct response? JRST [ HRRO C,MRKNAM(A) ; No, give error TYPE JRST C.OPE5] ; Try again TYPE( < %4S%/) ; Ok, print server herald CAIE B,FTPVER ; Correct protocol version? JRST [ ERROR JRST C.DIS1] ; Go disconnect PUSHJ P,FLSEOC## ; All ok, scan past EOC JRST DISCON ; End ; Check for foreign host being a Maxc, and if so set the ; default transfer type to "Paged". HRRZ A,CONJFN MOVE C,[1,,D] ; Get net,,host into D GDSTS MOVSI A,-NMAXTB ; Search table of Maxc addresses CAMN D,MAXTAB(A) JRST [ MOVEI A,3 ; Found, set default type MOVEM A,DEFPRP+P.TYPE TYPE < Type defaulted to "Paged"%/> JRST C.OPE6] AOBJN A,.-2 HRRZ A,DEFPRP+P.TYPE ; Not found, check current type CAIN A,3 ; Tenex paged? SETZM DEFPRP+P.TYPE ; Yes, reset default to unspecified C.OPE6: POPJ P, ; Done ; Table of Maxc net,,host addresses MAXTAB: 3 ,, 200 ; All the addresses of Maxc1 4 ,, 40 3 ,, 5 ; Maxc2 4 ,, 240 NMAXTB==.-MAXTAB ; Open Pup connection port ; Assumes foreign port specification in HSTNAM ; Returns +1: Failed, message already printed ; +2: Succeeded, nothing printed ; input,,output JFNs in CONJFN ; Clobbers A-D OPNCON: HRROI A,TEMP ; Build complete name here HRROI B,HSTNAM ; Foreign port spec WRITE ; Build the string MOVSI A,(1B2+1B17) ; Short form, name from string HRROI B,TEMP GTJFN ; Get a JFN for the port ERROR ,1 ; Shouldn't ever fail HRLZM A,CONJFN ; Ok, save input JFN MOVE B,[8B5+8B17+1B19] ; Bytesize 8, 30-second timeout OPENF ; Initiate rendezvous JRST OPNCO4 ; Failed ; Now make name string and open same port for output CVSKT ; Get local port address PUSHJ P,SCREWUP HRROI A,TEMP ; Where to build name WRITE ; Start it off PUSH P,A HLRZ A,CONJFN MOVE C,[2,,C] ; Get foreign port address GDSTS HLRZ B,C ; Separate net and host HRRZS C POP P,A WRITE <%2O#%3O#%4O> ; Append foreign port to string MOVSI A,(1B2+1B17) ; Short form, name from string HRROI B,TEMP GTJFN ; Get a JFN for the port JRST OPNCO6 ; Failed (unlikely) HRRM A,CONJFN ; Ok, save output JFN MOVE B,[8B5+1B20] ; Bytesize 8, open for output OPENF JRST OPNCO5 ; Failed (unlikely) TLO F,(CONOPF) ; Succeeded, remember open JRST SKPRET## ; Return +2 ; Failure from first OPENF OPNCO4: HRLM A,0(P) ; Save error code HLRZ A,CONJFN ; Recover JFN RLJFN ; Release it PUSHJ P,SCREWUP SETZM CONJFN ; Insurance... HLRZ A,0(P) ; Recover error code CAIN A,OPNX20 ; Check for special cases ERROR ,1 CAIN A,OPNX21 ERROR ,1 ERROR ,1 ; Catchall ; Failure from second OPENF OPNCO5: HRLM A,0(P) ; Save error code HRRZ A,CONJFN ; Release the output JFN RLJFN PUSHJ P,SCREWUP HLRZ A,0(P) ; Recover error code ; Failure from second GTJFN OPNCO6: ERROR HLRZ A,CONJFN ; Get input JFN MOVEI B,25 ; Abort function SETZ C, ; No code assigned HRROI D,[ASCIZ /Connection attempt aborted/] ; Abort text MTOPR ; Abort the connection CLOSF ; Close the port PUSHJ P,SCREWUP ; Can't fail after abort done SETZM CONJFN ; Forget connection JFNs POPJ P, ; Take fail return ; "Login" ; Also called as a subroutine from PROCNO. ; Returns +2 upon successful completion. C.LOGI::SETZM TEMP ; Clear temp page MOVE A,[TEMP,,TEMP+1] BLT A,TEMP+3*-1 TLNN D,(C.SPAC+C.CEOL) ; Terminated by space or EOL? JRST CERR ; No, complain TLNE D,(C.CEOL) ; EOL? TRO F,ESCAPF ; Yes, pretend Escape was hit NOISE HRROI A,[ASCIZ /Remote user name/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) ; Alphanumerics & punct. PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete JUMPE C,[TLNN D,(C.ESC) ; Null input ended by escape? JRST CERR ; No, error PUSHJ P,BAKBYT## ; Yes, back up over the escape HRROI A,USRNAM ; Supply default user name PROMPT <%1S > JRST C.LOG1] PUSHJ P,ESPACE## ; Print space for escape TLNN D,(C.SPAC+C.CEOL+C.ESC) ; Error if not space or EOL JRST CERR CAILE C,USRSTL ; Make sure not too long ERROR <%/Word too long>,1 C.LOG1: HRROI A,TEMP ; Where to buffer user name PUSHJ P,CPYWRD## ; Copy the word that was input TLNE D,(C.CEOL) ; End of command? JRST C.LOG5 ; Yes PUSHJ P,NOECHO## ; No, turn off echoing for next NOISE HRROI A,[ASCIZ /Password/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) PUSHJ P,INWORD## ; Input the password POPJ P, ; Line delete TRNN F,ESCAPF ; Unless Escape hit PRINT 0(A) ; print the terminator PUSHJ P,ESPACE## ; Print space for Escape PUSHJ P,OKECHO## ; Echoing back on TLNN D,(C.SPAC+C.CEOL+C.ESC) ; Error if not space or EOL JRST CERR CAILE C,USRSTL ; Make sure not too long ERROR <%/Word too long>,1 HRROI A,TEMP+ ; Where to buffer user password PUSHJ P,CPYWRD## ; Copy the word that was input LDB A,CMDBYT## ; Get terminating character MOVE B,WRDBYT## ; Flush password from command MOVEM B,CMDBYT## ; string (so ^R won't type it) IDPB A,CMDBYT## ; Append password terminator TLNE D,(C.CEOL) ; End of command? JRST C.LOG5 ; Yes NOISE HRROI A,[ASCIZ /Account/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) PUSHJ P,INWORD## ; Input the account POPJ P, ; Line delete PUSHJ P,ESPACE## ; Print space for Escape CAILE C,USRSTL ; Make sure not too long ERROR <%/Word too long>,1 HRROI A,TEMP+2* ; Where to buffer user account PUSHJ P,CPYWRD## ; Copy the word that was input C.LOG5: PUSHJ P,CONFRM## ; Await confirming EOL POPJ P, ; Line delete MOVE A,[TEMP,,USRNAM] ; Ok, remember all parameters BLT A,USRNAM+3*-1 JRST SKPRET## ; Done, signal success ; "Connect" C.CONN: SETZM TEMP ; Clear temp page MOVE A,[TEMP,,TEMP+1] BLT A,TEMP+2*-1 NOISE HRROI A,[ASCIZ /Remote directory name/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) ; Alphanumerics & punct. PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete PUSHJ P,ESPACE## ; Print space for Escape TLNN D,(C.SPAC+C.CEOL+C.ESC) ; Error if not space or EOL JRST CERR TLNE D,(C.CEOL) ; Null input followed by EOL? JUMPE C,C.CON2 ; Yes, zap connect parameters CAILE C,USRSTL ; Make sure not too long ERROR <%/Word too long>,1 HRROI A,TEMP ; Where to buffer connect name PUSHJ P,CPYWRD## ; Copy the word that was input TLNE D,(C.CEOL) ; End of command? JRST C.CON2 ; Yes PUSHJ P,NOECHO## ; No, turn off echoing for next NOISE HRROI A,[ASCIZ /Password/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) PUSHJ P,INWORD## ; Input the password POPJ P, ; Line delete TRNN F,ESCAPF ; Unless Escape hit PRINT 0(A) ; print the terminator PUSHJ P,ESPACE## ; Print space for Escape PUSHJ P,OKECHO## ; Echoing back on TLNN D,(C.SPAC+C.CEOL+C.ESC) ; Error if not space or EOL JRST CERR CAILE C,USRSTL ; Make sure not too long ERROR <%/Word too long>,1 HRROI A,TEMP+ ; Where to buffer password PUSHJ P,CPYWRD## ; Copy the word that was input LDB A,CMDBYT## ; Get terminating character MOVE B,WRDBYT## ; Flush password from command MOVEM B,CMDBYT## ; string (so ^R won't type it) IDPB A,CMDBYT## ; Append password terminator C.CON2: PUSHJ P,CONFRM## ; Await confirming EOL POPJ P, ; Line delete MOVE A,[TEMP,,CONNAM] ; Ok, remember all parameters BLT A,CONNAM+2*-1 POPJ P, ; Done ; "Directory" -- supply default directory C.DIRE: SETZM TEMP ; Zero to detect null case HRROI A,[ASCIZ /Default remote directory name/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) ; Alphanumerics & punct. PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete PUSHJ P,ESPACE## ; Print space for Escape TLNN D,(C.SPAC+C.CEOL+C.ESC) ; Error if not space or EOL JRST CERR CAILE C,USRSTL ; Make sure not too long ERROR <%/Word too long>,1 HRROI A,TEMP ; Where to buffer directory name PUSHJ P,CPYWRD## ; Copy the word that was input PUSHJ P,CONFRM## ; Await confirming EOL POPJ P, ; Line delete MOVE A,[TEMP,,DEFPRP+P.DIRE] ; Ok, copy default directory BLT A,DEFPRP+P.DIRE+USRSTL/5 POPJ P, ; "Automatic" -- special kind of Retrieve, Store, or Delete C.AUTO: MOVE A,[-NAUTCM,,AUTDSP] ; Setup ptr to dispatch table PUSHJ P,INKEY## ; Input following keyword JRST DELERR ; Line delete or error TRO F,AUTOF ; Ok, set Automatic flag MOVE D,0(A) ; Get dispatch JRST 0(D) ; Enter regular command handler ; "Retrieve" ; Also get here on "Automatic Retrieve" with AUTOF on in F C.RETR: C.GET: NOISE HRROI A,[ASCIZ /Remote filename/] MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC) ; All printable chars PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete TRNE F,ESCAPF ; Ended with Escape? JRST [ ERROR <> ; Yes, can't recognize here JRST APWORD##] ; So just ask for more input TLNN D,(C.CEOL) ; Ended with eol? JRST CERR ; No, give error JUMPE C,CERR ; Also bad if no input MOVE A,[DEFPRP,,FILPRP] ; Ok, init file property list BLT A,FILPRP+PLSIZE-1 HRROI A,FILPRP+P.SFIL ; Where to put server filename PUSHJ P,CPYWRD## ; Do it ; Generate "Retrieve" command to server C.RET1: HRROI A,NETBUF ; Buffer property list here HRROI B,FILPRP+P.SFIL ; String ptr to server filename WRITE <(Server-Filename %2S)>; Generate property MOVEI B,FILPRP ; Default property list PUSHJ P,GNTPAR## ; Generate transfer parameters PUSHJ P,SNDLGN## ; Send login/connect parameters HRROI A,NETBUF ; Where property list is FTPM(RETR,,<(%1S)>,,EOC) ; Send command and property list ; Wait for response C.RET2: PUSHJ P,GETRSP## ; Get response JRST DISCON ; End JRST [ TYPE POPJ P,] CAIN A,MKNO ; See if "No" JRST [ ERROR( < %4S%/) ; Report failure to user HRLM B,0(P) ; Save "No" code PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End HLRZ B,0(P) ; Recover "No" code PUSHJ P,PROCNO## ; Process "No" code POPJ P, ; Not recoverable, exit JRST C.RET1] ; Recoverable, retry CAIE A,MKPLST ; Here-is-property-list response? JRST [ HRRO C,MRKNAM(A) ; No, give error TYPE JRST C.RET2] ; Try again JRST C.RET4 ; Ok, go process ; "Retrieve" (cont'd) ; Loop here after each retrieval C.RET3: PUSHJ P,GETRSP## ; Get next command from server JRST DISCON ; End POPJ P, ; EOC, retrieve finished CAIE A,MKPLST ; Here-is-property-list response? JRST [ HRRO C,MRKNAM(A) ; No, give error TYPE JRST C.RET3] ; Try again ; Interpret property list, check filename and properties C.RET4: MOVE A,[DEFPRP,,FILPRP] ; Copy default property list BLT A,FILPRP+PLSIZE-1 HRROI A,NETBUF ; Where text is MOVEI B,FILPRP ; Where to put decoded properties PUSHJ P,SCNPRP## ; Interpret property list JRST [ TYPE PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End FTPM(EOC) ; Return control to server for next file JRST C.RET3] ; On to next PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End MOVEI A,FILPRP ; Construct Server-Filename if PUSHJ P,FIXNAM## ; there isn't one already HRROI A,FILPRP+P.SFIL ; Make string ptr to filename MOVE B,FILPRP+P.TYPE ; Make sure type specified, CAIN B,2 ; and also bytesize if binary SKIPE FILPRP+P.BYTE SKIPN FILPRP+P.TYPE JRST [TYPE FTPM(NO,105,,,EOC) JRST C.RET3] ; If "Automatic Retrieve", try to create a local filename using ; just the Name-Body property SKIPE FILPRP+P.SFIL ; Name supplied as property? TRNN F,AUTOF ; Automatic retrieve? JRST C.RET6 ; No, go ask TYPE <%1S (to local file) >; Type server filename for user C.RET5: MOVSI A,(1B0+1B17) ; No, name from string, short form TLNE F,(PREVRF) ; Want to preserve versions? HRR A,FILPRP+P.VERS ; Yes, set default version HRROI B,FILPRP+P.NAMB ; String in Name-Body property GTJFN ; Get JFN for local output file JRST [ HRROI B,FILPRP+P.NAMB ; Failed, print string as is ERROR <%2S%/ %1J%/> JRST C.RET6] ; Go ask user for name HRRZM A,DSTJFN ; Ok, store file JFN TYPE <%1F%/> ; Type the filename JRST C.RET7 ; Go try to open it ; "Retrieve" (cont'd) ; If not "Automatic Retrieve" or default filename didn't work, ; get local filename from user C.RET6: PUSHJ P,INIEDT## ; Initialize editor HRROI A,FILPRP+P.SFIL ; Get server filename string PROMPT <%1S (to local file) >; Prompt user TRO F,NEOLEF ; Say don't echo eols HRROI A,[ASCIZ / Carriage Return to transfer to default local file, Delete to bypass transfer of file, or enter desired local filename/] MOVSI B,(C.ALPH+C.NUM) ; Terminate on non-alphanumerics PUSHJ P,INWORD## ; Input first field of reply JRST [ SKIPE WRDLEN## ; Line delete, any previous input? JRST C.RET6 ; Yes, give user another try FTPM(NO,105,,,EOC) ; No, bypass JRST C.RET3] ; On to next file TRZ F,NEOLEF ; Normal echoing again TLNE D,(C.CEOL+C.ESC) ; Ended by eol or escape? JUMPE C,C.RET5 ; Yes, default if no word input MOVSI A,(1B0+1B3) ; Output use, "new version" etc. PUSHJ P,GETJFN## ; Do GTJFN and capture terminator JRST [ TLNN D,(C.CDEL) ; Failed, command delete? ERROR < ? > ; No, give brief error message JRST C.RET6] ; Try again HRRZM A,DSTJFN## ; Ok, store file JFN MOVEI A," " ; Pretend terminator was space DPB A,CMDBYT## PUSHJ P,CONFRM## ; Confirm command JRST [ HRRZ A,DSTJFN## ; Line delete, release JFN RLJFN PUSHJ P,SCREWUP JRST C.RET6] ; Request input again ; Now we have JFN for the local file. ; Open it and tell server to send file C.RET7: HRRZ A,DSTJFN## ; Get the JFN PUSHJ P,CHKDSK## ; Check for device disk HRRZ B,FILPRP+P.TYPE ; Dispatch on type JRST @[ SCREWUP ; Unspecified RTYTXT ; Text RTYBIN ; Binary RTYPAG](B) ; Paged RTYPAG: TRNN F,DSKDVF ; Paged, device disk? JRST [ ERROR <"Type Paged" illegal for non-disk files> HRRZ A,DSTJFN## ; Release the JFN RLJFN PUSHJ P,SCREWUP JRST C.RET6] ; Ask for a new filename MOVEI B,^D36 ; Byte size is 36 JRST .+3 RTYBIN: SKIPA B,FILPRP+P.BYTE ; Binary, use specified byte size RTYTXT: MOVEI B,7 ; Text, use byte size 7 HRRZM B,FILPRP+P.BYTE ; Save byte size for transfer code ROT B,-6 ; Position for OPENF HRRI B,1B20 ; Open for output OPENF JRST [ PUSHJ P,ROPNER## ; Failed, print message HRRZ A,DSTJFN## ; Release the JFN RLJFN PUSHJ P,SCREWUP JRST C.RET6] ; Ask for a new filename FTPM(YES,0,,,EOC) ; Tell server ; Set file creation date to value given in property list, if present SKIPE C,FILPRP+P.CDAT ; Present in property list? TRNN F,DSKDVF ; Output file on disk? JRST C.RET8 ; No HRRZ A,DSTJFN## ; Yes, set creation date HRLI A,13 SETO B, CHFDB ; "Retrieve" (cont'd) ; Await server's Here-is-File command and file data C.RET8: PUSHJ P,GETRSP## ; Get command from server JRST RETEND ; End received JRST RETEOC ; Unsynchronized EOC CAIN A,MKNO ; "No", i.e. abort? JRST RETABT ; Go handle CAIE A,MKFILE ; "Here-is-File"? JRST [ HRRO C,MRKNAM(A) ; No, make ptr to command name TYPE JRST C.RET8] ; Ignore, look for another HLRZ A,CONJFN ; Set source JFN MOVEM A,SRCJFN## MOVEI A,FILPRP ; File property list PUSHJ P,RECDAT## ; Do the retrieval JRST [ HRRZ A,DSTJFN## ; Failed, give local message TYPE PUSHJ P,GYESNO## ; Flush rest of file, get command JRST RETEND ; End JRST RETEOC ; EOC CAI ; Yes PUSHJ P,KILFIL## ; No, flush local file JRST C.RET3] ; On to next file PUSHJ P,GYESNO## ; Retrieve finished, get terminator JRST RETEND ; End JRST RETEOC ; Unsynchronized EOC CAIA ; Yes JRST RETABT ; No, i.e. abort HRRZ A,DSTJFN ; Yes, transfer completed CLOSF ; Close local file TYPE JRST C.RET3 ; On to next file if any ; Here for errors during the actual retrieval RETEND: PUSHJ P,KILFIL## ; End received JRST DISCON RETEOC: PUSHJ P,KILFIL## ; Unsynchronized EOC JRST UNSEOC RETABT: HRRZ A,DSTJFN## TYPE PUSHJ P,KILFIL## ; Flush local file if possible JRST C.RET3 ; On to next ; "Store" ; Also get here on "Automatic Store" with AUTOF on in F C.STOR: C.SEND: NOISE C.STO1: HRROI A,[ASCIZ /Local filename/] MOVSI B,(C.ALPH+C.NUM) ; Terminate on non-alphanumerics PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete MOVSI A,(1B2+1B11) ; Old file, "*" ok PUSHJ P,GETJFN## ; Do GTJFN, capture terminator JRST [ TLNE D,(C.CDEL) ; Failed, command delete? POPJ P, ; Yes, stop here ERROR < ? > ; No, give brief error message MOVE A,WRDBYT## ; Flush word that was input MOVEM A,CMDBYT## JRST C.STO1] ; Try again MOVEM A,SRCJFN## ; Ok, save JFN TLNE D,(C.CEOL) ; Terminated with EOL? JRST C.STO2 ; Yes, no confirmation needed PROMPT < [Confirm] > PUSHJ P,CONFRM## ; Input confirmation JRST [ HRRZ A,SRCJFN## ; Command delete RLJFN PUSHJ P,SCREWUP POPJ P,] ; Loop here for each local file designated by JFN C.STO2: MOVE A,[DEFPRP,,FILPRP] ; Copy default property list BLT A,FILPRP+PLSIZE-1 HRRZ A,SRCJFN## ; Get local JFN PUSHJ P,CHKDSK## ; Set DSKDVF appropriately ; If "Automatic Store", create a remote filename using ; just the local name and extension TRNN F,AUTOF ; Automatic store? JRST C.STO5 ; No, go ask for foreign filename TYPE <%1F (to remote file) >; Type filename C.STO3: HRRZ B,SRCJFN## ; No, get source JFN MOVE C,[1B8+1B11+1B35] ; Name and ext with punctuation PUSHJ P,DOJFNS## ; Convert to string, quote if req'd PUSH P,B ; See if string ends in "." GFNPR4: ILDB C,B CAIN C,"." JRST [ MOVE C,B ILDB C,C JUMPN C,GFNPR4 DPB C,B ; Yes, strip trailing "." JRST .+2] JUMPN C,GFNPR4 MOVE B,0(P) HRROI A,FILPRP+P.NAMB ; Set Name-Body property WRITE <%2S> POP P,B TYPE <%2S> ; Type foreign name for user TLNE F,(PREVRF) ; Preserving versions? TRNN F,DSKDVF ; Yes, is local file on disk? JRST C.STO4 ; No, can't do version stuff HRRZ A,SRCJFN## ; Yes, get version number from FDB MOVE B,[1,,7] MOVEI C,C ; Put it here GTFDB HLRZS C ; Put in RH MOVEM C,FILPRP+P.VERS ; Put in property list TYPE <;%3D> C.STO4: PRINT EOL JRST C.STO6 ; Go begin store ; "Store" (cont'd) ; If not "Automatic Store", get remote filename from user C.STO5: PUSHJ P,INIEDT## ; Initialize editor HRRZ A,SRCJFN## ; Get local JFN PROMPT <%1F (to remote file) >; Prompt user TRO F,NEOLEF ; Say don't echo eols HRROI A,[ASCIZ / Carriage Return to transfer to default remote file, Delete to bypass transfer of file, or enter desired remote filename/] MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC) ; All printable chars PUSHJ P,INWORD## ; Input remote filename JRST [ SKIPE WRDLEN## ; Line delete, any input? JRST C.STO5 ; Yes, give user another try JRST C.STO9] ; No, skip over this file TLNE D,(C.CEOL+C.ESC) ; Terminated by eol or escape? JUMPE C,C.STO3 ; Yes, default if no word input TRNE F,ESCAPF ; Escape terminated? JRST [ ERROR <> ; Yes, can't recognize here JRST APWORD##] ; So just ask for more input TLNN D,(C.CEOL) ; Ended by EOL? JRST [ ERROR < ?%/> ; No, bad char or something JRST C.STO5] ; Try again PRINT EOL ; Print the EOL that was suppressed HRROI A,FILPRP+P.SFIL ; Copy to Server-Filename property PUSHJ P,CPYWRD## ; Here when ready to initiate Store C.STO6: HRRZ A,SRCJFN## ; Get local JFN PUSHJ P,CKSPAR ; Check parameters JRST C.STO9 ; Can't store this file PUSHJ P,OPNSTO ; Open local file JRST C.STO9 ; Failed, bypass file ; Loop back here to retry after recoverable "No" responses C.STO7: HRROI A,NETBUF ; Where to buffer property list HRROI B,FILPRP+P.SFIL ; Make ptr to Server-Filename SKIPE FILPRP+P.SFIL ; Was that specified? WRITE <(Server-Filename %2S)>; Yes, send property HRROI B,FILPRP+P.NAMB ; Make ptr to Name-Body SKIPE FILPRP+P.NAMB ; Was that specified? WRITE <(Name-Body %2S)>; Yes, send property SKIPE B,FILPRP+P.VERS ; Is there a version? WRITE <(Version %2D)> ; Yes, send it SKIPE B,FILPRP+P.CDAT ; Have creation date property? WRITE <(Creation-Date %2Z)>; Yes, send it MOVEI B,FILPRP ; File property list PUSHJ P,GNTPAR## ; Generate transfer parameters PUSHJ P,SNDLGN## ; Append Login/Connect properties HRROI A,NETBUF ; Where the property list is FTPM(STOR,,<(%1S)>,,EOC) ; Send off command and properties ; "Store" (cont'd) ; Await server's "Yes" or "No" reply, and do transfer if Yes PUSHJ P,GYESNO## ; Get reply JRST STOEND ; End received JRST STOEOC ; Unsynchronized EOC CAIA ; Yes JRST [ PUSHJ P,PROCNO## ; No, process "No" code CAIA ; Not recoverable JRST [ PUSHJ P,FLSEOC## ; Recoverable, try again JRST DISCON JRST C.STO7] JUMPE B,STOABT ; No, check error code CAIL B,20 ; Username or password problem? CAILE B,24 CAIG B,3 ; Or other global problem? HRRZS SRCJFN## ; Yes, disable indexing of JFN JRST STOABT] ; so we stop with this file PUSHJ P,FLSEOC## ; Normal, flush following EOC JRST STOEND ; End MOVEI A,MKFILE ; Insert "Here-Is-File" mark SETZ B, PUSHJ P,BEGCMD## HRRZ A,CONJFN ; Set destination JFN MOVEM A,DSTJFN## MOVEI A,FILPRP ; Property list PUSHJ P,SNDDAT## ; Do the actual store JRST [ HRRZ A,SRCJFN## ; Failed, give local message TYPE FTPM(NO,103,,,EOC) ; Tell server PUSHJ P,GYESNO## ; Await response JRST STOEND ; End JRST STOEOC ; EOC CAI ; Yes (shouldn't happen) JRST STOABT] ; Go close file, on to next file FTPM(YES,0,,,EOC) ; Done, tell server HRRZ A,SRCJFN## ; Close local file HRLI A,400000 ; But don't release CLOSF TYPE PUSHJ P,GYESNO## ; Get server's response JRST DISCON ; End JRST UNSEOC ; EOC CAI ; Yes (i.e. successful) PUSHJ P,FLSEOC## ; No (message already typed) JRST DISCON ; Here to advance to next file designated by local JFN C.STO9: MOVE A,SRCJFN## ; Get JFN with flags GNJFN ; Step to next file POPJ P, ; No more (JFN released). Done. JRST C.STO2 ; More, go process ; Here for errors during the actual store STOEND: HRRZ A,SRCJFN## ; End received, close local file CLOSF ; and release JFN CAI JRST DISCON ; Handle disconnect STOEOC: HRRZ A,SRCJFN## ; Unsynchronized EOC CLOSF ; Close and release JFN CAI JRST UNSEOC ; Go abort connection STOABT: HRRZ A,SRCJFN## ; Here if server said "No" HRLI A,400000 ; Close file, don't release JFN CLOSF CAI PUSHJ P,FLSEOC## ; Flush server's EOC JRST DISCON ; End JRST C.STO9 ; On to next file ; "Store" subroutines ... ; Check and/or default parameters for "Store" command ; A/ JFN for file being stored ; Assumes transfer parameters are in FILPRP ; Returns +1: Error, message already typed ; +2: Ok, type and byte size filled in appropriately ; Clobbers B-D CKSPAR: SETZ B, ; Assume don't know byte size TRNN F,DSKDVF ; Local file on disk? JRST CKSPA2 ; No MOVE B,[1,,11] ; Yes, read byte size from FDB MOVEI C,C ; Put it here GTFDB LDB B,[POINT 6,C,11] ; Extract byte size CKSPA2: HRRZ C,FILPRP+P.TYPE ; Get specified transfer type HRRZ D,FILPRP+P.BYTE ; Get specified byte size JRST @[ STYUNS ; Dispatch on type: Unspecified STYTXT ; Text STYBIN ; Binary STYPAG](C) ; Paged ; Here for type unspecified STYUNS: SKIPN D,B ; File byte size known? ERROR ,1 MOVEI C,2 ; Assume binary CAIN B,7 ; 7-bit file? MOVEI C,1 ; Yes, assume text JRST CKSPA4 ; Go set parameters ; Here for type Text STYTXT: 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 CKSPA4 ; Yes ERROR ,1 ; Here for type Binary STYBIN: JUMPN D,.+3 ; Transfer byte size specified? SKIPN D,B ; No, substitute file byte size ERROR ,1 JUMPE B,CKSPA4 ; Ok if file byte size unknown CAMN B,D ; Both known, make sure consistent JRST CKSPA4 ; Ok CAIE B,^D36 ; No, but permit anyway for 36-bit file ERROR ,1 TYPE JRST CKSPA4 ; Here for type Tenex-Paged STYPAG: TRNN F,DSKDVF ; Is local file on disk? ERROR <"Type Paged" illegal for non-disk files>,1 MOVEI D,^D36 ; Set local byte size to 36 ; All cases converge here ; C/ Transfer type, D/ Transfer byte size CKSPA4: MOVEM C,FILPRP+P.TYPE ; Store type and byte size MOVEM D,FILPRP+P.BYTE MOVE B,[1,,13] ; Get file creation date MOVEI C,FILPRP+P.CDAT TRNE F,DSKDVF GTFDB JRST SKPRET## ; Return +2 ; "Store" subroutines ... ; Open file for store ; Assumes file JFN is in SRCJFN ; and that transfer parameters are in FILPRP ; Returns +1: Failed, error message already generated ; +2: Succeeded, file open ; Clobbers A-D OPNSTO: TRNN F,DSKDVF ; Is file on disk? JRST OPNST1 ; 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 OPNST1: MOVEI B,1B19 ; Open in frozen mode MOVE A,FILPRP+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 SOPNER## ; Failed again, give error JRST .+1] ; Succeeded, continue JRST SKPRET## ; Return +2 ; "Delete" ; Also get here on "Automatic Delete" with AUTOF on in F C.DELE: NOISE HRROI A,[ASCIZ /Remote filename/] MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC) ; All printable chars PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete TRNE F,ESCAPF ; Ended with Escape? JRST [ ERROR <> ; Yes, can't recognize here JRST APWORD##] ; So just ask for more input TLNN D,(C.CEOL) ; Ended with eol? JRST CERR ; No, give error JUMPE C,CERR ; Also bad if no input MOVE A,[DEFPRP,,FILPRP] ; Ok, init file property list BLT A,FILPRP+PLSIZE-1 HRROI A,FILPRP+P.SFIL ; Where to put server filename PUSHJ P,CPYWRD## ; Do it ; Generate "Delete" command to server C.DEL1: HRROI A,NETBUF ; Buffer property list here HRROI B,FILPRP+P.SFIL ; String ptr to server filename WRITE <(Server-Filename %2S)>; Generate property PUSHJ P,SNDLGN## ; Send login/connect parameters HRROI A,NETBUF ; Where property list is FTPM(DELE,,<(%1S)>,,EOC) ; Send command and property list ; Wait for response C.DEL2: PUSHJ P,GETRSP## ; Get response JRST DISCON ; End JRST [ TYPE POPJ P,] CAIN A,MKNO ; See if "No" JRST [ ERROR( < %4S%/) ; Report failure to user HRLM B,0(P) ; Save "No" code PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End HLRZ B,0(P) ; Recover "No" code PUSHJ P,PROCNO## ; Process "No" code POPJ P, ; Not recoverable, exit JRST C.DEL1] ; Recoverable, retry CAIE A,MKPLST ; Here-is-property-list response? JRST [ HRRO C,MRKNAM(A) ; No, give error TYPE JRST C.DEL2] ; Try again JRST C.DEL4 ; Ok, go process ; "Delete" (cont'd) ; Loop here after each file deleted C.DEL3: PUSHJ P,GETRSP## ; Get next command from server JRST DISCON ; End POPJ P, ; EOC, delete finished CAIE A,MKPLST ; Here-is-property-list response? JRST [ HRRO C,MRKNAM(A) ; No, give error TYPE JRST C.DEL3] ; Try again ; Interpret property list, check filename and properties C.DEL4: MOVE A,[DEFPRP,,FILPRP] ; Copy default property list BLT A,FILPRP+PLSIZE-1 HRROI A,NETBUF ; Where text is MOVEI B,FILPRP ; Where to put decoded properties PUSHJ P,SCNPRP## ; Interpret property list JRST [ TYPE PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End FTPM(EOC) ; Return control to server for next file JRST C.DEL3] ; On to next PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End MOVEI A,FILPRP ; Construct Server-Filename if PUSHJ P,FIXNAM## ; there isn't one already ; If not "Automatic Delete", request confirmation from user PUSHJ P,INIEDT## ; Initialize editor HRROI A,FILPRP+P.SFIL ; Get server filename string PROMPT TRNE F,AUTOF ; Automatic delete? JRST [ PRINT EOL ; Yes, charge ahead JRST C.DEL7] PROMPT < [Confirm] > PUSHJ P,CONFRM## ; Confirm command JRST [ FTPM(NO,105,,,EOC) JRST C.DEL3] ; On to next file ; Tell server to delete file C.DEL7: FTPM(YES,0,,,EOC) PUSHJ P,GYESNO## ; Get response from server JRST DISCON ; End received JRST UNSEOC ; Unsynchronized EOC JRST C.DEL3 ; Yes, finished JRST C.DEL3 ; No (message already printed) ; "Rename" C.RENA: NOISE HRROI A,[ASCIZ /Existing remote filename/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) ; All printable chars PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete TLNN D,(C.CEOL+C.SPAC+C.ESC) ; Proper terminator? JRST CERR ; No, complain JUMPE C,CERR ; Null input not allowed TLNE D,(C.CEOL) ; Terminated by EOL? TRO F,ESCAPF ; Yes, pretend escape hit HRROI A,FILPRP+P.SFIL ; Where to put old server filename PUSHJ P,CPYWRD## ; Do it NOISE HRROI A,[ASCIZ /New remote filename/] MOVSI B,(C.ALPH+C.NUM+C.PUNC) ; All printable chars PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete TRNE F,ESCAPF ; Ended with escape? JRST [ ERROR <> ; Yes, can't recognize here JRST APWORD##] ; So just ask for more input TLNN D,(C.CEOL) ; Proper terminator? JRST CERR ; No, complain JUMPE C,CERR ; Null input not allowed HRROI A,FILBUF ; Where to put new server filename PUSHJ P,CPYWRD## ; Do it ; Generate "Rename" command to server C.REN1: HRROI A,NETBUF ; Buffer property list here HRROI B,FILPRP+P.SFIL ; String ptr to old name WRITE <(Server-Filename %2S)>; Generate property PUSHJ P,SNDLGN ; Send login/connect parameters WRITE <)(> ; End first property list, start second HRROI B,DEFPRP+P.DIRE SKIPE 0(B) ; Is there a default directory WRITE <(Directory %2S)> HRROI A,NETBUF ; Result string HRROI B,FILBUF ; New server filename FTPM(RENA,,<(%1S(Server-Filename %2S))>,,EOC) ; Send it ; Wait for response PUSHJ P,GYESNO## JRST DISCON ; End JRST UNSEOC ; Unsynchronized EOC JRST [ PUSHJ P,FLSEOC## ; "Yes", flush EOC JRST DISCON POPJ P,] ; Done HRLM B,0(P) ; "No", save code PUSHJ P,FLSEOC## ; Flush EOC JRST DISCON HLRZ B,0(P) ; Recover "No" code PUSHJ P,PROCNO## ; Process "No" code POPJ P, ; Not recoverable, exit JRST C.REN1 ; Recoverable, retry ; "List" C.LIST: PUSHJ P,SAVE1## SETZ P1, ; Reset list format flags NOISE HRROI A,[ASCIZ /Remote file designator/] MOVSI B,(C.ALPH+C.NUM+C.PUNC+C.SPAC) ; All printable chars PUSHJ P,INWORD## ; Input a word POPJ P, ; Line delete TRNE F,ESCAPF ; Ended with Escape? JRST [ ERROR <> ; Yes, can't recognize here JRST APWORD##] ; So just ask for more input TLNN D,(C.CEOL) ; Ended with eol? JRST CERR ; No, give error JUMPE C,CERR ; Also bad if no input MOVE A,CMDBYT ; Get command byte pointer BKJFN ; Back it up PUSHJ P,SCREWUP LDB D,A ; Get char before terminator CAIN D,"," ; Comma? MOVEM A,CMDBYT ; Yes, store backed up pointer HRROI A,FILPRP+P.SFIL ; Where to put server filename PUSHJ P,CPYWRD## ; Do it CAIE D,"," ; Subcommands follow? JRST C.LIS1 ; No ; Loop to gather subcommands C.LIS0: PUSHJ P,CRIF## PUSHJ P,INIEDT## ; Reinitialize editor PROMPT <**> MOVE A,LSTSUB ; List subcommand dispatch table PUSHJ P,INKEY## ; Input keyword JRST [ TLNE D,(C.CDEL) ; Command delete? POPJ P, ; Yes, exit MOVE C,WRDLEN## ; Null input? TLNE D,(C.CEOL) ; Terminated by eol JUMPE C,C.LIS1 ; Yes, end of subcommands ERROR < ?> JRST C.LIS0] HRRZ A,0(A) ; Get list format flags for keyword IORI P1,(A) ; Set them JRST C.LIS0 ; Back for more subcommands ; Generate "List" command to server C.LIS1: HRROI A,NETBUF ; Buffer property list here HRROI B,FILPRP+P.SFIL ; String ptr to server filename WRITE <(Server-Filename %2S)>; Generate property PUSHJ P,SNDLGN## ; Send login/connect parameters HRROI A,NETBUF ; Where property list is FTPM(ENUM,,<(%1S)>,,EOC) ; Send command and property list ; "List" (cont'd) ; Wait for response C.LIS2: PUSHJ P,GETRSP## JRST DISCON ; End POPJ P, ; EOC, done CAIN A,MKNO ; See if "No" JRST [ ERROR( < %4S%/) ; Report failure to user HRLM B,0(P) ; Save "No" code PUSHJ P,FLSEOC## ; Scan past EOC JRST DISCON ; End HLRZ B,0(P) ; Recover "No" code PUSHJ P,PROCNO ; Process "No" code POPJ P, ; Not recoverable, exit JRST C.LIS1] ; Recoverable, retry CAIE A,MKPLST ; Here-is-property-list response? JRST [ HRRO C,MRKNAM(A) ; No, give error TYPE JRST C.LIS2] ; Try again ; Parse property list SETZM FILPRP ; Zero it out MOVE A,[FILPRP,,FILPRP+1] BLT A,FILPRP+PLSIZE-1 HRROI A,NETBUF ; Where text is MOVEI B,FILPRP ; Where to put decoded properties PUSHJ P,SCNPRP## ; Interpret property list JRST [ TYPE JRST C.LIS2] ; Print header if necessary TLON P1,(1B0) ; Already printed? TRNN P1,-1 ; Or printing only name? JRST C.LIS3 ; Yes TYPE <%/ > TRNE P1,LSTYPE ; Printing type? TYPE < Type > TRNE P1,LSSIZE ; Printing size? TYPE < Size> SETZ A, ; For dates, assume no times TRNE P1,LSTIME ; List times? HRROI A,[ASCIZ / /] ; Yes, extra space TRNE P1,LSCDAT ; Printing creation date? TYPE < Creation%1S> TRNE P1,LSWDAT ; Printing write date? TYPE < Write %1S> TRNE P1,LSRDAT ; Printing read date? TYPE < Read %1S> TRNE P1,LSAUTH ; Print author? TYPE < Author> TYPE <%/%/> ; "List" (cont'd) ; Now print listing for this file C.LIS3: MOVEI A,101 HRROI B,FILPRP+P.SFIL ; Server filename MOVEI C,^D1000 ; Get Tenex to count the bytes SETZ D, SOUT TRNN P1,-1 ; Anything else to print? JRST C.LIS8 ; No SUBI C,^D<1000-25> ; Reserve 25 chars for name PRINT " " ; Print spaces up to position 25 SOJG C,.-1 TRNN P1,LSTYPE ; List file type? JRST C.LIS4 ; No HRRZ A,FILPRP+P.TYPE ; Yes, get file type HRRZ B,FILPRP+P.BYTE ; Byte size XCT [ TYPE < ? > ; Unspecified TYPE < Text > ; Text TYPE < B(%2D)> ; Binary TYPE < Paged> ; Paged (huh?) ](A) CAIN A,2 ; Binary? CAIL B,^D10 ; Byte size less than 10? CAIA PRINT " " ; Yes, another space C.LIS4: TRNN P1,LSSIZE ; List file size? JRST C.LIS5 ; No MOVEI A,101 MOVE B,FILPRP+P.SIZE ; Get file size MOVE C,[1B2+1B4+6B17+^D10] ; Leading blanks, width 6 NOUT CAI ; Ok if number overflows C.LIS5: MOVE B,FILPRP+P.CDAT TRNE P1,LSCDAT ; List creation date? PUSHJ P,PRDATE ; Yes, do so MOVE B,FILPRP+P.WDAT TRNE P1,LSWDAT ; List write date? PUSHJ P,PRDATE ; Yes, do so MOVE B,FILPRP+P.RDAT TRNE P1,LSRDAT ; List read date? PUSHJ P,PRDATE ; Yes, do so HRROI A,FILPRP+P.AUTH TRNE P1,LSAUTH ; List author? TYPE < %1S> ; End of listing for this file C.LIS8: PRINT EOL JRST C.LIS2 ; Back for next ; Print date in correct format for "List" command ; B/ Tenex-format date and time ; P1/ List format flags ; Returns +1 always ; Clobbers A-C PRDATE: PRINT " " JUMPE B,[TYPE < --- >; Handling for unspecified date TRNE P1,LSTIME TYPE < > POPJ P,] MOVEI A,101 MOVSI C,(1B9) ; Normally omit time TRNE P1,LSTIME ; Want to include time? TLC C,(1B9+1B10) ; Yes, but omit seconds ODTIM ; Do it POPJ P, ; "List" subcommand definitions and keyword table LSTYPE==1B18 ; List type and byte size LSSIZE==1B19 ; List size LSCDAT==1B20 ; List creation date LSWDAT==1B21 ; List write date LSRDAT==1B22 ; List read date LSTIME==1B23 ; List times as well as dates LSAUTH==1B24 ; List author DEFINE X(KEY,FLAGS) <[ASCIZ /KEY/],,FLAGS> LSUBTB: X AUTHOR,LSAUTH X CREATION,LSCDAT X EVERYTHING,-1 X READ,LSRDAT X SIZE,LSSIZE X TIMES,LSTIME X TYPE,LSTYPE X VERBOSE,LSTYPE+LSWDAT+LSRDAT+LSAUTH X WRITE,LSWDAT LSTSUB: LSUBTB-.,,LSUBTB ; Table pointer ; Initialize PSI system ; Returns +1 ; Clobbers A, B INIPSI: MOVEI A,400000 ; Initialize psi system MOVE B,[LEVTAB,,CHNTAB] SIR EIR MOVE B,[ACTCHN] ; Activate channels AIC POPJ P, ; PSI channel definitions DEFINE PSI(CH,LEV,DISP) < ACTCHN==ACTCHN!1B RELOC CHNTAB+^D LEV ,, DISP > ACTCHN==0 CHNTAB: PSI(9,1,PDLOVF) ; Pushdown overflow PSI(11,1,DATERR) ; 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 LEVTAB: CH1PC ; Level 1 - fatal errors CH2PC ; Level 2 - not used CH3PC ; Level 3 - normal wakeups, eof, etc. ; Interrupt routines ; Fatal errors PDLOVF: JSP B,CRASHX ASCIZ /Pushdown overflow/ DATERX: JSP B,CRASHX ASCIZ /IO data error/ ILLINS: JSP B,CRASHX ASCIZ /Illegal instruction/ ILLRED: JSP B,CRASHX ASCIZ /Illegal read/ ILLWRT: JSP B,CRASHX ASCIZ /Illegal write/ ILLXCT: JSP B,CRASHX ASCIZ /Illegal execute/ ILLSIZ: JSP B,CRASHX ASCIZ /Machine size exceeded/ ; Common code for fatal error interrupts CRASHX: PUSH P,CH1PC ; Put trap pc on stack TLOA B,-1 ; Make call pc into string ptr ; UUO handlers and FORMAT escape sequences not defined in PUPFTP %ULOG:: %UELOG:: %LETC:: %LETP:: ; Routine to call if an impossible error occurs ; Does not return SCREWUP::HRROI B,[ASCIZ /An impossible error has occurred/] HRRZ A,0(P) ; Get return pc SUBI A,1 ; Backup to call ERROR <%2S at %1O> HALTF ; Handling for data error DATERR: PUSH P,A ; Save an ac SKIPL A,SRCDSP ; Check for error dispatches SKIPGE A,DSTDSP TRNN A,-1 ; Both specified and armed? JRST DATERX ; 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 assignments LS CH1PC ; PSI return locations LS CH2PC LS CH3PC LS STACK,STKLEN ; Local stack LSP TEMP,1 ; One page for general scratch use LS CONJFN ; Network input,,output JFNs 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 HSTNAM,20 ; Remote port name (from Host command) LS DEFPRP,PLSIZE ; Default property list LS FILPRP,PLSIZE ; File property list (Store/Retrieve) ; *** Do not change the order of the following *** LS USRNAM,USRSTL/5+1 ; User-Name string LS USRPSW,USRSTL/5+1 ; User-Password string LS USRACT,USRSTL/5+1 ; User-Account string LS CONNAM,USRSTL/5+1 ; Connect-Name string LS CONPSW,USRSTL/5+1 ; Connect-Password string ; *** END PUPFTP