;PUPFTS.MAC;56 14-MAY-83 15:45:15 EDIT BY TAFT ;PUPFTS.MAC;55 13-JAN-83 14:19:36 EDIT BY TAFT ;PUPFTS.MAC;54 8-NOV-82 16:33:00 EDIT BY TAFT ;PUPFTS.MAC;53 4-OCT-82 16:28:45 EDIT BY TAFT ; Bug fix in GFNPRP ;PUPFTS.MAC;51 26-SEP-82 15:14:10 EDIT BY TAFT ; Implement New-enumerate ; Observe Desired-property requests ;PUPFTS.MAC;49 10-AUG-81 18:00:30 EDIT BY TAFT ; Time zones in Retrieve date properties. ;PUPFTS.MAC;47 18-MAY-81 11:41:48 EDIT BY TAFT ;PUPFTS.MAC;46 24-APR-81 21:26:29 EDIT BY TAFT ; Include time zone in date properties ;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. ;PUPFTS.MAC;44 2-DEC-80 09:17:45 EDIT BY TAFT ; Fix bug in handling of connect name in LOGCHK. ;PUPFTS.MAC;43 29-AUG-80 13:43:23 EDIT BY TAFT ; Add FRNHAD ;PUPFTS.MAC;42 26-AUG-80 11:11:23 EDIT BY TAFT ; Generate full property list in Delete ;PUPFTS.MAC;41 15-AUG-80 18:38:29 EDIT BY TAFT ; Call RECPAS from LOGCHK ;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 ;PUPFTS.MAC;39 2-FEB-80 18:00:31 EDIT BY TAFT ; Send Size property in Retrieve property list ;PUPFTS.MAC;38 20-JAN-80 17:42:05 EDIT BY TAFT ; FTPM does not attempt to send if receive connection closes in midstream. ;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. ;PUPFTS.MAC;36 4-NOV-79 12:24:55 EDIT BY TAFT ; Set creation date during [Store] if present in property list ;PUPFTS.MAC;35 2-SEP-79 15:59:33 EDIT BY TAFT ;PUPFTS.MAC;34 16-JAN-79 14:26:59 EDIT BY TAFT ;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 ;PUPFTS.MAC;32 4-SEP-78 13:05:01 EDIT BY TAFT ; Add Rename error code 112 ;PUPFTS.MAC;31 4-JUL-78 16:41:36 EDIT BY TAFT ; Fix bug in Rename failure code ;PUPFTS.MAC;30 24-MAY-78 18:26:44 EDIT BY TAFT ; Add [New-store] command ;PUPFTS.MAC;29 3-FEB-78 19:46:55 EDIT BY TAFT ; Add distinct error code for file busy ;PUPFTS.MAC;28 16-SEP-77 10:14:14 EDIT BY TAFT ;PUPFTS.MAC;27 1-SEP-77 15:54:44 EDIT BY TAFT ; Make a few things internal for the mail server ;PUPFTS.MAC;26 26-JUL-77 14:58:18 EDIT BY TAFT ; "Directory" defaults server filename to *.*;* ; Reset watchdog timer in appropriate places ;PUPFTS.MAC;25 3-JUN-77 13:09:16 EDIT BY TAFT ; Add "Rename" command ;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" ;PUPFTS.MAC;23 7-APR-77 17:42:08 EDIT BY TAFT ; Zero memory cells holding JFNs when they are closed or released. ;PUPFTS.MAC;22 31-MAR-77 21:10:00 EDIT BY TAFT ; Add hooks for mail server ;PUPFTS.MAC;20 19-MAR-77 20:05:57 EDIT BY TAFT ; Add "Delete" command ;PUPFTS.MAC;19 19-MAR-77 13:39:42 EDIT BY TAFT ; Fix bugs in Tenex-paged stuff ;PUPFTS.MAC;18 18-MAR-77 19:13:59 EDIT BY TAFT ; Add REFILL procedure for property list parser ;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. ;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 ;PUPFTS.MAC;13 30-JUN-76 17:21:38 EDIT BY TAFT ; Remove various utility routines to PUPUTL.MAC ;PUPFTS.MAC;11 1-JUN-76 19:41:50 EDIT BY TAFT ; Change FIXNAM to apply generic filename properties as defaults ;PUPFTS.MAC;8 1-JUN-76 16:43:58 EDIT BY TAFT ; "Directory" returns properties as separate commands for each file ;PUPFTS.MAC;7 31-MAY-76 19:13:49 EDIT BY TAFT ; Include dates in retrieve property lists ;PUPFTS.MAC;5 14-MAY-76 20:07:10 EDIT BY TAFT ; Add code to handle CLOSF failure at FTPEND ;PUPFTS.MAC;4 27-MAR-76 18:01:12 EDIT BY TAFT ; Straighten out defaulting of account during store ;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,> 0 ,, C.'SYM > DEFINE XS(SYM,TYPE,NAME,FLAGS) < REPEAT TYPE-<.-MRKDSP>,<0> IF2,> 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,) 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 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,,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,,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 ; 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,) JRST C.RET7] HRRZ A,SRCJFN## FTPM(YES,0,) 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,,,1) FTPM(NO,,,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,,,1) FTPM(NO,,,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,,,1) FTPM(NO,,,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,,,1) FTPM(NO,,,1)] FTPM(COMM,,) 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+1B ; 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+1B+1B+1B ; 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 ; Output whatever was requested WRITE <(Size %2D)> TXNE P1,1B WRITE <(Creation-date %3Z)> TXNE P1,1B WRITE <(Write-date %4Z)> JUMPE D+1,.+3 ; Skip if never read TXNE P1,1B 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,) 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 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,) 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 ; 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 FTPM(NO,103,) 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 FTPM(NO,106,) 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,) JRST KILFIL] ; Flush output file and return HRRZ A,DSTJFN## ; Transfer ok FTPM(YES,0,) CLOSF ; Close file ELOG 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 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,,1) STYPAG: TRNN F,DSKDVF ; Paged, devide disk? FTPM(NO,15,,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,,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+1B+1B+1B+1B+1B+1B ; 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+1B ; 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 ; Want Size property? WRITE D,<(Size %2D)> MOVE B,TEMP+13 ; Get creation date TXNE P1,1B ; Want Creation-date property? WRITE D,<(Creation-date %2Z)> MOVE B,TEMP+14 ; Get write date TXNE P1,1B ; Want Write-date property? WRITE D,<(Write-date %2Z)> TXNN P1,1B ; 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 ; 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,,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 ; Make log entry HRLI A,400000 ; Don't release JFN DELF ; Delete file JRST [ LOG PUSHJ P,DELERR ; Report reason JRST C.DEL8] ; On to next HRRZ A,SRCJFN## ; Succeeded, report FTPM(YES,0,) ; 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,) 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 ; 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 ; 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 ; 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 ; 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 ; 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,,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,,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,,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,,1) CAIE A,GJFX33 ; More illegal format errors CAIN A,GJFX34 FTPM(NO,11,,1) CAIN A,GJFX16 ; More file not found errors FTPM(NO,100,,1) CAIN A,GJFX17 FTPM(NO,100,,1) CAIN A,GJFX32 FTPM(NO,100,,1) FTPM(NO,0,,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,,1) CAIN A,OPNX23 FTPM(NO,101,,1) CAIN A,OPNX9 ; File busy error FTPM(NO,111,,1) CAIN A,OPNX10 ; Disk full error FTPM(NO,104,,1) CAIN A,SFBSX2 ; Byte size error FTPM(NO,102,,1) FTPM(NO,0,,1) ; Other ; "Delete" errors DELERR: HRRZ C,SRCJFN## CAIN A,DELFX1 FTPM(NO,101,,1) FTPM(NO,0,,1) ; "Rename" errors RENERR: HRRZ C,SRCJFN## ; Get "from" JFN CAIN A,RNAMX3 FTPM(NO,101,,1) CAIN A,RNAMX5 FTPM(NO,111,,1) CAIN A,RNAMX8 FTPM(NO,101,,1) CAIN A,RNMX10 FTPM(NO,101,,1) FTPM(NO,0,,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 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 <%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,,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,,1) FTPM(NO,20,,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,,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 ; 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,,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,,1) FTPM(NO,23,,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 ; 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: FTPM(NO,1,) ; 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, , 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 ; 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,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 RELOC CHNTAB+^D 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