perm filename FTPSER.OLD[S,NET] blob
sn#740551 filedate 1984-01-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00042 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00009 00002 MES REPMES history FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ICPBLK ICPSTS ICPSKT HOSTNO FDHOST CONECB CNIBTS HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD MFRBUF MSJBUF LTOSTR TOSMAX TOSTR TOSCNT TOSBPT XRSQSW XRBBEG XRBTOP XRBPTR XRBCNT XRFBUF XRFBZZ XRFBBP XRFOBP XRFHBP DSKIBF DSKOBF MFDIBF OLDIBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS WAITST WATSIT
C00027 00003 DEFINITIONS OF A "GLOBAL" NATURE ERRBTS UFDN RFCS RFCR CLSS CLSR RFC CLS STLOC LSLOC WFLOC BSLOC FSLOC HNLOC INTINP INTIMS INTINS INTCLK
C00031 00004 ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
C00035 00005 IDCON IDCONZ IDCONI IDCNFI IDCNFO IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCONS IDCONB IDCONP IDCOND IDCONF IDSOCS IDSOCK IDSOC0 IDSOC1 IDSOC2
C00041 00006 ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
C00053 00007 START %SITE% REGO
C00060 00008 LOOP SCHEK STATUS
C00062 00009 SAVACX SAVACS GETACS
C00064 00010 CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
C00067 00011 CIROUT COMDIS BADCOM
C00068 00012 Receive a file APPE STOR WAITIL GETSET GETSE1 GETSEL C2 STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
C00079 00013 RNFR DELE GCRNTO RENFIL RNMOK RELDMP RNTO BADTO BDTONM BADDRN ALLO NOOP
C00083 00014 WRTSTR WRTST1 WRTST2 HELP NOMAIL NOUSER NOPPNM XRCOFL RCVD DAYLIT RCVD9 MAISTR MAIST2 MAIDEC MAI2DG
C00092 00015 SEND LOGGED LOGGE1 LOGTST JBLP JBNXT SENDER JUSTEL MSPG MSNFR MSNSJ SENTTY DPBSTR DPBNAM MSBUFR
C00096 00016 VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
C00103 00017 MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
C00106 00018 MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
C00109 00019 NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STAPRO LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
C00120 00020 Send a file RETR RETRX0 ASCERR
C00122 00021 WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEL BYTE9 MODE MODEUN MODEOK STRU XRSQ
C00127 00022 PORT PORT2 PORT3 DECIN DECIN0 DECIN DECIN0 SOCK
C00132 00023 PASS NOPRVS WRONGP GIVUSR MUSTLG USEROK PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE
C00140 00024 GETCOM GETCO1 FLUSCS flcs1 GETCO2
C00143 00025 GETIDX ANAMES NNAMES
C00144 00026 PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
C00147 00027 GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH8 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
C00151 00028 GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
C00154 00029 DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH WATHST MAXSIT WATHS2
C00158 00030 SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
C00161 00031 GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
C00167 00032 MLNMST MLNMIN MLNMOK MLNMF1 MLNMFF TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HAKREG HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX FOPEN FACTXT
C00176 00033 FF CR LF TAB TRYFOR TRYFO0 TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
C00181 00034 DIROUT DIROU1 DIROU2 DIRO25 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOFL DIEOF0 DIEOF1 DIFINI DIEOML DIMLFL DIERR3 RMDWAK RMDSYS OMLGET OMLGT1 OMLOUT OMLOPN OMLBUF OMLNAM PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
C00193 00035 GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
C00196 00036 DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR OCONER
C00201 00037 GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI9 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK
C00206 00038 NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00209 00039 ILEVEL DNTSAY timout SXACTV LOOK
C00211 00040 GETHNM CPYHST CPYDUN HSTTAB HSTSIX WHYWHY
C00213 00041 QUIT BYE BYE1 BYE2 ERRKIL QUITX QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
C00220 00042 Unimplemented commands REIN PASV REST SITE
C00221 ENDMK
C⊗;
;MES REPMES ;⊗ history FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ICPBLK ICPSTS ICPSKT HOSTNO FDHOST CONECB CNIBTS HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD MFRBUF MSJBUF LTOSTR TOSMAX TOSTR TOSCNT TOSBPT XRSQSW XRBBEG XRBTOP XRBPTR XRBCNT XRFBUF XRFBZZ XRFBBP XRFOBP XRFHBP DSKIBF DSKOBF MFDIBF OLDIBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS WAITST WATSIT
TITLE FTPSER
COMMENT ⊗ History (please record changes):
24 Jan 83 ME Made FTPSER translate WAITS 33 ↔ ASCII 32 (not-equals), making
character set translation reversible.
13 Feb 83 ME To-string saved and inserted in mail for debugging returned mail.
26 Apr 83 ME,JJW IP/TCP code under FTIP.
06 May 83 ME Fix to set FDSS correctly (fixing typo), to allow STOR to work.
Also implemented NOOP, fixed ALLO, flushed BYTE.
17 May 83 JJW Fix to convert IP addresses to/from HOSTS2 format.
14 May 83 ME Added PORT command, fixed some reply codes for TCP/FTP,
fixed bug at STATDO going to DOERR with data on stack.
15 May 83 ME Fixed ICONER and OCONER to clear HOLDIL since transfer is
aborted at that point.
11 Jun 83 ME Conversion to HOSTS3. Also uses dotted host number string
if no known host name for given host number. Allows connection
if from any of our alias host numbers when system down. Uses
exec 355 ptr to our host numbers.
23 Jun 83 ME Turned off "verbose" mode, to speed up I-level.
24 Jun 83 ME Fixed ILEVEL's verbose mode output buffer check to be more
conservative to avoid attempt to reschedule at I-level.
01 Jul 83 ME Fixed TYPE L to parse following byte size. All other types
(namely, A and I) assume 8-bit "real" byte size (RBS).
Fixed up response to HELP cmd. Only byte sizes allowed in
TYPE L are 8, 32, and 36; the latter is treated as TYPE I
locally, since it has same meaning with our 36-bit words.
21 Jul 83 JJW Reads WATSIT[S,SYS] to set FTREQL for S1-A.
12 Aug 83 JJW NBUFS different for FTF2 to provide optimal disk buffering.
16 Sep 83 JJW Removed FTHST3 switch and non-HOSTS3 code. Changed failure
return from HSTNUM to call HNUMST in NETWRK.
18 Nov 83 JJW Made password rejection return code 530 instead of 501.
03 Dec 83 JJW Fixed image mode FTP of odd-length files (partial byte at EOF).
22 Jan 84 JJW Recognize commands REIN, PASV, REST, SITE as unimplemented.
history: end of comment ⊗
PRINTS /Have you listed your changes at History: on page 2?
/
.INSERT WATSIT[S,SYS] ;See who we are
IFN FTLLL,<FTREQL←←1> ;LLL wants to be paranoid
IFNDEF FTIP,<↓FTIP←←1> ;IP/TCP version, using "new" FTP protocol
IFNDEF FTTOS,<FTTOS←←1> ;collect to-string for Received: line
IFNDEF FTREQL,<FTREQL←←0> ;set nonzero to require login for main stuff
IFN FTREQL,<PRINTS/Will require login for file operations.
/>
IFE FTIP,<
PRINTS/To put up a new FTPSER, save core image as RFC003.DMP[NET,SYS].
/
>;IFE FTIP
IFN FTIP,<
PRINTS/To put up a new FTPSER, save core image as TCP025.DMP[NET,SYS].
/
>;IFN FTIP
IFE FTIP,<
IFNDEF FTPSKT,<FTPSKT←←3>
>;IFE FTIP
IFN FTIP,<
IFNDEF FTPSKT,<FTPSKT←←25> ;"new" FTP
>;IFN FTIP
IFNDEF VERBOSE,<VERBOSE←←0> ;SET TO 0 FOR QUIET
IFNDEF IVERBOSE,<IVERBOSE←←0> ;I-level verbosity
IFN FTIP,<%XRCP←←0> ;No mail in FTP if IP/TCP
IFNDEF %XRCP,<%XRCP←←1> ;For new XRCP code...
IFNDEF FTMSJ,<FTMSJ←←0> ;Nonzero means extract subject from mail
;Zero now to let MAIL program find the subject
EXTERN JOBFF,JOBSA
; ACCUMULATOR DEFINITIONS:
FLG← 0 ;High order bit for EOF from MAIL command, see below
↓A← 1 ;TEMP
↓B← 2 ;TEMP
C← 3
D← 4
E← 5
F← 6
FLG2← 7 ;USED TO INSERT INITIAL SPACES IN MLFL LINES
MBP← 10 ;USED FOR MAIL "FROM" LINE FINDER
MCH← 11 ;DITTO
IFN FTMSJ,<
MSJ← 12 ;USED FOR MAIL "SUBJECT" LINE FINDER
>;IFN FTMSJ
T← 13
↓T1← 14
↓T2← 15
↓T3← 16
↓P← 17 ;PUSH DOWN LIST
; STORAGE ASSIGNMENTS:
PDLL←← 20 ;PDL LENGTH
PDL: BLOCK PDLL
DIBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM IMP DATA CONNECTION
DOBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO IMP DATA CONNECTION
FOBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM (DSK,MTA,DTA,ETC.)
FIBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO (DSK,MTA,DTA,ETC.)
IBUF: BLOCK 3 ;INPUT CONTROL BUFFER HEADER
OBUF: BLOCK 3 ;OUTPUT CONTROL BUFFER HEADER
IFE FTIP,<
ICPBLK: 1 ; LISTEN
ICPSTS: 0 ; status
FTPSKT ; listen socket
-1 ; wait flag
=32 ; byte size
ICPSKT: 0 ; foreign socket
>;IFE FTIP
HOSTNO: 0 ; foreign host (IP format now)
IFN FTIP,<
FDHOST: 0 ; foreign host for data connection, IP format
>;IFN FTIP
CONECB: BLOCK 7
CNIBTS: 0 ;INTERRUPT LEVEL ROUTINES PUTS BITS HERE
HSTSTR: BLOCK =10 ;HOST STRING
PRIVS: 0 ;SAVE USER'S PRIVILEGES HERE
UFDFIL: 0
SIXBIT/UFD/
0
SIXBIT/ 1 1/
PASMTA: SIXBIT/GODMOD/
15
0
0
PRVMTA: SIXBIT /GODMOD/
14
IOWD 17,PRVBUF
PRVBUF: BLOCK 13
PASWD: 0 ;PASSWORD RETURNED HERE IF INF
PRIVWD: 0 ;PRIVILEGES RETURNED HERE
0 ;LAST LOGIN TIME RETURNED HERE
GRPWD: 0 ;GROUP ACCESS BITS RETURNED HERE
MFRBUF: BLOCK 40 ;FOR "FROM" LINE STORAGE
IFN FTMSJ,<
MSJBUF: BLOCK 40 ;FOR "SUBJECT" LINE STORAGE
>;IFN FTMSJ
IFN FTTOS,<
LTOSTR←←10 ;size of block to collect to-string
TOSMAX←←5*LTOSTR ;max nbr of 7-bit bytes in to-string
TOSTR: BLOCK LTOSTR ;to-string -- destination given by mail, etc.
0 ;zero terminates max-length to-string with null
TOSCNT: 0 ;count of free bytes left in TOSTR
TOSBPT: 0 ;byte ptr for saving to-string
>;IFN FTTOS
IFN %XRCP,< ; XRCP MESSAGE BUFFER VARS
XRSQSW: 0 ; 0 Default scheme, -1 Text-first scheme.
; +1 Recip-first BH 7/28/80
XRBBEG: 0 ; Addr of start of buffer
XRBTOP: 0 ; Addr of 1st non-used loc (should be = JOBFF)
XRBPTR: 0 ; BP to deposit text at
XRBCNT: 0 ; If -, # chars free in buffer, else # chars.
XRFBUF: BLOCK =70 ; Block for remembering recipients
XRFBZZ: 0 ; Must stay zero, overflow test
XRFBBP: 0 ; BPT for adding recipient
XRFOBP: 0 ; BPT after last added recipient
XRFHBP: 0 ; Copy of OBP as flag for header generation
>
IFE FTF2,<NBUFS←←11;>NBUFS←←40 ;optimum number of disk buffers (one more than one tk)
;I/O BUFFERS
DSKIBF: BLOCK NBUFS*203 ;A WHOLE TRACK'S WORTH FOR THE MAIN DISK CHANNELS
DSKOBF: BLOCK NBUFS*203
MFDIBF: BLOCK 2*203 ;NOT WORTH IT FOR THESE LOW-USE ONES
OLDIBF: BLOCK 2*203
LOURH3←←10 ;number of host numbers to allow for ourselves
OURH3: BLOCK LOURH3 ;our host number(s), copied from system via lowcore 355
; VARIABLE DEFINITONS:
LCSS: 0 ;LOCAL CONTROL SEND SOCKET
LCRS: 0 ;LOCAL CONTROL RECEIVE SOCKET
FCSS: 0 ;FOREIGN CONTROL SEND SOCKET
FCRS: 0 ;FOREIGN CONTROL RECEIVE SOCKET
LDSS: 0 ;LOCAL DATA SEND SOCKET
LDRS: 0 ;LOCAL DATA RECEIVE SOCKET
FDRS: 0 ;FOREIGN DATA RECEIVE SOCKET
FDSS: 0 ;FOREIGN DATA SEND SOCKET
UPPN: SIXBIT/NETGUE/ ;"LOCAL" PPN OF USER FTP
ALIPPN: SIXBIT/NETGUE/ ;ALIAS PPN OF USER FTP
UPRG: 'GUE' ;JUST PRG FROM UPPN (FOR CAME IN ILDDEV)
PPNTMP: 0 ;Save user name here until password is given
PASTRY: 0 ;Number of try user has left to guess password
ifn verbose,<
SILENT: 0 ;Hide password from spies running FTPS
>
DOMODE: 0 ;LEGAL MODES ARE: 0-Stream, 1-Block, 2-Text,
DIMODE: 0 ; 3-Hasp
DOTYPE: 0 ;LEGAL TYPES ARE: 0-Ascii, 1-Image, 2-Local byte,
DITYPE: 0 ; 3-Print file ascii, 4-Ebcdic
IMODES: 1000 ↔ 1010 ↔ 1010
FMODES: 1000 ↔ 1010 ↔ 1010
DOBS: =8 ;BYTE SIZE, DATA CONNECTION OUT
DIBS: =8 ;BYTE SIZE, DATA CONNECTION IN
DOACTV: 0 ;DATA OUT LINE IS ACTIVE
DIACTV: 0 ;DATA IN LINE IS ACTIVE
XACTV: 0
RTYPE: 0 ;REAL TYPE, LATEST GOTTEN FROM USER
RBS: =8 ;REAL BYTE SIZE, LATEST GOTTEN FROM USER
SCHEKF: 0 ;IF MINUS, IT'S TIME TO CHECK IMP STATUS
OUTINSTR:0 ;FOR DATGEN, WHICH OUTPUT SINK TO WRITE CHARS TO
SYNCH: 0 ;IF +, # OF UNMATCHED DATA MARK CHARS (200)
;IF -, # OF UNMATCHED INS INTERRUPTS
;WHILE -, FLUSH ALL INPUT CHARS EXCEPT DM
DIRFLC: 0 ;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES
PATCH: 40 ;patch space
; I/O CHANNEL DEFINITONS
IMP←← 4 ;CONTROL CONNECTIONS
DIMP←← 1 ;DATA IN FROM IMP CHANNEL
DOMP←← 0 ;DATA OUT TO IMP CHANNEL
FIMP←← 3 ;FILE IN (IN FROM IMP, OUT TO DEVICE) CHANNEL
FOMP←← 2 ;FILE OUT (OUT TO IMP, IN FROM DEVICE) CHANNEL
; NOTE: DIMP,FIMP ARE USED TOGETHER,
; SIMILARLY, DOMP,FOMP GO TOGETHER
; SOME OF THE ABOVE ARE USED NON-SYMBOLICALLY IN CODE!!!
.MFD←←5 ;READ MFD FOR VALID MAIL RECIPIENT
.OLD←←6 ;READ OLD MAIL FILE
.PASS←←7 ;USED TO CHECK PASSWORD
UFDC←←10 ;USED TO READ UFD FOR ACCESS CHECK
; FLG bits
MEOFBT←← 1B0 ;EOF on MAIL (must be 4.9 bit!)
USREBT←← 1B1 ;User command given, expecting password
PASSBT←← 1B2 ;Password given, OK to STOR, etc.
MFRWIN←← 40000 ;MAIL "FROM" LINE FINDER IS ON THE RIGHT LINE
MFRLUZ←← 20000 ;MAIL "FROM" LINE FINDER IS ON THE WRONG LINE
MFRDUN←← 10000 ;MAIL "FROM" LINE FINDER IS FINISHED READING IT
MFNMF←← 4000 ;MLFLNM IN PROGRESS
LFSEEN←← 2000 ;LF HAS BEEN EATEN IN INCOMING COMMAND LINE
LISTFL←← 1000 ;DO OPERATION IS LIST (OR NLST) AS OPPOSED TO RETR OR STAT
IFN FTMSJ,<
MSJDUN←← 400 ;MAIL "SUBJECT" LINE FINDER IS FINISHED READING IT
MSJWIN←← 200 ;MAIL "SUBJECT" LINE FINDER IS ON THE RIGHT LINE
MSJLUZ←← 100 ;MAIL "SUBJECT" LINE FINDER IS ON THE WRONG LINE
>;IFN FTMSJ
IFE FTMSJ,<
MSJDUN←← 0 ;no such bit now
>;IFE FTMSJ
QUOTEF←← 40 ;QUOTED STRING IN PROGRESS
LEFTF←← 20 ;LEFT JUSTIFIED SIXBIT
;ABOVE ARE LH FLAGS
.MAIL←← 1 ;MAIL COMMAND LIKE LOCAL MAIL
.XSEN←← 2 ;XSEN COMMAND LIKE LOCAL SEND/N
.XSEM←← 4 ;XSEM COMMAND LIKE LOCAL SEND/Y
.XMAS←← 10 ;XMAS COMMAND LIKE LOCAL SEND/M
;ABOVE ARE RH FLAGS AND MAYN'T BE MOVED
CPOPJ2: AOS (P)
POPJ1: ;I CAN NEVER REMEMBER
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
DEFINE MES(TEXT) <
IFN VERBOSE, <OUTSTR [ASCIZ ⊗TEXT
⊗] >>
DEFINE REPMES(TEXT) <
MOVE E,[POINT 7,[ASCIZ ⊗TEXT
⊗]]
JRST REPMET >
REPMET: PUSHJ P,GSRCI
PUSHJ P,ASCIIE
SOS IMPSTF
JRST FLUSCS
QUANTM←← =60 ;ONE CLOCK "TICK" IS ONE SECOND
;GROUP ACCESS/PRIVILEGE BITS
;None of these symbols are actually used in the code except GROUPS and MASPRV.
;GROUPS is a fullword value but MASPRV must be right half.
REAPRV←←40000
WRTPRV←←20000
MASPRV←←1
SYSPRV←←2
SCYPRV←←4
DECPRV←←10
ACTPRV←←20
CSPPRV←←40
GROUPS←←47 ;ALL OF THE ABOVE.
WAITST: 0 ;WAITS site number goes here
WATSIT←←263 ;low core location containing WATCPU,,WATSIT
; DEFINITIONS OF A "GLOBAL" NATURE ;⊗ ERRBTS UFDN RFCS RFCR CLSS CLSR RFC CLS STLOC LSLOC WFLOC BSLOC FSLOC HNLOC INTINP INTIMS INTINS INTCLK
ERRBTS←← 0;
UFDN←←20 ;NUMBER OF WORDS IN A DIRECTORY ENTRY
DEFINE X(BIT,VAL) <
BIT ← VAL ↔ ERRBTS ← ERRBTS!VAL
>
IFE FTIP,<
X(RSET,400) ; HOST SEND US A RESET
X(CTROV,1000) ; HOST OVERFLOWED OUR ALLOCATION
X(HDEAD,2000) ; HOST IS DEAD
>;IFE FTIP
X(IODEND,020000); END OF FILE
X(IOBKTL,040000); BLOCK TOO LARGE
X(IODTER,100000); DEVICE ERROR
X(IODERR,200000); DATA ERROR
X(IOIMPM,400000); IMPROPER MODE
RFCS←← 200000 ; RFC SENT
RFCR←← 100000 ; RFC RECEIVED
CLSS←← 040000 ; CLS SENT
CLSR←← 020000 ; CLS RECEIVED
RFC←← RFCS ! RFCR
CLS←← CLSS ! CLSR
STLOC←← 1
LSLOC←← 2
WFLOC←← 3
BSLOC←← 4
FSLOC←← 5
HNLOC←← 6
EXTERNAL JOBCNI,JOBAPR,JOBREL,JOBFF
DEFINE NAMES <
X(RNTO) ;MUST BE INDEX 1 WHEN DEFINED
X(USER)
X(PASS)
X(TYPE)
IFE FTIP,<
X(SOCK)
>;IFE FTIP
IFN FTIP,<
X(PORT) ;specifies foreign host and port for data connection
>;IFN FTIP
X(STRU)
X(MODE)
IFE FTIP,<
X(BYTE)
>;IFE FTIP
X(RETR)
X(STOR)
X(APPE)
X(RNFR)
X(DELE)
IFE FTIP,<
X(MAIL)
X(MLFL)
>;IFE FTIP
X(STAT)
X(HELP)
X(CWD)
IFE FTIP,<
X(XCWD)
X(BYE)
>;IFE FTIP
IFN FTIP,<
X(QUIT)
X(NOOP)
>;IFN FTIP
X(ABOR)
X(LIST)
X(NLST)
IFE FTIP,<
X(XSEN) ;EXPERIMENTAL, SEND/N
X(XSEM) ;EXPERIMENTAL, SEND/Y
X(XMAS) ;EXPERIMENTAL, SEND/M
IFN %XRCP,<
X(XRSQ) ; XRCP scheme selection
X(XRCP) ; XRCP command itself
>;IFN %XRCP
>;IFE FTIP
X(ACCT)
X(ALLO)
IFN FTIP,< ;Unimplemented commands
X(REIN) ;Reinitialize
X(PASV) ;Passive
X(REST) ;Restart
X(SITE) ;Site parameters
>;IFN FTIP
>;NAMES
INTINP←← 000010
INTIMS←← 000020
INTINS←← 000040
INTCLK←← 000200
;OPCODE DEFINITONS:
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
OPDEF PTOCNT [PTYUUO 3,]
;⊗ ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
; ICP: INITIAL CONTROL LINK CONNECTION ESTABLISHMENT ROUTINE
ICP: ;THIS ROUTINE ESTABLISHES BOTH CONTROL CONNECTIONS
; TO THE USER FTP, AND SKIP RETURNS. NON-SKIP RETURN
; INDICATES SOME KIND OF FAILURE.
MTAPE IMP,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
MTAPE IMP,ICPSTO ;SET TIMEOUTS
IFE FTIP,<
SETZM CONECB
SETZM CONECB+FSLOC ;DON'T WAIT FOR CONNECTION
>;IFE FTIP
IFN FTIP,<
MOVEI A,1
MOVEM A,CONECB ;Do a LISTEN, not a connect
SETOM CONECB+WFLOC ;Wait for (duplex) connection
SETZM CONECB+FSLOC ;Listen for any foreign port
SETZM CONECB+HNLOC ;Any foreign host will do
>;IFN FTIP
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
IFE FTIP,<
MOVE A,FCRS
MOVEM A,CONECB+FSLOC
MOVE A,HOSTNO
MOVEM A,CONECB+HNLOC
>;IFE FTIP
MOVEI A,10
MOVEM A,CONECB+BSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION OUT
IFN FTIP,<
MOVE A,CONECB+FSLOC ;get foreign port number
MOVEM A,FCSS ;new FTP has all foreign port nbrs the same
MOVEM A,FCRS
MOVEM A,FDRS
MOVEM A,FDSS
MOVE 0,CONECB+HNLOC ;get foreign host number (IP format)
MOVEM 0,FDHOST ;remember default host for data connections
MOVEM 0,HOSTNO ;remember whom we're talking to
>;IFN FTIP
IFE FTIP,<
MOVE A,LCRS
MOVEM A,CONECB+LSLOC
MOVE A,FCSS
MOVEM A,CONECB+FSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION IN
MOVEI A,4
MOVEM A,CONECB
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
MTAPE IMP,CONECB ;WAIT FOR OUT CONNECTION
>;IFE FTIP
STATZ IMP,ERRBTS ;TIMEOUT? (OR OTHER RANDOM ERROR)?
JRST ICPTO ; YES
PUSHJ P,ICPCHK
IFE FTIP,<
MOVE A,LCRS
MOVEM A,CONECB+LSLOC
MTAPE IMP,CONECB ;WAIT FOR IN CONNECTION
STATZ IMP,ERRBTS ;TIMEOUT OR OTHER ERROR?
JRST ICPTO ; YES
>;IFE FTIP
JRST CPOPJ1
ICPCHK: MOVE A,CONECB+STLOC
TRNN A,-1
STATZ IMP,ERRBTS
JRST ICPX
POPJ P,
ICPX:
IFE FTIP,<
POP P,A ;RETURN UPLEVEL ON ERROR
MES (Error in control connections)
>;IFE FTIP
IFN FTIP,<
IFN VERBOSE<
OUTSTR [ASCIZ/⊗Error in control connections: /]
MOVE 0,A ;Error code where MTPERR wants it
PUSHJ P,MTPERR ;Print error message
>;IFN VERBOSE
POP P,A
>;IFN FTIP
POPJ P,
ICPTO: ;ICP Time Out
MES (ICP times out)
MOVE A,['KILL-1']
MOVEM A,KFLAG
JRST QUITX
KFLAG: 0
ICPGTO: =16 ↔ 0
ICPSTO: =15 ↔ 0
;⊗ IDCON IDCONZ IDCONI IDCNFI IDCNFO IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCONS IDCONB IDCONP IDCOND IDCONF IDSOCS IDSOCK IDSOC0 IDSOC1 IDSOC2
; IDCON: INITIIZE DATA LINK CONNECTION ROUTINE
; THIS ROUTINE WILL INITIALIZE A DATA CONNECTION TO THE USER.
; CALL: MOVEI B,0 ;FOR DATA OUT CONNECTION
; MOVEI B,1 ;FOR DATA IN
; PUSHJ P,IDCON
; ERROR RETURN
; SUCCESS RETURN
IDCON:
IFN VERBOSE, <
OUTSTR [ASCIZ /Initializing data link /]
JUMPN B,.+2
OUTSTR [ASCIZ /out/]
JUMPE B,.+2
OUTSTR [ASCIZ /in/]
>;IFN VERBOSE
IFE FTIP,<
PUSHJ P,IDSOCK ;TELL USER WHICH DATA SOCKET WE'RE USING
>;IFE FTIP
MOVE A,DOTYPE(B)
MOVE A,IMODES(A)
HRRM A,IDCONI
MOVE A,IDCONB(B)
MOVEM A,IDCONI+2
DPB B,[POINT 4,IDCONI,12]
DPB B,[POINT 4,IDCNFI,12]
DPB B,[POINT 4,IDCNFO,12]
DPB B,[POINT 4,IDCONC,12]
DPB B,[POINT 4,IDCNQ1,12]
DPB B,[POINT 4,IDCNQ2,12]
DPB B,[POINT 4,IDCONW,12]
IDCONZ: DPB B,[POINT 4,IDCONY,12]
IDCONI: INIT 000,000
SIXBIT /IMP/
XWD DOBUF,DIBUF
JRST NOIMP
JUMPE B,IDCNFO
IDCNFI: INBUF 000,0
JRST IDCNQ1
IDCNFO: OUTBUF 000,0
IDCNQ1: MTAPE 000,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
IDCNQ2: MTAPE 000,ICPSTO ;SET TIMEOUTS
CAIN B,1 ;ARE WE RECEIVING DATA?
IDCONW: MTAPE 000,[=13↔1] ; YES, GIVE ALLOCATION
SETZM CONECB
MOVE A,LDSS(B)
MOVEM A,CONECB+LSLOC
MOVE A,FDRS(B)
MOVEM A,CONECB+FSLOC
IFE FTIP,<
MOVE A,HOSTNO
MOVEM A,CONECB+HNLOC
>;IFE FTIP
IFN FTIP,<
MOVE A,FDHOST ;get current default host for data connection
MOVEM A,CONECB+HNLOC ;use that as host to connect to for data
>;IFN FTIP
MOVE A,DOBS(B)
MOVEM A,CONECB+BSLOC
SETZM CONECB+WFLOC ;DON'T WAIT FOR CONNECTION
IFN FTIP,<
SETZM CONECB+STLOC ;clear any previous status bits
>;IFN FTIP
IDCONC: MTAPE 000,CONECB ;INITIATE DATA CONNECTION W/ USER
IFN FTIP,<
;connect always waits under IP/TCP, so check what status we've already got
MOVE A,CONECB+STLOC ;get status
TRNN A,77 ;ANY ERROR CODES?
TLNE A,CLS ;ANYBODY CLOSING CONNECTION?
POPJ P, ;yes, quit now
>;IFN FTIP
IDCONX: INTOFF ;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY: MTAPE 000,IDCONS ;GET STATUS OF DIMP
INTON
MOVE A,IDCONS+STLOC(B) ;get status
TRNN A,77 ;ANY ERROR CODES?
TLNE A,CLS ;or ANYBODY CLOSING CONNECTION?
POPJ P, ;YES
TLC A,RFC
TLCN A,RFC ;CONNECTION COMPLETE?
JRST IDCONF ; YES, SUCCESS RETURN
ifn verbose,<
tlne a,200000 ;rfcs?
outchr ["S"]
tlne a,100000 ;rfcr?
outchr ["R"]
>;verbose
PUSHJ P,@IDCOND(B)
XCT IDCONZ ;THIS INSTRUCTION MAKES IDCON REENTRANT
; - OR ENOUGH SO TO WORK, ANYWAY!
JRST IDCONX
IDCONS: 2 ↔ 0 ↔ 0
IDCONB: XWD DOBUF,0
XWD 0,DIBUF
IDCONP: POINT 6,DOBUF+1,11
POINT 6,DIBUF+1,11
IDCOND: DOWAIT
DIWAIT
IDCONF: MES (...done)
MOVE A,DOBS(B) ;GET CONNECTION BYTE SIZE
DPB A,IDCONP(B) ;SET BYTE SIZE IN BUFFER HEADER
JRST CPOPJ1
IFE FTIP,<
IDSOCS: ASCIZ /255 SOCK 0000000000XX/
IDSOCK: PUSHJ P,IDSOC0 ;PUT SOCKET NUMBER INTO ABOVE STRING
MOVEI D,15 ;PUT CRLF INTO ABOVE STRING
IDPB D,C
MOVEI D,12
IDPB D,C
SETZ D,
IDPB D,C
MOVE E,[POINT 7,IDSOCS]
MOVEI A,DOMP
ADD A,B ;C(A) = DIMP or DOMP
PUSHJ P,GSR ;GET PERMISSION TO OUTPUT ON CONTROL LINK
PUSHJ P,ASCIIE
SOS IMPSTF
POPJ P,
IDSOC0: MOVE C,[POINT 7,IDSOCS+1,27] ;POINTS TO " " AFTER "SOCK" IN IDSOCS
MOVE D,LDSS(B) ;GET DATA SOCKET NUMBER
IDSOC1: IDIVI D,12
PUSH P,E ;PUSH LOW ORDER DIGIT ONTO STACK
SKIPE D ;WAS IT HIGH ORDER DIGIT ALSO?
PUSHJ P,IDSOC1 ; NO, GET ANOTHER DIGIT
IDSOC2: POP P,D ;GET DIGIT
ADDI D,"0" ;CONVERT TO ASCIZ
IDPB D,C ;STUFF INTO STRING
POPJ P, ;GET NEXT DIGIT OR RETURN IF NONE
>;IFE FTIP
;⊗ ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
;; ILDDEV - INITIALIZE LOCAL DATA DEVICE
;;THIS ROUTINE DOES THE NECESSARY OPEN'S, LOOKUP'S OR ENTER'S REQUIRED
;;SO THAT INPUT OR OUTPUT UUO'S ON THE CHANNELS FIMP, FOMP WILL FUNCTION.
;;NOTE: THE LOCAL DATA DEVICE NEED NOT NECCESSARILY BE THE DISK.
;; CALL: MOVE C,[<DEVICE NAME IN SIXBIT>]
;; MOVE D,[<PPN IN SIXBIT>]
;; MOVE E,[<XWD <FILE EXTENSION IN SIXBIT>,0]
;; MOVE F,[<FILE NAME IN SIXBIT>]
;; MOVEI B,1 (FOR DATA OUT TO IMP, LOCAL LOOKUP)
;; ,5 (FOR STAT, LOCAL LOOKUP, NO DATA TRANSFER)
;; ,2∨6 (FOR DATA IN FROM IMP, LOCAL ENTER)
;; (6 FOR MAIL OR MLFL, COPIES OLD FILE LATER)
;; ,3 (FOR DATA IN FROM IMP, LOCAL UPDATE)
;; ,10 (FOR RNTO OR DELE)
;; ,21 (FOR RNFR, DOES LOOKUP BUT CHECKS WRITE ACCESS)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; SUCCESS RETURN
ILDDEV: SETZM UFDOKF# ;FLAG WHERE -1 MEANS DON'T CHECK UFD PROTECTION
CAIN B,6 ;HERE FROM MAIL OR MLFL?
SETOM UFDOKF ;YES
TRNN D,-1 ;WAS A PROGRAMMER NAME SPECIFIED?
MOVE D,ALIPPN ; NO, USE THE DEFAULT PPN
CAIN B,10
JRST ILDSTT ;DON'T CHANGE STORED FILENAME FOR RNTO OR DELE
MOVEM C,ERRDEV#
MOVEM F,ERRFIL#
HLLZM E,ERREXT#
MOVEM D,ERRPPN#
ILDSTT: TRZ B,4
TLZ FLG,(MEOFBT) ;STAYS 0 EXCEPT FOR MAIL
IFN VERBOSE, <
OUTSTR [ASCIZ /Opening local file system... /]
>
SETZM ERRTYP# ;THIS WILL INDICATE WHEN ERROR HAPPENS
MOVEM C,ILDD+1 ;store device name for OPEN
MOVE A,DOTYPE
TRNE B,2
MOVE A,DITYPE
MOVE A,FMODES(A)
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;SKIP IF NOT DISK
TRO A,200 ;***** ONLY IF DEVICE IS DISK!!
MOVEM A,ILDD
MOVEI A,2 ;ASSUME RENAME, USE INPUT CHANNEL
TRNE B,10 ;FORGET OPEN STUFF IF RENAMING
JRST DPBIT
MOVE T,B
ANDI T,3
MOVE A,[FOBUF
FIBUF,,0
FIBUF,,FOBUF]-1(T) ;BUFFER STRUCTURE
MOVEM A,ILDD+2
MOVE A,[2↔3↔3]-1(T) ;CHANNELS
DPBIT: DPB A,[POINT 4,ILDDO,12] ;DEPOSIT CHANNEL NUMBERS EVERYWHERE.
DPB A,[POINT 4,ILDDL,12]
DPB A,[POINT 4,ILDDE,12]
DPB A,[POINT 4,ILDDE1,12]
DPB A,[POINT 4,ILDDL1,12]
DPB A,[POINT 4,ILDDUG,12]
DPB A,[POINT 4,ILDL69,12]
DPB A,[POINT 4,ILDE69,12]
DPB A,[POINT 4,ILDDRN,12]
DPB A,[POINT 4,ASSHOL,12] ;YA MISSED ONE!!!
DPB A,[POINT 4,ILDVC1,12]
DPB A,[POINT 4,ILDVC2,12]
HRRM A,ILDVCH
TRNE B,10 ;NO OPEN ON RNTO
JRST NOOPEN ; BECAUSE RNFR DID IT
ILDDO: OPEN 000,ILDD
POPJ P, ;ERROR RETURN, CAN'T OPEN DEVICE
NOOPEN:
AOS ERRTYP
IFN VERBOSE, <OUTSTR [ASCIZ / OPEN/]>
ILDVCH: MOVEI T,000 ;CHANNEL NUMBER
DEVCHR T,
TLNN T,200000 ;SKIP IF DISK
JRST [AOS ERRTYP↔JRST ACCOK]
ILDVC1: GETSTS 000,T
TRO T,200
ILDVC2: SETSTS 000,(T)
MOVEI T,217
MOVEM T,ILDD
SETZM ILDD+2
OPEN UFDC,ILDD ;CHANNEL FOR UFD LOOKUPS TO CHECK FILE ACCESS
JRST [MES(Access check OPEN failure)↔POPJ P,]
MOVEM D,ILDD ;PREPARE TO LOOKUP UFD
CAMN D,[' 1 1'] ;DON'T ACCESS CHECK MFD IF READING UFD
JRST NOUFDC
HRLZI T,'UFD'
MOVEM T,ILDD+1
SETZM ILDD+2
MOVE T,[' 1 1']
MOVEM T,ILDD+3
LOOKUP UFDC,ILDD
JRST [MES(No UFD for access check)↔POPJ P,]
PUSHJ P,GRPCHK
SKIPE UFDOKF ;DO WE NEED TO CHECK THE UFD PROTECTION?
JRST NOUFDC ;NO
PUSHJ P,ACCCHK ;CHECK ACCESS
JRST [MES(UFD access prohibited)↔POPJ P,]
NOUFDC: MOVEM D,ILDD+3 ;Store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
LOOKUP UFDC,ILDD ;NOW WE CHECK THE ACTUAL FILE
JRST [AOS ERRTYP↔JRST ACCOK]
CAMN D,[' 1 1'] ;IF READING A UFD,
PUSHJ P,GRPCHK ; NOW IS THE TIME FOR GROUP CHECKING
PUSHJ P,ACCCHK ;CHECK FILE ACCESS
JRST [MES(File access prohibited)↔POPJ P,]
RELEAS UFDC, ;DONE READING FILE FOR ACCESS CHECK
ACCOK: AOS ERRTYP
MOVEM D,ILDD+3 ;store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
TRNN B,1 ;going to do input?
JRST ILDDET ;no
PUSH P,JOBFF ;RECYCLE BUFFER SPACE
MOVEI T,DSKIBF ;FIXED LOCATION
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDL1 ;use more buffers for disk
ILDL69: INBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDL1: INBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF ;JUST IN CASE SOMEBODY ELSE USES IT
ILDDL: LOOKUP 000,ILDD
JRST [CAIN B,3 ;IF UPDATING, LOOKUP FAILURE IS OK
JRST ILDDE0
MES(LOOKUP failed)
POPJ P, ; OTHERWISE, IT ISN'T
]
ILDDE0: SETZM FOBTSL ;SET UP FOR IMAGE INPUT
MOVEI T,1
LSH T,@DOBS
SUBI T,1
MOVEM T,FOMASK
ILDDET: TRNN B,2
JRST ILDDD ;INPUT ONLY
PUSH P,JOBFF
MOVEI T,DSKOBF
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDE1 ;use more buffers for disk
ILDE69: OUTBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDE1: OUTBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF
MOVEM D,ILDD+3 ;REPLACE ZAPPED PPN
HLLZS ILDD+1 ;DATE75
SETZM ILDD+2
MOVE T,[ILDD,,OMLNAM] ;SAVE FILE FOR LATER LOOKUP IN CASE IT'S MAIL
BLT T,OMLNAM+3
ILDDE: ENTER 000,ILDD
JRST [MES(ENTER failed)↔POPJ P,]
MOVEI T,=36
MOVEM T,FIBTSL
SETZM FIWORD
MOVS T,DIBS
LSH T,6
IOR T,[POINT 0,FIWORD]
MOVEM T,FIBPT
CAIN B,3 ;UPDATE FILE?
ILDDUG: UGETF 000,A ;DOES USETO TO NEXT FREE
ILDDD: MOVE T,DOTYPE
TRNE B,2
MOVE T,DITYPE
XCT ILDSS1(T)
TRNE B,1
DPB T,[POINT 6,FOBUF+1,11]
TRNE B,2
DPB T,[POINT 6,FIBUF+1,11]
TRNN B,10 ;RENAME TIME
JRST ILD123
ILDDRN: HLLZS ILDD+1
SETZM ILDD+2
ASSHOL: RENAME 000,ILDD ;DO IT
JRST [MES(RENAME failed)↔POPJ P,]
ILD123: MES ( Done)
JRST CPOPJ1
ILDD: BLOCK 4
ILDSS1: MOVEI T,7 ;TABLE OF BYTE SIZE GOBBLERS BY XFER TYPE
MOVEI T,=36
PUSHJ P,ILDSS2 ;LOCAL, NEED DOBS OR DIBS
ILDSS2: MOVE T,DOBS
TRNE B,2
MOVE T,DIBS
POPJ P,
ACCCHK: MOVE T,ILDD+2 ;GET PROTECTION
TLZ T,600000 ;FLUSH THESE LOSING BITS
SKIPN OWNER ;IF USER HAS GROUP ACCESS PRIVS TO THIS UFD,
CAMN D,UPPN ; OR IF FILE PPN IS USER'S PPN,
JRST OWNACC ; USE OWNER ACCESS
LSH T,3 ;ELSE EITHER LOCAL OR GUEST ACCESS
TLNN FLG,(PASSBT) ; DEPENDING
LSH T,3
OWNACC: TRNE B,36 ;IF ANYTHING OTHER THAN STRAIGHT READ,
LSH T,1 ; CHECK WRITE ACCESS
TLNN T,200000 ;THE MAGIC BIT SHOULD ALWAYS BE HERE NOW
AOS (P) ;ACCESS OK
POPJ P,
GRPCHK: SETZM OWNER# ;THIS WILL FLAG OWNER ACCESS
AOS ERRTYP ;WE'VE FOUND THE UFD
MTAPE UFDC,PRVMTA ;READ RETRIEVAL
POPJ P, ;CAN'T, NO GROUP ACCESS
SETZM PASWD ;JUST IN CASE WE HAVE INF
MOVE T,GRPWD ;GET FILE ACCESS GROUPS FOR THIS UFD
AND T,[GROUPS] ;JUST THE RIGHT BITS PLEASE
HRRZ A,ILDD ;PRG OF TARGET UFD
CAME A,UPRG ;PRG OF OUR USER
TRZ T,MASPRV ;NOT THE SAME, NO MAS ACCESS
TLO T,REAPRV!WRTPRV ;ALSO ALLOW REA AND WRT ACCESS
TDNE T,PRIVS ;DOES USER HAVE ANY CORRESPONDING PRIVS?
SETOM OWNER ;YES! ALLOW OWNER ACCESS
POPJ P,
;⊗ START %SITE% REGO
; MAIN PROGRAM STARTS HERE
START: JFCL
RESET
OUTSTR [ASCIZ/FTPSER started
/]
MOVE [SIXBIT/FTPSER/]
SETNAM
MOVE P,[XWD -PDLL,PDL] ;GET A PUSH DOWN LIST
CLKINT =30*=60*=60
SETZM PRIVS ;PARANOID? ME, PARANOID?
SETZ FLG, ;Zero flags
IFN FTREQL,<
SETZM USEROK ;nonzero indicates login done (can't be flag in FLG)
>;IFN FTREQL
SETO B,
GETLIN B
MOVEM B,TTYNUM#
SETZM OURH3 ;clear all our host numbers
MOVE T1,[OURH3,,OURH3+1] ;BLT source,,dest
BLT T1,OURH3+LOURH3-1 ;clear entire array
MOVSI T1,377777
SETPR2 T1, ;peek at system
JRST [ OUTSTR [ASCIZ/?? SETPR2 failed./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
SKIPL T1,400000!355 ;lowcore 355 is aobjn ptr to our HOSTS3 address
JRST [ ;can't tell who we are if no addresses
OUTSTR [ASCIZ /?? No valid host number for us pointed to by exec 355./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
HLRE T2,T1 ;- number of addresses
MOVN T2,T2 ;make positive nbr of host numbers
CAILE T2,LOURH3 ;skip if our table is as at least big as systems
MOVEI T2,LOURH3 ;only store as many as we have room for
MOVSI T3,400000(T1) ;BLT source address -- in system
HRRI T3,OURH3 ;BLT dest -- our table of our host number(s)
BLT T3,OURH3-1(T2) ;copy whole table from system (or what fits)
%SITE%:
MOVEI B,WATSIT
PEEK B, ;get WAITS site number from system (CPU,,SITE)
MOVEI B,(B) ;just site number
CAIL B,MAXSIT ;reasonable site number?
MOVEI B,MAXSIT-1 ;no, use unknown site
MOVEM B,WAITST ;remember it for figuring out our host name
INIT IMP,1
('IMP')
OBUF,,IBUF
JRST NOIMP
IFE FTIP,<
INIT 17 ; open IMP in dump mode
('IMP')
0 ; no buffers
JRST NOIMP
MTAPE [17 ↔ BYTE (6)1,=10,0,=30,0,0]; set timeouts
MTAPE ICPBLK ; connect → foreign logger
MOVE B,ICPSTS ; check for MTAPE error
TRNE B,77
JRST QUITX
STATZ ERRBTS
JRST QUITX
TLC B,RFC ; for next instruction to win
TLCE B,RFC ; legal socket state?
JRST QUITX
MOVEI A,21
MTAPE A
MOVEM B,LCRS
DPB B,[044000,,ICPS#]
HRROI B,ICPS-1
SETZ C,
OUT B ; send socket from user
CAIA ; won
JRST QUITX
RELEAS
OUTSTR [ASCIZ /Using socket /]
MOVSI B,-14
MOVE D,LCRS
SETZ C,
LSHC C,3
ADDI C,"0"
OUTCHR C
AOBJN B,.-4
OUTSTR [ASCIZ /, connecting to host /]
PUSHJ P,GETHNM
OUTSTR HSTSTR
OUTSTR [ASCIZ/
/]
MOVE A,LCRS
ADDI A,1
MOVEM A,LCSS
ADDI A,1
MOVEM A,LDRS
ADDI A,1
MOVEM A,LDSS
MOVE A,ICPSKT
ADDI A,2
MOVEM A,FCRS
ADDI A,1
MOVEM A,FCSS
ADDI A,1
MOVEM A,FDRS
ADDI A,1
MOVEM A,FDSS
>;IFE FTIP
IFN FTIP,<
MOVEI A,FTPSKT ;listen port
MOVEM A,LCRS ; is used for both send
MOVEM A,LCSS ; and receive of control connection
SUBI A,1 ;port one less
MOVEM A,LDRS ; is used for both send
MOVEM A,LDSS ; and receive of data connection
>;IFN FTIP
MOVEI A,ILEVEL ;INTENB USED TO BE AFTER ICP
MOVEM A,JOBAPR ; SO A VERY QUICK CLOSE COULD GO UNNOTICED
MOVSI A,INTINP!INTIMS!INTINS
INTENB A, ;ENABLE FOR IMP INPUT INTERRUPTS
PUSHJ P,ICP ;INITIAL CONNECTION PROTOCOL
JRST ERRKIL
INBUF IMP,2
OUTBUF IMP,2
MOVEI A,=8
DPB A,[POINT 6,IBUF+1,11]
DPB A,[POINT 6,OBUF+1,11]
;dcs: 4-12-73
;Some sites won't send allocation for our control out link until we
; send them some for our control in link. We don't do that (in the NCP)
; until the user program does something to suggest input -- so that
; user-specified allocation, if any, will be used. This test for input
; is sufficient to get our NCP to send allocation.
mtape imp,[=8] ;send them allocation for control conn.
jfcl
PUSHJ P,GREET ;SEND USER OUR GREETING MESSAGE
MOVEM P,SAVPDP#
IFN FTIP,<
PUSHJ P,SAYWHO ;type out name of host we're talking to
>;IFN FTIP
REGO: MOVE P,SAVPDP
MOVE A,CIP1
MOVEM A,CIP
MOVE A,DIP1
MOVEM A,DIP
MOVE A,DOP1
MOVEM A,DOP ;BECOMES CLEAR NEED TO
SETZM CIHUNG ; SAVE DATA IN COMMON
SETZM DIHUNG ; AND CLEAR WITH BLT'S!
SETZM DOHUNG
SETZM QUITNG
SETZM DIACTV
SETZM DOACTV
SETZM PRIVS ;PARANOID? ME, PARANOID?
;⊗ LOOP SCHEK STATUS
;; MAIN LOOP OF FTPS
;; PROGRAM LOOPS UNTIL XACTV IS INCREASED TO ZERO, THEN GOES
;; INTO INTERRUPT WAIT. INTERRUPT-LEVEL MODULE WILL SET XACTV TO
;; A SMALL NEGATIVE INTEGER, AND MAY ALSO SET SCHEKF
LOOP: CLKINT =30*=60*=60
AOSG SCHEKF ;TIME TO CHECK IMP STATUS?
PUSHJ P,SCHEK ; YES
PUSHJ P,CIDISP ;DISPatch to Control Input handler
SKIPE DIACTV ;Data In channel ACTiVe?
PUSHJ P,DIDISP ; YES
SKIPE DOACTV
PUSHJ P,DODISP
INTMSK [0]
AOSLE XACTV ;ANYTHING STILL WANTING ATTENTION?
IMSTW [-1] ; NO, ENABLE INTERRUPTS AND WAIT
INTMSK [-1] ;ENABLE INTERRUPTS IN CASE WE SKIPPED
JRST LOOP
SCHEK: MTAPE IMP,STATUS
MOVE A,STATUS+1
OR A,STATUS+2
TLC A,RFC ;these bits should be on (now off)
TLNN A,RFC!CLS ;CONTROL LINK CLOSING?
POPJ P, ; NO, ALL IS OK
IFN VERBOSE,<
OUTSTR [ASCIZ / Control link closed!/]
>;
JRST ERRKIL
STATUS: 2 ↔ 0 ↔ 0
;⊗ SAVACX SAVACS GETACS
;; ACCUMULATOR SAVE, RESTORE ROUTINES, ALSO CLOCK TURNING-ON ROUTINE
SAVACX: 0
SAVACS: ;CALL: PUSH P,[XWD 0,<ADDRESS OF 17 WORD BLOCK>]
; JRST SAVACS
; ROUTINE DOES NOT RETURN. THE ARGUMENT
; ON THE STACK IS POPPED OFF, AND THEN A POPJ
; IS PERFORMED.
MOVEM 0,@(P) ;SAVE AC0
MOVE 0,(P)
ADD 0,[XWD 1,16] ;C(0) = 1,,LOC+16
HRRZM 0,SAVACX
SUBI 0,15 ;C(0) = 1,,LOC+1
BLT 0,@SAVACX ;SAVE AC1-16
SUB P,[XWD 1,1] ;DELETE ARGUMENT FROM STACK
POPJ P, ;RETURN UPLEVEL
GETACS: ;CALL: PUSHJ P,GETACS
; XWD 1,<ADDRESS OF 17 WORD BLOCK>
; RETURN HERE ALWAYS
HRLZ 16,@(P) ;C(16) = XWD <ADDR>,0
BLT 16,15 ;RESTORE ACS 0-15
HRRZ 16,@(P)
MOVE 16,16(16) ;RESTORE AC16
JRST CPOPJ1 ;RETURN
;⊗ CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
; DISPATCH ROUTINES
; CI PREFIX MEANS CONTROL INPUT
; DI PREFIX MEANS DATA INPUT
; DO PREFIX MEANS DATA OUTPUT
CIDISP: SKIPE CIHUNG ;IS CI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST CIREEN ; YES, REENTER CI ROUTINE
EXCH P,CIP
PUSHJ P,CIROUT ; NO, START AT BEGINNING OF CI ROUTINE
EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
SETZM CIHUNG ;INDICATE THAT CI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
CIREEN: PUSHJ P,GETACS
XWD 1,CIACS
EXCH P,CIP ;RETRIEVE CI PUSHDOWN POINTER
POPJ P, ;AND RETURN WO WAITING CI ROUTINE.
CIWAIT: SETOM CIHUNG ;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
CIWAIX: EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
PUSH P,[XWD 0,CIACS]
JRST SAVACS ;SAVE CI ACCUMULATORS, RETURN TO MAIN LOOP
CIACS: BLOCK 17 ;STORAGE FOR CI ACCUMULATORS 0-16
CIP: XWD -20,CIPDL ;STORAGE FOR CI ACCUMULATOR 20 WHEN CI
CIP1: XWD -20,CIPDL
; ROUTINE IS ACTIVE, MAIN ACC 17 OTHERWISE
CIHUNG: 0 ;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL: BLOCK 20
DIDISP: SKIPE DIHUNG
JRST DIREEN
EXCH P,DIP
PUSHJ P,DIROUT
EXCH P,DIP
SETZM DIHUNG
POPJ P,
DIREEN: PUSHJ P,GETACS
XWD 1,DIACS
EXCH P,DIP
POPJ P,
DIWAIT: SETOM DIHUNG
EXCH P,DIP
PUSH P,[XWD 0,DIACS]
JRST SAVACS
DIACS: BLOCK 17
DIP: XWD -30,DIPDL
DIP1: XWD -30,DIPDL
DIHUNG: 0
DIPDL: BLOCK 30
DODISP: SKIPE DOHUNG
JRST DOREEN
EXCH P,DOP
PUSHJ P,DOROUT
EXCH P,DOP
SETZM DOHUNG
POPJ P,
DOREEN: PUSHJ P,GETACS
XWD 1,DOACS
EXCH P,DOP
POPJ P,
DOWAIT: SETOM DOHUNG
EXCH P,DOP
PUSH P,[XWD 0,DOACS]
JRST SAVACS
DOACS: BLOCK 17
DOP: XWD -30,DOPDL
DOP1: XWD -30,DOPDL
DOHUNG: 0
DOPDL: BLOCK 30
;⊗ CIROUT COMDIS BADCOM
;; CI ROUTINE - READ COMMANDS FROM CONTROL LINK, SEND ANSWERS, ETC.
CIROUT: PUSHJ P,GETCOM ;READ COMMAND FROM IMP
POPJ P, ; IT WAS A BUM COMMAND
PUSHJ P,GETIDX ;C(A) ← # OF COMMAND
PUSHJ P,@COMDIS(A)
JRST SXACTV ;4-28-73 make sure all input is read.
DEFINE X(A) <0+A↔>
COMDIS: BADCOM
NAMES
BADCOM: PUSHJ P,FLUSCS
PUSHJ P,GSRCI ;GET PERMISSION TO OUTPUT ON CONTROL CHANNEL
PUSHJ P,IMPST0
ASCIZ /500 No comprendo "/
PUSHJ P,ASCII1
C
PUSHJ P,IMPST0
ASCIZ /"
/
SOS IMPSTF ;RETURN PERMISSION
JRST FLUSCS
;Receive a file ;⊗ APPE STOR WAITIL GETSET GETSE1 GETSEL C2 STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
APPE: SKIPA B,[3] ;APPEND
STOR: MOVEI B,2 ;STORE
PUSHJ P,WAITIL ;WAIT FOR OLD FILENAME, XFERTYPE FREE
MOVEM B,STORTYP# ;SAVE FOR MESSAGE LATER
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
SKIPE DIACTV ;DATA CHANNEL ALREADY IN USE?
JRST STORX0 ; YES
MOVEI B,1
PUSHJ P,GETSET ;SET UP DITYPE, DIBS
JRST ASCERR
PUSHJ P,GFN ;GET FILE NAME
JRST STORX1 ; DIDN'T GET ONE
IFE FTIP,<
SETZM EOFMAI
>;IFE FTIP
SETOM HOLDIL ;DON'T LET ANYONE ELSE IN
MOVE B,STORTYP
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR ; FAILED
MOVEM C,DIACS+C ;PASS ON FILE NAME INFORMATION,
MOVEM D,DIACS+D ; ETC. TO THE
MOVEM E,DIACS+E ; DI ROUTINE
MOVEM F,DIACS+F
SETOM DIACTV ;STARTUP DI ROUTINE
JRST FLUSCS ;FLUSH COMMAND STRING & RETURN
WAITIL: SKIPN HOLDIL# ;WAIT FOR HOLDIL FREE
POPJ P, ; WHICH MEANS WE DON'T NEED ERRFIL ETC ANYMORE
PUSHJ P,CIWAIT
JRST WAITIL
;; GETSET SET UP TYPE AND BYTE SIZE FOR TRANSFER
;;CALL: MOVEI B,<0 FOR DO, 1 FOR DI>
;; PUSHJ P,GETSET
;; ERROR RETURN - TYPE A AND NOT BYTE 8
GETSET: MOVE A,RTYPE ;GET TYPE FROM USER
CAIN A,3 ;LOCAL PRINT
MOVEI A,0 ; IS REALLY ASCII
MOVE T,RBS ;ELSE WE GOBBLE REAL BYTE SIZE
CAIE T,=8
JUMPE A,CPOPJ ;jump if TYPE ASCII (and not 8-bit bytes!)
AOS (P)
IFN FTIP,<
CAIE A,2 ;skip if TYPE L (local byte)
JRST GETSE1 ;TYPEs A and I always have 8-bit bytes
CAIN T,=36 ;TYPE L 36 is same as Image here
MOVEI A,1 ;make it image mode, with 8-bit bytes
>;IFN FTIP
IFE FTIP,<
CAIE A,1 ;IMAGE?
JRST GETSEL ;NO, LOCAL BYTE
CAIE T,=8 ;IMAGE, MAYBE CONVERT TO EASIER LOCAL BYTE
CAIN T,=32 ; BUT NOT FOR THESE BYTE SIZES
JRST GETSEL
SKIPA A,C2 ;ANY OTHER BYTE SIZE OK FOR LOCAL TYPE
>;IFE FTIP
GETSE1: MOVEI T,=8 ;CONSTANT BYTE SIZE FOR ASCII
GETSEL: MOVEM T,DOBS(B) ;SAVE BYTE SIZE
HRRZM A,DOTYPE(B) ; AND TYPE FOR THIS TRANSFER
C2: POPJ P,2
STORX3:
STORX0: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /505 You are already STORing!
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /503 You are already STORing!
/
>;IFN FTIP
STOR1: JRST FLUSCS ;FLUSH REST OF COMMAND STRING
RETRX1:
STORX1: PUSHJ P,IMPSTR
ASCIZ /501 Pathname unparsable
/
JRST FLUSCS
ILDERR: PUSHJ P,GSRCI ;INTERPRET ILDDEV ERROR FOR LOSER
MOVE F,ERRTYP ;THIS IS THE TYPE OF ERROR
CAIGE F,3 ; UNLESS ERROR WAS FROM LOOKUP ETC
JRST ILDER1 ; IN WHICH CASE WE NEED ERROR CODE
HRRZ C,ILDD+1 ; FROM LOOKUP (ETC) BLOCK
SKIPA D,ERRNM1(C) ;THIS IS THE RESPONSE CODE IN THAT CASE
ILDER1: MOVE D,ERRNUM(F) ;RESPONSE CODE FOR NON-LOOKUP-ETC ERROR
MOVE E,[POINT 7,D]
PUSHJ P,ASCIIE ;PUT OUT CODE
PUSHJ P,STOMES ;PUT OUT TYPE OF OPERATION AND FILE
HRRZ C,ILDD+1 ;RESTORING CLOBBERED AC
MOVE E,[POINT 7,[ASCIZ / failed, /]]
PUSHJ P,ASCIIE
CAIGE F,3 ;DISPATCH ON ERROR AGAIN
SKIPA E,ERRTXT(F)
MOVE E,ERRTX1(C)
PUSHJ P,ASCIIE
MOVE E,[POINT 7,[ASCIZ /
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL ;RELEASE ILDDEV RESOURCE
JRST FLUSCS
STOMES: MOVE D,STORTYP ;FIND OUT WHAT HE WAS DOING
CAIN D,30
MOVEI D,4 ;FILL A BIG HOLE
MOVE E,TYPNAM-1(D) ;GET PTR TO OPERATION NAME
PUSHJ P,ASCIIE
JRST @TYPDSP-1(D) ;PUT OUT FILE NAME OR WHATEVER
IFE FTIP,<
ERRNUM: ASCII /453 / ;0 - OPEN FAILED
ASCII /450 / ;1 - UFD LOOKUP FAILED
ASCII /451 / ;2 - ACCESS PROHIBITED
ERRNM1: ASCII /450 / ;0 - NO SUCH FILE
ASCII /450 / ;1 - NO SUCH PPN (CAN'T HAPPEN)
ASCII /451 / ;2 - PROTECTION VIOLATION (CAN'T)
ASCII /453 / ;3 - FILE BUSY
ASCII /450 / ;4 - ALREADY EXISTS (RENAME)
ASCII /506 / ;5 - NO FILE OPEN (CAN'T)
ASCII /506 / ;6 - DIFFERENT FILENAME (R/A, CAN'T)
ASCII /506 / ;7 - CAN'T
ASCII /453 / ;10 - BAD RTVL
ASCII /453 / ;11 - BAD RTVL
ASCII /453 / ;12 - DISK FULL
>;IFE FTIP
IFN FTIP,<
ERRNUM: ASCII /450 / ;0 - OPEN FAILED
ASCII /550 / ;1 - UFD LOOKUP FAILED
ASCII /550 / ;2 - ACCESS PROHIBITED
ERRNM1: ASCII /550 / ;0 - NO SUCH FILE
ASCII /550 / ;1 - NO SUCH PPN (CAN'T HAPPEN)
ASCII /550 / ;2 - PROTECTION VIOLATION (CAN'T)
ASCII /450 / ;3 - FILE BUSY
ASCII /450 / ;4 - ALREADY EXISTS (RENAME)
ASCII /451 / ;5 - NO FILE OPEN (CAN'T)
ASCII /451 / ;6 - DIFFERENT FILENAME (R/A, CAN'T)
ASCII /451 / ;7 - CAN'T
ASCII /450 / ;10 - BAD RTVL
ASCII /450 / ;11 - BAD RTVL
ASCII /450 / ;12 - DISK FULL
>;IFN FTIP
TYPNAM: POINT 7,[ASCIZ /Retrieve of /]
POINT 7,[ASCIZ /Store of /]
POINT 7,[ASCIZ /Append to /]
POINT 7,[ASCIZ /Rename of /] ;REALLY STORTYP 30
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Mail scratch file open/]
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Delete of /]
ERRTXT: POINT 7,[ASCIZ /can't initialize local device/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
ERRTX1: POINT 7,[ASCIZ /no such file/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
POINT 7,[ASCIZ /file busy/]
POINT 7,[ASCIZ /new filename already exists/]
POINT 7,[ASCIZ /impossible system error (5)/]
POINT 7,[ASCIZ /impossible system error (6)/]
POINT 7,[ASCIZ /impossible system error (7)/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /disk is full/]
TYPDSP: ERRFN ;RETR, WHOLE FILESPEC
ERRFN ;STOR
ERRFN ;APPE
ERRFN ;RENAME
ERRPP ;STAT, FN AS PPN
CPOPJ ;MAIL
ERRFN ;USED FOR START MSG FOR LIST, NLST
ERRFN ;DELE
ERRPP: MOVE D,ERRFIL ;DO FILENAME AS PPN
ERRPP1: TLNN D,-1 ;IF MAIL, MAYBE ONLY PRG
JRST ERRPP2
MOVEI A,"["
PUSHJ P,PUTCHR
HLLZ B,D
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,PUTCHR
ERRPP2: HRLZ B,D
JUMPN B,.+2
MOVEI B,'* ' ;FOR MAIL
PUSHJ P,SIXWRT
TLNN D,-1
POPJ P,
MOVEI A,"]"
JRST PUTCHR
IFE FTIP,<
ERRMF: MOVE B,RMLF
PUSHJ P,SIXWRT
SKIPN B,RMLE
JRST ERRMF1
MOVEI A,"."
PUSHJ P,PUTCHR
PUSHJ P,SIXWRT
ERRMF1: MOVE D,RMLD
JRST ERRPP1
>;IFE FTIP
ERRFN: MOVE B,ERRDEV
PUSHJ P,SIXWRT
MOVEI A,":"
PUSHJ P,PUTCHR
MOVE B,ERRFIL
PUSHJ P,SIXWRT
SKIPN B,ERREXT
JRST ERRFN1
MOVEI A,"."
PUSHJ P,PUTCHR
PUSHJ P,SIXWRT
ERRFN1: MOVE D,ERRPPN
JRST ERRPP1
;⊗ RNFR DELE GCRNTO RENFIL RNMOK RELDMP RNTO BADTO BDTONM BADDRN ALLO NOOP
;; RNFR (RNTO), DELE ROUTINE : ZAP LOCAL FILES
RNFR: SKIPA B,[30] ;RENAME
DELE: MOVEI B,10 ;DELETE
PUSHJ P,WAITIL
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
MOVEM B,STORTYP ;SAVE WHICH
SKIPE DOACTV
JRST RETRX0
PUSHJ P,GFN ;FIRST OR ONLY FILE
JRST RETRX1
MOVEI B,21 ;20 BIT CHECKS WRITE ACCESS EVEN THO READ OP
PUSHJ P,ILDDEV ;DO THE LOOKUP
JRST ILDERR ; COULDN'T FIND
SETZB E,F
MOVE B,STORTYP ;NOW MUST EITHER DELETE OR RENAME
TRNN B,20 ;RENAME?
JRST RENFIL ;NO, DELETE
PUSHJ P,FLUSCS ;TERMINATE THAT LINE
PUSHJ P,IMPSTR ;REPORT PARTIAL SUCCESS
IFE FTIP,<
ASCIZ /200 RNFR OK, Please issue RNTO
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /350 RNFR OK, Please issue RNTO
/
>;IFN FTIP
GCRNTO: PUSHJ P,GETCOM ;NOW GET THE NEXT
JRST RELDMP ;BAD COMMAND, COULDN'T BE RNTO
PUSHJ P,GETIDX
TRNE A,777776 ;NEXT COMMAND MUST BE RNTO, WHOSE
JRST BADTO ; COMMAND INDEX IS 1 (LH JUNK)
PUSHJ P,GFN
JRST BDTONM ;BAD NAME AFTER RNTO
MOVEI B,10 ;ONE MORE TIME
RENFIL: PUSHJ P,ILDDEV ;DELETE (RENAME) THE FILE
JRST BADDRN ; COULDN'T DO THAT
JUMPN F,RNMOK
PUSHJ P,IMPSTR ;OK RESPONSE
IFE FTIP,<
ASCIZ /254 File deleted
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 File deleted
/
>;IFN FTIP
JRST RELDMP
RNMOK: PUSHJ P,IMPSTR ;OK RESPONSE
IFE FTIP,<
ASCIZ /253 File renamed
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 File renamed
/
>;IFN FTIP
RELDMP: RELEASE DIMP, ;CLOSE DOWN
JRST FLUSCS
RNTO:
BADTO: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /505 Must have RNTO after RNFR
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /503 Must have RNTO after RNFR
/
>;IFN FTIP
JRST RELDMP
BDTONM: PUSHJ P,IMPSTR
ASCIZ /501 Pathname for rename unparseable
/
JRST RELDMP
BADDRN: RELEAS DIMP,
JRST ILDERR
ALLO: PUSHJ P,IMPSTR
IFN FTIP,<
ASCIZ/202 ALLOcations are unnecessary
/
>;IFN FTIP
IFE FTIP,<
ASCIZ/206 It's ALLOver, don't shed a tear for me
/
>;IFE FTIP
JRST FLUSCS
IFN FTIP,<
NOOP: PUSHJ P,IMPSTR
ASCIZ/200 NOOP OK
/
JRST FLUSCS
>;IFN FTIP
;⊗ WRTSTR WRTST1 WRTST2 HELP NOMAIL NOUSER NOPPNM XRCOFL RCVD DAYLIT RCVD9 MAISTR MAIST2 MAIDEC MAI2DG
WRTSTR: HRLI B,(<POINT 7,0>)
WRTST1: ILDB A,B
WRTST2: JUMPE A,CPOPJ
XCT OUTINSTR
JRST WRTST1
HELP: PUSHJ P,IMPSTR
IFN FTIP,<
ASCIZ ⊗214-Welcome to rainy California!
Implemented Commands: HELP,USER,PASS,TYPE,MODE,STRU,PORT,
RETR,STOR,APPE,DELE,RNFR,RNTO,STAT,LIST,NLST,CWD,QUIT.
MODE S only; STRU F only.
TYPE A implies translation to/from the WAITS character set. Output from WAITS
in TYPE A will discard nulls, E directory pages, and SOS line numbers.
Text files should be FTP'd in TYPE A for proper character set conversion.
TYPE L byte size may be 8, 32, or 36. TYPE L 8 and TYPE L 32 use only
bits 0-31 of the 36-bit PDP-10 word.
TYPE I and TYPE L 36 are equivalent at the WAITS end.
214 Report problems to Bug-FTP @ ⊗
>;IFN FTIP
IFE FTIP,<
ASCIZ ⊗050-Welcome to sunny California!
Implemented Commands: HELP,USER,PASS,TYPE,MODE,BYTE,STRU,
SOCK,RETR,STOR,APPE,MAIL,MLFL,DELE,RNFR,RNTO,STAT,LIST,NLST,XCWD,BYE.
MODE S only, STRU F only. TYPE A or P (equivalent here) imply
byte size 8 and translation to/from WAITS character set. TYPE I or L
byte size may be 8, 32, or any factor of 36; I and L are equivalent
except for 8 and 32, in which case TYPE L uses only bits 0-31 of the
36-bit PDP-10 word.
The following three experimental commands work like MAIL but send the
message to a logged-in user's terminal instead of his mail file:
XSEN - fails (code 453) if recipient not logged in.
XSEM - does MAIL if recipient not logged in (indicated by 009 message).
XMAS - does MAIL as well as SEND even if recipient is logged in.
050 Report problems to Bug-FTP @ ⊗
>;IFE FTIP
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPCR ;output crlf
JRST FLUSCS
IFE FTIP,<
NOMAIL: MOVE T1,MLDEST
TLNE T1,-1
JRST NOPPNM
NOUSER: PUSHJ P,IMPSTR
ASCIZ /450 Unrecognized MAIL recipient.
/
IFN %XRCP,<
SKIPN XRFBBP ; If not doing XRCP right now,
SETZM XRFOBP ; we must have lost doing MAIL.
SETZM XRFBBP ; No longer copying name.
>;%XRCP
JRST FLUSCS
NOPPNM: PUSHJ P,IMPSTR
ASCIZ /450 Cannot mail to PPNs--use programmer name.
/
IFN %XRCP,<
SKIPN XRFBBP ; If not doing XRCP right now,
SETZM XRFOBP ; we must have lost doing MAIL.
SETZM XRFBBP ; No longer copying name.
>;%XRCP
JRST FLUSCS
IFN %XRCP,<
XRCOFL: PUSHJ P,IMPSTR
ASCIZ /440 Recipient table full, this name not stored.
/
SETZM XRFBBP ; No longer copying name.
JRST FLUSCS
>;%XRCP
;insert line saying when Received and from where, e.g.:
;Received: from CMU-CS-C by SU-AI with NCP/FTP; 20 Jan 83 11:42:41 PST
;preserves all ACs but A.
RCVD: PUSH P,C
PUSH P,B
MOVEI C,[ASCIZ/Received: from /]
PUSHJ P,MAISTR
MOVEI C,HSTSTR ;ptr to host name
PUSHJ P,MAISTR ;print foreign host's name (our version)
MOVEI C,[ASCIZ/ by /]
PUSHJ P,MAISTR
MOVE C,WAITST ;get waits site number
MOVE C,WATHST(C) ;get ptr to host name string
PUSHJ P,MAISTR ;print our host name
MOVEI C,[ASCIZ $ with NCP/FTP; $]
PUSHJ P,MAISTR
ACCTIM A, ;get current date,,time in secs
PUSH P,A ;save time
HLRZ A,A ;date
IDIVI A,=31 ;day of month-1 to B
PUSH P,A
MOVEI A,1(B) ;day of month
PUSHJ P,MAIDEC ;print day of month
MOVEI A," "
PUSHJ P,SWRTCH
POP P,A
IDIVI A,=12 ;month-1 to B, year-=64 to A
PUSH P,A
MOVE B,@MONTAB(B) ;name of month
AND B,[BYTE (7)177,177,177] ;shorten name of month to three chars
MOVEI C,B
PUSHJ P,MAISTR ;print month name
MOVEI A," "
PUSHJ P,SWRTCH
POP P,A
ADDI A,=64
PUSHJ P,MAIDEC ;print year in two digits
MOVEI C,[ASCIZ/ /]
PUSHJ P,MAISTR
POP P,A ;time in secs
MOVEI A,(A) ;flush date from LH
IDIVI A,=60*=60 ;hours to A, secs to B
PUSH P,B
PUSHJ P,MAI2DG ;print hours as 2 digits
MOVEI A,":"
PUSHJ P,SWRTCH
POP P,A
IDIVI A,=60 ;mins to A, secs to B
PUSH P,B
PUSHJ P,MAI2DG ;print mins as 2 digits
MOVEI A,":"
PUSHJ P,SWRTCH
POP P,A
PUSHJ P,MAI2DG ;print secs as 2 digits
DAYLIT←←261 ;LOWCORE POINTER TO NONZERO IF DAYLIGHT SAVINGS TIME
MOVEI B,DAYLIT ;FIND OUT IF DAYLIGHT SAVINGS
PEEK B, ;get ptr to cell
PEEK B, ;get flag from cell
MOVEI C,[ASCIZ/ PDT/]
SKIPN B ;skip if daylight savings
MOVEI C,[ASCIZ/ PST/]
PUSHJ P,MAISTR ;print time zone
IFN FTTOS,<
SKIPN TOSTR ;destination seen yet?
JRST RCVD9 ;no, can't show it
MOVEI C,[ASCIZ/; for: /]
PUSHJ P,MAISTR
MOVEI C,TOSTR ;copy to-string (destination) into line
PUSHJ P,MAISTR
RCVD9:
>;IFN FTTOS
MOVEI C,[ASCIZ/
/]
PUSHJ P,MAISTR ;end line with crlf
POP P,B
POP P,C
POPJ P,
MAISTR: HRLI C,440700 ;make byte ptr
MAIST2: ILDB A,C
JUMPE A,CPOPJ
PUSHJ P,SWRTCH ;String to .FTP file
JRST MAIST2
MAIDEC: IDIVI A,=10 ;output decimal number to .FTP file
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,MAIDEC
HLRZ A,(P)
ADDI A,"0"
JRST SWRTCH
MAI2DG: CAIL A,=10
JRST MAIDEC ;number already has two (or more) digits
PUSH P,A
MOVEI A,"0"
PUSHJ P,SWRTCH ;print leading zero
POP P,A
ADDI A,"0"
JRST SWRTCH ;print second digit
>;IFE FTIP
;⊗ SEND LOGGED LOGGE1 LOGTST JBLP JBNXT SENDER JUSTEL MSPG MSNFR MSNSJ SENTTY DPBSTR DPBNAM MSBUFR
IFE FTIP,<
;This code is not used!! Except LOGGED and LOGTST.
repeat 0,<
SEND: PUSHJ P,LOGTST
PUSHJ P,SENDER
POPJ P,
>;repeat 0
LOGGED: PUSH P,C
PUSH P,D
PUSH P,F
PUSHJ P,LOGTST
JRST LOGGE1
POP P,F
POP P,D
POP P,C
POPJ P,
LOGGE1: POP P,(P)
POP P,F
POP P,D
POP P,C
JRST CPOPJ1
LOGTST: MOVSI A,377777 ;NOTIFY MAIL RECIPIENT IF LOGGED IN
SKIPE MLDEST ;FORGET THIS IF MAIL TO :FILE
SETPR2 A,
JRST CPOPJ1
MOVE T,400222 ;MAX JOB NUMBER
JBLP: MOVE C,400210 ;JBTSTS
ADDI C,400000(T)
MOVE C,(C)
TLNN C,40000
JRST JBNXT ;NO SUCH JOB
MOVE A,400236 ;JBTLIN
ADDI A,400000(T)
MOVE A,(A)
MOVE D,A
AOJE D,JBNXT ;DETACHED
TLNE A,4000 ;PTY BIT
TLNE A,1000 ;ARPA BIT
JRST .+2
JRST JBNXT
MOVEI B,(A)
MOVE F,400211 ;PRJPRG
ADDI F,400000(T)
MOVE F,(F) ;GET JOB'S PPN
MOVE D,MLDEST
TRNE D,-1
TLZA D,-1
HLLZS F
TLNN D,-1 ;MASK OUT WILD FIELD
HRRZS F
CAME F,D
JRST JBNXT
XCT @(P)
JBNXT: SOJG T,JBLP ;LOOK FOR MORE DESTS
JRST CPOPJ1
repeat 0,<
SENDER: TRNN FLG,16 ;SENDING?
JRST JUSTEL ;NO, JUST TELL HIM ABOUT THE MAIL
MOVEI C,[ASCIZ /;; Network message:
/]
MOVEI D,B
TTYMES D,
JFCL
MOVE C,JOBFF ;YES, HERE IS THE MESSAGE
JRST SENTTY
JUSTEL: MOVE A,[POINT 7,MSBUFR] ;B HAS DEST DEVICE
MOVEI C,[ASCIZ /;; →→→ Network mail for /]
PUSHJ P,DPBSTR ;BUILD UP MESSAGE
HLLZ C,MLDEST
JUMPE C,MSPG
PUSHJ P,DPBNAM
MOVEI C,","
IDPB C,A
MSPG: HRLZ C,MLDEST
JUMPN C,.+2
HRLZI C,'* '
PUSHJ P,DPBNAM
TLNN FLG,MFRDUN ;IF "FROM" LINE FOUND,
JRST MSNFR ; WE WILL INCLUDE IT HERE
MOVEI C,[ASCIZ / from /]
PUSHJ P,DPBSTR
MOVEI C,MFRBUF
PUSHJ P,DPBSTR
MSNFR:
IFN FTMSJ,<
TLNN FLG,MSJDUN ;IF "SUBJECT" LINE FOUND,
JRST MSNSJ ; WE WILL INCLUDE IT HERE
MOVEI C,11
IDPB C,A
MOVEI C,MSJBUF
PUSHJ P,DPBSTR
>;IFN FTMSJ
MSNSJ: MOVEI C,[ASCIZ / ←←←
/]
PUSHJ P,DPBSTR
MOVEI C,0
IDPB C,A ;MAKE IT ASCIZ
MOVEI C,MSBUFR
SENTTY: MOVEI D,B
TTYMES D, ;SEND IT
JFCL
BEEP B,
POPJ P,
DPBSTR: HRLI C,440700 ;DEPOSIT ASCIZ C IN BPT A
ILDB E,C
JUMPE E,CPOPJ
IDPB E,A
JRST .-3
DPBNAM: JUMPE C,CPOPJ
TLNE C,770000
JRST .+3
LSH C,6
JRST .-3
MOVE D,[POINT 6,C]
ILDB E,D
JUMPE E,CPOPJ
ADDI E,40
IDPB E,A
JRST .-4
MSBUFR: BLOCK 20
>;repeat 0
>;IFE FTIP
;⊗ VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
IFN FTIP,< ;restore MFD reading routine to pre-VALDAT form, fixing [*,*] bugs.
GETMFD: MOVEM C,MOPEN+1
OPEN .MFD,MOPEN ;CHECK DEST LIST AGAINST MFD
POPJ P,
PUSH P,JOBFF
MOVEI T1,MFDIBF
MOVEM T1,JOBFF
INBUF .MFD,2
POP P,JOBFF
MOVE T1,MFDNAM
MOVEM T1,MFDNAM+3
LOOKUP .MFD,MFDNAM
POPJ P,
JRST POPJ1
MFDIN: SOSG MBUF+2 ;READ A WORD FROM MFD
IN .MFD,
JRST MFDIN1
STATO .MFD,20000
JRST NOMFD
POPJ P,
MFDIN1: ILDB T1,MBUF+1
JRST POPJ1
MOPEN: 10
SIXBIT /DSK/
XWD 0,MBUF
MBUF: BLOCK 3
MFDNAM: SIXBIT / 1 1/
SIXBIT /UFD/
0
SIXBIT / 1 1/
NOMFD: REPMES (451 System error, can't read master file directory.)
>;IFN FTIP
IFE FTIP,<
COMMENT ⊗
Modified 8/2/80 by BH, to use VALDAT[RMD,SYS] instead of mfd
for validation. VALDAT's first record is an index into the rest of
the file for USETIing for extra speed; the rest is sorted PRGs from
the mfd. Don't believe any MFDxxx labels, it's really reading VALDAT. ⊗
VALID: SKIPN T1,MLDEST ;ALWAYS OK TO :FILE
JRST VALFIL ; IF THE PPN EXISTS. BH 8/17/80
SKIPE FWDING ;ALWAYS OK IF FORWARDING
JRST VWINS
TLNE T1,-1 ;Cannot mail to prj,prg now
JRST VLDONE ;Nor to prj,*
MOVE T1,[POINT 6,MLDEST,17]
VALCL1: MOVE T2,T1
ILDB T3,T1
JUMPE T3,VALCL1
MOVEM T2,FBPINI
MOVE T2,[PUSHJ P,VSXCHR]
MOVEM T2,FBPXCT
PUSHJ P,TRYFOR
JRST VWINS ;FORWARDING WINS
MOVSI C,'DSK'
PUSHJ P,GETMFD
JRST NOMFD
MFDLP: PUSHJ P,MFDIN ;GET UFD NAME
JRST VTRYFT ;EOF
COMMENT ⊗
MOVE T2,T1
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
MFDLP1: PUSHJ P,MFDIN
JRST VTRYFT
SOSLE DIRFLC
JRST MFDLP1
JUMPE T2,MFDLP ;IGNORE ZERO PPN
MOVE T1,MLDEST
; TLNN T1,-1
HRRZS T2
; TRNN T1,-1
; HLLZS T2
CAME T1,T2
⊗
CAME T1,MLDEST
JRST MFDLP
VWINS: AOS (P)
VLDONE: RELEAS .MFD,
POPJ P,
GETMFD: MOVEM C,MOPEN+1
OPEN .MFD,MOPEN ;CHECK DEST LIST AGAINST MFD
POPJ P,
PUSH P,JOBFF
MOVEI T1,MFDIBF
MOVEM T1,JOBFF
INBUF .MFD,2
POP P,JOBFF
;;; MOVE T1,MFDNAM
MOVE T1,['MAISYS']
MOVEM T1,MFDNAM+3
LOOKUP .MFD,MFDNAM
POPJ P,
INPUT .MFD, ;READ VALDAT INDEX
MOVE T1,MLDEST ;THING TO CHECK IN INDEX
TRNN T1,777700 ;SINGLE-CHAR?
JRST GTM1CH ;YES, START AT BEGINNING OF DATA
MOVEI T2,=27 ;BEGINNING OF 3-CHAR STUFF IN INDEX
TRNN T1,770000 ;TWO-CHAR?
TDZA T2,T2 ;YES, START AT BEGINNING OF INDEX
LSH T1,-6 ;NO, FIRST CHAR IS OVER HERE
LSH T1,-6 ;RIGHT ADJUST FIRST CHAR
SUBI T1,'A'
JUMPGE T1,.+2
MOVNI T1,1 ;ANYTHING BELOW A IS -1
ADDI T2,1(T1) ;FINAL INDEX POSITION
MOVE T1,MBUF+1
IBP T1 ;I FORGET WHAT THE BPT LOOKS LIKE INITIALLY
ADDI T2,(T1) ;THIS IS POINTER TO INDEX WORD IN CORE
USETI .MFD,@(T2)
GTM1CH: SETZM MBUF+2
JRST POPJ1
MFDIN: SOSG MBUF+2 ;READ A WORD FROM MFD
IN .MFD,
JRST MFDIN1
STATO .MFD,20000
JRST NOMFD
POPJ P,
MFDIN1: ILDB T1,MBUF+1
JRST POPJ1
VTRYFT: MOVE T1,MLDEST
TLNE T1,-1 ;IF DEST ISN'T JUST PRG,
JRST VLDONE ;WE'VE HAD IT
JRST TRYFAC ;BUT IF SO GIVE FACT.TXT A CHANCE
MOPEN: 10
SIXBIT /DSK/
XWD 0,MBUF
MBUF: BLOCK 3
COMMENT ⊗
MFDNAM: SIXBIT / 1 1/
SIXBIT /UFD/
0
SIXBIT / 1 1/
⊗
MFDNAM: 'VALDAT'
0
0
SIXBIT /MAISYS/
NOMFD: REPMES (453 System error, can't read master file directory.)
VSXCHR: MOVEI A,0
TLNN F,770000
POPJ P,
ILDB A,F
ADDI A,40
POPJ P,
VALFIL: JUMPE D,CPOPJ ;MAIL TO FILE, MUST BE A PPN
MOVEM D,VALFPP ;SAVE FOR LOOKUP
MOVE T1,[' 1 1'] ;PUT MFD PPN IN LOOKUP BLOCK
MOVEM T1,VALFPP+3
INIT .MFD,17
'DSK '
0
POPJ P, ;GOTTA BE A DISK
LOOKUP .MFD,VALFPP ;LOOK FOR THE UFD
JRST VLDONE ;NO, CAN'T MAIL TO FILE IN IT
JRST VWINS ;YES, OK
VALFPP: 0
'UFD '
0
' 1 1'
>;IFE FTIP
;⊗ MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
IFE FTIP,<
MFRINI: TLNE FLG,MFRDUN ;INIT FINDING "FROM" LINE IN HEADER
POPJ P, ;NOTHING TO DO IF FOUND ALREADY
TLZ FLG,MFRWIN+MFRLUZ
MOVE MBP,[POINT 7,[ASCIZ /FROM: /]]
CAIN A," " ;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
POPJ P, ; WHERE "CATCH" MEANS IGNORE
MFRCHR: TLNE FLG,MFRLUZ!MFRDUN ;HERE FOR EACH CHAR
POPJ P, ;IF LOSING, LOSE
TLNE FLG,MFRWIN ;IF WINNING,
JRST MFRING ; WIN
ILDB MCH,MBP ;NOT SURE YET. GET A TRIAL CHAR
JUMPE MCH,MFRSTR ;IF NO MORE TO TEST, START WINNING
CAILE A,140 ;STRANGE UC/LC CONVERSION
ADDI MCH,40 ; NAMELY MAKE THE MASK AGREE
CAIE A,(MCH) ;TEST FOR EQUAL
TLO FLG,MFRLUZ ;NOPE, LOSING
POPJ P,
MFRSTR: TLO FLG,MFRWIN ;THIS IS THE FROM LINE
MOVE MBP,[POINT 7,MFRBUF]
MFRING: CAIE A,12 ;WINNING LINE:
CAIN A,15 ;IS IT OVER?
JRST MFROVR ;YUP
CAIN A,42 ;DOUBLE QUOTE?
JRST MFRQTE ;YES, CHANGE TO TWO SINGLE QUOTES!
IDPB A,MBP ;SAVE WINNING CHAR
POPJ P,
MFRQTE: MOVEI MCH,47 ;RIGHT SINGLE QUOTE
IDPB MCH,MBP ;Two of them to simulate double quote
IDPB MCH,MBP
POPJ P,
MFROVR: MOVEI MCH,0 ;FROM FINISHED
IDPB MCH,MBP ;MARK END OF FROM LINE
TLZ FLG,MFRWIN+MFRLUZ ;NOT IN PROGRESS ANYMORE
TLO FLG,MFRDUN ;DON'T LOOK AGAIN
POPJ P,
>;IFE FTIP
;⊗ MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
IFE FTIP,<
IFN FTMSJ,<
MSJINI: TLNE FLG,MSJDUN ;INIT FINDING "SUBJECT" LINE IN HEADER
POPJ P, ;NOTHING TO DO IF FOUND ALREADY
TLZ FLG,MSJWIN+MSJLUZ
MOVE MSJ,[POINT 7,[ASCIZ /SUBJECT: /]]
CAIN A," " ;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
POPJ P, ; WHERE "CATCH" MEANS IGNORE
MSJCHR: TLNE FLG,MSJLUZ!MSJDUN ;HERE FOR EACH CHAR
POPJ P, ;IF LOSING, LOSE
TLNE FLG,MSJWIN ;IF WINNING,
JRST MSJING ; WIN
ILDB MCH,MSJ ;NOT SURE YET. GET A TRIAL CHAR
JUMPE MCH,MSJSTR ;IF NO MORE TO TEST, START WINNING
CAILE A,140 ;STRANGE UC/LC CONVERSION
ADDI MCH,40 ; NAMELY MAKE THE MASK AGREE
CAIE A,(MCH) ;TEST FOR EQUAL
TLO FLG,MSJLUZ ;NOPE, LOSING
POPJ P,
MSJSTR: TLO FLG,MSJWIN ;THIS IS THE SUBJECT LINE
MOVE MSJ,[POINT 7,MSJBUF]
MSJING: CAIE A,12 ;WINNING LINE:
CAIN A,15 ;IS IT OVER?
JRST MSJOVR ;YUP
CAIN A,42 ;DOUBLE QUOTE?
JRST MSJQTE ;YES, CHANGE TO TWO SINGLE QUOTES!
IDPB A,MSJ ;SAVE WINNING CHAR
POPJ P,
MSJQTE: MOVEI MCH,47 ;RIGHT SINGLE QUOTE
IDPB MCH,MSJ ;Two of them to simulate double quote
IDPB MCH,MSJ
POPJ P,
MSJOVR: MOVEI MCH,0 ;SUBJECT FINISHED
IDPB MCH,MSJ ;MARK END OF SUBJECT
TLZ FLG,MSJWIN+MSJLUZ ;NOT IN PROGRESS ANYMORE
TLO FLG,MSJDUN ;DON'T LOOK AGAIN
POPJ P,
>;IFN FTMSJ
>;IFE FTIP
;⊗ NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STAPRO LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
;; STAT, FLST -- Send directory status LIST, NLST, STATDO
NLST:
LIST: SKIPE DOACTV ;THIS CHECK MUST BE THE FIRST THING
JRST RETRX0
TLO FLG,LISTFL ;SET FLAG
JRST STAT1
STAT: SKIPE DOACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST RETRX0
TLZ FLG,LISTFL ;CLEAR LIST FLAG
STAT1:
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
PUSHJ P,GPPFIL ;GET A FILE OR PPN
JRST STORX1
JUMPN D,STAT2 ;IF NO NAME, USE CURRENT
MOVE D,ALIPPN
STAT2: MOVEM D,STAPPN# ;SAVE PPN FOR HEADER
MOVEM D,STAPP1# ;SAVE AGAIN FOR WILD PPN HACK
MOVEM C,STADEV#
JUMPN F,.+2
MOVSI F,'* ' ;GFN SOMETIMES ZEROS IT WRONGLY
MOVEM F,STANAM# ;STAT TAKES FN AND EXT TOO
MOVEM E,STAEXT#
PUSHJ P,FLUSCS ;FLUSH USER ID LINE
MOVEI A,2 ;SET LOCAL BYTE TYPE
MOVEM A,DOTYPE
MOVEI A,=36 ;AND 36-BIT BYTES
MOVEM A,DOBS
TLNE FLG,LISTFL ;IF LIST,
JRST [SETOM DOACTV↔POPJ P,] ; WE DO THE REST IN DO MODE
REJOIN: MOVEI F,(D) ;SEPARATE PRJ AND PRG
HLRZ E,D
CAIE F,'*'
CAIN E,'*'
JRST STWILD ;WILD PPN
PUSHJ P,DOSTAT ;NOT WILD PPN, ONLY DO ONCE
STDONE: TLNE FLG,LISTFL
JRST LIDONE ;LIST IS DIFFERENT
PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /200 That's all, folks!
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 That's all, folks!
/
>;IFN FTIP
RELEASE FOMP,
POPJ P,
LIDONE: PUSHJ P,DOMPSTR
IFE FTIP,<
ASCIZ /252 LIST completed successfully
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 LIST completed successfully
/
>;IFN FTIP
JRST DOEOF1
STWILD: MOVE C,STADEV
PUSHJ P,GETMFD ;WILD PPN, READ THE MFD
JRST NOMFD
STWLP: PUSHJ P,MFDIN
JRST STDONE
MOVE T2,T1 ;SAVE ENTRY
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
STWLP1: PUSHJ P,MFDIN
JRST STDONE
SOSLE DIRFLC
JRST STWLP1
JUMPE T2,STWLP ;SKIP EMPTY SLOTS
HLRZ T1,T2 ;SEPARATE PRJ AND PRG IN MFD ENTRY
HLRZ T3,STAPP1
CAIE T3,(T1) ;COMPARE PRJ
CAIN T3,'*'
JRST .+2
JRST STWLP ;NOPE
HRRZ T3,STAPP1
CAIE T3,(T2) ;COMPARE PRG
CAIN T3,'*'
JRST .+2
JRST STWLP
MOVEM T2,STAPPN ;WIN, SAVE FOR DOSTAT
PUSHJ P,DOSTAT ;HIT ME
JRST STWLP
DOSTAT: MOVE F,STAPPN
MOVE C,STADEV
MOVSI E,'UFD'
MOVE D,['1 1']
PUSHJ P,WAITIL
MOVEI B,5 ;CODE FOR UFD READ
MOVEM B,STORTYPE
PUSHJ P,ILDDEV ;OPEN FILE FOR OUTPUT
JRST STAPRO ;UFD PROTECTION FAILURE
MOVEI C,20
STATLP: TLNN FLG,LISTFL
JRST STALP1 ;STAT AND LIST HAVE DIFFERENT WAIT TESTS
SOJG C,STALP2
PUSHJ P,SXACTV ;I HATE THIS PROGRAM!
PUSHJ P,DOWAIT
MOVEI C,20
JRST STALP2
STALP1: SKIPGE SYNCH
PUSHJ P,CIWAIX ;GIVE ABORT A CHANCE
STALP2: PUSHJ P,GETFIL ;C(A) ← BYTE OF DATA FROM FILE
JRST STATERR
JRST STATEOF
JUMPE A,NXTFIL ;SKIP ALL IF FILE NO EXIST
MOVEM A,STAFL1#
PUSHJ P,GETFIL ;EXTENSION
JRST STATERR ;NEITHER WILL HAPPEN (READS EVEN # OF FILES)
JRST STATEOF
HLLZS A
MOVEM A,STAEX1#
MOVE B,STAEXT
CAME B,A
CAMN B,['* ']
JRST .+2 ;EXT MATCHES OR WILD
JRST NXTFL2
MOVE A,STAFL1
MOVE B,STANAM
CAME B,A
CAMN B,['* ']
JRST .+2
JRST NXTFL2
TLNE FLG,LISTFL
JRST LISTIT ;DIFFERENT OUTPUT ROUTINE FOR LIST CMD
SKIPN STAPPN ;HAVE WE TOLD HIM THE PPN YET?
JRST STAPOK ;YES
PUSHJ P,IMPSTR ;PRINT WHOSE
IFE FTIP,<
ASCIZ /151 [/
>;IFE FTIP
IFN FTIP,<
ASCIZ /213-[/
>;IFN FTIP
HLLZ B,STAPPN
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,ASCIIC
HRLZ B,STAPPN
PUSHJ P,SIXWRT
PUSHJ P,IMPSTR
ASCIZ /]
/
SETZM STAPPN ;FLAG NOT TO DO IT AGAIN
STAPOK: MOVE B,STAFL1
PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /151 /
>;IFE FTIP
IFN FTIP,<
ASCIZ /213 /
>;IFN FTIP
PUSHJ P,SIXWRT ;FILE
HLLZ B,STAEX1 ; . EXT?
JUMPE B,NXTFL1
MOVEI A,"." ; . EXT
PUSHJ P,ASCIIC
PUSHJ P,SIXWRT
NXTFL1: PUSHJ P,IMPCR
NXTFL2: SKIPA A,[UFDN-2] ;SKIP UFDN-2 WORDS
NXTFIL: MOVEI A,UFDN-1 ;SKIP UFDN-1 WORDS
ADDM A,FOBUF+1 ;OK TO DO, SINCE INCREMENTAL # OF
MOVNS A ; UFD ENTRIES PER RECORD
ADDM A,FOBUF+2
JRST STATLP
STATEOF:POPJ P, ;return from DOSTAT
STATERR:
POP P,(P) ;flush return from DOSTAT
TLNE FLG,LISTFL ;GOTTA DO THE RIGHT MPSTR
JRST DOERR
PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /453 STAT incomplete, local file system error
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /451 STAT incomplete, local file system error
/
>;IFN FTIP
RELEAS FOMP,
POPJ P,
STAPRO: MOVE A,STAPP1 ;PROTECTION FAILURE:
TLNN FLG,LISTFL
CAME A,STAPPN ;IF WILD PPN,
POPJ P, ; IGNORE IT
JRST ILDERR ;ELSE TELL HIM
LISTIT: MOVE B,STAFL1 ;PUT OUT A FILESPEC ON DATA LINK
PUSHJ P,PUT6
SKIPN B,STAEX1
JRST LISTI1
MOVEI A,"."
PUSHJ P,PUT1
PUSHJ P,PUT6
LISTI1:
REPEAT 0,< ; TENEX DOES NOT INCLUDE THE DIRECTORY NAME,
; AND THIS FUCKS TOPS-20 UP THE ASS!
MOVEI A,"["
PUSHJ P,PUT1
HLLZ B,STAPPN
PUSHJ P,PUT6
MOVEI A,","
PUSHJ P,PUT1
HRLZ B,STAPPN
PUSHJ P,PUT6
MOVEI A,"]"
PUSHJ P,PUT1
>;END REPEAT 0
MOVEI A,15
PUSHJ P,PUT1
MOVEI A,12
PUSHJ P,PUT1
JRST NXTFL2
PUT1: SOSG DOBUF+2
PUSHJ P,DOROU3
IDPB A,DOBUF+1
POPJ P,
PUT6: MOVE D,[POINT 6,B]
PUT61: ILDB A,D
JUMPE A,PUT62
ADDI A,40
PUSHJ P,PUT1
PUT62: TLNN D,770000
POPJ P,
JRST PUT61
begin sixwrt
GLOBAL A,C
↑sixwrt:movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,PUTCHR ;WAS ASCIIC, FUCK IT
wrsoj: sojg c,wrlp
popj p,
bend sixwrt
STATDO: PUSH P,DOTYPE ;HERE FROM DO ROUTINE TO START XFER
PUSH P,DOBS ;IDCON AND ILDDEV USE DIFFERENT VALUES
SETZM DOTYPE ;BECAUSE WE READ UFD IN IMAGE MODE
MOVEI A,10 ;BUT SEND NVT ASCII OVER DATA LINK
MOVEM A,DOBS
MOVEI B,0 ;RETR FLAG
PUSHJ P,IDCON ;SET UP NET LINK
JRST DOERRC ;failed
POP P,DOBS ;WE CONTROL THE NET OUTPUT OURSELF
POP P,DOTYPE ; SO WE CAN LEAVE THESE IN ILDDEV MODE
PUSHJ P,WAITIL ;THIS IS A CROCK
MOVEI B,7 ;WILL CHANGE TO 5 LATER. FOR STOMES.
MOVEM B,STORTYP
MOVE A,STADEV
MOVEM A,ERRDEV
MOVE A,STANAM ;SET UP VARS AS IF FROM ILDDEV
MOVEM A,ERRFIL
MOVE A,STAEXT
HLLZM A,ERREXT
MOVE A,STAPPN
MOVEM A,ERRPPN
SETOM HOLDIL ;PROTECT OURSELF
MOVEI A,DOMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
PUSHJ P,ASCII1
IFE FTIP,<
[ASCII /250 /]
>;IFE FTIP
IFN FTIP,<
[ASCII /125 /]
>;IFN FTIP
PUSHJ P,STOMES ;SEND OPERATION NAME AND FILESPEC
MOVE E,[POINT 7,[ASCIZ / started correctly.
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
MOVE D,STAPPN
JRST REJOIN
;Send a file ;⊗ RETR RETRX0 ASCERR
RETR: SKIPE DOACTV
JRST RETRX0
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
TLZ FLG,LISTFL ;NOT LIST COMMAND
MOVEI B,0 ;DO FLAG
PUSHJ P,GETSET ;SET UP TYPE, BYTE SIZE
JRST ASCERR ;ERROR RETURN, TYPE A NOT BYTE 8
PUSHJ P,GFN ;GET FILE NAME
JRST RETRX1 ; DIDN'T GET ONE
PUSHJ P,WAITIL
MOVEI B,1
MOVEM B,STORTYP ;"STOR"TYP IS NOW REALLY ILD-TYPE
SETOM HOLDIL
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR
MOVEM F,DOACS+F ;WHAT??????????????????????????
SETOM DOACTV
JRST FLUSCS
RETRX0: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /505 You are already RETRing
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /503 You are already RETRing
/
>;IFN FTIP
JRST FLUSCS
ASCERR: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /457 TYPE A must be BYTE 8
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /503 TYPE A must be BYTE 8
/
>;IFN FTIP
JRST FLUSCS
;⊗ WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEL BYTE9 MODE MODEUN MODEOK STRU XRSQ
;; TYPE, MODE, STRU ROUTINES
WHICHA: ;CALL: MOVEI A,<ASCII CHARACTER>
; MOVE B,[POINT 7,[ASCIZ /<LIST OF ASCII CHARACTERS>/]
; PUSHJ P,WHICHA
; RETURN HERE, B,C,D CLOBBERED, A=0,1,2 DEPENDING ON POSITION
; IN LIST WHICH MATCHED ORIGINAL C(A), OR A=-1 IF NONE.
MOVE C,A
SETZ A,
WHICHB: ILDB D,B
JUMPE D,[SETO A, ↔ POPJ P,]
CAMN D,C
POPJ P,
AOJA A,WHICHB
TYPE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /AILPE/]]
PUSHJ P,WHICHA
JUMPL A,[REPMES (501 Unrecognized type)]
JRST .+1(A)
JRST TYPEOK ;TYPE A (0)
JRST TYPEOK ;TYPE I (1)
JRST TYPEL ;TYPE L (2), read byte size that follows
JRST TYPEUN ;TYPE P (3) (not used in TCP/FTP)
JRST TYPEUN ;TYPE E (4)
TYPEUN: REPMES (504 Unimplemented type)
TYPEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (503 Can't change TYPE while data transfer in progress)]
MOVEM A,RTYPE ;SAVE REAL TYPE AS RECEIVED
CAIE A,2 ;TYPE L?
MOVEI B,8 ;no, implicit byte size of 8
MOVEM B,RBS ;SAVE "REAL" BYTE SIZE
REPMES (200 Type OK)
TYPEL: PUSHJ P,GETCHR ;get char after type identifier, should be space
CAIE A," "
JRST [REPMES (501 Bad syntax in TYPE L command)]
PUSHJ P,DECIN ;read decimal byte size into B
CAIA ;CR seen
JRST [REPMES (501 Bad byte size in TYPE L command)]
MOVEI A,2 ;select TYPE L
CAIE B,=8
CAIN B,=32
JRST TYPEOK ;these byte sizes ok
CAIE B,=36 ;so is this one
JRST [REPMES (<504 TYPE L byte size must be 8, 32 or 36>)]
JRST TYPEOK
IFE FTIP,<
BYTE9: MOVEI C,=36
IDIV C,B ;IS 36 MOD (BYTESIZE) = ZERO?
JUMPE D,CPOPJ1 ; YES
POPJ P, ; NO
>;IFE FTIP
MODE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /SBTH/]]
PUSHJ P,WHICHA
IFE FTIP,<
JUMPL A,[REPMES (503 Unrecognized mode)]
>;IFE FTIP
IFN FTIP,<
JUMPL A,[REPMES (501 Unrecognized mode)]
>;IFN FTIP
JRST .+1(A)
JRST MODEOK
JRST MODEUN
JRST MODEUN
JRST MODEUN
MODEUN:
IFE FTIP,<
REPMES (506 Unimplemented mode)
>;IFE FTIP
IFN FTIP,<
REPMES (504 Unimplemented mode)
>;IFN FTIP
MODEOK: SKIPN DIACTV
SKIPE DOACTV
IFE FTIP,<
JRST [REPMES (504 Both data channels busy)]
>;IFE FTIP
IFN FTIP,<
JRST [REPMES (503 Can't change MODE while data transfer in progress)]
>;IFN FTIP
REPMES (200 Mode OK)
STRU: PUSHJ P,GETCAP
CAIN A,"F"
JRST [REPMES (200 File structure OK)]
IFE FTIP,<
CAIN A,"R"
JRST [REPMES (506 Record structure not implemented)]
REPMES (503 Unrecognized structure)
>;IFE FTIP
IFN FTIP,<
CAIN A,"R"
JRST [REPMES (504 Record structure not implemented)]
REPMES (501 Unrecognized structure)
>;IFN FTIP
IFN %XRCP,<
XRSQ: PUSHJ P,XRSRST ; Always reset state of XRCP.
SETZM XRFOBP ; Reset R-first too.
PUSHJ P,GETCAP
CAIN A,"?"
JRST [REPMES (215 R Recipients first please.)]
CAIN A,"R"
JRST [MOVEM A,XRSQSW ; positive value selects R
REPMES (<200 Okay, R scheme.>)]
CAIN A,"T"
JRST [SETOM XRSQSW ; Select T scheme!!
REPMES (200 Win!)]
SETZM XRSQSW ; Don't grok, reset to default.
REPMES (501 Don't know that scheme.)
>;IFN %XRCP
;⊗ PORT PORT2 PORT3 DECIN DECIN0 DECIN DECIN0 SOCK
IFN FTIP,<
;FTP command to change the default host and port numbers for data connection.
;Format of command is PORT h1,h2,h3,h4,p1,p2 where h1 is high decimal byte of
;host number.
PORT: SETZB D,E ;collect host and port numbers in D and E, resp.
MOVE C,[POINT 8,D,3] ;set up byte ptr to collect 32-bit IP host nbr
PORT2: PUSHJ P,DECIN ;read one decimal field
JFCL ;CR seen before we even got to port nbr is error
JRST [REPMES (501 Bad PORT argument)]
IDPB B,C ;save byte of host number
TLNE C,770000 ;end of host number word?
JRST PORT2 ;no, read more
MOVE C,[POINT 8,E,19] ;set up byte ptr to collect 16-bit port nbr
PORT3: PUSHJ P,DECIN ;read one decimal field
CAMN C,[POINT 8,E,19] ;CR seen, better not be after first arg
JRST [REPMES (501 Bad PORT argument)]
IDPB B,C ;save byte of port nbr
TLNE C,770000 ;end of port number word?
JRST PORT3 ;no, read more
CAIE A,15 ;CR was the terminating char?
JRST [REPMES (<501 Extraneous text after PORT arguments>)]
MOVEM D,FDHOST ;store host number for future data connections
MOVEM E,FDRS ;store port number for each direction of
MOVEM E,FDSS ; future data connections
REPMES (<200 PORT command accepted>)
;Read a decimal argument (terminated by comma or cr) from IMP
;CALL: PUSHJ P,DECIN
; CR seen, end of line
; error return (non numeric in argument, or number bigger than 8 bits)
; normal return (C(B) = number, C(A)=delimeter)
DECIN: SETZ B, ;collect arg here
DECIN0: PUSHJ P,GETCHR
CAIN A,15
POPJ P, ;CR seen, end of line
CAIN A,","
JRST CPOPJ2 ;comma seen, end of number
CAIL A,"0"
CAILE A,"9"
JRST CPOPJ1 ;illegal character seen
IMULI B,=10
ADDI B,-"0"(A) ;collect decimal number in B
CAIL B,1⊗8 ;number less than 8 bits worth?
JRST CPOPJ1 ;no, number too big
JRST DECIN0 ;yes, keep scanning
>;IFN FTIP
IFE FTIP,<
;; BYTE, SOCK ROUTINES
DECIN: ;READ A DECIMAL ARGUMENT (TERMINATED BY SPACE OR CR) FROM IMP
;CALL: PUSHJ P,DECIN
; ERROR RETURN (NON NUMERIC IN ARGUMENT)
; NORMAL RETURN (C(B) = NUMBER, C(A)=DELIMETER)
SETZ B,
DECIN0: PUSHJ P,GETCHR
CAIE A,15 ;CR?
CAIN A," " ;SPACE?
JRST CPOPJ1 ; YES TO EITHER
CAIL A,"0"
CAILE A,"9"
POPJ P, ;ILLEGAL CHARACTER
IMULI B,=10
ADDI B,-"0"(A)
JRST DECIN0
SOCK: PUSHJ P,DECIN
JRST [REPMES (501 Bad SOCK argument)]
CAML B,[1B4] ;SOCKET NUMBER WILL FIT IN 32 BITS
JRST [REPMES (503 Socket number too big)]
ILDB C,[POINT 1,B,35]
TRC C,1 ;FOREIGN COMPLIMENT OF LOCAL DIRECTION
MOVEM B,FDRS(C) ;STORE IN FDRS OR FDSS
CAIE A,15 ;C.R. WAS THE TERMINATING CHR.?
JRST SOCK ; NO, GET ANOTHER ARGUMENT
REPMES (<200 SOCK argument(s) OK>)
>;IFE FTIP
;⊗ PASS NOPRVS WRONGP GIVUSR MUSTLG USEROK PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE
; USER, PASS ROUTINES
PASS: TLNN FLG,(PASSBT) ;Password already given?
TLNN FLG,(USREBT) ;User not given?
JRST GIVUSR ;Yes, tell him to give user name first
SETZ T3, ;Read password, no break characters
IFN VERBOSE,<
SETOM SILENT ;avoid showing password
>;IFN VERBOSE
PUSHJ P,SIXINL
IFN VERBOSE,<
SETZM SILENT ;password reading done
>;IFN VERBOSE
TRNN T,77 ;Right justified?
JUMPN T,[ROT T,-6 ;No, try advancing a character
JRST .-1]
MOVEM T,PASMTA+3 ;Compare with UFD
MTAPE .PASS,PASMTA
JRST WRONGP
PUSHJ P,IMPSTR
ASCIZ/230 Password OK, happy hacking
/
MOVE T3,PPNTMP ;Copy saved PPN
MOVEM T3,UPPN
MOVEM T3,ALIPPN ;Set alias, too
HRRZM T3,UPRG ;SAVE FOR CAME WRT MASPRV IN ILDDEV
SETZM PRIVS ;NO PRIVILEGES YET
MTAPE .PASS,PRVMTA ;READ PRIVILEGES
JRST NOPRVS
MOVE T3,PRIVWD ;GET PRIVS FROM UFD
MOVEM T3,PRIVS ;SAVE THEM
SETZM PASWD ;JUST IN CASE WE HAVE INF
NOPRVS: TLO FLG,(PASSBT)
IFN FTREQL,<
SETOM USEROK ;note password given
>;IFN FTREQL
RELEASE .PASS,
JRST FLUSCS
WRONGP: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ/431 Password rejected. Shame on you.
/
>;IFE FTIP
IFN FTIP,<
ASCIZ/530 Password rejected. Shame on you.
/
>;IFN FTIP
SOSLE PASTRY ;Too many attempts?
JRST FLUSCS ;No, let him/her try again
MOVEI D,1 ;Yes, obviously a password hacker. Flush!
SLEEP D, ;Wait a sec to send lose message
JRST ERRKIL ;Now, flush!
GIVUSR: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /504 No USER command given
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /503 No USER command given
/
>;IFN FTIP
JRST FLUSCS
IFN FTREQL,<
MUSTLG: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /504 You forgot to log in; must give USER command.
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /530 You forgot to log in; must give USER command.
/
>;IFN FTIP
JRST FLUSCS
USEROK: 0 ;nonzero if USER command given with password
>;IFN FTREQL
PASFOO:
IFE FTIP,<
REPMES (453 System error, can't check password.)
>;IFE FTIP
IFN FTIP,<
REPMES (451 System error, can't check password.)
>;IFN FTIP
USER: SETZM PRIVS ;NO PRIVILEGES ANYMORE
SETOM USRCMD#
PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,UFDFIL ;Check for valid user name
MOVEM D,PPNTMP ;SAVE HERE FOR PASS
IFE FTREQL,< ;if requiring login, don't allow guest login
CAME D,['ANONYM']
CAMN D,['NETGUE'] ;LET THIS ONE IN BUT WITH GUEST STATUS
JRST INFREE
>;IFE FTREQL
MOVE D,[SIXBIT/ 1 1/]
MOVEM D,UFDFIL+3
INIT .PASS,17
SIXBIT/DSK/
0
JRST PASFOO
LOOKUP .PASS,UFDFIL
JRST [ HRRZ D,UFDFIL+1 ;File not found?
JUMPE D,USER4 ;Yes, unknown user
CAIN D,2 ;Protection violation perhaps?
JRST USER3 ;Yes, can't check password then
JRST PASFOO]
SETZM PASMTA+3 ;Check for password
MTAPE .PASS,PASMTA
JRST ASKPAS ;Something there, ask for it
USER3: PUSHJ P,IMPSTR ;None, don't let him/her thru
IFE FTIP,<
ASCIZ *432 No remote login for that account.
*
>;IFE FTIP
IFN FTIP,<
ASCIZ *530 No remote login for that account.
*
>;IFN FTIP
JRST FLUSCS
ASKPAS: TLZ FLG,(PASSBT) ;Forget old user
IFN FTREQL,<
SETZM USEROK ;no password given yet
>;IFN FTREQL
TLO FLG,(USREBT) ;Remember we got a user name
MOVEI D,5 ;Set number of tries for password
MOVEM D,PASTRY
PUSHJ P,IMPSTR ;Tell user we want a password
IFE FTIP,<
ASCIZ /330 What's yer password?
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /331 What's yer password?
/
>;IFN FTIP
JRST FLUSCS
USER1: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ *431 Invalid user name. Format is PRJ,PRG
*
>;IFE FTIP
IFN FTIP,<
ASCIZ *501 Invalid user name. Format is PRJ,PRG
*
>;IFN FTIP
JRST FLUSCS
USER4: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ *431 I don't know you
*
>;IFE FTIP
IFN FTIP,<
ASCIZ *530 I don't know you
*
>;IFN FTIP
JRST FLUSCS
CWD:
XCWD: PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,ALIPPN ;Set user ppn
PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /200 XCWD command accepted
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 CWD command accepted
/
>;IFN FTIP
JRST FLUSCS
ACCT: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ/420 Acct ID not in hash table, add 1 and try again
/
>;IFE FTIP
IFN FTIP,<
ASCIZ/202 Acct ID not in hash table, add 1 and try again
/
>;IFN FTIP
JRST FLUSCS
IFE FTREQL,<
INFREE: TLZ FLG,(PASSBT+USREBT) ;SET HIS UPPN BUT NO LOCAL ACCESS.
MOVEM D,UPPN ;COULD IN PRINCIPLE BE OTHER THAN NETGUE
MOVEM D,ALIPPN ;IE "SPECIAL GUEST ACCT" HACK
HRRZM D,UPRG
PUSHJ P,IMPSTR
ASCIZ /230 Welcome to sunny California
/
JRST FLUSCS
>;IFE FTREQL
;⊗ GETCOM GETCO1 FLUSCS flcs1 GETCO2
;GETCOM,FLUSCS COMMAND STRING READER
GETCOM: ;CALL: PUSHJ P,GETCOM
; RETURN HERE, NON-SYNTACTICAL COMMAND
; RETURN HERE, C(C) = COMMAND (IN ASCIZ),
;CLOBBERS A,B,C,D
TLZ FLG,LFSEEN ;OK TO REALLY READ FROM IMP AGAIN (FLUSCS FAKEOUT HACK)
MOVNI D,-5 ;MAXIMUM LENGTH OF COMMAND (INCLUDING DELIMITER)
MOVE B,[POINT 7,C]
SETZ C,
PUSHJ P,GETCAP
CAIE A," "
CAIN A,11
JRST .-3 ;IGNORE LEADING TABS, SPACES
CAIA
GETCO1: PUSHJ P,GETCAP
CAIN A," " ;END OF COMMAND?
JRST CPOPJ1 ; YES, SUCCESS EXIT
CAIN A,15 ;IGNORE CR!
JRST GETCO1
CAIN A,12 ;PREMATURE END OF COMMAND LINE?
JRST GETCO2 ; YES
IDPB A,B
AOJL D,GETCO1 ;LOOP FOR NEXT COMMAND CHARACTER...
PUSHJ P,GSRCI
PUSHJ P,IMPST0 ; ... UNLESS TOO MANY ALREADY
ASCIZ /500 Command more than 4 characters: /
PUSHJ P,ASCII1
C
PUSHJ P,IMPCR
SOS IMPSTF
FLUSCS: ;FLUSH COMMAND STRING
ifn verbose,<
outchr [173] ;flushing (dcs: 4-12-73)
>;
flcs1: PUSHJ P,GETCHR ;GET CHARACTER
; CAIN A,15 ;C.R.?
; JRST FLCS1 ; YES, IGNORE
CAIE A,12 ;L.F.?
JRST FLCS1 ;LOOP FOR NEXT
ifn verbose,<
outchr [176]
>;
POPJ P, ; YES, EXIT (FAILURE EXIT FROM GETCOM)
;FLUSH WANTS TO SEE SOMETHING PERHAPS
GETCO2:
; AOS IBUF+2 ;BACK UP ONE IN COUNTER
; MOVE B,[100000,,0]
; ADDM B,IBUF+1 ; AND IN BUFFER
MOVEI A," " ;FAKE THE SPACE
JRST CPOPJ1
;⊗ GETIDX ANAMES NNAMES
;GETIDX CONVERT COMMAND STRING TO INDEX
GETIDX: ;CALL: PUSHJ P,GETIDX
; RETURN HERE, C(A) = XWD <GARBAGE>,N
; N=0 - UNRECOGNIZED COMMAND
MOVSI A,-NNAMES
CAMN C,ANAMES(A)
AOJA A,CPOPJ
AOBJN A,.-2
SETZ A,
POPJ P,
DEFINE X(A) <ASCIZ /A/ ↔ >
ANAMES: NAMES
NNAMES←← .-ANAMES
;⊗ PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
;; PUTCHR - SEND ASCII CHARACTER OUT ON IMP CONTROL CONNECTION
PUTCH1:
ifn verbose,<
OUTCHR A
>;
PUTCHR: ;CALL: MOVE A,<ASCII CHARACTER>
; PUSHJ P,PUTCHR
; RETURN HERE ALWAYS, ALL ACCUMULATORS INTACT
JUMPE A,CPOPJ ;DON'T OUTPUT NULL CHARACTER
SOSG OBUF+2 ;ROOM IN BUFFER FOR THIS CHARACTER?
PUSHJ P,PUTBUF ; NO, MAKE ROOM BY OUTPUTTING BUFFER
PUSH P,A ;JUST IN CASE
;WAITS to ASCII character conversion
CAIN A,33
SOJA A,PUTCH2 ;not-equals
CAIN A,175
MOVEI A,33 ;altmode
CAIN A,176
MOVEI A,175 ;right brace
CAIN A,32
MOVEI A,176 ;tilde
PUTCH2: IDPB A,OBUF+1 ; STUFF IT IN
POP P,A
CAIE A,12 ;IT'S A LINE FEED?
POPJ P, ; NO
JRST PUTBUF ; YES, SEND OUT ENTIRE BUFFER, AND RETURN
PUTBUF: ;CALL: PUSHJ P,PUTBUF
; RETURN HERE ALWAYS
; OUTPUTS A BUFFER OF ASCII ON THE CONTROL IMP CONNECTION.
PUSH P,B ;GET AN ACCUMULATOR
PUSH P,A
PUTBU2: LDB B,[POINT 3,OBUF+1,2];PUT MAGIC BITS FOR NULL BYTES
MOVEI A,1
LSH A,(B)
SUBI A,1
IORM A,@OBUF+1
REPEAT 0,<
PUTBU2: LDB B,[POINT 6,OBUF+1,5]
CAIGE B,10 ;IS WORD FILLED OUT?
JRST PUTBU3 ; YES
SOS OBUF+2 ; NO, FILL IT OUT WITH NOP'S
MOVEI B,202
IDPB B,OBUF+1
JRST PUTBU2
>
PUTBU3: ;IT MIGHT BE NICE TO PUT A TEST HERE
; TO MAKE SURE WE CAN DO THE OUTPUT
; WITHOUT HANGING UP FOR ALLOCATION
; OR BLOCKED LINK OR WHATEVER.
; (IN WHICH CASE, IMPSTR,DIMPSTR,DOMPSTR
; SHOULD BE DISTINGUISHED, TO PREVENT
; INTERMIXING OF THEIR MESSAGES.)
POP P,A
POP P,B ;RESTORE ACCUMULATOR
OUT IMP, ;SEND OUT THE BUFFER
POPJ P, ; SUCCESS, RETURN
MES (OUT IMP fails)
; IN THIS CASE, TIS BETTER TO GO ON THAN TO QUIT
POPJ P, ;NO MATTER WHAT THE PROBLEM, IGNORE IT
; OR LET SOMEBODY ELSE FIND IT!
; (BECAUSE SOME MAIL's CLOSE DOWN BEFORE
; ACKNOWLEDGEMENT)
;⊗ GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH8 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
;; GETCHR - GET ASCII CHARACTER FROM IMP CONTROL CONNECTION
GETCHR: ;CALL: PUSHJ P,GETCHR
; RETURN HERE ALWAYS, C(A) HAS CHARACTER
; CLOBBER NO ACCUMULATORS
TLNE FLG,LFSEEN ;IS THIS COMMAND LINE ALREADY DONE?
JRST FAKELF ;YUP, KEEP RETURNING LF TO MAKE FLUSCS HAPPY.
RGETCH: SOSG IBUF+2 ;CHR IN BUFFER?
JRST GETCH2 ; NO, DO AN INPUT
GETCH1: ILDB A,IBUF+1
CAIN A,200 ;DATA MARK?
AOS SYNCH ; YES, UPDATE COUNT
SKIPL SYNCH ;IF SYNCH IS NEGATIVE, IGNORE INPUT
;;;;; CAIN A,202 ;NOP?
CAIL A,200 ;TELNET CONTROL?
JRST RGETCH ; YES, GET ANOTHER CHARACTER
JUMPE A,RGETCH ;IGNORE NULLS
ifn verbose,<
SKIPE SILENT ;HIDING THEIR INPUT?
JRST GETCH6 ;YES
trne a,200
outchr ["↑"]
outchr a
GETCH6:
>;verbose
TRNE A,200 ;CONTROL CHARACTER?
POPJ P, ;RETURN, WHATEVER IT IS
;ASCII to WAITS character conversion
CAIN A,32
AOJA A,GETCH7 ;not-equals
CAIN A,176
MOVEI A,32 ;tilde
CAIN A,175
MOVEI A,176 ;right brace
CAIN A,33
MOVEI A,175 ;altmode
GETCH7:
IFN FTTOS,<
SOSG TOSCNT ;saving chars for to-string?
JRST GETCH8 ;no
CAIE A,15 ;end of line?
CAIN A,12
JRST [ PUSH P,A ;yes
SETZB A,TOSCNT ;stop collecting, but mark end with null
IDPB A,TOSBPT
POP P,A
JRST GETCH8]
IDPB A,TOSBPT ;save this char in to-string
GETCH8:
>;IFN FTTOS
CAIN A,12
TLO FLG,LFSEEN ;NO MORE READING UNTIL NEXT GETCOM
IFN %XRCP,<
SKIPE XRFBBP ; Are we saving XRCP recipient name?
SKIPE XRFBZZ ; And not overflowed?
POPJ P,
CAIE A,15 ; And not cr or lf?
CAIN A,12
POPJ P,
IDPB A,XRFBBP ; Yes, save char.
>;%XRCP
POPJ P, ;THANK YOU, MR. WRIGHT
GETCH2: PUSH P,F ;GET AN ACCUMULATOR
HRRZ F,IBUF ;GET POINTER TO BUFFER
HRRZ F,(F) ;GET POINTER TO NEXT BUFFER
SKIPGE (F) ;INPUT WAITING IN NEXT BUFFER?
JRST GETCH3 ; YES
INTMSK 1,[0] ;TURN OFF INTERRUPTS
MTAPE IMP,[10] ;INPUT WAITING IN FREE STORAGE?
JRST GETCH4 ; NO
INTMSK 1,[-1] ; YES, RE-ENABLE INTERRUPTS
GETCH3: POP P,F ;RESTORE ACCUMULATOR
IN IMP, ;DO THE INPUT
JRST GETCH1 ; AND FETCH THE CHARACTER
JRST GETCH5 ; OOPS! INPUT FAILED
GETCH4: INTMSK 1,[-1]
POP P,F ;RESTORE ACCUMULATOR
GETCH5: PUSHJ P,CIWAIT
JRST GETCH2
GETCAP: PUSHJ P,GETCHR ;SAME AS GETCHR, EXCEPT CHANGES
CAIL A,"a" ; LOWER CASE TO UPPER CASE
CAILE A,"z" ; BEFORE RETURNING
POPJ P,
SUBI A,"a"-"A"
POPJ P,
FAKELF: MOVEI A,12
POPJ P,
;⊗ GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
; ROUTINES TO OUTPUT ASCII INFORMATION ON CONTROL CHANNEL
; NOTE: THE PRIVILEGE OF SENDING ASCII OUT ON CONTROL CHANNEL
; IS A "SCARCE RESOURCE", SINCE THE CI,DI AND DO ROUTINES MAY ALL
; TRY TO DO SO SIMULTANEOUSLY. THE FLAG "INPSTF" GOVERNS THE USE
; OF THESE ROUTINES.
; IMPORTANT: WHEN DONE, THE CALLING ROUTINE MUST RELEASE THE
; RESOURCE BY A "SOS IMPSTF" INSTRUCTION.
GSRCI: MOVEI A,IMP
GSR: ;Get Scarce Resource
;CALL: MOVEI A,<DIMP or DOMP or IMP>
; PUSHJ P,GSR
; RETURN HERE WITH CONTROL OF SCARCE RESOURCE
AOSG IMPSTF ;IS RESOURCE AVAILABLE?
POPJ P, ; YES
SOS IMPSTF ; NO
CAIN A,IMP
PUSHJ P,CIWAIT
CAIN A,DIMP
PUSHJ P,DIWAIT
CAIN A,DOMP
PUSHJ P,DOWAIT
JRST GSR
ASCII1: ;CALL: PUSHJ P,ASCII1
; <ADDRESS OF ONE WORD OF ASCII OR ASCIZ>
; RETURN HERE, 0,1,2,3,4,OR 5 CHARACTERS OUTPUT
;CLOBBERS ACCUMULATORS E,F
MOVNI F,5
PUSH P,A
MOVE E,[POINT 7,0]
HRR E,@-1(P)
ASCII2: ILDB A,E
JUMPE A,ASCII3 ;JUMP ON END OF ASCIZ STRING
ifn verbose,<
outchr a ;how are we responding?
>;verbose
PUSHJ P,PUTCHR ;OUTPUT 1 CHARACTER
AOJL F,ASCII2 ;LOOP FOR NEXT CHARACTER
ASCII3: POP P,A
JRST CPOPJ1
ASCIIY: ILDB A,E
JUMPE A,ASCII3
ifn verbose,<
outchr a
>;verbose
PUSHJ P,PUTCHR
JRST ASCIIY
ASCIIE: ;CALL: MOVE E,[POINT 7,[ASCIZ /MESSAGE TO GO OUT ON IMP/]]
; PUSHJ P,ASCIIE
; RETURN HERE ALWAYS, ACCUMULATOR A LOST
PUSH P,[.+1] ;PUT <RETURN ADDRESS LESS ONE> ON STACK
PUSHJ P,ASCIIY ;THIS IMPLICIT RETURN ADDRESS IS CLOBBERED
POPJ P, ;THIS IS THE RETURN FROM ASCIIE
ASCIIC: PUSH P,A
PUSHJ P,GSRCI ;GET SCARCE RESOURCE -- IMP OUTPUT CONTROL
POP P,A
PUSHJ P,PUTCHR
SOS IMPSTF
POPJ P,
;⊗ DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH WATHST MAXSIT WATHS2
;; ANOTHER ROUTINE TO OUTPUT ASCII STRING TO IMP CONTROL CHANNEL
;; IMPST0 IS A ROUTINE TO OUTPUT AN ASCII STRING TO THE IMP CONTROL
;;CHANNEL. HOWEVER, SERVERAL DIFFERENT ROUTINES MAY WISH SIMULTANEOUS
;;ACCESS TO IMPST0, WHICH WOULD CAUSE THE MESSAGES GOING OUT TO BE INTER-
;;MINGLED, AND THEREFORE GARBLED. THUS, INPST0 IS TREATED AS A "SCARCE
;;RESOURCE", AND THE COUNTER "IMPSTF" INDICATES ITS AVAILIBILITY.
;; SO, IMPST0 HAS 3 ENTRY POINTS: DIMPSTR, DOMPSTR AND IMPSTR.
;;THESE CORRESPOND TO THE 3 ROUTINES DIROUT, DOROUT AND CIROUT.
DIMPSTR:AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,DIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST DIMPSTR
DOMPSTR:AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,DOWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST DOMPSTR
IMPSTR: AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,CIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST IMPSTR
IMPSTF: -1 ;MINUS ONE MEANS IMPST0 ROUTINE IS AVAILABLE
IMPST0: ;CALL: PUSHJ P,IMPST0
; ASCIZ /STRING TO BE OUTPUT/
; RETURN HERE
;CLOBBERS ACCUMULATOR E
ifn verbose,<
outstr @(p) ;what are we telling him?
>;verbose
POP P,E
PUSHJ P,IMPSTN ;output string pointed to by E
SOS IMPSTF
JRST 1(E)
;Output to IMP the ASCIZ string pointed to by RH E.
IMPSTN: HRLI E,(<POINT 7,0>)
OUTSTR (E) ;type the message too, in case attached
PUSH P,A
IMPST1: ILDB A,E
JUMPE A,IMPST2
PUSHJ P,PUTCHR
JRST IMPST1
IMPST2: POP P,A
POPJ P,
IMPCR: PUSHJ P,IMPSTR
ASCIZ /
/
POPJ P,
;routine to output our host name to the IMP
IMPSTH: MOVE E,WAITST ;get waits site number
MOVE E,WATHST(E) ;get ptr to host name string
JRST IMPSTN ;output host name to imp
WATHST: [ASCIZ/SU-AI/] ;site 0
[ASCIZ/SU-CCRMA/] ;site 1
[ASCIZ/S1-A/] ;site 2
[ASCIZ/New/] ;(always last) unknown sites will just say New
MAXSIT←←.-WATHST
;⊗ SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
;CR'S ARE IGNORED, ALSO LEADING SPACES AND TABS
;CALL: MOVE T3,[POINT 7,[ASCIZ /<BREAK CHARACTERS>/]]
; PUSHJ P,SIXINL/R
; RETURN HERE ALWAYS,
; C(T) = LEFT/RIGHT JUSTIFIED SIXBIT
; C(T1)= BREAK CHARACTER:
; ILLEGAL 6BIT(1-37),LF(12),OR FROM TABLE(1-177)
SIXINL: MOVE T2,[POINT 6,T]
TLOA FLG,LEFTF
SIXINR: TLZ FLG,LEFTF
SETZ T, ;PUSHJ TO HERE FOR RIGHT NORMALIZATION
PUSH P,A
PUSH P,T3 ;SAVE POINTER TO BREAK CHARACTERS
TLZ FLG,QUOTEF ;FLAG NO QUOTING IN PROGRESS
SIXIN1: PUSHJ P,GETCHR ;C(A) GETS CHARACTER
MOVE T1,A
CAIN T1,42 ;QUOTE HACKING?
TLCA FLG,QUOTEF ;YES, TOGGLE FLAG AND CHECK STATE
CAIA
JRST SIXIN1
TLNE FLG,QUOTEF
JRST SIXIN3
CAIE T1,40
CAIN T1,11
JRST [JUMPE T,SIXIN1 ;IGNORE LEADING BLANKS AND TABS
JRST SIXIN4] ;ELSE RETURN
MOVE T3,(P) ;T3 ← POINTER TO BREAK CHARACTERS
SIXIN2: ILDB A,T3 ;A ← BREAK CHARACTER FROM TABLE
JUMPE A,SIXIN3 ;JUMP ON END OF BREAK TABLE
CAMN A,T1 ;MATCH WITH INPUT CHARACTER?
JRST SIXIN4 ; YES, GO EXIT
JRST SIXIN2 ;FETCH NEXT BREAK CHARACTER
SIXIN3: CAIL T1,"a"
CAILE T1,"z"
JRST .+2
TRZ T1,40 ;MAKE LOWER CASE INTO UPPER CASE
CAIGE T1,40
JRST SIXIN4 ;RETURN IF CHAR. HAS NO SIXBIT CODE
SUBI T1,40
ANDI T1,77
TLNE FLG,LEFTF ;LEFT JUSTIFIED SIXBIT?
JRST [ TLNE T2,770000 ;YES, ALREADY HAVE SIX CHARACTERS?
IDPB T1,T2 ;NO, STASH IT IN
JRST SIXIN1]
TLNE T,770000 ;ALREADY HAVE 6 CHARACTERS?
JRST SIXIN1 ; YES, FLUSH EXTRA CHARACTERS
LSH T,6
IOR T,T1
JRST SIXIN1 ;READ NEXT CHARACTER
SIXIN4: POP P,T3 ;RESTORE POINTER TO BREAK CHARACTERS
POP P,A ;RESTORE ACCUMULATOR A
POPJ P, ;AND RETURN
;⊗ GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
;; CALL: PUSHJ P,GFN ;(Get File Name)
;; ERROR RETURN
;; SUCCESS RETURN, C(F) = FILENAME IN SIXBIT
;; C(E) = EXTENSION IN SIXBIT
;; C(D) = PPN IN SIXBIT
;; C(C) = DEVICE IN SIXBIT
;; CLOBBERS T,T1,T2,T3 ONLY
;; CALL: PUSHJ P,GPPN ;(Get PPN)
;; ERROR RETURN
;; SUCCESS RETURN, C(D) = PPN IN SIXBIT
IFE FTIP,<
GFNML: SETZM MLDEST ;MAIL TO :FILE or via indirect file (@)
MOVEM A,MBOXCH ;SAVE # OR @ FOR MAIL COMMAND
MOVE D,[' PDOC'] ;DEFAULT PPN FOR @ FILE
MOVEI E,0 ;NO DEFAULT EXT FOR @ FILE (MAIL handles it)
CAIE A,"@" ;USE ABOVE DEFAULTS FOR INDIRECT FILE
>;IFE FTIP
GFN: SETZB D,E ;DEFAULT EXT AND PPN
TLZ FLG,MFNMF
MOVSI C,'DSK' ;DISK IS ASSUMED DEVICE
MOVE T3,[POINT 7,[ASCIZ /:.[/]]
PUSHJ P,SIXINL
GFN0: CAIE T1,":"
JRST GFN0A
MOVE C,T
MOVE T3,[POINT 7,[ASCIZ/.[/]]
PUSHJ P,SIXINL
GFN0A: MOVE F,T ;SET FILE NAME
CAIE T1,"." ;EXTENSION IS NEXT?
JRST GFN1 ; NO
MOVE T3,[POINT 7,[ASCIZ /[/]]
PUSHJ P,SIXINL
;;; This change installed for the benefit of a multiple STOR
;;; from a tenex with longer filenames, so we truncate the ext instead of
;;; refusing the transfer
HLLZS T
;;; TRNE T,-1 ;EXTENSION NAME MORE THAN 3 CHARACTERS?
;;; POPJ P, ; YES, ERROR RETURN
MOVE E,T ;SET EXTENSION NAME
GFN1: CAIE T1,"[" ;PPN IS NEXT?
JRST CPOPJ1 ; NO, SUCCESS EXIT
GPPN1: ;ENTER HERE FOR PPN ONLY
MOVE T3,[POINT 7,[ASCIZ /,]/]]
PUSHJ P,SIXINR
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
JRST GPPWIN
GPPN2: TLNE T,-1 ;PROJECT NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
MOVS D,T
JUMPE T,CPOPJ1 ;THIS IS NO PPN ON GPPN ENTRY
CAIE T1,"," ;PROJECT & PROGRAMMER NAMES DELIMITED OK?
JRST GPPN3 ; NO, JUST PROJECT CODE
MOVE T3,[POINT 7,[ASCIZ /]/]]
PUSHJ P,SIXINR
TLNE T,-1 ;PROGRAMMER NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
HRR D,T ;SET PPN
JRST CPOPJ1 ;SUCCESS RETURN
GPPN3: TLNE FLG,MFNMF ;IF MLFLNM, TAKE ERROR RETURN SIGH
POPJ P,
HRR D,ALIPPN ;GET DEFAULT PROGRAMMER NAME
JRST CPOPJ1
GPPN: TLZ FLG,MFNMF
GPPNX: MOVE T3,[POINT 7,[ASCIZ /[,/]]
PUSHJ P,SIXINR
JUMPE T,GPPN1
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
GPPWIN: MOVE D,T
JRST CPOPJ1
;; GPPFIL: LIKE GFN BUT ACCEPTS "PRJ,PRG" TO MEAN "*.*[PRJ,PRG]"
;THIS IS COMPLETELY WRONG.
GPPFIL: MOVSI F,'* '
MOVSI E,'* '
MOVEI D,0
MOVSI C,'DSK'
TLZ FLG,MFNMF
MOVE T3,[POINT 7,[ASCIZ /:[.,/]]
PUSHJ P,SIXINL
CAIE T1,","
JRST GFN0 ;WE HAVE FILENAME
TRNN T,77 ;ELSE RIGHT JUSTIFY
JRST [ LSH T,-6
JRST .-1]
JRST GPPN2 ;AND TREAT AS PPN
IFE FTIP,<
MLFLNM: TLO FLG,MFNMF
PUSHJ P,GPPNX
MLFLN1: JRST [MOVE D,T ;IF NO COMMA WAS FOUND, THAT'S
TLNN T,-1 ; OK, MAILING TO PROGRAMMER ONLY
JRST OKMF ; ELSE P OR PN WAS
POPJ P,] ;TOO LONG
OKMF: MOVSI C,'DSK'
MOVSI E,'MSG'
MOVE F,D
MOVE D,['2 2'] ;PERSON.MSG[2,2]
MOVEM F,MLDEST# ;SAVE PPN FOR HEADER ETC.
JRST CPOPJ1 ;SUCCESS RETURN
>;IFE FTIP
;⊗ MLNMST MLNMIN MLNMOK MLNMF1 MLNMFF TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HAKREG HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX FOPEN FACTXT
IFE FTIP,<
;;MLNMST: NEW MLFLNM TO ACCEPT HUMAN BEING NAMES AND LOOK IN FACT.TXT
MLNMST: SETZM FWDING# ;FLAG NOT FORWARDING
IFN FTTOS,<
MOVEI A,TOSMAX ;max length for to-string
MOVEM A,TOSCNT ;save
MOVE A,[POINT 7,TOSTR] ;set up byte ptr for saving to-string
MOVEM A,TOSBPT ;force GETCHR to save chars in dest string
>;IFN FTTOS
PUSHJ P,GETCHR ;START SCANNING HIS INPUT
CAIE A,40 ; SKIPPING IRRELEVANCIES
CAIN A,11
JRST MLNMST
CAIN A,"[" ;THIS IS A REGULAR PPN
JRST MLFLNM ; SO WE REJOIN THE STANDARD ROUTINE
CAIE A,"#"
CAIN A,":" ;DEST STARTS WITH COLON
SKIPA A,["#"] ;(GFNML WILL SAVE THE CHAR FOR LATER
CAIN A,"@" ; AND WE ACCEPT INDIRECT REQUESTS)
JRST GFNML ; SO IT'S A FILE SPEC
MOVE B,[POINT 7,NBUFFR] ;OTHERWISE WE MUST ACCUMULATE HIS NAME
MOVEI C,0 ;CHAR COUNT
MLNMIN: CAIL A,"A" ;JUST TAKE ALPHAMERICS
CAILE A,"Z" ;NONE OF THIS FUNNY STRING STUFF
CAIN A,"-" ;ACCEPT HYPHEN FOR PSEUDO-MAILBOX
JRST MLNMOK
CAIL A,"a"
CAILE A,"z"
JRST .+2
JRST MLNMOK
CAIL A,"0" ;YOU MAY WONDER WHO HAS DIGITS IN HIS NAME
CAILE A,"9" ;WELL WHAT IF IT'S "MAIL 1,FOO"
JRST MLNMFF ;WE GOTTA BE ABLE TO RECOVER FROM THAT Y'KNOW
MLNMOK: IDPB A,B
PUSHJ P,GETCHR
SKIPN NBUFFX ;QUICK & DIRTY OFLO DETECTOR
AOJA C,MLNMIN
PUSHJ P,FLUSCS
SETZM NBUFFX ;SO HE CAN TRY AGAIN
JRST UNRECU ;NAME UNRECOGNIZD IF TOO LONG
MLNMF1: PUSHJ P,GETCHR
MLNMFF: CAIE A,40 ;NAME DONE, SKIP SPACES
CAIN A,11
JRST MLNMF1
MOVEI T,0
IDPB T,B ;JUST FOR LUCK
CAIN A,"," ;DISPATCH ON DELIMITER
JRST HAKREG ;PRJ,PRG : GO REJOIN STANDARD AFTER FIXUP
CAIN A,15
PUSHJ P,GETCHR ;SKIP OVER CR
CAIE A,12
POPJ P, ;GOTTA END WITH CRLF
JUMPE C,CPOPJ ;GOTTA HAVE SOME TEXT!
CAIG C,3 ;IF ≤3 CHARS STORED,
JRST HRPRIM ; TREAT AS JUST PRG (MAYBE WE'LL COME BACK)
MOVE A,[POINT 7,NBUFFR] ;INITIALIZE POINTERS
MOVEM A,FBPINI#
MOVE T2,[ILDB A,F]
MOVEM T2,FBPXCT#
PUSHJ P,TRYFOR ;TRY FORWARDING
JRST OKMF ;WIN
TRYFAC: OPEN .MFD,FOPEN ;OTHERWISE WE DO THE FACT.TXT THING
JRST [REPMES (453 System error, can't open disk to find user name.)]
MOVE C,['SPLSYS']
MOVEM C,FACTXT+3
LOOKUP .MFD,FACTXT
JRST NOFACT ;TROUBLE
SETZM FACCNT# ;COUNT MATCHES HERE
FACTLP: MOVE C,[POINT 6,B] ;READ A FACT.TXT ENTRY
MOVEI B,0 ;FIRST PRG IN SIXBIT
FACGE1: PUSHJ P,FACCHR ;GET DSK CHAR
JRST FACEOF
SUBI A,40
JUMPLE A,FACGE2
IDPB A,C
JRST FACGE1 ;CONTINUES TO TAB
FACGE2: MOVEM B,FACPRG#
MOVE B,[POINT 7,FACBUF]
MOVEM B,FACBPT#
FACGE3: PUSHJ P,FACCHR ;NOW COLLECT NAME
JRST FACEOF
IDPB A,B
CAIE A,12
JRST FACGE3
MOVEI A,0
IDPB A,B
FACWRD: MOVE B,[POINT 7,NBUFFR]
MOVEM B,FCSTBP# ;PREPARE TO START SCAN
FACTRY: ILDB A,FACBPT ;COMPARISON LOOP
ILDB B,FCSTBP
JUMPE B,FACTST ;USER'S NAME DONE, CHECK END OF FILE NAME
CAIL A,140 ;IGNORE CASE DIFFERENCES
SUBI A,40
CAIL B,140
SUBI B,40
CAIE B,(A)
JRST FACLUZ ;NOT THE SAME, SORRY
JRST FACTRY ;SAME, KEEP TRYING
FACTST: CAIE A,15 ;IF NEXT FILE CHAR IS DELIM
CAIN A,40 ; (COULD FLUSH 40 TO JUST MATCH LAST NAME)
SKIPA B,FACPRG ; THEN MATCH, TELL HIM
JRST FACLUZ
MOVEM B,FACPPN# ;AND SAVE FOR LATER
PUSHJ P,IMPSTR
ASCIZ /050 /
PUSHJ P,SIXWRT ;PUT OUT PRG IN SIXBIT
PUSHJ P,IMPSTR
ASCIZ / is the ID for user /
MOVE E,[POINT 7,FACBUF]
PUSHJ P,ASCIIE ;GOOD GRIEF
AOS FACCNT ;COUNT MATCHES
JRST FACTLP ;GET NEXT FILE ENTRY
FACLUZ: CAIN A,15 ;NON-MATCH: IF AT END OF FILE ENTRY,
JRST FACTLP ; GET ANOTHER
CAIN A,40 ;IF AT END OF FILE WORD BUT NOT ENTRY,
JRST FACWRD ; KEEP SCANNING THIS ENTRY
ILDB A,FACBPT ;OTHERWISE SCAN THE FILE MORE
JRST FACLUZ
FACEOF: CLOSE .MFD, ;END OF FACT.TXT, LET IT GO
SKIPN C,FACCNT ;HOW MANY MATCHES?
JRST UNRECU ;NONE, NO SUCH USER
SOJN C,AMBIG ;TOO MANY
SKIPA D,FACPPN ;OK, GET THE PRG CODE
FACRGT: LSH D,-6
TRNN D,77 ;RIGHT ADJUST
JRST FACRGT
MOVEM D,MLDEST
JRST OKMF ;CONTINUE AS USUAL
FACCHR: SOSG MBUF+2
IN .MFD,
JRST FACCH1
STATO .MFD,20000
JRST NOFACT
RELEAS .MFD,
POPJ P,
FACCH1: ILDB A,MBUF+1
JUMPE A,FACCHR
JRST CPOPJ1
HAKREG: SKIPA T1,A ;DELIMITER (COMMA IN THIS CASE)
HRPRIM: MOVEI T1,12 ;FAKE DELIM OF LF
MOVEI T,0 ;ACCUMULATE RT-JUSTIFIED NAME
MOVE B,[POINT 7,NBUFFR] ; FROM TYPEIN
HRLOOP: ILDB A,B
JUMPE A,HRDONE
CAIL A,140
SUBI A,40
SUBI A,40
LSH T,6
IORI T,(A)
TLNN T,77
JRST HRLOOP
HRDONE: TLO FLG,MFNMF
PUSHJ P,GPPN2 ;FOOLS JUMP IN...
JRST MLFLN1 ;AND AGAIN
TRNE D,-1 ; (DON'T ASK. JUST DON'T ASK.)
PUSHJ P,FLUSCS
JRST OKMF ;AND AGAIN
NOFACT: PUSHJ P,IMPSTR
ASCIZ /453 Error reading user name file--mail aborted.
/]
RELEAS .MFD,
FACERR: POP P,A ;POP RET ADDR TO THWART OLD ERROR MSG AND FLUSCS
POPJ P,
UNRECU: PUSHJ P,IMPSTR
ASCIZ /450 I don't know anybody named /
MOVE E,[POINT 7,NBUFFR]
PUSHJ P,ASCIIE
PUSHJ P,IMPSTR
ASCIZ /
/]
JRST FACERR
AMBIG: PUSHJ P,IMPSTR
ASCIZ /450 Pick one of the ID's listed above and try again
/]
JRST FACERR
FACBUF: BLOCK 20 ;BUFFER FOR FACT.TXT NAME
NBUFFR: BLOCK 20 ;BUFFER FOR TYPED-IN NAME
NBUFFX: 0 ;BECOMES NONZERO ON OVERFLOW
FOPEN: 0
SIXBIT /DSK/
XWD 0,MBUF
FACTXT: SIXBIT /FACT/
SIXBIT /TXT/
0
SIXBIT /SPLSYS/
>;IFE FTIP
;⊗ FF CR LF TAB TRYFOR TRYFO0 TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
IFE FTIP,<
;TRYFOR FORWARDING
FF←←14
CR←←15
LF←←12
TAB←←11
TRYFOR: SKIPE XRFBBP ;Doing XRCP R scheme?
JRST TRYFO0 ;Yes, accept forwarding.
TRNN FLG,.MAIL
JRST CPOPJ1 ;NO FORWARDING EXCEPT FOR MAIL CMD
TRYFO0: MOVEM B,FORB#
MOVEM C,FORC#
MOVEM D,FORD#
MOVEM E,FORE#
MOVEM F,FORF#
OPEN .MFD,FOPEN
JRST [REPMES (453 System error, can't open disk to find user name.)]
MOVE C,['MAISYS']
MOVEM C,FORTXT+3
LOOKUP .MFD,FORTXT
JRST NOFACT ;TROUBLE
PUSHJ P,FORCHG ;CHECK FOR E DIRECTORY
MOVE T1,MBUF+1
MOVE T2,(T1)
CAME T2,[ASCII /COMME/]
JRST FORLIN
MOVE T2,1(T1)
CAME T2,[ASCII /NT ⊗ /]
JRST FORLIN
MOVE T2,2(T1)
CAME T2,[ASCII / VAL/]
CAMN T2,[ASCII /INVAL/]
JRST TRYFO1
JRST FORLIN
TRYFO1: PUSHJ P,FORCHG
JUMPE A,FORLIN
CAIE A,FF
JRST TRYFO1
PUSHJ P,FORCHG
FORLIN: MOVE F,FBPINI ;NEW LINE OF FILE, REREAD THE USER'S STRING
FORCHR: JUMPE A,FORZIP ;FORMAT ERROR, EOF IN MID-LINE
CAIN A,LF
JRST FORZIP ;FORMAT ERROR, LINE ENDS W/O TAB
CAIN A,TAB
JRST FOTAB ;END OF STRING IN FILE
PUSH P,A
XCT FBPXCT ;ELSE GET A CHAR FROM USER'S STRING
POP P,T1
CAIL T1,140
SUBI T1,40
CAIL A,140
SUBI A,40 ;LC TO UC
CAIE T1,(A) ;MATCH THE FILE?
JRST FORNO ;NO, GO TO NEXT LINE
PUSHJ P,FORCHG ;READ CHAR FROM FORWRD.TXT
JRST FORCHR
FORNO: PUSHJ P,FORCHG ;SKIP TO END OF LINE
JUMPE A,FORZIP
CAIE A,LF
JRST FORNO
PUSHJ P,FORCHG ;BEGINNING OF NEXT LINE
JUMPE A,FORZIP ;DONE IF DONE
JRST FORLIN ;ELSE CHECK OUT THIS LINE
FORTEL: AOJN C,FORCPY ;JUMP IF NOT FIRST GRITCH
PUSHJ P,IMPSTR
ASCIZ /050 Mail for /
PUSH P,F
MOVE F,FBPINI
FORTE1: XCT FBPXCT ;COPY THE FORWARDEE
JUMPE A,FORTE2
PUSHJ P,PUTCHR
JRST FORTE1
FORTE2: PUSHJ P,IMPSTR
ASCIZ / will be forwarded to /
POP P,F
JRST FORCPY
FOTAB: XCT FBPXCT ;END OF FILE STRING. END OF USER STRING TOO?
JUMPN A,FORNO ;NO, NOT A MATCH
MOVNI C,1 ;FLAG FOR INFORMING THE REMOTE END
FORCPY: PUSHJ P,FORCHG ;COPY A CHAR
CAIE A,CR
CAIN A,LF
MOVEI A,0 ;SIMULATE EOF ON EOL
CAIN A,"⊗"
JRST FORTEL ;GRITCH MEANS TELL ABOUT THE FORWARDING
JUMPL C,FORCP1 ;JUMP IF NOT NOTIFYING
CAIN A,"%"
MOVEI A,"@" ;USE OFFICIAL NETWORK FORMAT (SIGH...)
PUSHJ P,PUTCHR
FORCP1: JUMPN A,FORCPY ;CONTINUE IF NOT DONE
JUMPL C,FORCP2
PUSHJ P,IMPCR
FORCP2: SETOM FWDING ;FLAG FORWARDING
CLOSE .MFD,
POPJ P, ;SUCCESS RETURN
FORZIP: CLOSE .MFD,
MOVE B,FORB#
MOVE C,FORC#
MOVE D,FORD#
MOVE E,FORE#
MOVE F,FORF#
JRST CPOPJ1 ;FAILURE RETURN
FORCHG: PUSHJ P,FACCHR
MOVEI A,0
POPJ P,
FORTXT: SIXBIT /FORWRD/
SIXBIT /TXT/
0
SIXBIT /MAISYS/
>;IFE FTIP
;⊗ DIROUT DIROU1 DIROU2 DIRO25 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOFL DIEOF0 DIEOF1 DIFINI DIEOML DIMLFL DIERR3 RMDWAK RMDSYS OMLGET OMLGT1 OMLOUT OMLOPN OMLBUF OMLNAM PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
;; DI ROUTINE - GET DATA FROM IMP, STORE IN WAITS FILE SYSTEM
;; ENVIRONMENTAL PREQUISITES FOR CALLING DIROUT:
;; 1) WAITS FILE SYSTEM IS INITIALIZED, AND HAS BEEN
;; "ENTERED". THE DI ROUTINE WILL STORE THE FILE IN WAITS
;; FILE SYSTEM USING BUFFER HEADER "FIBUF".
;; 2) C(DIMODE) INDICATES MODE OF DATA TRANSFER
;; 4) C(DITYPE) INDICATES TYPE OF DATA (ARPANET FTP CONVENTIONS)
;; 5) C(FOTYPE) INDICATES MOVE OF DATA TRANSFER (LOCAL TO
;; WAITS, THIS INDICATES THE WAY OF HANDLING "FIBUF" BUFFER).
;; WHAT DI ROUTINE DOES:
;; 1) INITS THE IMP, ON CHANNEL DIMP.
;; 2) ESTABLISHES DATA CONNECTION WITH FOREIGN USER TELNET.
;; 3) ACCEPTS DATA FROM IMP, STUFFING IT INTO WAITS FILE
;; SYSTEM.
;; 4) CLOSES DATA CONNECTION AND RELEASES WAITS FILE SYSTEM
;; UPON ANY OF THE FOLLOWING:
;; A) DATA CONNECTION CLOSED FOR ANY REASON
;; B) EOF ARRIVES ON DATA CONNECTION
;; C) "DIABORT" FLAG IS FOUND TO BE SET
;; D) ERROR IN WAITS FILE SYSTEM
DIROUT: MOVEI B,1 ;INDICATE DATA DIRECTION "IN"
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST ICONER ;ERROR
;;# DCS 10-15-72 ADD FTP START RESPONSE HERE PER CMU REQUEST
MOVEI A,DIMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
IFE FTIP,<
MOVE E,[POINT 7,[ASCIZ /250 Socket to me!
/]]
>;IFE FTIP
IFN FTIP,<
MOVE E,[POINT 7,[ASCIZ /125 Socket to me!
/]]
>;IFN FTIP
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
;;# DCS
MOVNI FLG2,1
TLO FLG,MEOFBT
MOVE B,[JRST CPOPJ2] ;MOST DATA MODES RETURN SUCCESSFUL WITH ANY BYTE
MOVE A,DIMODE ; BUT TEXT MODE MUST DO AN EOF TEST FIRST
CAIN A,2 ;ARE WE DOING TEXT MODE TRANSFER?
MOVE B,[JRST GETDAE] ; YES, SPECIAL GLITCH
MOVEM B,GETDA0 ;PLANT RETURN INSTRUCTION
DIROU1: HRROI C,-40
DIROU2: PUSHJ P,GETDAT ;C(A) ← BYTE OF DATA FROM IMP
JRST DIERR3 ; FAILURE RETURN
JRST DIEOF9 ; EOF RETURN
IFE FTIP,<
SKIPN EOFMAI
JRST DIROU3
AOJN FLG2,DIRO25
PUSHJ P,MFRINI ;"FROM" LINE FINDER LINE INIT
IFN FTMSJ,<
PUSHJ P,MSJINI ;"SUBJECT" LINE FINDER LINE INIT
>;IFN FTMSJ
JRST DIROU3
DIRO25: PUSHJ P,MFRCHR ;"FROM" LINE FINDER CHAR SCANNER
IFN FTMSJ,<
PUSHJ P,MSJCHR ;"SUBJECT" LINE FINDER CHAR SCANNER
>;IFN FTMSJ
>;IFE FTIP
DIROU3:
IFN %XRCP,<
SKIPE XRBPTR
JRST [ PUSHJ P,XRCHO
JRST .+3] ; Bypass PUTFIL & err return.
>;IFN %XRCP
PUSHJ P,PUTFIL
JRST DIERR2
CAIN A,12
MOVNI FLG2,1
AOJL C,DIROU2
PUSHJ P,SXACTV
PUSHJ P,DIWAIT
JRST DIROU1
DIERR: PUSHJ P,DIMPSTR
IFE FTIP,<
ASCIZ /452 STOR incomplete, data connection closed early.
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /426 STOR incomplete, data connection closed early.
/
>;IFN FTIP
JRST DIER2A
ICONER: SETZM HOLDIL ;now OK to start up again
PUSHJ P,DIMPSTR
IFE FTIP,<
ASCIZ /454 STOR incomplete, can't connect to your data socket
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /425 STOR incomplete, can't connect to your data port
/
>;IFN FTIP
JRST DIER2A
DIERR2: PUSHJ P,DIMPSTR
IFE FTIP,<
ASCIZ /453 STOR incomplete, local file system error
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /451 STOR incomplete, local file system error
/
>;IFN FTIP
DIER2A:
IFE FTIP,<
SETZM EOFMAI ;ERROR. FORGET ABOUT SPECIAL MAIL STUFF
IFN %XRCP,<
SKIPE XRBPTR
JRST [ PUSHJ P,XRSRST
JRST DIFINI]
>;IFN %XRCP
>;IFE FTIP
RELEAS FIMP,3 ; BECAUSE WE ARE FLUSHING THE OUTPUT HERE
JRST DIFINI
DIEOF9:
IFE FTIP,<
SKIPN EOFMAI
JRST DIEOF
IFN %XRCP,<
SKIPE XRBPTR
JRST [ PUSHJ P,XRSSET ; Finalize saved text stuff.
PUSHJ P,DIMPSTR
ASCIZ /252 Text saved.
/
JRST DIFINI]
>;IFN %XRCP
USETO FIMP,1 ;BACK UP TO WHERE THE COMMAND BELONGS
PUSHJ P,WRHDR
>;IFE FTIP
DIEOF: MOVE A,DITYPE ;SPECIAL EOF FOR IMAGE TYPE
SOJN A,DIEOFQ ;ELSE JUST CLOSE EVERYTHING
IFN FTIP,<
;JJW 12/83 If other host is 36-bit and file length in words is even, FIWORD is
;now full and we need to store it. If file length is odd, we've already stored
;the 4 data bits in the last 8-bit byte, and the other 4 are padding. I'm not
;sure what happens, though, with non-36-bit hosts.
SKIPE FIBTSL ;Do store if full word (even length file)
JRST DIEOFQ
>;IFN FTIP
MOVE A,FIWORD ;GET LAST PARTIAL WORD
PUSHJ P,PUTFI0
JFCL ;NEVER MIND ERROR, TOO LATE
DIEOFQ: RELEASE FIMP,
IFE FTIP,<
SKIPN EOFMAI
JRST DIEOF1
MOVEI A,RMDWAK
WAKEME A,
JFCL
>;IFE FTIP
DIEOF1: JUMPL FLG,DIEOML
PUSHJ P,DIMPSTR
IFE FTIP,<
ASCIZ /252 Finis; /
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 Finis; /
>;IFN FTIP
PUSHJ P,ERRFN
PUSHJ P,DIMPSTR
ASCIZ/
/
DIFINI: SETZM DIACTV
RELEASE DIMP,
SKIPN QUITNG ;IF TRIED TO QUIT, TRY
POPJ P, ; AGAIN (MULTIPLE-SUICIDE MODE)
JRST BYE1
DIEOML:
IFN FTIP,<
PUSHJ P,DIMPSTR
ASCIZ /451 Server error, impossible flag set
/
JRST DIER2A ;this should never happen anyway
>;IFN FTIP
IFE FTIP,<
TRNN FLG,17 ;WAS THIS A MAIL&FRIENDS COMMAND, OR MLFL?
JRST DIMLFL ;MLFL -- succeeds with different code
PUSHJ P,DIMPSTR
ASCIZ /256 Thanks for the blurb
/
JRST DIFINI
DIMLFL: PUSHJ P,DIMPSTR
ASCIZ /252 Thanks for the blurb
/
JRST DIFINI
>;IFE FTIP
DIERR3: PUSHJ P,DIMPSTR
IFE FTIP,<
ASCIZ /452 STOR incomplete, error reading data connection
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /426 STOR incomplete, error reading data connection
/
>;IFN FTIP
JRST DIER2A
RMDWAK: '<RMND>'
RMDSYS: 'RMDSYS'
0
OMLGET: SOSG OMLBUF+2
IN .OLD,
JRST OMLGT1
STATO .OLD,20000
JRST DIERR2
POPJ P, ;EOF
OMLGT1: ILDB A,OMLBUF+1
JUMPE A,OMLGET
JRST CPOPJ1
OMLOUT: SOSG FIBUF+2 ;ROOM IN BUFFER?
OUT FIMP, ; NO, DO AN OUTPUT
CAIA
JRST DIERR2 ; OUTPUT FAILS
IDPB A,FIBUF+1 ;STUFF DATA BYTE INTO BUFFER
POPJ P,
OMLOPN: 0
SIXBIT /DSK/
XWD 0,OMLBUF
OMLBUF: BLOCK 3
OMLNAM: 0
SIXBIT /MSG/
0
SIXBIT / 2 2/
;; CALL: MOVE A,<BYTE TO GO INTO LOCAL FILE SYSTEM>
;; PUSHJ P,PUTFIL
;; ERROR RETURN
;; NORMAL RETURN
PUTFIL: MOVE B,DITYPE ;PROCESSING DEPENDS ON TYPE
JRST .+1(B) ;DISPATCH
JRST PUTFI2 ;ASCII, DO CHAR TRANSLATION
JRST PUTFI3 ;IMAGE, HAIRY CROCK. ELSE LOCAL BYTE
PUTFI0: SOSG FIBUF+2 ;ROOM IN BUFFER FOR THIS BYTE?
OUT FIMP, ; NO, OUTPUT THE BUFFER
JRST PUTFI1 ;ROOM IN BUFFER, OR SUCCESSFUL OUTPUT
POPJ P, ; ERROR RETURN
PUTFI1: IDPB A,FIBUF+1 ;PUT BYTE INTO BUFFER
JRST CPOPJ1 ;SUCCESS RETURN
PUTFI2: JUMPE A,CPOPJ1 ;ASCII, IGNORE NULLS,
CAIL A,200
JRST CPOPJ1 ; IGNORE FUNNY NVT CODES,
;ASCII to WAITS character conversion
CAIN A,32
AOJA A,PUTFI0 ;not-equals
CAIN A,176
MOVEI A,32 ;TILDE
CAIN A,175
MOVEI A,176 ;RIGHT BRACE
CAIN A,33
MOVEI A,175 ;ALTMODE
JRST PUTFI0 ;NOW NORMAL IO STUFF
PUTFI3: SKIPE B,FIBTSL ;HAIRY IMAGE MODE WRAPAROUND BYTE CROCK
JRST PUTFI4
EXCH A,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVE A,FIWORD
SETZM FIWORD
MOVS B,DIBS
LSH B,6
IOR B,[POINT 0,FIWORD]
MOVEM B,FIBPT
MOVEI B,=36
PUTFI4: SUB B,DIBS
MOVEM B,FIBTSL
JUMPL B,PUTFI5
IDPB A,FIBPT
JRST CPOPJ1
PUTFI5: MOVEI B,0
MOVE D,FIBTSL
LSHC A,(D) ;POSITION THE NEW BYTE
IOR A,FIWORD
MOVEM B,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVEI A,=36
ADDB A,FIBTSL
LSH A,6 ;MAKING NEW BPT
ADD A,DIBS
LSH A,=24
HRRI A,FIWORD
MOVEM A,FIBPT
JRST CPOPJ1
FIBTSL: 0
FIWORD: 0
FIBPT: 0
;⊗ GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
;; GETDAT - GET DATA BYTE FROM IMP DATA CONNECTION
;; CALL: PUSHJ P,GETDAT
;; RETURN HERE, ERROR
;; RETURN HERE, EOF
;; RETURN HERE, C(A) = DTAT BYTE
GETDAT: SOSG DIBUF+2 ;BYTE IN BUFFER?
JRST GETDA2 ; NO, THINK ABOUT DOING AN INPUT
GETDA1: ILDB A,DIBUF+1 ;GET THE DATA BYTE
GETDA0: 000 ; [JRST CPOPJ2] OR [JRST GETDAE]
GETDA2: PUSH P,B ;GET AN ACCUMULATOR TO PLAY WITH
HRRZ B,DIBUF ;GET POINTER TO BUFFER
HRRZ B,(B) ;GET POINTER TO NEXT BUFFER
SKIPGE (B) ;IS THERE DATA IN THAT BUFFER?
JRST GETDA3 ; YES, DO AN INPUT
INTOFF ;TURN OFF INTERRUPTS
MTAPE DIMP,[10] ;INPUT DATA WAITING IN FREE STORAGE?
JRST GETDA4 ; NO
INTON
GETDA3: POP P,B
IN DIMP,
JRST GETDA1 ;SUCCESSFUL INPUT
POPJ P, ;ERROR ON INPUT, GIVE ERROR RETURN
GETDA4: INTON ;TURN ON INTERRUPTS
POP P,B
MTAPE DIMP,GETDA7 ;GET STATUS OF CONNECTION
MOVE A,GETDA7+2 ;GET STATUS BITS
TLC A,RFC
TLNE A,RFC!CLS ;IS SOMEBODY CLOSING THIS CONNECTION?
JRST GETDAC ; YES
GETDA5: PUSHJ P,DIWAIT ;WAIT FOR AWHILE, ...
JRST GETDA2 ; ... AND TRY AGAIN
GETDA7: 2 ↔ 0 ↔ 0 ;DATA BLOCK FOR MTAPE UUO
GETDAC: MOVE A,DIMODE ;ARRIVE HERE IF DI CONNECTION CLOSES
JRST .+1(A) ;DISPATCH ACCORDING TO CONNECTION MODE
JRST CPOPJ1 ;STREAM MODE, GIVE EOF RETURN
000 ;BLOCK MODE, UNIMPLEMENTED
POPJ P, ;TEXT MODE, GIVE ERROR RETURN
000 ;HASP MODE, UNIMPLEMENTED
GETDAE: CAIE A,301 ;ARRIVE HERE WITH BYTE IF DI CONNECTION IS
JRST CPOPJ2 ; TEXT MODE, GIVE NORMAL RETURN HERE.
JRST CPOPJ1 ; UNLESS EOF, GIVE EOF RETURN HERE.
;⊗ DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR OCONER
;; DOROUT - GET DATA FROM LOCAL FILE SYSTEM, TRANSMIT TO IMP
;; ENVIRONMENTAL PREREQUISITES FOR CALLING DOROUT:
;; 1) WAITS FILE SYSTEM IS INIT'ED, AND LOOKUP HAS BEEN
;; DONE. DOROUT WILL RETRIEVE THE FILE USING BUFFER
;; HEADER "FOBUF".
;; 2) C(DOMODE) INDICATES MODE OF DATA TRANSFER.
;; 3) C(DOTYPE) INDICATES TYPE OF DATA TRANSFER.
;; WHAT DOROUT DOES:
;; 1) INITS THE IMP, ON CHANNEL DOMP.
;; 2) ESTABLISHED DATA CONNECTION WITH FOREIGH TELNET.
;; 3) READS DATE FROM LOCAL FILE SYSTEM, TRANSMITTING IT
;; TO THE IMP.
;; 4) CLOSES DATA CONNECTION ON EOF FROM FILE SYSTEM
DOROUT: TLNE FLG,LISTFL ;IF THIS IS THE LIST COMMAND,
JRST STATDO ; GO BACK TO STAT ROUTINE FOR OUR PART
MOVEI B,0
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST OCONER ; CAN'T MAKE DATA CONNECTION
MOVEI A,DOMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
IFE FTIP,<
MOVE E,[440700,,[ASCIZ /250 Look out! Here comes /]]
>;IFE FTIP
IFN FTIP,<
MOVE E,[440700,,[ASCIZ /125 Look out! Here comes /]]
>;IFN FTIP
PUSHJ P,ASCIIE
PUSHJ P,ERRFN
MOVE E,[440700,,[ASCIZ/
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
SETOM NOEDIR# ;FLAG TO HELP ASCII TYPE FLUSH E DIRECTORY
DOROU1: HRROI C,-40
DOROU2: PUSHJ P,GETFIL ;C(A) ← BYTE OF DATA FROM FILE
JRST DOERR
JRST DOEOF
SOSG DOBUF+2 ;ROOM FOR BYTE IN DOMP BUFFER?
PUSHJ P,DOROU3 ; NO, DO OUTPUT TO IMP
IDPB A,DOBUF+1 ; YES, PUT IT IN
AOJL C,DOROU2 ;LOOP FOR NEXT BYTE IF NOT TOO MANY
PUSHJ P,SXACTV ;TOO MANY ALL AT ONCE, PAUSE SO THE
PUSHJ P,DOWAIT ; CONTROL LINK CAN GET IT IF IT WANTS
JRST DOROU1 ;CONTINUE
DOROU3: ;IT MIGHT BE NICE TO PUT A TEST HERE TO
; INSURE THAT THE OUTPUT WILL NOT HANG
OUT DOMP,
POPJ P,
MES (OUT DOMP fails)
JRST ERRKIL
DOEOF: PUSHJ P,DOMPSTR
IFE FTIP,<
ASCIZ /252 The End
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /250 The End
/
>;IFN FTIP
DOEOF1: PUSHJ P,DOROU3
DOEOF2: RELEASE FOMP,
RELEASE DOMP,
SETZM DOACTV
SKIPN QUITNG ;IF TRIED TO QUIT, TRY AGAIN
POPJ P, ; (QUITTERS NEVER QUIT QUITTING)
JRST BYE1
DOERR: PUSHJ P,DOMPSTR
IFE FTIP,<
ASCIZ /453 RETR incomplete, local file system error
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /451 RETR incomplete, local file system error
/
>;IFN FTIP
JRST DOEOF1
;Here on error making data connection for listing
DOERRC: POP P,DOBS ;restore saved data
POP P,DOTYPE
CAIA
OCONER: SETZM HOLDIL ;now OK to start up again
PUSHJ P,DOMPSTR
IFE FTIP,<
ASCIZ /454 RETR incomplete, can't connect to your data socket
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /425 RETR incomplete, can't connect to your data port
/
>;IFN FTIP
JRST DOEOF2
;⊗ GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI9 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK
;; GETFIL
;CALL: PUSHJ P,GETFIL
; ERROR RETURN
; EOF RETURN
; NORMAL RETURN
; Getfil -- Get data byte from local file system. GETDAT
GETFIL: MOVE A,DOTYPE ;GETTING FROM FILE IS HAIRY
CAIN A,1 ; IF IMAGE TYPE
JRST GETFI3 ; ELSE DROP THROUGH TO STANDARD ROUTINE
GETFI0: SOSG FOBUF+2 ;DATA BYTE IN BUFFER?
JRST GETFI2 ; NO, DO AN INPUT
GETFI1: ILDB A,FOBUF+1 ; YES, GET DATA BYTE
JRST GETFI6 ; AND RETURN UNLESS ASCII
GETFI2: IN FOMP, ;DO AN INPUT
JRST GETFI1 ; INPUT WAS SUCCESSFUL
GETSTS FOMP,B ; EOF OR ERROR, GET STATUS BITS IN B
TRNE B,IODEND ;EOF?
JRST CPOPJ1 ; YES
MES (Error detected on FOMP)
POPJ P,
GETFI3: SKIPE A,FOBTSL ;IMAGE MODE: MORE BITS IN THE CURRENT FILE WORD?
JRST GETFI4 ; YES, CARRY ON
MOVS A,DOBS ;ELSE CREATE A NEW BPT
LSH A,6 ;BYTE SIZE INTO S FIELD
IOR A,[POINT 0,FOWORD] ;POSITION TO BEGINNING OF WORD
MOVEM A,FOBPT
PUSHJ P,GETFI0 ;GET ANOTHER WORD
POPJ P, ;ERROR RETURNS
JRST CPOPJ1
MOVEM A,FOWORD ;SAVE FILE WORD FOR BYTE EXTRACTION
MOVEI A,=36 ;INIT BITS LEFT
GETFI4: SUB A,DOBS ;SUBTRACT BYTE SIZE FROM BITS LEFT IN WORD
MOVEM A,FOBTSL
JUMPL A,GETFI5 ;JUMP IF NOT ENOUGH
ILDB A,FOBPT ;THIS IS AN EASY ONE
JRST CPOPJ2
GETFI5: PUSHJ P,GETFI0 ;WRAPAROUND CASE, GET NEXT WORD
POPJ P,
IFE FTIP,<
JRST CPOPJ1
>;IFE FTIP
IFN FTIP,<
JRST GETFI9 ;JJW 12/83 Deal with partial word at EOF
>;IFN FTIP
MOVEM A,FOTEMP ;SAVE NEXT WORD
MOVE B,A ;POSITION FOR LSHC
MOVE A,FOWORD
MOVN D,FOBTSL ;*** NOTE WE ARE USING AC D. C IS IN USE UPLEVEL.
LSHC A,(D) ;POSITION COMBINATION BYTE
AND A,FOMASK ;FLUSH CRUFT
MOVE B,FOTEMP
MOVEM B,FOWORD ;SET UP FOR NEW WORD
MOVEI B,=36
ADDB B,FOBTSL
LSH B,6 ;MAKE NEW BPT
ADD B,DOBS
LSH B,=24
HRRI B,FOWORD
MOVEM B,FOBPT
JRST CPOPJ2
IFN FTIP,<
;Here for Image mode at EOF when there is a partial byte left.
GETFI9: MOVE A,FOWORD
SETZ B, ;Pad it with zeros
MOVN D,FOBTSL ;Same as above
LSHC A,(D)
AND A,FOMASK
SETZM FOBTSL ;Make next call to GETFIL fail
JRST CPOPJ2
>;IFN FTIP
GETFI6: SKIPE DOTYPE ;DONE EXCEPT FOR ASCII MODE
JRST CPOPJ2
JUMPE A,GETFIL ;FOR ASCII, WE FLUSH NULLS
MOVE B,@FOBUF+1 ; CHECK FOR SOS LINE NUMBERS
TRNN B,1
JRST GETFI7
MOVNI B,5
ADDM B,FOBUF+2
AOS FOBUF+1
JRST GETFIL
GETFI7: AOSE NOEDIR ; CHECK FOR E DIRECTORY
JRST GETFI8
MOVE D,FOBUF+1
MOVE B,(D)
CAME B,[ASCII /COMME/]
JRST GETFI8
MOVE B,1(D)
CAME B,[ASCII /NT ⊗ /]
JRST GETFI8
MOVE B,2(D)
CAME B,[ASCII / VAL/]
JRST GETFI8
GETF71: PUSHJ P,GETFIL
POPJ P,
JRST CPOPJ1
CAIE A,14
JRST GETF71
JRST GETFIL
;finish with WAITS to ASCII character conversion
GETFI8: CAIN A,33
SOJA A,CPOPJ2 ;not-equals
CAIN A,175
MOVEI A,33 ;ALTMODE
CAIN A,176
MOVEI A,175 ;RIGHT BRACE
CAIN A,32
MOVEI A,176 ;TILDE
JRST CPOPJ2
FOBTSL: 0
FOWORD: 0
FOBPT: 0
FOTEMP: 0
FOMASK: 0
;⊗ NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
; OUTPUT IS TO DISK FILE
DEFINE STROUT(X) <
MOVEI B,X
PUSHJ P,WRTSTR
>
DEFINE OUT1 (X) <MOVE A,X ↔ XCT OUTINSTR>
DEFINE PRNUM(X,N) <
IFN X-T2,<MOVE T2,X ;arranged to be ok for this routine,
; to clobber T2 whenever prnum called>
PUSHJ P,NUMPR ;ok to generate multiple words
N ; in PRNUM -- this is min width
>;PRNUM
NUMPR:PUSH P,T1
MOVE T1,@-1(P)
PUSHJ P,NUMPR1
POP P,T1
AOS (P)
POPJ P,
NUMPR1:IDIVI T2,=10
IORI T3,"0"
HRLM T3,(P)
SUBI T1,1
JUMPE T2,.+2
PUSHJ P,NUMPR1
JUMPLE T1,DON0
OUT1 (["0"])
SOJG T1,.-1
DON0:HLRZ T2,(P)
OUT1 T2
POPJ P,
; THE DATGEN ROUTINE
DATGEN: DATE T1,
IDIVI T1,=31
ADDI T2,1
PUSH P,T2
NODA1: IDIVI T1,=12
MOVEI T3,261 ;DAYLIT
PEEK T3,
PEEK T3,
SKIPE T3
SKIPA T3,[PDDATE]
MOVEI T3,PSDATE
MOVEM T3,DTKIND
MOVEI B,@MONTAB(T2)
PUSHJ P,WRTSTR
POP P,A
IDIVI A,=10
JUMPE A,ONEDDD
ADDI A,"0"
XCT OUTINSTR
ONEDDD: MOVEI A,"0"(B)
XCT OUTINSTR
MOVEI B,[ASCIZ/, /]
PUSHJ P,WRTSTR
MOVEI T2,=1964(T1)
PRNUM (T2,2)
STROUT ([ASCIZ/ /])
NODATE: MSTIME T2,
IDIVI T2,=1000*=60
IDIVI T2,=60
MOVE T1,T3
PRNUM (T2,2)
MOVE T2,T1
PRNUM (T2,2)
NOTIME: STROUT (@DTKIND)
NOZON: POPJ P,
MONTAB: [ASCIZ/January /]
[ASCIZ/February /]
[ASCIZ/March /]
[ASCIZ/April /]
[ASCIZ/May /]
[ASCIZ/June /]
[ASCIZ/July /]
[ASCIZ/August /]
[ASCIZ/September /]
[ASCIZ/October /]
[ASCIZ/November /]
[ASCIZ/December /]
PDDATE: ASCIZ/ PDT/
PSDATE: ASCIZ/ PST/
DTKIND: 0
;⊗ ILEVEL DNTSAY timout SXACTV LOOK
; INTERRUPT LEVEL ROUTINE
ILEVEL: MOVE A,JOBCNI
ifn iverbose, <
PTOCNT LOOK
MOVE b,LOOK+1
CAILE b,120 ;make sure plenty of room in output buffer
JRST DNTSAY ;not enough room, avoid I-level schedule attempt
outchr ["↔"]
tlne a,intinp
outchr ["p"]
tlne a,intims
outchr ["s"]
TLNE A,INTINS
OUTCHR ["A"]
>;ifn iverbose
DNTSAY: tlne a,intclk
jrst timout
TLNE A,INTINS
SOS SYNCH ;IF THIS GOES NEGATIVE WE STOP TILL IT CATCHES UP
TLNE A,INTINS
SETZM CIHUNG ;PREPARES US FOR A COMMAND AT ONCE (BETTER BE ABOR)
TLNE A,INTIMS
SETOM SCHEKF ;Status CHEcK Flag
MOVE A,[-3]
MOVEM A,XACTV
DISMIS
timout: debreak
jrst errkil
SXACTV: PUSH P,[-3] ;HANDY ROUTINE TO SET XACTV
POP P,XACTV ; WITHOUT CLOBBERING ANY
POPJ P, ; ACCUMULATORS
ifn iverbose, <
LOOK: 0↔0
>
;⊗ GETHNM CPYHST CPYDUN HSTTAB HSTSIX WHYWHY
SUBTTL HOST NAME MAGIC USING NETWRK
GETHNM:
BEGIN NETHAK
PUSH P,A
PUSHJ P,MAPHST ;get host table into core
MOVE 0,HOSTNO ;Get IP format host number
PUSHJ P,HSTNUM ;get host name from number
JRST [ MOVEI 1,HSTSTR ;Failed, make NETWRK put number in HSTSTR for us
PUSHJ P,HNUMST
JRST CPYDUN]
PUSH P,1 ;save ptr to name
HRLI 1,440700 ;make byte ptr to name
MOVE 2,[440700,,HSTSTR]
CPYHST: ILDB 1 ;copy host name text to HSTSTR
IDPB 2
JUMPN CPYHST
POP P,1
CPYDUN: PUSHJ P,SETANM ;set alias name to something rep'ing foreign host
PUSHJ P,UNMHST ;flush host table from core (core down)
POP P,A
POPJ P,
HSTTAB←←1
HSTSIX←←1
IFN FTIP,<ERRTNS←←1> ;Also get error routine
WHYWHY: 0 ;unused, but ref'd by NETWRK's HSTDED (not called)
.INSERT NETWRK.FAI[S,NET]
BEND NETHAK
;⊗ QUIT BYE BYE1 BYE2 ERRKIL QUITX QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
; MISCELLANEOUS ERROR MESSAGES ERRKIL, BYE, QUIT, FLUSH, ABOR, GREET
IFN FTIP,<
QUIT:
>;IFN FTIP
BYE: PUSHJ P,FLUSCS ;THE COMMAND
BYE1: SKIPN DIACTV ;IF I/O ACTIVE, CAN'T QUIT YET
SKIPE DOACTV
JRST [SKIPE QUITNG ;GIVE INTERIM MESSAGE BUT ONCE
POPJ P,
SETOM QUITNG# ;THIS IS HOW
PUSHJ P,IMPSTR
ASCIZ /503 I'll split just as soon as the current transfer is done.
/
POPJ P,]
BYE2: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ /231 CUL
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /221 CUL
/
>;IFN FTIP
ERRKIL: MTAPE IMP,NEWTMO ;Order of RELEASing changed to insure
RELEASE IMP, ;at least the control link gets closed.
PUSHJ P,FLUSH ;FLUSH ALL DATA I/O
MOVE A,['KILL-2']
MOVEM A,KFLAG
QUITX: RELEASE FIMP,3 ;IN CASE OF MAIL ABORT
SETZM PRIVS ;PARANOID? ME, PARANOID?
RESET ;IF ATTACHED TO A TERMINAL,
MOVNI B,1 ; START OVER (TEST AGAIN
GETLIN B ; IN CASE IT'S CHANGED).
AOJN B,QUIT1
EXIT
QUIT1: OUTSTR [ASCIZ /Starting over
/]
JRST START
ABOR: SETZM DIACTV ;FLUSH ALL ACTIVITY
SETZM DOACTV
SETZM DIHUNG ;AND RESET COROUTINES
SETZM DOHUNG
PUSHJ P,IMPSTR ;BARF SO WHAT IF SCARCE RESOURCE
IFE FTIP,<
ASCIZ /201 El grande de grosse ABORtion
/
>;IFE FTIP
IFN FTIP,<
ASCIZ /226 El grande de grosse ABORtion
/
>;IFN FTIP
PUSHJ P,FLUSH
JRST REGO ;RESET ALL ACTV, HUNG, AND PDLS
FLUSH: RELEASE FIMP,3 ;(The other mtapes get unassigned I/O
RELEASE FOMP,3 ;sometimes)
CHNSTS DIMP,A ;FIXING ABOVE LOSS
TRNE A,400000
MTAPE DIMP,NEWTMO
RELEASE DIMP,
CHNSTS DOMP,A ;FIXING ABOVE LOSS
TRNE A,400000
MTAPE DOMP,NEWTMO
RELEASE DOMP,
POPJ P,
NEWTMO: 17
BYTE (6) 2,24,24,7,7
NOIMP: MES(CANNOT INIT IMP)
JRST ERRKIL
UFLUSH: PUSHJ P,PUTBUF ; EXCRETE MESSAGE
MOVEI B,5
SLEEP B,
JRST QUITX
GREET:
MOVE E,[-LOURH3,,OURH3] ;aobjn ptr to list of our host nbrs
MOVE B,HOSTNO ;get nbr of foreign host
GREETL: CAMN B,(E) ;is this one of our host nbrs?
JRST GREET0 ;host nbr is ours, let us in even if system down
AOBJN E,GREETL ;no, check other numbers
MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET0
PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ/451- /
>;IFE FTIP
IFN FTIP,<
ASCIZ/421- /
>;IFN FTIP
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS FTP Server at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ\
451 Sorry, the system is being debugged. Try again later.
\
>;IFE FTIP
IFN FTIP,<
ASCIZ\
421 Sorry, the system is being debugged. Try again later.
\
>;IFN FTIP
IFN FTIP,<
OUTSTR [ASCIZ/MaintMode: Refusing /]
PUSHJ P,SAYWHO
>;IFN FTIP
JRST UFLUSH
GREET0: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ/300- /
>;IFE FTIP
IFN FTIP,<
ASCIZ/220- /
>;IFN FTIP
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS FTP Server at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
MOVEI B,256 ; LASTDISASTERTIME
PEEK B,
PEEK B,
JUMPE B,NOFLAK
ACCTIM A,
SUB A,B
TLZE A,1 ;FORGIVE ONE DAY
ADDI A,=24*=60*=60
CAILE A,=15*=60
JRST NOFLAK
PUSHJ P,IMPSTR
ASCIZ/
The system is misbehaving. Proceed with caution!/
NOFLAK: MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET1
PUSHJ P,IMPSTR
ASCIZ/
The system is being debugged./
GREET1: PUSHJ P,IMPSTR
IFE FTIP,<
ASCIZ\
300 Bugs/gripes to Bug-FTP @ \
>;IFE FTIP
IFN FTIP,<
ASCIZ\
220 Bugs/gripes to Bug-FTP @ \
>;IFN FTIP
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPCR ;output crlf
POPJ P,
IFN FTIP,<
SAYWHO: OUTSTR [ASCIZ /Connection from host /]
PUSHJ P,GETHNM
OUTSTR HSTSTR
OUTSTR [ASCIZ/
/]
POPJ P,
>;IFN FTIP
;Unimplemented commands ;⊗ REIN PASV REST SITE
IFN FTIP,<
REIN:
PASV:
REST:
SITE: PUSHJ P,IMPSTR
ASCIZ/502 Sorry, that command is not implemented
/
JRST FLUSCS
>;IFN FTIP
END START