perm filename MAIL.MAC[IP,NET] blob
sn#702355 filedate 1983-02-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00056 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00006 00002 TITLE MAIL -- COMPLICATED MAIL SYSTEM
C00009 00003 EDIT HISTORY (VERSION 7)
C00015 00004 \
C00025 00005
C00030 00006 SUBTTL INITIALIZATION AND COMMAND DECODING
C00039 00007 GET NAMES OF ALL USERS TO BE MAILED TO
C00043 00008 SUBTTL SEND MAIL
C00047 00009 READ NEXT ACCT.SYS ENTRY
C00051 00010 HERE WHEN REACH THE END OF ACCT.SYS
C00056 00011 SUBTTL SEND MAIL - READ THE TEXT OF THE MAIL INTO CORE
C00058 00012 READING FROM A TTY. GIVE INSTRUCTIONS.
C00061 00013 (EOL) SOME SPECIAL EOL CHARACTERS PUT A CRLF INTO THE TEXT.
C00066 00014
C00069 00015 SUBTTL MAIN MAIL SENDER
C00071 00016 NOW LOOP THROUGH ALL NAMES, SENDING WHERE APPROPRIATE
C00074 00017 SUBTTL MAIL SENDER SUBROUTINES
C00076 00018 ROUTINE TO ACTUALLY WRITE THE LETTER
C00078 00019 IFN FTCIMP,<
C00080 00020 HEADER - SUBROUTINE TO BUILD A HEADER IN CORE, EITHER TO SEND TO NET
C00087 00021
C00088 00022
C00089 00023 SUBTTL RECEIVE MAIL
C00095 00024 WRITE A PIP COMMAND FILE FOR PRINTING THE MAIL
C00100 00025 HERE WHEN RENAME INTO USER'S DIRECTORY FAILED
C00104 00026 SUBTTL COMMAND SCANNER SUBROUTINES
C00115 00027
C00116 00028 ROUTINE TO GET A HALF-WORD OCTAL NUMBER
C00120 00029 IFN FTCIMP,<
C00123 00030 GETUSR (CONT'D)
C00128 00031 ROUTINE TO GET TWO WORDS OF SIXBIT ALPHANUMERIC TEXT
C00132 00032 ROUTINE TO SEARCH FOR SIXBIT NAME IN A TABLE, WITH UNIQUE AND FORCED
C00136 00033 SUBTTL QUEUE ROUTINES
C00138 00034 SUBROUTINE FOR USE WHEN FTP ATTEMPT FAILS, TO QUEUE THE MAIL
C00140 00035 HERE TO SEND OUT QUEUED MAIL
C00149 00036 SUBROUTINES USED BOTH BY QUEUE AND FORWARD [41]
C00153 00037 SUBROUTINES TO MANIPULATE LINKED LISTS [44,45]
C00155 00038 SUBTTL HELP ROUTINES
C00157 00039 SUBTTL FTP ROUTINES FOR SENDING MAIL TO ARPANET
C00161 00040 ROUTINE TO CLOSE FTP MAIL CONNECTION
C00163 00041 ROUTINE TO GET A REPLY FROM THE FTP SERVER
C00167 00042 ROUTINE TO ABORT FTP CONNECTION
C00169 00043 FTP CHAR-AT-A-TIME INPUT ROUTINE
C00172 00044 SUBTTL CHECK MAIL ROUTINE
C00175 00045 SUBTTL MISCELLANEOUS SUBROUTINES
C00180 00046 ROUTINE TO SET SOME THINGS INTO THE MAILBOX FILE BLOCK
C00182 00047 ROUTINE TO SAVE A COPY OF THE MAIL BEING SENT ON NNNMAI.TMP
C00185 00048 ROUTINE TO OPEN AN INCORE TEMP FILE FOR SENDING OUTPUT.
C00187 00049 ROUTINE TO GET THE MAIL SYSTEM INTERLOCK
C00193 00050 ROUTINE TO EXTRACT JUST A USER'S LAST NAME (STRIP OFF
C00198 00051 ROUTINE TO PRINT TIME OF DAY
C00204 00052 CHKUNX:
C00206 00053 SUBTTL CCTRAP-- CONTROL-C TRAP ROUTINE [AFAL-10]
C00208 00054 SUBTTL INITIAL FILE BLOCKS
C00210 00055 FILE BLOCK FOR READING MAILBOX
C00214 00056 SUBTTL LOW SEGMENT
C00220 ENDMK
C⊗;
TITLE MAIL -- COMPLICATED MAIL SYSTEM
SUBTTL E. A. TAFT/DK/DAR/DAW -- 24-MAR-76
TWOSEG
RELOC 400000
SEARCH MACTEN,UUOSYM,TULIP,IMP
.DIRECTIVE SFCOND,.XTABM
; to assemble, define appropriate conditional switches in a parameter
; file and compile with "compile mail.par+mail.mac.
;ASSEMBLY SWITCHES:
IFNDEF FTRUTG,<FTRUTG== 0> ;ASSEMBLE RUTGERS-ONLY CODE
IFNDEF FTHARV,<FTHARV== 0> ;ASSEMBLE HARVARD-ONLY CODE
IFNDEF FTNBS, <FTNBS== 0> ;ASSEMBLE NBS-ONLY CODE
IFNDEF FTAFAL,<FTAFAL== 0> ;assemble avsail-only code
IFE FTRUTG!FTHARV!FTNBS!FTAFAL,<
PRINTX ?No site switch selected. Define one in parameter file.
>
;[afal-21] define in parameter file if not these. if you don't
; have (or want) daylight saving's time, define DSTime==0
ifndef TimeZn,<TimeZn==sixbit \EST\> ;[afal-21] normal time
ifndef DSTime,<DSTime==sixbit \EDT\> ;[afal-21] daylight time
IFNDEF FTCIMP,<FTCIMP==-1> ;ASSEMBLE APRANET-ONLY CODE
IFNDEF FTBCOM,<
IFN FTCIMP,<FTBCOM==-1> ;ASSEMBLE MAIL REQUEUE CODE
IFE FTCIMP,<FTBCOM== 0>
>
IFNDEF FTMSGH,<FTMSGH==-1> ;ASSEMBLE MSGH SUPPORT CODE
IFNDEF FTGUES,<FTGUES== 0>
IFNDEF FTHELP,<FTHELP==-1>
IFNDEF FTR066,<FTR066==-1>
IFNDEF FTR067,<FTR067==-1>
IFNDEF FTR073,<FTR073==-1>
IFNDEF FTR074,<FTR074==-1>
IFNDEF FTR075,<FTR075==-1>
IFNDEF FTR076,<FTR076==-1>
IFNDEF FTR077,<FTR077==-1>
IFNDEF FTR100,<FTR100==-1>
IFNDEF FTR101,<FTR101==1>
IFNDEF FTR102,<FTR102==0> ;[AFAL-14]
IFNDEF FTR103,<FTR103==-1>
IFNDEF FTR104,<FTR104==-1>
IFNDEF FTR105,<FTR105==-1>
IFNDEF FTR106,<FTR106==-1>
VERSION 7,M,122,1 ;[afal-26] AFAL EDIT LEVEL
; EDIT HISTORY (VERSION 7)
; 27 PRINT INDIRECT FILE NAME INSTEAD OF LIST OF NAMES
; 30 ALLOW USER NAMES TO CONTAIN ANY SIXBIT CHARACTERS
; 31 ALLOW MAIL TO *FILESPEC BY ITSELF AND CORRECT THE
; PROTECTION PROBLEM IN *FILESPEC
; 32 CORRECTION TO EDIT 27: ADD /DETAIL AND /SUPPRESS
; SWITCHES FOR INDIRECT FILES TO ALLOW CONTROL OVER
; WHETHER FILE NAME OR USER LIST IS PRINTED OUT. IF
; BOTH USED (IE ONE IN INDIRECT FILE AND ONE LATER)
; THE LATTER IS TAKEN. DEFAULT: IF NO MORE THAN -
; INDSPS - NAMES, THEN DETAIL, ELSE SUPPRESS.
; 33 CORRECT RCH OPERATION ON INDIRECT FILE TO SWALLOW
; <CR>
; 34 CORRECT DATE FIELD FOR HANDLING VIA TENEX MESSAGE
; HANDLERS
; 35 CORRECT FTPSRV CALCULATION AND CHANGE "NOT LOGGED
; IN" MESSAGE
; 36 ELIMINATE CONFLICT BETWEEN *FILE AND /FILE:
; 37 CORRECT INTERLOCK PROBLEM
; 41 CLEAN UP QUEUE ROUTINES SO WE CAN USE THEM IN THE
; IMPLEMENTATION OF FORWARDING
; 42 DELAY QUEUE INTERLOCK UNTIL FILE RENUMBERING, AND
; COMPLETE INTERLOCK CLEANUP
; 43 CLEAN UP USAGE OF CORE UUO
; 44 REARRANGE QUEUE STATUS LIST AS A LINKED LIST, NOW
; IT'S OPEN-ENDED
; 45 REARRANGE SEND-MAIL CODE INTO LOGICAL MODULES
; 46 USE CHKACC UUO TO DETERMINE FILE ACCESS PRIVS AND
; THUS ALLOW *FILESPEC TO FOLLOW MONITOR PROTECTION
; SCHEME (IE ALLOW USER TO APPEND TO SOMEONE ELSE'S
; FILE IF IT IS <X4X> OR <XX4>)
; 47 REORGANIZE MAIL TEXT INPUT ROUTINES - PREPARATION
; FOR EDITING
; 50 REARRANGE INSTALLATION DEPENDENT CODE FOR HARVARD
; NBS AND RUTGERS. HARVARD IS NOW RUNNING STANDARD
; 5.07, INCLUDING SNDMAIL.
; 51 ON CTRL-C, ASK IF TEXT IS TO BE SAVED
; 53 ALLOW USE OF /HELP AND POTENTIALLY OTHER SWITCHES
; WITHOUT LOGGING IN
; 54 MAKE .MSG THE DEFAULT EXTENSION FOR *FILE
; 55 ADD HARVARD SPECIALITIES: MAKE BOTH MSGH AND PIP
; STYLE MAIL READING POSSIBLE, WITH /MSGH SWITCH TO
; REQUEST MSGH READING, AND WITH PIP AS THE DEFAULT
; 56 ADD CHECK FOR NETWORK AVAILABILITY; IF DOWN, SEND
; NOTE TO USER AND QUEUE ALL NETWORK MAIL.
; 57 DON'T SAVE TEXT IF /FILE: SPECIFIED
; DON'T TYPE "?NETMAI close error - no such device"
; IF SENDING TO A UNIX SITE
; 60 DEFINE SYSTEM TTY(S) FOR "You have mail" MESSAGE.
; 61 FIX THE SENDING OF Unable to send queued mail, SO
; THE SENDER RECEIVES IT AS ORIGINALLY INTENDED.
; 62 NOTIFY TTY34 IF THE OPERATOR(7) RECEIVES MAIL.
; 63 ON ↑C: IF BATCH, DIE.
; IF NOT ON PTY, DISABLE JACCT.
; 64 CHANGE MAIL'S MAILING ADDRESS TO [SYSTEM]MAIL.
; 65 DEFINE MAIL QUEUE MAI:[3,5]
; 66 MAKE MAIL WRITE NNNMAI.TMP INSTEAD OF SVMAIL.TMP
; 67 MAKE MAIL PASS MAIL FILE SPEC TO MSGH IN TMP:MSG
; OR NNNMSG.TMP INSTEAD OF TMP:MAI OR NNNMAI.TMP
; 70 CHECK PB.GST IN .PDPRO TO SEE IF GUEST
; [GETTAB -10]
; CHECK PB.SHR IN .PDPRO TO SEE IF
; USER IS ON A SHARED ACCOUNT; IDENT REQUIRED!
; 71 TAKE **'S OUT OF (NOT LOGGED IN) IDENT
; 72 DON'T TYPE "?NETMAI close error - no such device"
; REGARDLESS OF SITE NAME; NOT ALL UNIX SITES USE
; UNIX IN THEIR SITE NAME
; 73 CHANGE <077> TO <477> TO ALLOW FILDAE CONTROL OF
; ACCESS OF MAI:*.MAI
; 74 DON'T BUILD TMP FILE IF THERE IS NOTHING TO SAVE
; 75 TELL [*,2] JOBS ABOUT SYSTEM MAIL, TOO
; 76 USE CONTROLLING JOB NUMBER FOR NNN IN NNNMAI.TMP
; 77 USE NNNMAI.TMP FOR DEFAULT /FILE: SPEC
; 100 CLEAN UP SPECIAL TTY NOTIFICATION CODE
; 101 ALLOW UNIQUE ABBREVIATIONS FOR LOCAL USER NAMES!
; 102 SAVE CLOBBERED AC IN CLOSE ERROR SUPRESSION CODE
; REMOVED BY [AFAL-14]
; 103 HAVE TTY35 NOTIFIED OF MAIL FOR SYSTEM
; 104 INFORM USER OF ACTION TAKEN ON NOT-LOGGED-IN ↑C
; 105 FORCE RENAME (ON READING MAIL) TO UFD
; 106 REPORT MAIL AS UNDELIVERABLE IF ATTEMPT TO SEND
; QUEUED MAIL FAILS FOR UNQUEUEABLE REASON
; ** END EDIT HISTORY **
comment \
Air Force Avionics Laboratory Edits
Edits are marked in the code as "[AFAL-nn]".
MAIL 7L(106) was obtained from Robertson@RUTGERS in early 1979.
[AFAL-1] 13-Jun-79, Nick Eastridge
At SNMSYS:+1 insert a POPJ. This routine is looking for a terminal
to notify in case [*,2] receives mail. AFAL's staff and terminal
configuration isn't stable enough to hardwire in such info--
a year from now Joe User would get a message saying the system
has mail, and some poor Air Force Captain would have to go hunt
down the bug.
[AFAL-2] 13-Jun-79, Nick Eastridge
Replace the high-seg interlock with ENQ/DEQ interlocks.
This code was written by Jim McCool for an earlier version of MAIL.
It ENQs on the programmer number alone and hence doesn't lock
out other users.
[AFAL-3] 13-Jun-79, Nick Eastridge
I don't know where this edit came from, but it was in a running
version of MAIL. Here are earlier comments:
IN GETRSP ROUTINE DON'T TRY TO READ CHARACTERS FROM THE
NET IF NONE ARE AVAILABLE (EITHER IN OUR BUFFERS OR THE
MONITOR'S)
[AFAL-4] 15-Jun-79, Nick Eastridge
Don't ever use QUE: device to send mail-- use QUEPPN, [3,5].
(%LDQUE GETTAB entry).
[AFAL-5] 15-Jun-79, Nick Eastridge
Names at AFAL may be preceded with non-alphanumeric characters.
LSTNAM was rewritten to reflect this.
[AFAL-6] 20-JUN-79, Nick Eastridge
Normally, MAIL RENAMEs the mail file from [3,5] to the user's
directory so MSGH can get its grubby little paws on it. But AFAL has
multiple user file structures, and as we all know, you cannot rename a
file across a structure. So instead the file is copied to the user
directory. Previous versions of AFAL MSGH read it straight off [3,5].
To prevent excess damage, append to the file instead of overwriting
it.
[AFAL-7] 14-JUL-79, Nick Eastridge
Unfortunately the users don't like edit 6, so it's back to letting
MSGH work on the [3,5] file directly. Edit 6 code was left mostly
intact however, so the /FILE switch would still correctly.
[AFAL-10] 1-AUG-79, Nick Eastridge
Install a .JBINT style ↑C trap so users can bomb out with ↑C even
while running. (Edit 63 will cause an exit if ↑C typed while in TTY
input wait.) This code does some fancy footwork to determine if a
network connection is open and if so to close it. WARNING: MAIL must
be kept protected "execute only" now (<x66>); otherwise the user
could DDT in and take a look at ACCT.SYS in the buffer.
[AFAL-11] 20-Aug-79, Nick Eastridge
Make the device for all files in the QUEPPN "SSL", i.e. the
system search list. This keeps mail from looking on DSKF:, etc.
[AFAL-12] 29-Feb-79, Nick Eastridge Removed 18-Jun-80 Jim McCool
This version of MAIL only reads ACCT.SYS to find local
names, which is unsatisfactory due to differences in ACCT.SYS
and NETUSR.SYS. So, install a kluge to look in NETUSR.SYS first,
then ACCT.SYS.
[AFAL-13] 18-Jun-80, Jim McCool
At AFAL PPN's of the form *,11 are dummies and should not
have mail delivered to them. Since most project numbers are greater
than 11, mail for many users was being delivered to the dummy account.
AFAL edit 12 was an attempt to cure this problem but required that
NETUSR.SYS be read. This edit simply causes the code at NXTACT to
ignore an entry if the programmer number is 11.
[AFAL-14] 13-Mar-81, Jim McCool
Convert to the 96bit IMPUUO format. Also use the routines
in IMPSUB to find out host numbers, whether they have mail servers
etc.
[AFAL-15] 13-Mar-81, Jim McCool
When sending mail to several users over the ARPANET, it can
become extremely boring waiting for all the mail to be delivered.
Add a switch /NOWAIT which tells MAIL to queue all mail for later
delivery by queued mail handler.
[AFAL-16] 9-Apr-81, Jim McCool
It is a royal pain to try to find problems with MAIL using DDT etc.
because the JACCT bit is not set by the monitor unless it is run from SYS:
and does not have DDT loaded. Add a new conditional assembly parameter,
DEBUG, which when non-zero, will cause MAIL to poke its JACCT bit on (assuming
of course, that the user has appropriate privs).
[afal-17] 1-july-81, provan
Handle <user name>@host@host@host.... We might have to send to
other networks sometime in the future. it turns out that the code is cleaner
this way anyway. also, ignore leading blanks in a host name. also,
[afal-14] missed a few unimportant 96-bit changes.
[AFAL-20] 6-Nov-81, Jim McCool
FILACC code being excessively stupid and ignorant. Code tries to
be smart by getting the PPN for ersatz devices then opens device DSK with
the PPN from the ersatz device. The original authors only forgot one
important point: it is highly likely that the ersatz device will be some
DSK structure that is not on the user's search list. Fix this trivial
oversight by copying the device from the Add-A-File-On-The-Fly TULIP block
into the Check-File block before doing the FIOPEN.
[afal-21] march 18, 1982 provan
make the time use the correct version of EST or EDT.
while we're at it, get rid of WkDay, and do day code ourselves.
(by the way, with this edit, <esc> = ↑Z when entering mail.)
[afal-22] march 19, 1982 provan
fix LstNam so it understands a name of zero.
also, make a more reasonable header for received net mail.
(also, other clean-up.)
[afal-23] april 2, 1982 provan
HstChk turns out to have a double skip return that isn't
documented anywhere. allow for this.
[afal-24] april 3, 1982 provan
ill mem ref if mail is queued for a host which
is non-existent when the queue is processed.
problem is that AtHost assumes a host it's printing
exists, in an amazing absence of defensiveness.
[afal-25] may 21, 1982 provan
support SFDs finally so MSGH can specify an exact path when
running MAIL as a subjob.
[AFAL-26] DEC. 10,1982 OJ
MODIFICATION TO EDIT AFAL-25. THE EDIT CAUSE MAIL
TO GO BELLY UP WHEN ONLY THE PROGRAMMER NUMBER WAS
INPUT.
[afal-27] december 31, 1982 provan
allow monitor to choose local socket freely for arpanet mail,
rather than force job relative socket 2.
[afal-30] december 31, 1982 provan
take out references to byte size when discussion IMP connections.
end of AFAL edits \
OPDEF IMPUUO [MCALL [SIXBIT /IMPUUO/]]
OPDEF SNDMAI [MCALL [SIXBIT /SNDMAI/]]
IFN FTGUES,<
OPDEF GUEST. [MCALL [SIXBIT /GUEST./]]
>
;ADDED REGISTERS
S0==11
S1==12
S2==13
;MISC PARAMETERS
PDSIZE==100 ;PDS LENGTH
USRTBL==144 ;MAX NUMBER OF USERS MAILED TO AT ONCE
IDENTL== 40 ;MAX LENGTH OF IDENTIFICATION STRING
SUBJSL==110 ;MAX LENGTH OF SUBJECT STRING
INDSPS== 17 ;MAX NUMBER OF NAMES FOR INDIRECT FILE [32]
; BEFORE DEFAULT /SUPPRESS
IFN FTAFAL,< ;[AFAL-14]
HSTLEN=↑D55 ;[AFAL-14] MAX LENGTH OF HOST NAME (CHARS)
;[AFAL-14] (INCLUDING ASCIZ BYTE)
HSTWDS=<HSTLEN/5>+<IFN <HSTLEN-<<HSTLEN/5>*5>>,<1>>
IFN FTBCOM,<
QUEDAY==5 ;#DAYS BEFORE GIVING UP ON QUEUED MAIL
>
IFN FTAFAL,<
QUEPPN==3,,5
>
IFNDEF QUEPPN,<QUEPPN==3,,3>
IFNDEF DEBUG,<DEBUG=0>;[AFAL-16] Turn on Debugging stuff
IFNDEF JACCT,<JACCT=1,,0> ;[AFAL-16] JACCT bit
;I/O CHANNELS
ACT== 1 ;FOR READING ACCT.SYS
FIL== 1 ;INPUT FILE FOR /FILE: SWITCH
BOX== 2 ;'MAILBOX' MANAGEMENT
SVM== 3 ;FOR SAVING MAIL AS NNNMAI.TMP
TMP== 3 ;TMP FILE OUTPUT
IFN FTCIMP,<
NET== 3 ;FTP NETWORK I/O
>
IFN FTBCOM,<
QUE== 4 ;SEND/RECV QUEUED MAIL
>
IND== 4 ;INDIRECT MAILING LIST
AFL== 4 ;ADD A FILE ON THE FLY
CKC== 10 ;CHECK FILE ACCESS PRIVLEGES [46]
;SPECIAL FLAGS
FLAG (FILFLG) ;/FILE: SWITCH GIVEN
FLAG (FLOFLG) ;MAILING TO *FILE ONLY [31]
FLAG (CRIFLG) ;DON'T FLUSH CR ON TTY INPUT
FLAG (LGIFLG) ;JOB IS LOGGED IN
FLAG (IDNFLG) ;/IDENT: SWITCH GIVEN
FLAG (PPNFLG) ;LOOKING FOR PPN
FLAG (LSXFLG) ;ALL SIXBIT CHAR'S LEGAL TO GETSIX [30]
FLAG (DTLFLG) ;/DETAIL SWITCH GIVEN [32]
FLAG (SPSFLG) ;/SUPPRESS SWITCH GIVEN [32]
IFN FTCIMP,<
FLAG (FTPSVF) ;MAIL RUNNING UNDER FTP SERVER
FLAG (LINFLG) ;LINE-AT-A-TIME OUTPUT REQ'D TO FTP
FLAG (LOCNET) ;CREATE HEADER FOR NET OR LOCAL BOX
FLAG (FTOFLG) ;INPUT BEING DONE IN FTPWCH
FLAG (NVLFLG) ;[56]IF TRUE, NET NOT AVAILABLE
>
IFN FTBCOM,<
FLAG (QUEFLG) ;SENDING QUEUED MAIL - /QUEUE:SEND
FLAG (QUDFLG) ;THIS MESSAGE BEING REQUEUED
>
FLAG (INDFLG) ;INDIRECT MAILING LIST
FLAG (FLXFLG) ;PROCESSING *FILE SPEC [31,36,47]
FLAG (CCPFLG) ;/CC: SWITCH GIVEN AND IN EFFECT
FLAG (CHKFLG) ;/CHECK SWITCH FOUND AND IN EFFECT
IFN FTHARV,< ;IF HARVARD, INCLUDE /MSGH SWITCH
FLAG (MSHFLG)
>
FLAG (SVMFLG) ;TRUE WHEN MAIL HAS BEEN SAVED AS
; NNNMAI.TMP, TO AVOID DOING IT MORE
; THAN ONCE
FLAG (PTYFLG) ;THIS JOB IS ON A PTY [63]
FLAG (BATFLG) ;THIS JOB IS A BATCH JOB [63]
IFN FTBCOM,< ;[AFAL-15]
FLAG (NOWAIT) ;[AFAL-15] QUEUE MAIL, DON'T WAIT
> ;[AFAL-15]
SALL
SUBTTL INITIALIZATION AND COMMAND DECODING
MAIL: JFCL ;IN CASE CCL ENTRY
MOVE P,[IOWD PDSIZE,PDS] ;SETUP STACK
START ;SETUP UUO PACKAGE
SETZM LOWBEG ;CLEAR LOW SEGMENT
MOVE T1,[LOWBEG,,LOWBEG+1]
BLT T1,LOWEND-1
IFN DEBUG,<
MOVSI T1,.GTSTS ;[AFAL-16] Poke on our JACCT bit
HRRI T1,.GTSLF ;[AFAL-16] Get the addr of JBTSTS
GETTAB T1, ;[AFAL-16]
JRST MDB001 ;[AFAL-16] Failed, don't worry
HRRZS T1 ;[AFAL-16] Clear junk
PJOB T2, ;[AFAL-16] Get our job number
ADD T1,T2 ;[AFAL-16] T1 has addr of our JBTSTS
MOVEM T1,POKBLK ;[AFAL-16] Store it
HRROI T1,.GTSTS ;[AFAL-16] Get old contents of JBTSTS
GETTAB T1, ;[AFAL-16]
JRST MDB001 ;[AFAL-16] Failed, don't worry about it
MOVEM T1,POKBLK+1 ;[AFAL-16] Stash old contents
IORX T1,JACCT ;[AFAL-16] Light the JACCT bit
MOVEM T1,POKBLK+2
MOVSI T1,3 ;[AFAL-16] Poke it on
HRRI T1,POKBLK ;[AFAL-16]
POKE. T1, ;[AFAL-16]
JRST MDB001 ;[AFAL-16]
MDB001:> ;[AFAL-16] End of IFN
IFN FTCIMP,< ;[AFAL-14]
PUSHJ P,HSTCHK## ;[AFAL-14] GET HOST TABLES
JFCL ;[AFAL-14] DON'T WORRY FOR NOW
jfcl ;[afal-23] no changed needed
> ;[AFAL-14] END IFN
IFN FTAFAL,< ;[AFAL-10] Initialize ↑C trap
MOVE T1,[3,,CCTRAP] ;[AFAL-10] # WORDS, ROUTINE TO TRAP TO
MOVEM T1,CCTRTB ;[AFAL-10] AND STORE IT
MOVE T1,[0,,2] ;[AFAL-10] ↑C TRAP=BIT 34
MOVEM T1,CCTRTB+1 ;[AFAL-10] AND STORE IT
SETZM CCTRTB+2 ;[AFAL-10] ZERO OLD PC ADDRESS
MOVEI T1,CCTRTB ;[AFAL-10] ADDRESS OF BLOCK
MOVEM T1,.JBINT ;[AFAL-10] AND STORE IN LOC 134
>;end of [AFAL-10]
MOVE T1,[PUSHJ P,TTIRCH] ;SETUP TTY RCH OPERATION
MOVEM T1,TTIBLK##+FILXCT
GETPPN T1, ;GET OUR PPN
JFCL
MOVEM T1,OURPPN ;AND REMEMBER IT FOR LATER
MOVSI T1,'DSK' ;GET OUR DEFAULT DIRECTORY
MOVE T4,[3,,T1]
PATH. T4,
MOVE T3,OURPPN
MOVEM T3,DEFPPN ;STORE DEFAULT PPN
IFN FTCIMP,<
MOVSI T1,.IULHS ;GET LOCAL HOST NUMBER
HRRI T1,1(P)
TXO T1,IF.NEW ;[AFAL-14] NEW FORMAT CALL
IMPUUO T1,
TDZA T1,T1 ;NOT ON ARPANET
MOVE T1,.IBHST(T1) ;[AFAL-14] FETCH RETURNED HOST #
MOVEM T1,LHOSTN ;SAVE IT
> ;END IFN FTCIMP
ifn DSTime,< ;[afal-21] if there are two flavours of time
movx t1,%cndtm ;[afal-21] get universal date time
gettab t1, ;[afal-21] from monitor
setz t1, ;[afal-21] pretend it's a wednesday
hlrz t1,t1 ;[afal-21] just interested in the day
addi t1,3 ;[afal-21] make sunday 0
idivi t1,7 ;[afal-21] in fact, just want day of
;[afal-21] week, which is now in t2.
;[afal-21] now compute the number of days until next sunday
movei t1,7 ;[afal-21] number of days in a week
sub t1,t2 ;[afal-21] subtract off number of days
;[afal-21] so far this week
movx t2,%cnday ;[afal-21] get day of the month
gettab t2, ;[afal-21] from monitor
setz t2, ;[afal-21] go with the odds.
add t2,t1 ;[afal-21] compute day of month of
;[afal-21] next sunday.
movx t1,%cnmon ;[afal-21] get the month
gettab t1, ;[afal-21] from the monitor
jrst ESTime ;[afal-21] it's eastern standard
;[afal-21] watch carefully as i say the magic words
xct [ ;[afal-21] skip if EST, else don't
skipa ;[afal-21] january
skipa ;[afal-21] february
skipa ;[afal-21] march
caile t2,↑d30 ;[afal-21] april (next sunday in month?)
jfcl ;[afal-21] may
jfcl ;[afal-21] june
jfcl ;[afal-21] july
jfcl ;[afal-21] august
jfcl ;[afal-21] september
caig t2,↑d31 ;[afal-21] october (sun. not in month?)
skipa ;[afal-21] november
skipa ;[afal-21] december
]-1(t1) ;[afal-21] months start with 1.
EDTime: skipa t1,[DSTime] ;[afal-21] it is EDT (skipped if EST)
> ;[afal-21] end of ifn DSTime
ESTime: movx t1,TimeZn ;[afal-21] not EDT.
movem t1,TZone ;[afal-21] store for WNAMEing
PJOB T2, ;GET OUR JOB NUMBER
MOVN T1,T2 ;NEGATE FOR JOBSTS
JOBSTS T1, ;GET STATUS BITS
JRST .+2 ;NONE AVAILABLE?
TXNE T1,JB.ULI ;LOGGED IN?
TXO F,LGIFLG ;YES, REMEMBER SO
IFN FTR066,< ;CONSTRUCT NNNMAI FOR SAVE MAIL FILE
PUSH P,T2
IFN FTR076,<
SETO T1, ;ARG FOR SELF
CTLJOB T1, ;GET CONTROLLING JOB NUMBER
SETO T1, ;MAKE NEGATIVE FOR ERROR
SKIPG T1 ;IF CONTROLLING JOB, USE THAT NUMBER
> ;END IFN FTR076
MOVE T1,T2 ;GET JOB NUMBER
SETZB T2,T3 ;SET UP ACS
MAIL01: IDIVI T1,↑D10 ;GET NEXT DIGIT
ADDI T2,20 ;MAKE SIXBIT
LSHC T2,-6 ;SHIFT INTO RESULT
TLNN T3,000077 ;DONE YET?
JRST MAIL01 ;NO, KEEP GOING
HRRI T3,'MAI' ;SO IT'S NNNMAI
MOVEM T3,SVNAME ;STORE IT
POP P,T2
> ;END IFN FTR066
IFN FTCIMP,<
CTLJOB T2, ;PTY CONTROL?
JRST MAIL02 ;NO
JUMPLE T2,MAIL02 ;NO
TXO F,PTYFLG ;REMEMBER I'M ON PTY [63]
HRROI T1,.GTLIM ;CHECK IF WE'RE BATCH JOB [63]
GETTAB T1, ;IT'S IN LIMIT WORD [63]
SETO T1, ;ASSUME WE ARE [63]
TXNE T1,JB.LBT ;BATCH JOB? [63]
TXO F,BATFLG ;YES, REMEMBER THAT [63]
MOVSI T1,(T2) ;GET NAME OF CONTROLLING PROGRAM
HRRI T1,.GTPRG
GETTAB T1,
JRST MAIL02 ;??
MOVN T2,T2 ;NEGATE FOR JOBSTS
JOBSTS T2, ;GET STATUS OF CONTROLLING JOB
JRST .+2 ;MUST BE OK
TXNE T2,JB.UJC ;JACCT SET?
CAME T1,['FTPSRV'] ;AND FTP SERVER RUNNING? [35]
SKIPA ;REQUIRE BOTH FTPSRV AND JACCT [35]
TXO F,FTPSVF ;YES, REMEMBER SUBJOB OF FTP SERVER
>
MAIL02: FSETUP FILBLH ;SET DEFAULTS FOR /FILE: OPTION
RESCAN 1 ;RESCAN INPUT, SKIP IF NONE
SKPINL ;MAKE SURE THERE REALLY IS SOME
JRST NOCOM1 ;NOT REALLY ANY, PROMPT FOR INPUT
PUSHJ P,GETSX0 ;OK, GET COMMAND NAME
JUMPE T1,NOCOMR ;PROMPT IF NONE
HRROI T2,[SIXBIT\MAIL\] ;SEE IF IT WAS THE MAIL COMMAND
PUSHJ P,SIXSRC
JRST NOCOMR ;NO, FLUSH REST AND PROMPT FOR INPUT
;GET NAMES OF ALL USERS TO BE MAILED TO
GETFSU: MOVSI P3,-USRTBL ;SETUP USER TABLE POINTER
HRROI T1,.GTNM1 ;GET 1ST HALF OF OUR NAME
GETTAB T1,
SETZ T1,
HRROI T2,.GTNM2 ;GET 2ND HALF OF OUR NAME
GETTAB T2,
SETZ T2,
PUSHJ P,LSTNAM ;LAST NAME ONLY
MOVEM T1,OURNM1
MOVEM T2,OURNM2
PUSHJ P,SPNOR
JUMPE P1,MAIREC ;NOTHING THERE
CAIN P1,"@" ;SEE IF WANTS INDIRECT FILE
JRST GETNND
PUSHJ P,GETUSR ;TRY TO GET A USER NAME
JRST MAIREC ;NONE, GO READ OWN MAIL
TXZE F,FILFLG ;IS FIRST USER A FILE? [31]
JRST GETNXF ;YES, LEAVE ALONE [31]
GETNXU: MOVEM T1,USRTB1(P3) ;OK, STORE 1ST HALF OF USER NAME
MOVEM T2,USRTB2(P3) ;AND STORE 2ND HALF
MOVEM T3,USRPGN(P3) ;AND PROGRAMMER NUMBER, IF KNOWN
MOVEM T4,USRHSN(P3) ;[AFAL-14] AND HOST ADDRESS
TXNN F,CCPFLG ;IS THIS REG USER OR COPY SENT TO HIM?
AOS USRCCN ;REG
GETNXF: CAIE P1,"," ;ANOTHER NAME COMING?
JRST NONXTU ;NO, GO LOOK FOR SWITCHES
GETNXC: PUSHJ P,SPNOR1 ;YES, PASS COMMA AND SPACES
PUSHJ P,GETUSR ;GET ANOTHER USER NAME
EDISIX [ERRFLS,,[SIXBIT\?"% S&YNTAX ERROR#!\]]
TXZE F,FLXFLG ;WAS THE LAST ARGUMENT A FILE SPEC? [36]
JRST GETNXF ;YES,JUST CHECK FOR NEXT
AOBJN P3,GETNXU ;LOOP BACK TO STORE
EDISIX [ERRFLS,,[SIXBIT\?"% T&OO MANY USERS#!\]]
;HERE IF NOT 'MAIL' COMMAND, TO PROMPT FOR INPUT
NOCOMR: PUSHJ P,FLUSHL ;FLUSH INPUT LINE
NOCOM1: PUSHJ P,LGNCHK ;MAKE SURE HE HAS A RIGHT TO BE HERE
EWSIX [SIXBIT\E&NTER USER NAME (OR <CR> TO READ YOUR OWN MAIL)#!\]
PUSHJ P,SPNOR1 ;ADVANCE TO THE 1ST CHAR OF NXT LINE
JRST GETFSU ;GO START SCANNING INPUT
;SET UP TO READ FROM INDIRECT FILE
GETNND: PUSHJ P,LGNCHK ;MUST BE LOGGED IN
TXO F,INDFLG ;MARK INDIRECT
FSETUP INDFIH ;SET UP FILE SEG
MOVEI T4,INDFIL ;FILE BLOCK TO SET UP
PUSHJ P,FILARG ;GET FILE ARGS
JRST ERRFLS
HRRZI T1,CMDHLD ;SAVE REST OF LINE FOR LATER USE
HRLI T1,(POINT 7) ;AS A PSEUDO FILE
MOVEM T1,TMPPTR
LCH P1 ;BACK UP
GETNNL: RCHF P1 ;NOW GET REST OF LINE
TXNE P2,BREAK ;END OF THE LINE?
JRST GETNNN
IDPB P1,T1
JRST GETNNL
GETNNN: MOVEI T2,LF ;SIGNAL END OF LINE
IDPB T2,T1
FIOPEN INDFIL ;OPEN FILE FOR INPUT
PUSHJ P,SPNOR1 ;FORCE NEW LOOK
PUSHJ P,GETUSR ;START OFF FIRST ONE
EDISIX [ERRFLS,,[SIXBIT \?"% S&YNTAX ERROR IN INDIRECT LIST#!\]]
;MUST BE SOMETHING THERE
JRST GETNXU ;CONTINUE
SUBTTL SEND MAIL
NONXTU: TXNN F,INDFLG ;CHECK IF INDIRECT
JRST NONXT1 ;NONE
CAIE P1,"/" ;IF SWITCHES INCLUDED IN COMMAND FILE,
JRST NONXTX ;PROCESS THEM
PUSHJ P,SWTPRC
JRST ERRFLS ;BAD PROCESS
NONXTX: FICLOS INDFIL
TXZ F,INDFLG
FSETUP TMPCMF ;REREAD REST OF COMMAND LINE
FISEL TMPCML
RCHF P1 ;SET UP FOR SWITCH PROCESSING
NONXT1:
IFN FTR077,<
MOVE T1,SVNAME ;GET NAME OF SVMAIL.TMP
MOVEM T1,FILBLK+FILNAM;USE FOR /FILE: DEFAULT
HRLZI T1,'TMP'
MOVEM T1,FILBLK+FILEXT
> ;END IFN FTR077
IFE FTR077,<
HRRZS FILBLK+FILEXT ;MAKE BLANK BE THE DEFAULT FILE EXT
> ;END IFE FTR077
PUSHJ P,SWTPRC ;PROCESS SWITCHES
JRST ERRFLS ;INCORRECT COMMAND TERMINATION
IFN FTCIMP,<
TXNN F,LGIFLG!CHKFLG!IDNFLG!FTPSVF
;EITHER LOGGED IN, FTP, OR IDENTIFIED
>
IFE FTCIMP,<
TXNN F,LGIFLG!CHKFLG!IDNFLG
;EITHER LOGGED IN OR IDENTIFIED
>
NONXTI: EDISIX [STOP,,[SIXBIT\?"% P&LEASE USE SWITCH &/ID:&YOUR-NAME#!\]]
NONXT2: MOVE T1,USRTB1 ;CHECK TO SEE IF HAVE ANY USERS [31]
IOR T1,USRPGN ;OR JUST GOING TO *FILE [31]
JUMPN T1,NONXT3 ;AT LEAST ONE LIVE USER [31]
SKIPN SLFBLK+FILNAM ;JUST BE SURE WE HAVE SOMETHING THERE [31]
EDISIX [ERRFLS,,[SIXBIT\?"% S&YNTAX ERROR (&SLF)#!\]]
TXO F,FLOFLG ;MARK SENDING TO *FILE ONLY [31]
JRST SLFONL ;ALL OK, CONTINUE [31]
NONXT3: HRLOI T1,(P3) ;BUILD AOBJN PTR TO USER TABLE
EQVI T1,0
SKIPE USRHSN(T1) ;[AFAL-14]SEND TO LOCAL USER?
AOBJN T1,.-1 ;NO, NET, CHECK NEXT
JUMPGE T1,ACCEN0 ;SKIP READING ACCT.SYS IF ALL TO NET
PUSH P,.JBFF## ;SAVE FIRST FREE LOC
FSETUP ACTBLH ;PREPARE TO READ ACCT.SYS
MOVE T1,[SIXBIT\MAIL\] ;SEE IF DEVICE 'MAIL' ASSIGNED
DEVCHR T1,
MOVE T2,[SIXBIT\MAIL\]
JUMPE T1,.+3
SKIPE .JBDDT## ;YES--DEBUGGING?
MOVEM T2,ACTBLK+FILDEV ;YES, USE PRIVATE MAIL SYSTEM
FIOPEN ACTBLK ;OPEN FOR INPUT
RCH P4 ;GET FIRST WORD
DATE P4, ;GET DATE TO COMPARE AGAINST XPD DATE
MOVEM P4,DATE
;READ NEXT ACCT.SYS ENTRY
NXTACT: RCH P1 ;PPN
RCH T1 ;PASSWORD
RCH T1 ;PRIVILEGE BITS
RCH T1 ;1ST HALF OF USER'S NAME
RCH T2 ;2ND HALF OF USER'S NAME
MOVEI T3,↑D9 ;FLUSH REST OF ENTRY
RCH T4
SOJG T3,.-1
HLRZS T4 ;ISOLATE XPD DATE
CAMGE T4,DATE ;AND COMPARE AGAINST TODAY
JRST NXTACT ;PPN HAS EXPIRED
IFN FTAFAL,< ;[AFAL-13]
HRRZ T3,P1 ;[AFAL-13] Get the project number
CAIN T3,11 ;[AFAL-13] Is this a dummy account?
JRST NXTACT ;[AFAL-13] Yes, ignore this entry
>; End IFN FTAFAL ;[AFAL-13]
PUSHJ P,LSTNAM ;KEEP JUST USER'S LAST NAME
MOVEI T3,(P3) ;INDEX OF LAST USER BEING SENT TO
LIST
MOVEI P1,(P1) ;KEEP JUST PROGRAMMER NUMBER
NXTAC1: SKIPGE USRPGN(T3) ;DO WE KNOW WHO THIS IS?
JRST NXTAC4 ;YES, SKIP ON
SKIPE USRPGN(T3) ;NO, DID WE GET HIS NUMBER?
JRST NXTAC2 ;YES
CAMN T1,USRTB1(T3) ;NO, TRY MATCHING HIS NAME
CAME T2,USRTB2(T3)
IFN FTR101,<
JRST NXTAC5 ;SEE IF IT'S AN ABBREVIATION
> ;END IFN FTR101
IFE FTR101,<
JRST NXTAC4 ;NOT THIS ONE
> ;END IFE FTR101
JRST NXTAC3 ;WIN
NXTAC2: CAME P1,USRPGN(T3) ;COMPARE PROGRAMMER NUMBERS
JRST NXTAC4 ;NOT THIS ONE
MOVEM T1,USRTB1(T3) ;OK, STORE NAME FROM ACCT.SYS
MOVEM T2,USRTB2(T3)
NXTAC3: HRROM P1,USRPGN(T3) ;STORE PROGRAMMER NUMBER AND FLAG
NXTAC4: SOJGE T3,NXTAC1 ;SEE IF WE MATCHED OTHER USERS
JRST NXTACT ;ON TO NEXT ACCT.SYS ENTRY
IFN FTR101,<
NXTAC5: PUSH P,T1
PUSH P,T2
MOVE T2,USRTB1(T3) ;GET POSSIBLE ABBREVIATION
PUSHJ P,MATCH ;SEE IF IT IS
JRST NXTAC6 ;NO, NO LUCK
MOVE T1,(P) ;WORD TO MATCH
MOVE T2,USRTB2(T3) ;AND POSSIBLE ABBR
PUSHJ P,MATCH ;WELL?
JRST NXTAC6 ;AWW...
CAMN P1,USRMAT(T3) ;IS THIS SAME POSSIBLE MATCH?
JRST NXTAC6 ;YES, OK, WE'RE DONE ALREADY
SKIPE USRMAT(T3) ;WAS THERE ALREADY ONE?
JRST [SETOM USRMAT(T3) ;YES, FLAG NOT UNIQUE
JRST .+2] ;AND SKIP NEXT INST
MOVEM P1,USRMAT(T3) ;SAVE POSSIBLE MATCH
MOVE T1,-1(P) ;AND SAVE WHAT IT'S ABBREVIATING
MOVEM T1,USRAB1(T3)
MOVE T1,(P)
MOVEM T1,USRAB2(T3)
NXTAC6: POP P,T2
POP P,T1
JRST NXTAC4 ;GO CONTINUE LOOPING
;ROUTINE TO DETERMINE IF T2 IS A POSSIBLE ABBREVIATION FOR T1
MATCH: JUMPE T2,CPOPJ1## ;NULL IS A GOOD ABBR
PUSH P,T1 ;SAVE UNABBREVIATED WORD
SETO T1, ;AND CREATE A MASK
LSH T1,-6 ;SHIFT IT ONE CHAR
TDNE T2,T1 ;GOOD YET?
JRST .-2 ;NOT YET
ANDCA T1,(P) ;ABBREVIATE UNABBREVIATED WORD
CAMN T1,T2 ;MATCH?
AOS -1(P) ;YES, SKIP RETURN
POP P,T1 ;RESTORE T1
POPJ P,
> ;END IFN FTR101
;HERE WHEN REACH THE END OF ACCT.SYS
ACCEND: FICLOS ACTBLK ;CLOSE INPUT FILE
POP P,.JBFF## ;RECOVER BUFFER SPACE
ACCEN0: HRLOI T3,(P3) ;BUILD AOBJN POINTER TO USER TABLES
EQVI T3,0 ; (COURTESY HAKMEM MIT-AI 239)
;IF INDIRECT FILE NAME, DECIDE WHETHER TO PRINT NAME OR USER LIST [32]
SKIPN INDFIL+FILNAM ;INDIRECT FILE GIVEN?
JRST ACCEN1
TXNE F,DTLFLG!SPSFLG ;DID USER GIVE EXPLICIT DIRECTIONS?
JRST INFSDF ;YES, FOLLOW THEM
MOVE T1,USRCCN ;ONLY COUNT MAIN ADDRESSEES, NOT CC
CAIG T1,INDSPS ;MORE THAN MAX?
SETZM INDFIL+FILNAM ;NO, ALLOW DETAIL
JRST ACCEN1 ;CONTINUE PROCESSING
INFSDF: TXNE F,DTLFLG ;/DETAIL SWITCH GIVEN?
SETZM INDFIL+FILNAM ;YES, USER LIST INSTEAD OF FILE NAME
;MAKE SURE ALL REQUESTED RECIPIENTS ACTUALLY EXIST
ACCEN1:
IFN FTCIMP,<
SKIPE USRHSN(T3) ;[AFAL-14] LOCAL RECIPIENT?
JRST ACCEN2 ;[AFAL-14] No, to NET
>
SKIPE USRPGN(T3) ;[AFAL-14] Know about this local recipient?
JRST [ HRRZS USRPGN(T3) ;[AFAL-14] Yes, clear out flag and forge on
JRST ACCEN2 ]
IFN FTR101,<
SKIPN T1,USRMAT(T3) ;POSSIBLE MATCH?
JRST NSUERR ;NOPE, NO SUCH USER
JUMPL T1,[EWSIX [SIXBIT\?"%N&ON-UNIQUE ABBREVIATION - !\]
JRST NSUNAM] ;AND GO PRINT NAME GIVEN
MOVEM T1,USRPGN(T3) ;MAKE MATCH DESTINATION
MOVE T1,USRAB1(T3) ;AND USE WHOLE NAME
MOVEM T1,USRTB1(T3)
MOVE T1,USRAB2(T3)
MOVEM T1,USRTB2(T3)
JRST ACCEN2 ;AND GO SEND MAIL
NSUERR:
> ;END IFN FTR101
EWSIX [SIXBIT\?"%N&O SUCH USER AS !\]
JUMPE T1,.+3 ;WHAT WERE WE GIVEN?
WOCTI (T1) ;JUST A NUMBER
JRST .+3
IFN FTR101,<
NSUNAM:
> ;END IFN FTR101
WNAME USRTB1(T3) ;THE NAME, PRINT IT BACK
WNAME USRTB2(T3)
W2CHI CRLF
SETZM USRTB1(T3) ;IN CASE OF /CHECK, MARK IT LOST
TXNN F,CHKFLG ;AND ALLOW TO CONTINUE
SETZ P3, ;SIGNAL THAT WE MUST ABORT
ACCEN2: AOBJN T3,ACCEN1 ;LOOP THRU ALL USERS
JUMPE P3,STOP ;QUIT NOW IF ANY USERS NOT FOUND
TXNE F,CHKFLG ;CHECK FOR /CHECK
JRST CHECKU
SLFONL: ;*FILE ONLY CONTINUES HERE [31]
;GET A SUBJECT, IF USER DOESN'T KNOW HOW TO USE SWITCH
IFN FTCIMP,<
TXNE F,FTPSVF ;IF RUNNING UNDER FTPSRV,
JRST READIN ;DON'T ASK FOR SUBJECT
>
SKIPE SUBJCT ;SUBJECT GIVEN?
JRST READIN
EWSIX [SIXBIT\S&UBJECT: !\] ;NO, ASK FOR ONE
FISEL 0 ;FORCE TTY INPUT
MOVE T1,[POINT 7,SUBJCT] ;SET UP TO RECIEVE
MOVEI T2,SUBJSL ;MAX LENGTH OF SUBJECT
GETSJT: RCHF P1 ;SUBJECTIVELY SPEAKING...
TXNE P2,BREAK ;END?
JRST READIN ;(IF HE TYPES NOTHING,
; GETS NO SUBJECT HEADER)
IDPB P1,T1 ;DEPOSIT
SOJG T2,GETSJT
EDISIX [STOP,,[SIXBIT\?"% S&UBJECT STRING TOO LONG#!\]]
SUBTTL SEND MAIL - READ THE TEXT OF THE MAIL INTO CORE
;READ IN THE MAIL INTO CORE FROM TTY OR A FILE, OR TTY PRETENDING TO [47]
; BE A FILE
READIN: TXO F,CRIFLG ;PASS CR'S ON INSTEAD OF FLUSHING
TXNN F,FILFLG ;TEXT COMING FROM A FILE?
JRST RDNTTY ;NO - MUST BE TTY
FIOPEN FILBLK ;OPEN FILE, OPEN SESAME, OPEN CHANNEL
INBUF FIL,0 ;ESTABLISH BUFFERS, THEN...
MOVEI T2,TXTTIH ;...SET UP INCORE AREA
PUSHJ P,SETTMP ;FOR MAIL TEXT
PUSH P,T2 ;AND SAVE START ADDRESS
MOVE T1,FILBLK+FILDEV
DEVCHR T1, ;NOW WE WONDER IF THE FILE
TXNE T1,DV.TTY ;IS REALLY A TTY
JRST RDNTT1 ;HANDLE LIKE TTY
JRST INPALL ;GO READ ALL INPUT AND XFER TO CORE
;HERE ON EOF FROM FILE
RDNEOF: FICLOS FILBLK ;POLITELY CLOSE UP MOUTH
JRST GTMEND ;AND GO ON
;READING FROM A TTY. GIVE INSTRUCTIONS.
RDNTTY:
IFE FTHARV,<
EWSIX [SIXBIT\E&NTER MESSAGE, END WITH &CTRL-Z#!\]
>
IFN FTHARV,<
EWSIX [SIXBIT\E&NTER MESSAGE, END WITH &ESCAPE#!\]
>
SETZM IFILE## ;MAKE SURE HAVE TTY INPUT
MOVEI T2,TXTTIH ;NOW OPEN INCORE FILE
PUSHJ P,SETTMP ;FOR MAIL TEXT
PUSH P,T2 ;AND HOLD ADDRESS FOR LATER
RDNTT1: RCH T1 ;GET SOME CHARACTER
CAIGE T1,40 ;IS IT SPECIAL?
JRST @RDXCHR(T1) ;YES - DO SOMETHING SPECIAL FOR IT
RDNTTP: WCH T1 ;ORDINARY CHAR - WRITE INTO TEXT FILE
JRST RDNTT1 ;CONTINUE
;EDITING FUNCTION TABLE. JUMP TO ROUTINE CALLED FOR BY CONTROL CHAR.
; (CURRENTLY INPUT IS IN LINE MODE, AND MOST CHARACTERS ARE IGNORED.
; LATER ON THERE WILL BE EDITING.)
RDXCHR: RDNTT1 ;(00) NULL
RDNTT1 ;(01)
RDNTT1 ;(02)
STSAVE ;(03) CTRL-C: STOP; SAVE TEXT AS NNNMAI.TMP
RDNTT1 ;(04)
RDNTT1 ;(05)
RDNTT1 ;(06)
ADDFIL ;(07) BELL: ADD A FILE TO THE TEXT
RDNTT1 ;(10)
RDNTTP ;(11) TAB
RDNTTP ;(12) LF
RDCRLF ;(13) VT
RDCRLF ;(14) FF
RDNTTP ;(15) CR
RDNTT1 ;(16)
RDNTT1 ;(17)
RDNTT1 ;(20)
RDNTT1 ;(21)
RDNTT1 ;(22)
RDNTT1 ;(23)
RDNTT1 ;(24)
RDNTT1 ;(25)
RDNTT1 ;(26)
RDNTT1 ;(27)
RDNTT1 ;(30)
RDNTT1 ;(31)
GTMEND ;(32) CTRL-Z
GTMEND ;(33) ESCAPE/ALTMODE
RDNTT1 ;(34)
RDNTT1 ;(35)
RDNTT1 ;(36)
RDNTT1 ;(37)
;(EOL) SOME SPECIAL EOL CHARACTERS PUT A CRLF INTO THE TEXT.
RDCRLF: W2CHI CRLF
JRST RDNTT1 ;CONTINUE
;ADD A FILE ON THE FLY. GET FILE SPECS AND READ INTO TEXT.
ADDFIL: PUSHJ P,LGNCHK ;MUST BE LOGGED IN
EWSIX [SIXBIT\ (F&ILE NAME): !\]
FSETUP AFLFIH
MOVEI T4,AFLFIL
PUSHJ P,FILARG ;GET FILE ARGUMENTS
JRST RDNTT1 ;BAD ARGUMENT
PUSH P,IFILE## ;HOLD FOR A WHILE
FIOPEN AFLFIL ;OPEN SELF
MOVEI T1,.ACRED ;CHECK ACCESS [46]
MOVEI T2,AFLFIL
PUSHJ P,FILACC ;CHECK ACCESS [46]
JRST AFLLER ;BLEW IT
MOVEI T1,AFLBUF ;TO KEEP FREE CORE FREE
EXCH T1,.JBFF## ;WHILE BUILDING BUFFERS
INBUF AFL,2 ;SET UP IN KNOWN LOC
MOVEM T1,.JBFF## ;BE TIDY
;ROUTINE TO READ IN ALL OF A FILE AND WRITE IT SOMEWHERE. EOF LOCATION
; MUST BE SET UP.
INPALL: RCH T1 ;READ ONE CHARACTER FROM FILE
JUMPE T1,INPALL ;FLUSH NULLS
WCH T1 ;WRITE IT SOMEPLACE
JRST INPALL ;UNTIL EOF DO US PART
;HERE ON LOOKUP OR PROTECTION ERROR
AFLLER: EDISIX [AFLEOF+1,,[SIXBIT\?"% F&ILE NOT FOUND OR READ-PROTECTED#!\]]
;HERE ON EOF FROM ADD-A-FILE
AFLEOF: EWSIX [SIXBIT\ (D&ONE) !\]
CLRBFI ;CLEAN OUT ANY LEFTOVER GARBAGE
FICLOS AFLFIL ;PUT TOYS AWAY
POP P,IFILE## ;BACK TO ORIGINAL TALKER
JRST RDNTT1 ;CONTINUE
;(CTRL-C) STOP PROGRAM. SAVE TEXT SO FAR IN CASE USER WANTS TO USE IT.
STSAVE: SETZM .JBINT## ;[AFAL-10] CLEAR ↑C TRAPPING
CLRBFI ;[AFAL-10] CLEAR TTY BUFFER SOONER
TXNN F,BATFLG ;STOP FOR BATCH, TOO [63]
TXNN F,LGIFLG ;LOGGED IN?
IFN FTR104,<
EDISIX [STOP,,[SIXBIT\? ↑C &RECEIVED -- &MAIL& ABORTED.#!\]]
> ;END IFN FTR104
IFE FTR104,<
JRST STOP ;NO, JUST STOP
> ;END IFE FTR104
WCHI 0 ;THROW ON A NULL
POP P,P1 ;GET ADDRESS OF TEXT
CLRBFI ;PREPARE TO ASK IF WANTS IT SAVED [51]
TXZ F,CRIFLG ;NO CR THIS TIME [51]
IFN FTR066,<
EDISIX [[SIXBIT\T&EXT TO BE SAVED AS &%.TMP (Y &OR& CR): !\]
WNAME SVNAME]
> ;END IFN FTR066
IFE FTR066,<
EWSIX [SIXBIT\T&EXT TO BE SAVED AS &SVMAIL.TMP (Y &OR& CR): !\]
> ;END IFE FTR066
MOVE T1,[SIXBIT .MAIL.] ;PREPARE FOR SETNAM [63]
TXNN F,PTYFLG ;RUNNING ON PTY? [63]
SETNAM T1, ;NO, SETNAM DISABLES .JACCT [63]
RCH T1 ;GET ONE CHARACTER [51]
CLRBFI ;LEAVE NOTHING BEHIND [51]
TRZ T1,40 ;MAKE IT UPPER CASE [51]
CAIN T1,"Y" ;YES OR NO? [51]
PUSHJ P,SVMAIL ;AND SAVE IN CASE HE WANTS TO EDIT
JRST STOP ;I GUESS NO [51]
;(EOT) HERE ON END OF INPUT (CTRL-Z, ESCAPE FOR HARVARD)
GTMEND: WCHI 0 ;GUARANTEE A NULL FOR TEXT FILE
FOSEL 0 ;BACK TO TTY OUTPUT
POP P,P1 ;ADDRESS OF TEXT
IFE FTHARV,< ;ONLY SAVE TEXT IF NOT HARVARD SITE
TXNN F,FTPSVF ;IF FROM THE NET,
TXNN F,LGIFLG ;OR NOT LOGGED IN,
CAIA ;NO LOCAL COPY
PUSHJ P,SVMAIL ;SAVE TEXT ON DISK AS NNNMAI.TMP
> ;END OF IFE FTHARV
HRLOI P3,(P3) ;RESTART AOBJN POINTER
EQVI P3,0 ;TO LIST OF USERS
; MAIN ROUTINES TO SEND MAIL
IFN FTCIMP,<
; FIRST SEE IF COMING FROM FTPSRV, SENDING MAIL TO ONE LOCAL USER
TXNN F,FTPSVF ;UNDER FTP SERVER?
JRST MAINM0 ;NO - STANDARD LOOP
SETZ P3, ;ONLY ONE BOX ALLOWED - BUT FAKE IT
MOVEI T2,HDRTIH ;FOR NOW
PUSHJ P,SETTMP ;PREPARE TO WRITE SPECIAL HEADER
MOVEM T2,HDRLOC
;[afal-22] make this a reasonable header, and ignore user name.
;[a-22] WSIX [SIXBIT\M&AIL FROM !\] ;WRITE ONE-LINE HEADER
;[a-22] WNAME OURNM1
;[a-22] WNAME OURNM2
;[a-22] MOVE T1,IDENTI
;[a-22] JUMPE T1,MFTPS1 ;IF NO IDENT, SKIP THIS PART
;[a-22] SKIPE OURNM1 ;IDENT IN BRACKETTS IF NAME GIVEN
;[a-22] DISIX [MFTPS1,,[SIXBIT\[%]!\]
;[a-22] WASC IDENTI]
;[a-22] WASC IDENTI ;IF BY ITSELF, JUST WRITE
;[a-22]MFTPS1: DISIX [[SIXBIT\& AT % ON %#!\]
;[a-22] PUSHJ P,THSTIM ;INCLUDE A DATE AND TIME
;[a-22] PUSHJ P,THSDAT] ;FOR THE RECORD
disix [ ;[afal-22] put in header
[sixbit \R&eceived: from host % at % on %#!\]
wasc Identi ;[afal-22] host name is ID
pushj p,ThsTim ;[afal-22] give time
pushj p,ThsDat ;[afal-22] and date
] ;[afal-22]
WCHI 0 ;GUARANTEE A NULL
PUSHJ P,SNDLOC ;SEND MAIL LOCALLY
IFE FTHARV,< ;ONLY DO SNDBEL IF NOT AT HARVARD
PUSHJ P,SNDBEL ;NOTIFY THE TERMINAL
>
JRST STOP ;EXIT, CENTER STAGE
> ;END IFN FTCIMP
SUBTTL MAIN MAIL SENDER
;SEND MAIL TO ALL USERS, FILES, AND NETWORK HOSTS
;FIRST SEE IF SENDING TO A FILE
MAINM0: SKIPN SLFBLK+FILNAM ;ANY FILE NAME SET UP?
JRST MAINM1 ;NO, CONTINUE
IFN FTMSGH,<
PUSHJ P,SETCNT ;FIRST SET THE COUNT FOR MSGH
>
FAPEND SLFBLK ;PREPARE TO SEND
IFN FTMSGH,<
PUSHJ P,SNDMSH ;SEND AN MSGH-STYLE HEADER
>
MOVE T1,HDRLOC ;SEND THE HEADER
PUSHJ P,SDTEXT ;AND THE TEXT
FOCLOS SLFBLK ;THAT'S IT
;[afal-25]MOVEI T1,SLFBLK
EDISIX [[SIXBIT \F&ILE % -- &OK#!\]
;[afal-25] PUSHJ P,WFNAMX
WFName SlfBlk ;[afal-25] tell tulip to output the name
] ;INFORM USER IN DETAIL
TXNE F,FLOFLG ;WAS FILE THE ONLY THING?
JRST STOP ;YES, END OF THE ROAD
;NOW LOOP THROUGH ALL NAMES, SENDING WHERE APPROPRIATE
MAINM1:
IFN FTCIMP,<
SKIPN USRPGN(P3) ;LOCAL OR NET?
JRST MAINET ;NET
>
PUSHJ P,SNDLOC ;SEND MAIL TO LOCAL BOX
EDISIX [[SIXBIT\%% -- OK#!\]
WNAME USRTB1(P3) ;SEND CONGRATS
WNAME USRTB2(P3)] ;TO THE FATHER OF A LETTER
IFE FTHARV,< ;ONLY SEND BELL IF NOT HARVARD
PUSHJ P,SNDBEL ;SEND BELL TO LOCAL TERMINAL IF THERE
>
MAINM2: AOBJN P3,MAINM1 ;REPEAT FOR ALL USERS
JRST STOP
IFN FTCIMP,<
MAINET:
IFN FTBCOM,< ;[AFAL-15]
TXNE F,NOWAIT ;[AFAL-15] USER SAID DON'T WAIT?
JRST MAINEQ ;[AFAL-15] YES, QUEUE THE MAIL
> ;[AFAL-15]
PUSHJ P,SNDNET ;TRY SENDING TO THE NET
SKIPA
EDISIX [MAINM2,,[SIXBIT\%%% -- OK#!\]
WASC @USRTB1(P3) ;PRINT NET NAME
MOVE T1,USRHSN(P3) ;GET HOST NUMBER
PUSHJ P,ATHOST] ;PRINT THAT TOO
;FAILED. DO SOMETHING ABOUT IT.
IFN FTBCOM,<
TXNN F,NVLFLG ;[56]IF NETWORK DOWN, QUEUE ALL
TXNE F,QUDFLG ;FAILED FOR QUEUEABLE REASON?
MAINEQ: EDISIX [MAINM2,,[SIXBIT\%%%% -- Q&UEUED#!\]
PUSHJ P,MQUEUE ;QUEUE THE FILE
WASC @USRTB1(P3) ;TELL WHO IS BEING
MOVE T1,USRHSN(P3) ;QUEUED
PUSHJ P,ATHOST] ;TO WHERE
> ;END IFN FTBCOM
EDISIX [[SIXBIT\ -- C&AN'T MAIL TO %%%#!\]
WASC @USRTB1(P3) ;CAN'T DO IT
MOVE T1,USRHSN(P3)
PUSHJ P,ATHOST]
IFE FTBCOM,< ;IF NOT QUEUING, THEN SAVE TEXT ALWAYS
PUSHJ P,SVMAIL ;DO IT
IFN FTR066,<
EDISIX [[SIXBIT\T&EXT SAVED AS &%.TMP#!\]
WNAME SVNAME]
> ;END IFN FTR066
IFE FTR066,<
EWSIX [SIXBIT\T&EXT SAVED AS &SVMAIL.TMP#!\]
> ;END IFE FTR066
> ;END IFE FTBCOM
JRST MAINM2 ;IN ANY CASE, KEEP ON LOOPING
> ;END IFN FTCIMP
SUBTTL MAIL SENDER SUBROUTINES
;SNDLOC - SEND MAIL LOCALLY. SET UP HEADER AND COUNT IF NEEDED.
; P1 - MESSAGE STRING
; P3 - POINTER IN USRPGN, ETC.
SNDLOC:
IFN FTMSGH,<
SKIPN MALSIZ ;MAIL COUNTED YET?
PUSHJ P,SETCNT ;NO - DO SO
>
SKIPN T1,HDRLOC ;NEED TO BUILD HEADER?
PUSHJ P,HEADER ;YES - CALL THE CREW
MOVEM T1,HDRLOC
SKIPE BOXBLK+FILXCT ;MAILBOX SET UP?
JRST SNDLCA ;YES....
FSETUP BOXBLO
PUSHJ P,SETBOX ;SET BOX DEFAULTS
SNDLCA: HRRZ T1,USRPGN(P3) ;GET PROGRAMMER NUMBER
PUSHJ P,OCTNAM ;CONVERT TO OCTAL CHAR
MOVEM T2,BOXBLK+FILNAM
MOVX T1,%LDSPP ;GET STANDARD SPOOL PROTECTION
GETTAB T1,
MOVSI T1,(077B8)
IFN FTR073,<
TLO T1,(1B0) ;ALLOW FILDAE ACCESS
> ;END IFN FTR073
MOVEM T1,BOXBLK+FILDAT
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] USE ENQ/DEQ INSTEAD
IFN FTAFAL,<HRRZ T1,USRPGN(P3)> ;[AFAL-2] THE PROGRAMMER NUMBER
PUSHJ P,SETLOK ;MAKE SURE THE CHEESE STANDS ALONE
FAPEND BOXBLK ;OPEN SHOP
IFN FTMSGH,<
PUSHJ P,SNDMSH ;FIRST AN MSGH HEADER LINE
>
MOVE T1,HDRLOC
PUSHJ P,SDTEXT ;NOW THE HEADER AND TEXT
FOCLOS BOXBLK ;THROUGH WITH THAT ONE
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] SO LET THE WORLD IN AGAIN
PJRST CLRLOK ;AND EXIT
;ROUTINE TO ACTUALLY WRITE THE LETTER
SDTEXT: WASC (T1) ;WRITE A HEADER
WASC (P1) ;WRITE THE TEXT
W2CHI CRLF ;WRITE AN EXTRA LINE
POPJ P, ;COOKED
IFN FTMSGH,<
;ROUTINE TO WRITE A SPECIAL HEADER FOR MSGH
SNDMSH: DISIX [CPOPJ##,,[SIXBIT\% %,%%;000000000000#!\]
PUSHJ P,THHDAT
PUSHJ P,THHTIM
TXZ F,LZEFLG
WDEC MALSIZ] ;INCLUDE THE COUNT
; ROUTINE TO COUNT CHARACTERS IN MAIL FOR MSGH HEADER
SETCNT: FSETUP TMPSIZ
FOSEL TMPCBL ;I/O INSTRUCTIO IS SIMPLY AOS
SETZM MALSIZ
SKIPN T1,HDRLOC ;COUNT IS FOR LOCAL USERS
;INCLUDE LOCAL HEADER
PUSHJ P,HEADER ;CREATE ONE AS NEEDED
MOVEM T1,HDRLOC
PJRST SDTEXT ;SEND TEXT TO AOS AND GO HOME
> ;END IFN FTMSGH
IFN FTCIMP,<
;SNDNET - ROUTINE TO SEND MAIL TO USER AT A REMOTE ARPANET SITE
;ARGS SAME AS SNDLOC
SNDNET: SKIPN T1,HDRNET ;HAS NET-STYLE HEADER BEEN BUILT?
PUSHJ P,HEADRN ;BUILD ONE, SPECIAL
MOVEM T1,HDRNET
MOVEM P,ERRPDS ;SAVE THE STACK LEVEL
TXNE F,NVLFLG ;[56]DO WE KNOW NET IS NOT AVAILABLE?
JRST SNDNTF ;[56]WE KNOW IT IS DOWN - QUEUE IT
MOVE T1,[IF.NEW+<.IULHS,,CONBLK>] ;[AFAL-14][56]GET NETWORK STATUS IN...
IMPUUO T1,
JFCL
;[afal-17]SKIPGE CONBLK+.IBHST ;[56]...BIT ZERO OF .IBHST WORD
SKIPGE CONBLK+.IBStt ;[afal-17] check IMP up bit (high bit)
EDISIX [SNDNTF,,[SIXBIT\"%ARPA&NET NOT AVAILABLE%#!\]
TXO F,NVLFLG ;[56]SET FLAG FOR NEXT TIME
]
PUSHJ P,FTPOPN ;OPEN A CONNECTION
JRST SNDNTF ;OOPS
MOVE T1,HDRNET
PUSHJ P,SDTEXT ;SEND THE TEXT WITH HEADER
PUSHJ P,FTPCLZ ;NOW CLOSE YOUR MOUTH
SKIPA ;YOU'RE CATCHING FLIES
JRST CPOPJ1## ;GOOD BOY!
NTCANT:
SNDNTF: MOVE P,ERRPDS ;YE OLD ALMIGHTY CLUDGE STRIKES AGAIN!
POPJ P, ;BAD BOY.....
> ;END IFN FTCIMP
;HEADER - SUBROUTINE TO BUILD A HEADER IN CORE, EITHER TO SEND TO NET
; OR LOCAL.
;ENTRY POINTS:
; HEADER - PREPARE LOCAL HEADER
; HEADRN - PREPARE NET HEADER - FROM FIELD INCLUDES LOCAL HOST NAME
; RETURNS IN T1 - ADDRESS OF HEADER STRING
HEADER:
IFN FTCIMP,<
TXZA F,LOCNET ;LOCAL MAIL ENTRY - TURN OFF FLAG
HEADRN: TXO F,LOCNET ;NET MAIL ENTRY
>
PUSH P,OFILE## ;HOLD OUTPUT POINTER
MOVEI T2,HDRTIH ;SET UP TEMP COR AREA
PUSHJ P,SETTMP
PUSH P,T2 ;SAVE ADDRESS OF START TO RETURN LATER
;FIRST BUILD DATE LINE
DISIX [[SIXBIT\D&ATE: % (%) %#!\]
PUSHJ P,THSDAT
pushj p,ThsDay ;[afal-21] print day of week.
PUSHJ P,THSTIM]
IFN FTCIMP,<
TXNN F,LGIFLG!FTPSVF ;LOGGED IN OR FTPSRV?
>
IFE FTCIMP,<
TXNN F,LGIFLG
>
;IF NOT LOGGED IN, INCLUDE MESSAGE IN HEADER
DISIX [SNDMJ2,,[SIXBIT \I&D: % (NOT LOGGED IN)!\]
WASC IDENTI]
MOVE T1,[SIXBIT\[SYSTE\]
CAMN T1,OURNM1
SKIPE OURNM2
SKIPN IDENTI ;IF REGULAR USER GIVES IDENT, SHOW [52]
;THAT
SKIPA
DISIX [[SIXBIT\I&D: %#!\]
WASC IDENTI]
DISIX [[SIXBIT\F&ROM: %%!\]
WNAME OURNM1 ;PUT OUR NAME
WNAME OURNM2] ; IN HEADER
SNDMJ2:
IFN FTCIMP,<
;[afal-17]HRRZ T1,LHOSTN ;LOCAL HOST NUMBER
move T1,LHOSTN ;[afal-17] get local host number
TXNE F,LOCNET ;SENDING TO NET?
PUSHJ P,ATHOST ;YES, IDENTIFY SOURCE HOST
> ;END IFN FTCIMP
W2CHI CRLF
SKIPE SUBJCT ;HAVE SUBJECT STRING?
DISIX [[SIXBIT\S&UBJECT: %#!\]
WASC SUBJCT] ;YES, PRINT IT
;IF INDIRECT MAILING LIST, GIVE ONLY LIST NAME AND P,PN [27]
SKIPN INDFIL+FILNAM ;INDIRECT FILE NAME?
JRST SNMNAM ;NO...
SKIPN T3,INDFIL+FILPPN ;DID USER SPECIFY FILE NAME?
MOVE T3,OURPPN ;NO, USE OUR OWN
HLLZS INDFIL+FILEXT
DISIX [[SIXBIT\T&O: @%.%[%]!\]
WNAME INDFIL+FILNAM
WNAME INDFIL+FILEXT
;[afal-25] WPPN T3
WPath T3
]
IFN FTCIMP,<
;[afal-17]HRRZ T1,LHOSTN ;ANNOUNCE SELF
move T1,LHOSTN ;[afal-17] ANNOUNCE SELF
TXNE F,LOCNET ;IF SENDING TO NET,
PUSHJ P,ATHOST ;ADD HOST SPEC TO FILE NAME
>
SNMNAC: WCHI ":" ;PRETTY PRINT
;TELL EACH GUY WHO ELSE IS GETTING THE MESSAGE
SNMNAM: TXNE F,FLOFLG ;MAILING TO *FILE ONLY? [31]
DISIX [HDRFIN,,[SIXBIT\#!\]] ;YES - PUT OUT CR AND GO ON [31]
HLRE P2,P3 ;RESTART THE AOBJN POINTER
SUBI P2,(P3)
MOVSI P2,(P2)
SETZM CCSPAC ;INIT COUNT FOR CC: STUFF
PUSH P,USRCCN ;PRESERVE AGAINST LOCAL RAVAGES
AOS USRCCN ;ADJUST FOR LATER GAMES
MOVEI T1,[SIXBIT\T&O: !\] ;SET UP FIRST HEADER
MOVEM T1,CCTOHD
SNMAI3: SOSE USRCCN ;IF HAVE REACHED THE POINT OF SWITCH
JRST SNMA3A ;BETWEEN REGULAR AND CC PEOPLE,
SETZM CCSPAC ;MAKE THE CHANGES
MOVEI T1,[SIXBIT \&CC: !\] ;NEW HEADER
MOVEM T1,CCTOHD
W2CHI CRLF
WSIX (T1) ;PRINT HEADER
JRST SNMA3B
SNMA3A: SKIPLE USRCCN ;IF INDIRECT FILE USED, GIVE NAMES [27]
; ONLY
SKIPN INDFIL+FILNAM ;OF CC RECIPIENTS [27]
SKIPA ; [27]
JRST SNMAI4 ; [27]
MOVE T1,CCSPAC ;GET CHAR COUNT
CAIG T1,↑D72 ;ROOM ON LINE?
JRST .+3 ;YES, CONTINUE
WSIX [SIXBIT\,#!\] ;NO, START NEW LINE
SETZM CCSPAC
SKIPE CCSPAC ;STARTING NEW LINE?
DISIX [SNMA3B,,[SIXBIT\, !\]]
;NO - PRINT COMMA AND SKIP HEADER CODE
WSIX @CCTOHD ;PRINT APPROPRIATE HEADER
SNMA3B: MOVE T1,CCSPAC ;ADJUST CHAR COUNT
IFN FTCIMP,<
SKIPE USRHSN(P2) ;SENDING TO NET?
ADDI T1,↑D<25-15> ;YES - ALLOW 25 SPACES
>
ADDI T1,↑D15 ;JUST ALLOW 15 SPACES
MOVEM T1,CCSPAC ;SAVE FOR POSTERITY
IFN FTCIMP,<
SKIPN USRPGN(P2) ;SKIP IF LOCAL RECIPIENT
JRST [ WASC @USRTB1(P2) ;NET, PRINT USER NAME
MOVE T1,USRHSN(P2) ;AND HOST
PUSHJ P,ATHOST
JRST SNMAI4]
>
WNAME USRTB1(P2) ;PRINT THE RECIPIENT'S NAME
WNAME USRTB2(P2)
SNMAI4: AOBJN P2,SNMAI3 ;REPEAT FOR ALL OTHER USERS
SKIPN INDFIL+FILNAM ;EXTRA CR FOR FILE NAME [27]
SKIPE CCSPAC ;DID WE INCLUDE ANY CC'S?
W2CHI CRLF ;YES, NEED NEW LINE
W2CHI CRLF ;LEAVE BLANK LINE
POP P,USRCCN ;RESCUE EFFORT
HDRFIN: WCHI 0 ;GUARANTEE A NULL
POP P,T1 ;GET RETURN VALUE
POP P,OFILE## ;RESTORE OLD OUTPUT POINTER
POPJ P, ;AND RETURN FROM BUILDING HEADER
IFE FTHARV,< ;ONLY INCLUDE SNDBEL CODE FOR NON-HARVARD SITES
;SNDBEL - ROUTINE TO SEND "You have mail" MESSAGE TO USER
; IF HE IS LOGGED IN.
SNDBEL: MOVE T1,[%CNLMX]
GETTAB T1, ;FIND MAX NO. OF JOBS
POPJ P, ;FERGIT IT!
SNMAIO: HRLZ T2,T1 ;SEARCH LIST OF PPN TO SEE IF OUR
HRRI T2,.GTPPN ;BOY IS IN
GETTAB T2,
JFCL
HRRZS T2 ;PROG PART ONLY
CAMN T2,USRPGN(P3) ;SHIDDOCH?
JRST SNMAIF
SNMAIC: SOJG T1,SNMAIO ;NO - KEEP TRYING
POPJ P, ;NOT LOGGED IN
SNMAIF: MOVE T2,T1 ;PRESERVE IN CASE OF ERROR
SNDMAI T2, ;SEND OUT THE INVITATIONS
JRST SNMAIC ;BLEW SOMETHING...
POPJ P,
;HERE WHEN CAN'T ENTER OR UPDATE THE MAILBOX FILE
BOXENE: ERRENT BOXBLK ;SAY WHAT HAPPENED
JRST BXCANT ;PUNT THIS USER
BOXOUE: ERROUT BOXBLK ;HERE ON OUTPUT ERROR
BXCANT:
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2][42]
PUSHJ P,CLRLOK ;CLEAR MAILBOX INTERLOCK
EDISIX [MAINM2,,[SIXBIT\?"% -- C&AN'T MAIL TO %%#!\]
WNAME USRTB1(P3)
WNAME USRTB2(P3)]
;HERE WHEN OPEN FAILS FOR MAILBOX DEVICE (UNLIKELY!)
BOXOPE: ERRIOP BOXBLK ;SAY WHAT HAPPENED
JRST STOP
;HERE ON ERRORS READING ACCT.SYS
ACTOPE: ERRIOP @IFILE
JRST STOP
ACTLKE: ERRLK @IFILE
JRST STOP
ACTINE: ERRIN @IFILE
JRST STOP
SUBTTL RECEIVE MAIL
MAIREC: PUSHJ P,SWTPRC ;PROCESS SWITCHES IF ANY
JRST ERRFLS ;IMPROPER TERMINATION, PUNT
PUSHJ P,LGNCHK ;NOW CHECK FOR LOGGED-IN [53]
TXNE F,CHKFLG ;IF USING /CHECK, WARN HIM
PUSHJ P,CHKWRN ;..IF HE IS USING ANY OTHERS
IFN FTCIMP,<
TXNE F,FTPSVF ;CAN'T RECEIVE MAIL UNDER FTP SERVER
EDISIX [STOP,,[SIXBIT\?"% S&YNTAX ERROR#!\]]
>
HRRZ T1,OURPPN ;GET OUR PROGRAMMER NUMBER
PUSHJ P,OCTNAM ;CONVERT TO SIXBIT, LEFT-JUSTIFIED
FSETUP BOXBLI ;SETUP TO READ MAILBOX FILE
MOVEM T2,BOXBLK+FILNAM ;SELECT CORRECT MAILBOX
PUSHJ P,SETBOX ;SET DEFAULTS
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] [42]
IFN FTAFAL,<HRRZ T1,USRPGN(P3)> ;[AFAL-2]ENQ ON PROGRAMMER NUMBER
PUSHJ P,SETLOK ;GET MAILBOX INTERLOCK
FIOPEN BOXBLK ;LOOK UP THE MAILBOX
TXNN F,CHKFLG
JRST MAIRC0
DISIX [[SIXBIT\M&AIL HAS ARRIVED#!\]] ;JUST CHECKING....
FICLOS BOXBLK ;TIDY UP NOW
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] [42]
PUSHJ P,CLRLOK
JRST STOP ;DONE
MAIRC0: MOVE T1,[SIXBIT\MAIL\] ;OK, SET INITIAL NAME FOR RENAME
;[AFAL-7] don't do file copy unless /FILE switch set
TXNN F,FILFLG ;[AFAL-7] is /FILE switch set?
JRST MCHKDN ;[AFAL-7] no, so don't copy
MAIRC1: MOVSI T2,'TMP' ;'MAIL.TMP' OR 'MAIL##.TMP'
TXNE F,FILFLG ;USER WANT TO SAVE THE FILE?
MOVSI T2,'BOX' ;YES, MAKE IT 'MAIL.BOX' INSTEAD
SETZ T3,
MOVE T4,OURPPN ;USE OWN PPN (AS OPPOSED TO DEFAULT)
IFN FTR105,< ;USE A PATH BLOCK TO FOURCE FILE TO UFD
SETZM PTHBLK ;NULL PATH DEVICE
SETZM PTHBLK+1 ;NO PATH SWITCHES
SETZM PTHBLK+3 ;NO SFD
MOVEM T4,PTHBLK+2 ;OWN PPN
MOVEI T4,PTHBLK ;POINT TO PATH BLOCK
> ;END OF IFN FTR105
IFE FTAFAL,< ;[AFAL-6] Can't use rename if users on multiple structures
RENAME BOX,T1 ;RENAME MAILBOX INTO USER'S DIRECTORY
JRST MAIRNE ;FAILED, SEE WHY
>;[AFAL-6] end of turned off code sequence
IFN FTAFAL,< ;[AFAL-6] use file copy instead of RENAME
FSETUP TMPBLH ;[AFAL-6] TULIP file initialization
MOVEM T1,TMPBLK+FILNAM ;[AFAL-6] use gen'ed file name
MOVEM T2,TMPBLK+FILEXT ;[AFAL-6] and extension (may be .BOX)
MOVEM T4,TMPBLK+FILPPN ;[AFAL-6] and path block
MOVEI T4,MAIRNE ;[AFAL-6] get error handler
HRRM T4,TMPBLK+FILER1 ;[AFAL-6] for failed ENTER
MOVEI T4,TCOPDN ;[AFAL-6] EOF handler
HRLM T4,BOXBLK+FILER2 ;[AFAL-6] where to put it
FAPEND TMPBLK ;[AFAL-6] TULIP file open,enter, append
TCOPLP: RCH T4 ;[AFAL-6] read a char
WCH T4 ;[AFAL-6] and write it
JRST TCOPLP ;[AFAL-6] loop for more
TCOPDN: FOCLOSE TMPBLK ;[AFAL-6] close the file
PUSH P,T1 ;[AFAL-6] preserve file name
SETZ T1, ;[AFAL-6] zero name dletes file
RENAME BOX,T1 ;[AFAL-6] delete MAI: file
JFCL ;[AFAL-6] oh well
POP P,T1 ;[AFAL-6] restore T1
> ;[AFAL-6] end of FTAFAL
IFE FTAFAL,< ;[AFAL-2] NO ARG REQUIRED FOR CLRLOK
PUSH P,T1 ;PRESERVE T1 [41]
MOVEI T1,LOKMAI ; [42]
PUSHJ P,CLRLOK ;OK, CLEAR MAILBOX INTERLOCK
POP P,T1 ;BACK TO NORMAL (?) [42]
>;END OF IFE FTAFAL FOR [AFAL-2]
IFN FTAFAL,<
MCHKDN: CLOSE BOX, ;[AFAL-6] All done with mail
PUSHJ P,CLRLOK ;[AFAL-6] clear the interlock
> ;[AFAL-2] CLEAR THE INTERLOCK
TRNE T1,7777 ;IF USED 'MAIL##', SAY SO
EDISIX [[SIXBIT\"% MAIL.% &IN USE; MAIL STORED AS %#!\]
WSIX 3,T2
WNAMX T1]
TXNE F,FILFLG ;/FILE SWITCH SPECIFIED?
JRST STOP ;YES, DONE.
;WRITE A PIP COMMAND FILE FOR PRINTING THE MAIL
FSETUP TMPCBH ;SETUP CORE PSEUDO-FILE
MOVEI T3,TMPCBL
MOVEM T3,OFILE##
MOVE T3,[POINT 7,TMPBUF] ;SETUP BYTE PTR
IFN FTHARV,< ;IF HARVARD ALLOW FOR BOTH MSGH OR PIP
TXNE F,MSHFLG ;DOES THE USER WANT MSGH?
DISIX [.+2,, [SIXBIT\%#!\] ;YES, BUILD MSGH COMMAND
WNAMX T1] ;AND SKIP OVER NEXT LINE
DISIX [[SIXBIT\TTY:=%[%]#!\] ;NO, USER WANTS PIP OUTPUT
WNAMX T1
WPPN OURPPN]
> ;END OF IFN FTHARV
IFE FTHARV,<
IFE FTMSGH,< ;USE PIP, NOT MSGH
DISIX [[SIXBIT\TTY:=%[%]#!\] ;BUILD THE PIP COMMAND STRING
WNAMX T1
WPPN OURPPN]
>
IFN FTMSGH,<
IFE FTAFAL,< ;[AFAL-7]
DISIX [[SIXBIT\%[,]#!\] ;BUILD THE COMMAND
WNAMX T1]
>;[AFAL-7]
>
IFN FTAFAL,< ;[AFAL-7]
HRRZ T1,OURPPN ;CONVERT TO SIXBIT [AFAL-7]
PUSHJ P,OCTNAM ;[AFAL-7]
DISIX [[SIXBIT\SSL:%.MAI[3,5]#!\] ;[AFAL-7]
WNAME T2] ;[AFAL-7]
>;END IFN FTAFAL [AFAL-7]
> ;END OF IFE FTHARV
SUBI T3,TMPBUF-1 ;COMPUTE LENGTH OF COMMAND
HRLOI T3,-1(T3) ;BUILD IOWD
EQVI T3,TMPBUF-1
IFN FTHARV,< ;IF HARVARD ALLOW FOR BOTH MSGH OR PIP
TXNE F,MSHFLG ;DOES HE WANT MSGH?
JRST MAIRC5 ;YEP, GO GIVE MSGH STYLE EXTENSION
MOVSI T2,'PIP' ;NO, USE PIP TMPCOR NAME
CAIA
IFN FTR067,<
MAIRC5: MOVSI T2,'MSG' ;USE MSGH TMPCOR NAME
> ;END IFN FTR067
IFE FTR067,<
MAIRC5: MOVSI T2,'MAI' ;USE MSGH TMPCOR NAME
> ;END IFE FTR067
> ;END OF IFN FTHARV
IFE FTHARV,<
IFE FTMSGH,<
MOVSI T2,'PIP'
>
IFN FTMSGH,<
IFN FTR067,<
MOVSI T2,'MSG' ;NAME OF TMPCOR FILE
> ;END IFN FTR067
IFE FTR067,<
MOVSI T2,'MAI' ;NAME OF TMPCOR FILE
> ;END IFE FTR067
>
> ;END OF IFE FTHARV
MOVE T1,[.TCRWF,,T2] ;WRITE TMPCOR FILE
TMPCOR T1,
CAIA ;CAN'T, TRY DISK
JRST RUNPIP ;OK, GO RUN PIP
FSETUP TMPBLH ;SETUP DISK TMP FILE BLOCK
PJOB T1, ;BUILD CCL FILENAME ###PIP.TMP
MOVEI T3,0
MOVEI T4,3
IDIVI T1,↑D10
ADDI T2,'0'
LSHC T2,-6
SOJG T4,.-3
HLLM T3,TMPBLK+FILNAM
FOOPEN TMPBLK ;OK, OPEN TMP FILE FOR OUTPUT
WASC TMPBUF ;WRITE THE COMMAND FILE
FOCLOS TMPBLK ;CLOSE THE FILE
IFN FTHARV,< ;IF HARVARD ALLOW FOR BOTH MSGH OR PIP
;NOW RUN PIP OR MSGH ACCORDING TO USER REQUEST, AT CCL ENTRY POINT
RUNPIP: TXNE F,MSHFLG ;DOES HE WANT MSGH?
JRST RUNMSG ;YEP
MOVE T1,[1,,PIPBLK] ;NO, RUN PIP
RUN T1,
HALT ;ON ERROR, LET MONITOR DIAGNOSE
RUNMSG: MOVE T1,[1,,MSGBLK] ;RUN MSGH
RUN T1,
EDISIX [STOP,,[SIXBIT\?M&ESSAGE HANDLER NOT FOUND; RUN &PIP#!\]]
PIPBLK: SIXBIT \SYS\
SIXBIT \PIP\
EXP 0, 0, 0, 0
MSGBLK: SIXBIT \SYS\
SIXBIT \MSGH\
EXP 0, 0, 0, 0
> ;END OF IFN FTHARV
IFE FTHARV,<
IFE FTMSGH,<
;NOW RUN PIP AT THE CCL ENTRY POINT
RUNPIP: MOVE T1,[1,,PIPBLK]
RUN T1, ;START PIP
HALT ;LET MONITOR SAY WHY FAILED
PIPBLK: SIXBIT \SYS\
SIXBIT \PIP\
> ;END IFE FTMSGH
IFN FTMSGH,<
RUNPIP: MOVE T1,[1,,PIPBLK]
RUN T1,
EDISIX [STOP,,[SIXBIT\? M&ESSAGE HANDLER NOT FOUND; RUN &PIP#!\]]
PIPBLK: SIXBIT \SYS\
SIXBIT \MSGH\ ;RUN MESSAGE HANDLER
> ;END IFN FTMSGH
0
0
0
0
> ;END OF IFE FTHARV
;HERE WHEN RENAME INTO USER'S DIRECTORY FAILED
MAIRNE: HRRZ T3,T2 ;GET RENAME ERROR CODE
CAIE T3,ERAEF% ;ALREADY EXISTING FILENAME ERROR?
JRST MAIER0 ;NO, PUNT
HRRZ T3,T1 ;YES, GET LAST 3 CHARS OF NAME
CAIN T3,'L ' ;DID WE JUST TRY 'MAIL'?
HRRI T1,'L00' ;YES, TACK ON SOME DIGITS
CAIN T3,'L99' ;HAVE WE TRIED 99 FILES?
JRST MAIRE1 ;YES, PUNT
TRNE T1,10 ;NO, IS LAST DIGIT A 9?
TRNN T1,1
AOJA T1,MAIRC2 ;NO, INCREMENT AND RETRY
ADDI T1,100-'9'+'0' ;YES, INCREMENT 10'S AND RESET UNITS
MAIRC2: FLOOK BOXBLK ;RE-ESTABLISH PATH
JRST MAIRC1 ;AND GO TRY AGAIN
;HERE WHEN CAN'T DO THE RENAME AT ALL
MAIER0: HRRM T3,BOXBLK+FILEXT ;STORE RENAME ERROR CODE
ERRENT BOXBLK ;SAY WHAT HAPPENED
MAIRE1:
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] [42]
PUSHJ P,CLRLOK ;CLEAR MAIL INTERLOCK
DISIX [STOP,,[SIXBIT\?P&LEASE DELETE OR RENAME YOUR CURRENT MAIL FILE#!\]]
;HERE WHEN LOOKUP FAILED ON MAILBOX FILE
BOXLKE:
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] [42]
PUSHJ P,CLRLOK ;CLEAR MAILBOX INTERLOCK
HRRZ T3,BOXBLK+FILEXT ;GET ERROR CODE
CAIE T3,ERFNF% ;SIMPLY NOT FOUND?
ERRLK BOXBLK ;NO, GIVE NASTY MESSAGE
DISIX [STOP,,[SIXBIT\Y&OU HAVE NO MAIL#!\]]
;HERE ON TMP FILE ERRORS
TMPOPE: ERROOP TMPBLK
JRST STOP
TMPENE: ERRENT TMPBLK
JRST STOP
TMPOUE: ERROUT TMPBLK
JRST STOP
;HERE TO EXIT THE MAIL PROGRAM
ERRFLS: PUSHJ P,FLUSHL ;FLUSH REST OF LINE ON COMMAND ERROR
TXNN F,FTPSVF ;DID ERROR OCCUR UNDER FTPSRV?
JRST STOP ;NOPE, FINISH UP
EWSIX [SIXBIT \ -- M&AIL ABORTED.#!\]
;YES, GIVE MORE INFORMATION TO POOR
;LOSER AT OTHER END OF FTPSRV (NOTE
;THAT "? ..." ERROR ALREADY GIVEN)
;ALL ROADS LEAD TO ROME (HOME? MORE LIKELY NOME...)
STOP: RESET ;CLEAR I/O
TXNN F,LGIFLG!FTPSVF ;ARE WE LOGGED IN OR UNDER FTPSRV?
EWSIX [SIXBIT\#.KJOB#.!\] ;NO, WE TYPE OUR OWN PERIOD
LOGOUT 1, ;LOGOUT IF NECESSARY, ELSE EXIT
EDISIX [.-1,,[SIXBIT\? C&AN'T CONTINUE#!\]]
SUBTTL COMMAND SCANNER SUBROUTINES
;ROUTINE TO PROCESS SWITCHES AND CHECK FOR END-OF-LINE
; PUSHJ P,SWTPRC
; ERROR--MESSAGE ALREADY PRINTED
; OK RETURN--COMMAND LINE HAS BEEN PROCESSED
SWTPRC: CAIE P1,"/" ;STARTING A SWITCH?
JRST SWTPR5 ;NO, SEE IF END OF LINE
PUSHJ P,SPNOR1 ;YES, PASS "/" AND SPACES
PUSHJ P,GETSIX ;GET SWITCH NAME
MOVE T2,[-NSWIT,,SWTNAM] ;POINT TO SWITCH TABLE
SKIPE T3,T1 ;ANY SWITCH GIVEN?
PUSHJ P,SIXSRC ;YES, SEE IF IN TABLE
EDISIX [CPOPJ##,,[SIXBIT\?"% I&LLEGAL SWITCH %#!\]
WNAME T3]
XCT SWTDSP-SWTNAM(T1) ;OK, DISPATCH
;SWITCH TABLES
SWTNAM: SIXBIT \IDENTI\
SIXBIT \DETAIL\
SIXBIT \SUPPRE\
IFN FTHELP,<
SIXBIT \HELP\
>
SIXBIT \FILE\
SIXBIT \SUBJEC\
IFN FTBCOM,<
SIXBIT \QUEUE\
>
SIXBIT \CC\
SIXBIT \CHECK\
IFN FTHARV,< ;FOR HARVARD, ALLOW /MSGH SWITCH
SIXBIT \MSGH\
>
IFN FTBCOM,< ;[AFAL-15] /NOWAIT Switch
SIXBIT \NOWAIT\ ;[AFAL-15]
> ;[AFAL-15]
NSWIT== .-SWTNAM
SWTDSP: JRST SWIDEN ;/IDENT: IDENTIFIER STRING
JRST SWDETA ;/DETAIL LIST NAMES FROM INDIRECT FILE [32]
JRST SWSUPP ;/SUPPRESS GIVE THE INDIRECT FILE NAME [32]
IFN FTHELP,<
JRST SWHELP ;/HELP: INFORMATION STRING
>
JRST SWFILE ;/FILE: FILESPEC
JRST SWSUBJ ;/SUBJECT: SUBJECT STRING
IFN FTBCOM,<
JRST SWQUEU ;/QUEUE: SWITCH
>
JRST SWCCTO ;/CC: "COPY TO" STRING
JRST SWCCHK ;/CHECK: CHECK FOR MAIL SWITCH
IFN FTHARV,<
JRST SWMSGH ;/MSGH: SET MSGH-WANTED SWITCH
>
IFN FTBCOM,< ;[AFAL-15]
JRST SWNOWA ;[AFAL-15] SET NOWAIT WANTED
>
IFN FTHARV,<
;HERE TO PROCESS "MSGH" SWITCH
SWMSGH: TXO F,MSHFLG ;SET MSGH FLAG
JRST SWTPRC ;AND BACK FOR MORE SWITCHES
>; END IFN FTHARV -- CAREFUL ABOUT PLACEMENT OF THE ABOVE
IFN FTBCOM,< ;[AFAL-15]
SWNOWA: TXO F,NOWAIT ;[AFAL-15] SAY DON'T WAIT ON MAIL
JRST SWTPRC ;[AFAL-15]
> ;[AFAL-15]
;HERE TO PROCESS IDENTIFIER STRING
SWIDEN: TXO F,IDNFLG ;MARK IT ON
MOVE T1,[POINT 7,IDENTI] ;OK, START STORAGE POINTER
MOVEI T2,IDENTL ;MAX LENGTH IDENTIFICATION ALLOWED
JRST SWIDE0
; HERE TO TURN ON FLAG INDICATING JUST CHECKING IF MAIL ARRIVED
SWCCHK: TXO F,CHKFLG
JRST SWTPRC ;CONTINUE SWITCH PROCESSING
;PROCESS /DETAIL AND /SUPPRESS SWITCHES. IF THE OTHER WAS GIVEN, [32]
; GIVE WARNING AND RESET. ERROR IF NO INDIRECT FILE.
SWDETA: TXZE F,SPSFLG ;/DETAIL. WAS /SUPPRESS GIVEN?
EDISIX [[SIXBIT\"% O&VERRRIDING /&SUPPRESS &SWITCH#!\]]
TXO F,DTLFLG
JRST SWSPDT ;CHECK IF HAVE INDIRECT FILE TO DETAIL
SWSUPP: TXZE F,DTLFLG ;/SUPPRESS. WAS /DETAIL GIVEN?
EDISIX [[SIXBIT\"% O&VERRIDING /&DETAIL &SWITCH#!\]]
TXO F,SPSFLG
SWSPDT: SKIPE INDFIL+FILNAM ;DO WE HAVE AN INDIRECT FILE?
JRST SWTPRC ;YES - CONTINUE PROCESSING
EDISIX [STOP,,[SIXBIT\?"% N&O INDIRECT FILE#!\]]
;HERE TO PROCESS SUBJECT STRING
SWSUBJ: MOVE T1,[POINT 7,SUBJCT] ;START STORAGE POINTER
MOVEI T2,SUBJSL ;MAX LENGTH OF SUBJECT STRING
SWIDE0: CAIE P1,":" ;ARGUMENT GIVEN?
EDISIX [CPOPJ##,,[SIXBIT\?"% S&WITCH ERROR#!\]]
SWIDE1: RCHF P1 ;GET A CHAR
CAIE P1,"/" ;ANOTHER SWITCH?
TXNE P2,BREAK ;OR END OF LINE?
JRST SWTPRC ;YES, DONE IDENTIFICATION
IDPB P1,T1 ;NO, STORE CHARACTER
SOJG T2,SWIDE1 ;BACK FOR MORE
EDISIX [CPOPJ##,,[SIXBIT\?"% S&WITCH ARGUMENT STRING TOO LONG#!\]]
; HERE TO PROCESS /CC: SWITCH - SET UP FLAG
SWCCTO: TXO F,CCPFLG ;TURN ON FLAG
SKIPE USRCCN ;BE SURE HAVE SOMEONE REAL TO SEND TO
JRST GETNXC ;GO GET CC PEOPLE
EDISIX [ERRFLS,,[SIXBIT\?"% I&LLEGAL USE OF &CC& SWITCH#!\]]
;PROCESS /FILE: FILE SPECIFICATION
SWFILE: PUSHJ P,LGNCHK ;NO NON-LOGGED IN USERS, PLEASE
TXO F,FILFLG ;INDICATE /FILE SEEN
CAIE P1,":" ;ARGUMENT GIVEN?
JRST SWTPRC ;NO, DEFAULT IT
MOVEI T4,FILBLK ;ADDR OF LOW SEG FILE BLOCK
PUSHJ P,FILARG ;GET FILE ARGS
POPJ P, ;LOST
MOVEI T1,.ACRED ;CHECK NOW FOR ACCESS RIGHTS [46]
MOVEI T2,FILBLK
PUSHJ P,FILACC ;CHECK ACCESS [46]
EDISIX [STOP,,[SIXBIT\?"% F&ILE NOT FOUND OR READ-PROTECTED#!\]]
JRST SWTPRC ;BACK FOR MORE SWITCHES
; SUBROUTINE TO COLLECT PARAMETERS FOR FILE ARGUMENT AND PUT THEM
; IN LOW SEG BLOCK POINTED TO BY (T4).
FILARG: PUSHJ P,GETSX0 ;GET FIRST FIELD
CAIE P1,":" ;DEVICE?
JRST SWFIL1 ;NO
JUMPE T1,FILSYE ;YES, ERROR IF NULL
MOVEM T1,FILDEV(T4) ;STORE DEVICE NAME
PUSHJ P,GETSX0 ;GET NEXT FIELD
SWFIL1: MOVEM T1,FILNAM(T4) ;STORE FILENAME
CAIE P1,"." ;EXTENSION GIVEN?
JRST .+3 ;NO, DEFAULT TO .BOX
PUSHJ P,GETSX0 ;YES, GET NEXT FIELD
HLLZM T1,FILEXT(T4) ;STORE IT
CAIE P1,"[" ;PPN STARTING?
JRST CPOPJ1## ;NO
PUSHJ P,SCNPPN ;YES, GET IT
FILSYE: EDISIX [CPOPJ##,,[SIXBIT\?"% F&ILE NAME SYNTAX ERROR#!\]]
MOVEM T1,FILPPN(T4) ;STORE IT
JRST CPOPJ1## ;GOOD RETURN
;HERE IF NOT A NEW SWITCH
SWTPR5: TXNN P2,BREAK ;END OF LINE?
EDISIX [CPOPJ##,,[SIXBIT\?"% S&YNTAX ERROR#!\]]
JRST CPOPJ1## ;YES, OK RETURN
;SUBROUTINE TO PARSE A PROJECT-PROGRAMMER NUMBER. ENTER WITH
; LEFT BRACKET IN P1, AND EXIT WITH FIRST NONBLANK AFTER "]"
; PUSHJ P,SCNPPN
; ERROR (NO MESSAGE TYPED)
; OK, path pointer in t1
SCNPPN: PUSHJ P,GETOC0 ;GET HALFWORD OCTAL NUMBER
POPJ P, ;ERROR
MOVE T3,T1 ;SAVE IT
CAIN P1,"," ;CHECK PROPER SYNTAX
PUSHJ P,GETOC0 ;GET PROGRAMMER NUMBER
POPJ P, ;NO GOOD
HRLI T1,(T3) ;ASSEMBLE PROJECT-PROGRAMMER NO.
;[afal-25]CAIE P1,"]" ;CHECK PROPER TERMINATION
;[afal-25]POPJ P, ;ERROR
movem t1,APath+.PtPPn ;[afal-25] save the PPN in the path
movx t3,<xwd -<.PtMax-1-.PtSfd>,0> ; make an AOBJN pointer
ScnPP0: caie p1,"," ;[afal-25] further adventures?
jrst ScnPP1 ;[afal-25] nope. finish up
push p,t3 ;[afal-25] GetSix likes to eat registers
pushj p,GetSx0 ;[afal-25] get next sixbit word
pop p,t3 ;[afal-25] restore AOBJN pointer
movem t1,APath+.PtSfd(t3) ;[afal-25] save the first 6 chars.
aobjn t3,ScnPP0 ;[afal-25] loop until can't hold any more
ScnPP1: setzm APath+.PtSfd(t3);[afal-25] end the block
movei t1,APath ;[afal-25] point to our path block.
AOS (P) ;OK, SKIP SPACES AND TAKE GOOD RETURN
;THE USUAL ROUTINES TO SKIP SPACES
SPNOR1: RCHF P1
SPNOR: TXNE P2,BLANK
JRST SPNOR1
POPJ P,
SCNPGM: PUSHJ P,GETOCT ;[AFAL-26] GET THE PROGRAMMER#
POPJ P, ;[AFAL-26] ERROR RETURN
MOVEM T1,APATH+.PTPPN ;[AFAL-26]SAVE THE PGM# IN PPN PATH
MOVX T3,<XWD -<.PTMAX-1-.PTSFD>,0> ;[AFAL-26]MAKE AN AOBJN
;POINTER
SETZM APATH+.PTSFD(T3) ;[AFAL-26] END THE BLOCK
MOVEI T1,APATH ;[AFAL-26] POINT TO OUR PATH BLOCK.
AOS (P) ;[AFAL-26] PREPARE TO TAKE GOOD RETURN
POPJ P, ;[AFAL-26] TAKE GOOD RETURN
;ROUTINE TO GET A HALF-WORD OCTAL NUMBER
; PUSHJ P,GETOCT
; ERROR (NO MESSAGE PRINTED)
; OK RETURN--NUMBER IN T1
GETOC0: RCHF P1 ;ENTER HERE TO SKIP FIRST CHAR
GETOCT: PUSHJ P,SPNOR ;SKIP LEADING BLANKS
TXNN P2,DIGIT ;START WITH DIGIT?
POPJ P, ;NO, WE DON'T LIKE IT
SETZ T1, ;OK, START NUMBER
GETOC1: TRNN T1,700000 ;ROOM FOR ANOTHER DIGIT?
CAILE P1,"7" ; AND LEGAL OCTAL DIGIT?
POPJ P, ;NO, ERROR
LSH T1,3 ;YES, APPEND NEW DIGIT
IORI T1,-"0"(P1)
RCHF P1 ;GET NEXT
TXNE P2,DIGIT ;ANOTHER DIGIT?
JRST GETOC1 ;YES, PROCESS IT
PUSHJ P,SPNOR ;NO, SKIP TRAILING BLANKS
JRST CPOPJ1## ;NORMAL RETURN
;ROUTINE TO GET USER NAME OR NUMBER
; PUSHJ P,GETUSR
; USER NAME NOT SEEN (THIS IS NOT AN ERROR)
; USER NAME IN T1 AND T2, OR PROGRAMMER NUMBER IN T3,
; OR POINTER TO ASCIZ USERNAME IN T1, AND HOST ADDRESS IN T4
; NOTE SYNTAX ERRORS NEVER RETURN BUT GO STRAIGHT TO ERRFLS
GETUSR: PUSHJ P,SPNOR ;PASS LEADING BLANKS
CAIN P1,"/" ;STARTING A SWITCH?
POPJ P, ;YES - GIVE NON-SKIP RETURN [33]
TXNE P2,BREAK ;END OF LINE?
JRST GETUSI ;YES - SEE IF FROM INDIRECT FILE [33]
TXZ F,PPNFLG
setzm HstStr ;[afal-17] no host start seen yet
PUSH P,.JBFF## ;SAVE FREE START
HRRZ T1,.JBFF## ;MAKE BYTE PTR
TLOA T1,(POINT 7)
GETUS3: RCHF P1 ;GET A CHAR
CAIN P1,LSQUAR ;IF FIND A LEFT BRACKET,
TXO F,PPNFLG ;INSIST ON A RIGHT ONE ALSO
TXNE F,INDFLG ;IF READING FROM INDIRECT FILE,
CAIE P1,CR ;SWALLOW CR
SKIPA
JRST GETUS3
CAIE P1,"/" ;STARTING A SWITCH?
TXNE P2,BREAK ;END OF LINE?
JRST NOTNET ;YES, NOT NETWORK USER
TXNE F,PPNFLG ;IF LOOKING FOR WHOLE PPN,
JRST GETUSN ;SWALLOW COMMA
CAIN P1,"," ;COMMA?
JRST NOTNET ;NOT NETWORK USER
IFN FTCIMP,<
CAIN P1,"@" ;AT-SIGN?
;[afal-17]JRST GETUS4 ;YES, GO GATHER HOST NAME
movem t1,HstStr ;[afal-17] remember that we saw the start of
; a host name.
>
GETUSN: MOVEI T2,1(T1) ;NOT SPECIAL, CHECK FOR ROOM
PUSHJ P,GETCOR ;GET MORE CORE IF NEEDED [43]
IDPB P1,T1 ;STORE CHAR
TXNE F,PPNFLG ;NOW CHECK IF CHAR STORED
CAIE P1,RSQUAR ;ENDED THE PPN
JRST GETUS3 ;LOOP FOR MORE
RCHF P1 ;PPN FOUND, GET NEXT CHAR
JRST NOTNTP ;GO PROCESS
;IF BREAK IN INDIRECT FILE, SEE IF HAVE ANY MORE [33]
GETUSI: TXNN F,INDFLG ;INDIRECT OR TTY?
POPJ P, ;TTY. NON-SKIP RETURN
RCHF P1 ;GET NEXT CHAR. (EOF WILL POPJ)
JRST GETUSR ;CHECK IT OUT
IFN FTCIMP,<
;GETUSR (CONT'D)
;HERE IF SEE "@" -- NETWORK USERNAME
GETUS4: move t1,HstStr ;[afal-17] get the start of the host name
SETZ T2, ;APPEND NULL TO NAME
IDPB T2,T1
SKIPE LHOSTN ;CAN'T SEND TO NET IF NOT ON NET
TXNN F,LGIFLG ;OR IF NOT LOGGED IN
GETCMA: EDISIX [ERRFLS,,[SIXBIT\? C&AN'T MAIL TO &ARPA&NET#!\]]
MOVEI T2,1(T1) ;SET NEW FREE START
MOVEM T2,.JBFF##
repeat 0,< ;[afal-17] done in normal name parsing routines
MOVSI T1,(POINT 7,0) ;[AFAL-14] SET UP BYTE POINTER
HRRI T1,HOSTN ;[AFAL-14] POINT AT PLACE FOR HOST NAME
PUSHJ P,GETASC ;[AFAL-14] GET THE ASCIZ HOST NAME
CAIN P1,CR ;SWALLOW CR IF FROM INDIRECT FILE
RCHF P1
CAIE P1,"," ;CHECK FOR PROPER TERMINATOR
CAIN P1,"/"
JRST .+3
TXNN P2,BREAK
EDISIX [ERRFLS,,[SIXBIT\?"% H&OST NAME SYNTAX ERROR#!\]]
MOVEI T1,HOSTN ;[AFAL-14] SET ARG FOR HOST TNAME LOOKUP
> ;[afal-17] end of repeat 0
;[afal-17] T1 contains a pointer to the host name: skip
; leading blank-like characters.
HstBLp: movem t1,HstStr ;[afal-17] save point over ILDB
ildb t2,t1 ;[afal-17] get next char
caie t2,.chtab ;[afal-17] a tab?
cain t2," " ;[afal-17] or a space?
jrst HstBlp ;[afal-17] leading something: flush
move t1,HstStr ;[afal-17] recover correct pointer
PUSHJ P,HSTNAM## ;LOOKUP HOST NAME
SCU1: EDISIX [ERRFLS,,[SIXBIT\? C&AN'T ACCESS HOST NAME TABLE#!\]]
SCU2: JRST GETUS5 ;[AFAL-14] ERROR IF NOT FOUND
SCU3: POP P,T1 ;OK, GET BACK NAME STRING PTR
MOVE T4,T2 ;[AFAL-14] GET HOST ADDR IN RIGHT AC
SETZB T2,T3 ;[AFAL-14] T2, T3 HAVE NOTHING IN THEM
JRST CPOPJ1## ;TAKE SKIP RETURN
;HERE IF HOST NAME NOT FOUND
GETUS5: EDISIX [ERRFLS,,[SIXBIT\? N&O SUCH HOST AS %!\] ;[AFAL-14]
WASC HOSTN]
> ;END IFN FTCIMP
;GETUSR (CONT'D)
;HERE IF FINISHED COLLECTING NAME STRING
NOTNET: TXNE F,PPNFLG ;IF HERE WHILE LOOKING FOR PPN,
EDISIX [ERRFLS,,[SIXBIT\?"% S&YNTAX ERROR - NO TERMINATING BRACKET#!\]]
NOTNTP: SETZ T2, ;TERMINATE STRING
IDPB T2,T1
ifn FtCImp,< ;[afal-17] now check to see if we saw a host name on the way.
skipe HstStr ;[afal-17] ever see a host indication?
jrst GetUs4 ;[afal-17] yes: go handle network twiddling
> ;[afal-17] end of ifn FtCImp
PUSH P,IFILE## ;SAVE CURRENT INPUT FILE
FSETUP TMPIBH ;SETUP TO RESCAN STRING
FISEL TMPCBL
MOVE S1,-1(P) ;RESET STRING PTR
HRLI S1,(POINT 7)
RCHF P1 ;ADVANCE FIRST CHAR
TXNN P2,LETTER ;START WITH A LETTER?
JRST GETUS1 ;NO, TRY OTHER THINGS
TXO F,LSXFLG ;ALLOW FOR ALL KINDS OF STUFF IN NAME
PUSHJ P,GETSIX ;GET 2 WORDS OF USER NAME
TXZ F,LSXFLG ;NOW TURN IT OFF
JUMPN P1,GETUS2 ;ERROR IF DIDN'T USE WHOLE STRING
SETZ T3, ;CLEAR PROGRAMMER NUMBER
JRST GETUSX ;TAKE GOOD RETURN
; CHECK IF * BY ITSELF, IN WHICH CASE IS SEND-TO-SELF
GETUSS: PUSHJ P,LGNCHK ;MUST BE LOGGED IN
RCHF P1 ;MUST BE ONLY THING IN LINE
JUMPN P1,GETSLF ;ISN'T
MOVE T1,OURNM1 ;FIRST PART OF NAME
MOVE T2,OURNM2
SETZ T3,
JRST GETUSX ;GOOD RETURN
;IF * NOT BY ITSELF, IS FILE SPEC. CAN ONLY HAVE ONE.
GETSLF: SKIPE SLFBLK+FILNAM ;ALREADY HAVE FILE SPEC?
EDISIX [GETUSE,,[SIXBIT\?"% O&NLY ONE FILE PERMITTED#!\]]
FSETUP SLFBLH ;FILE SPEC FOR USER FILE
MOVEI T4,SLFBLK
LCHF P1 ;BACK UP SO CAN START OVER
PUSHJ P,FILARG ;GET FILE ARGUMENTS
JRST GETUSE
TXO F,FLXFLG ;FOR GETUSR ROUTINE TO ACKNOWLEDGE [36]
MOVEI T1,.ACAPP ;SEE IF WE CAN APPEND [46]
MOVEI T2,SLFBLK ;TO THIS FILE
PUSHJ P,FILACC ; [46]
EDISIX [STOP,,[SIXBIT\?"% N&OT PRIVILEGED TO WRITE THAT DIRECTORY#!\]]
SETZB T1,T3
JRST GETUSX ;ALL OK
GETUS1: CAIN P1,"*" ;IS IT ASTERISK?
JRST GETUSS ;CHECK IT OUT
SETZ T1,
CAIN P1,"[" ;WANT TO TYPE ENTIRE PPN?
MOVEI T1,SCNPPN ;YES, LET HIM (PROJ # IS DISCARDED)
TXNE P2,DIGIT ;START WITH A DIGIT?
;[AFAL-26] MOVEI T1,GETOCT ;YES
MOVEI T1,SCNPGM ;[AFAL-26] YES
JUMPE T1,GETUS2 ;SYNTAX ERROR IF NOT RECOGNIZED YET
PUSHJ P,(T1) ;PERFORM PROPER ACTION
EDISIX [GETUSE,,[SIXBIT\?"% I&LLEGAL USER ID#!\]]
;[afal-25]HRRZ T3,T1 ;OK, COPY PROGRAMMER NUMBER
HRRZ T3,.PtPPn(T1) ;[afal-25] get PPN or pgm# from path
;block.
SETZB T1,T2 ;CLEAR OTHER THINGS
GETUSX: POP P,IFILE## ;RESTORE CURRENT INPUT FILE
CCHF P1 ;RESTORE CURRENT CHAR
POP P,.JBFF## ;RESTORE FREE CORE PTR
SETZ T4, ;[AFAL-14] No host address to return
JRST CPOPJ1## ;SKIP RETURN
;HERE ON SYNTAX ERROR WHILE RESCANNING INPUT STRING
GETUS2: TXNN F,INDFLG ;IS ERROR FROM DIRECT OR INDIRECT?
EDISIX [GETUSE,,[SIXBIT\?"% S&YNTAX ERROR#!\]]
EWSIX [SIXBIT\? S&YNTAX ERROR IN INDIRECT FILE#!\]
GETUSE: POP P,IFILE##
CCHF P1
JRST ERRFLS
;ROUTINE TO GET TWO WORDS OF SIXBIT ALPHANUMERIC TEXT
; PUSHJ P,GETSIX
; ALWAYS RETURN HERE WITH SIXBIT IN T1 AND T2
GETSX0: RCHF P1 ;ENTER HERE TO SKIP CURRENT CHAR
GETSIX: PUSHJ P,SPNOR
SETZB T1,T2 ;INIT TEXT
SKIPA T3,[POINT 6,T1] ;INIT POINTER
GETSX1: RCHF P1 ;GET A CHAR
TXNE F,LSXFLG ;IF ALL SIXBIT CHAR OK, [30]
TXNN P2,LGLSIX!LETTER ;CHECK FOR THAT INSTEAD [30]
TXNE P2,LETTER!DIGIT ;ALPHANUMERIC?
SKIPA ; [30]
PJRST SPNOR ;NO, SKIP SPACES AND RETURN
CAIG P1,137 ;YES, LOWER CASE?
SUBI P1,40 ;NO, CONVERT TO SIXBIT
CAME T3,[POINT 6,T2,35] ;OUT OF ROOM?
IDPB P1,T3 ;NO, STORE CHAR
JRST GETSX1 ;BACK FOR MORE
repeat 0,< ;[afal-17] not used
;ROUTINE TO GET ALPHANUMERIC ASCIZ TEXT
; MOVEI T1,POINTER TO PLACE TO STORE TEXT
; MOVE T2,MAX SIZE OF STRING
; PUSHJ P,GETASC
; ALWAYS RETURN HERE WITH NUMBER OF CHARS READ
GETAS0: RCHF P1 ;ENTER HERE TO SKIP CURRENT CHAR
GETASC: PUSHJ P,SPNOR
SOJ T2, ;ACCOUNT FOR ZERO BYTE AT END
SETZ T3, ;CLEAR COUNTER
GETAS1: RCHF P1 ;GET A CHARACTER
TXNE P2,BREAK!BLANK ;[AFAL-14] STOP ON BREAK OR BLANK
JRST GETAS2 ;[AFAL-14] LEAVE
CAIE P1,"," ;[AFAL-14] ALSO CHECK COMMA AND SLASH
CAIN P1,"/" ;[AFAL-14]
JRST GETAS2 ;[AFAL-14]
AOJ T3, ;[AFAL-14] COUNT THE CHARACTER
CAIL T3,(T2) ;[AFAL-14] TOO MANY?
JRST GETAS2 ;[AFAL-14] YES, LEAVE
IDPB P1,T1 ;[AFAL-14] STORE THE CHAR
JRST GETAS1 ;[AFAL-14] LOOP FOR MORE
GETAS2: SETZ T2, ;[AFAL-14] STORE AN ASCIZ BYTE
IDPB T2,T1
MOVE T1,T3 ;[AFAL-14] RETURN THE COUNT
PJRST SPNOR ;[AFAL-14] IGNORE SPACES AND RETURN
> ;[afal-17] end of repeat 0
;ROUTINE TO FLUSH THE REMAINDER OF THE INPUT COMMAND
FLUSHL: TXNE P2,BREAK ;BREAK CHAR?
POPJ P, ;YES, RETURN
RCHF P1 ;NO, GET NEXT
JRST FLUSHL
;ROUTINE TO DO THE RCH OPERATION FOR TTY INPUT.
TTIRCH: INCHWL U1 ;GET CHAR FROM TTY
TXNE F,CRIFLG ;READING MAIL TEXT? [47]
POPJ P, ;YES - PASS ALL CHAR'S TO EDITOR [47]
CAIN U1,"C"-100 ;CONTROL-C?
JRST STOP ;YES, EXIT TO MONITOR
CAIE U1,CR ;NO, IS THIS ONE?
POPJ P, ;RETURN IT
JRST TTIRCH ;FLUSH IT
;ROUTINE TO DO RCH OPERATION FOR INDIRECT FILE - FLUSH CR [33]
INFRCH: PUSHJ P,I1BYTE## ;GET CHAR IN USUAL FASHION
CAIN U1,CR ;CARRIAGE RETURN?
JRST INFRCH ;YES - IGNORE
POPJ P, ;NO - SEND IT ON
; ROUTINE TO SEARCH FOR SIXBIT NAME IN A TABLE, WITH UNIQUE AND FORCED
; ABBREVIATIONS PROVIDED FOR. A FORCED ABBREVIATION IS ONE WHOSE TABLE
; ENTRY BEGINS WITH "*", AND A NON-UNIQUE ABBREVIATION WILL IT SO LONG
; AS IT IS NOT AN EXACT MATCH WITH SOMETHING ELSE.
; MOVE T1,SIXBIT NAME OR ABBREVIATION
; MOVE T2,[-LENGTH,,START OF NAME TABLE]
; PUSHJ P,SIXSRC
; ERROR RETURN
; NORMAL RETURN
; ON ERROR RETURN, T1=0 IF THE ENTRY WAS NOT FOUND OR IF THE ABBREVIA-
; TION WAS NOT UNIQUE AND DID NOT MATCH A FORCED ABBREVIATION.
; ON NRMAL RETURN, T1[RH] POINTS TO THE MATCHING NAME. T1[LH]=0 IF THE
; MATCH WAS EXACT OR FORCED, AND -1 IF IT WAS A UNIQUE ABBREVIATION.
; CLOBBERS T1,T2
SIXSRC: PUSHJ P,SAVE3## ;SAVE P1, P2, P3
MOVE P2,T1 ;REMEMBER NAME WE ARE LOOKING FOR
SETO P1, ;INITIALIZE MASK
LSH P1,-6 ;SHIFT MASK 1 CHAR TO RIGHT
AND T1,P1 ;CLEAR 1 CHAR FROM LEFT END OF WORD
JUMPN T1,.-2 ;JUMP IF MASK DIDN'T FIT
;NOTE--AFTER THIS, T1 IS CLEAR.
SIXSR1: MOVE P3,(T2) ;FETCH ENTRY FROM NAME TABLE
TLNN P3,(60B5) ;IS THE FIRST CHARACTER "*"?
LSH P3,6 ;YES, SHIFT IT OUT
CAMN P3,P2 ;DOES THE NAME MATCH EXACTLY?
SIXSR2: MOVEI T1,(T2) ;YES, REMEMBER ADR. LH=0 TO INDICATE
; WE HAVE FOUND EXACT OR FORCED MATCH
JUMPG T1,SIXSR3 ;JUMP IF GOOD MATCH FOUND
ANDCM P3,P1 ;NOT YET. APPLY MASK TO NAME ENTRY
CAME P3,P2 ;DOES THE ABBREVIATION MATCH?
JRST SIXSR3 ;NO, TRY NEXT
MOVE P3,(T2) ;YES, GET TABLE ENTRY AGAIN
TLNN P3,(60B5) ;IS FIRST CHARACTER "*"?
JRST SIXSR2 ;YES, REMEMBER FORCED MATCH OCCURRED
JUMPE T1,.+2 ;NO, HAS ANYTHING MATCHED PREVIOUSLY?
TRZA T1,-1 ;YES, LH=-1,RH=0 TO INDICATE AMBIGUITY
HRROI T1,(T2) ;NO, REMEMBER ADR OF ABBREVIATION WITH
; LH=-1 TO INDICATE IT WASN'T FORCED
SIXSR3: AOBJN T2,SIXSR1 ;JUMP IF NOT AT END OF TABLE
TRNN T1,-1 ;END, DID WE GET ONE SUCCESSFUL MATCH?
POPJ P, ;NO, TAKE ERROR RETURN
JRST CPOPJ1 ;YES, TAKE NORMAL RETURN
SUBTTL QUEUE ROUTINES
IFN FTBCOM,<
;IF FTP FAILS TO DELIVER MAIL FOR SOME REASON OTHER THAN THAT THERE IS
;NO SUCH USER AT THE REMOTE SITE, THE MAIL WILL BE QUEUED IN [3,5] FOR
;A LATER ATTEMPT, UNTIL TWO DAYS HAVE PASSED. SHOULD THIS HAPPEN, FLAG
; QUDFLG WILL BE SET, AND THE MAIL SENT TO n.MQQ[3,5] AS THOUGH TO A
;NORMAL MAILBOX, WITH ALL THE STANDARD MAIL HEADERS, AND AN ADDITIONAL
;QUEUE HEADER (DESCRIBED BELOW). n IS COUNTED AS 1, 2, 3,...AND ON UP,
;DEPENDING ON THE CURRENT STATE OF [3,5].
;WHEN AN [OPR] JOB - GENERALLY DONE VIA BATCH - USES THE /QUEUE:SEND
;SWITCH AN ATTEMPT WILL BE MADE TO SEND ALL QUEUED MAIL TO THE HOST AS
;DIRECTED BY THE HEADER. SWITCH QUEFLG WILL INDICATE THAT THIS IS
;GOING ON, SHOULD IT BE NECESSARY TO REQUEUE, THUS LETTING THE FILE BE
;OR REMOVING THE FILE SHOULD THE MAIL GO THROUGH. AFTER TWO DAYS, LOSE
;INTEREST.
;THE HEADER IS AN ASCII STRING AT THE START OF THE FILE:
;..P,PN;REMOTE-HOST-#;NAME-TO-SEND-TO;.......MAIL.......
;THE SEMICOLONS ARE THE DELIMITERS... EXPIRATION OF MAIL IS CALCULATED
;FROM THE CREATION DATE.
;DK RUTGERS/JUN 75
;DK RUTGERS/MAR 76 UPDATE
;SWITCH PROCESSING
SWQUEU: JRST SQUEUE ;FOR NOW, NO SUBPARAMETERS
; SUBROUTINE FOR USE WHEN FTP ATTEMPT FAILS, TO QUEUE THE MAIL
MQUEUE: SKIPN T1,HDRNET ;[AFAL-14] Net header built yet?
PUSHJ P,HEADRN ;[AFAL-14] No, build it
MOVEM T1,HDRNET ;[AFAL-14] Store the address
PUSH P,OFILE## ;HOLD ALL OUTPUT FOR A WHILE
FSETUP QUEFIH ;SET UP A NEW FILE
MOVE T1,OURPPN
SKIPE .JBDDT ;IF DEBUGGING,
MOVEM T1,QUEFIL+FILPPN ;MAKE US THE QUEUE
IFE FTAFAL,<MOVEI T1,LOKQUE> ;[AFAL-2] [42]
IFN FTAFAL,<SETZ T1,> ;[AFAL-2] ENQ ON PROGRAMMER ZERO
PUSHJ P,SETLOK ;SET QUEUE INTERLOCK [42]
PUSH P,P1 ;SAVE TEXT ADDRESS
FOGET QUEFIL ;OPEN ONLY
MOVEI P1,QUEFIL ;REQUEST PROCESSING FOR QUEUE [41]
PUSHJ P,QNBFND ;TO FIND NEXT FILE [41]
FENT QUEFIL ;ENTER NEW FILE
WPPN OURPPN ;IDENTIFY SELF IN FILE HEADER
WCHI SEMI ;DELIMITER
TXZ F,LZEFLG ;NOC LEADING ZEROS
WOCT USRHSN(P3) ;[AFAL-14] GET HOST AND ADD TO HEADER
WCHI SEMI
WASC @USRTB1(P3) ;REMOTE USER'S NAME
WCHI SEMI
POP P,P1 ;RECOVER ADDRESS OF TEXT
MOVE T1,HDRNET ;HEADER SET UP ALREADY - JUST USE IT
PUSHJ P,SDTEXT ;SEND LETTER TO QUEUE FILE
FOCLOS QUEFIL ;NOW CLOSE UP
IFE FTAFAL,<MOVEI T1,LOKQUE> ;[AFAL-2] AND TURN OUT THE LIGHTS
POP P,OFILE##
PJRST CLRLOK ;AND GO HOME
;HERE TO SEND OUT QUEUED MAIL
SQUEUE: TXZ F,FTPSVF ;IN CASE OF CONFUSION
PUSHJ P,HSTCHK## ;READ HOST TABLE IN CORE IN CASE
JRST STOP ;(SHOULDN'T HAPPEN)
jfcl ;[afal-23] no new file return
MOVE T1,OURPPN ;IF DEBUGGING,
SKIPN .JBDDT ;SET UP FOR USE AND SKIP CHECK
MOVE T1,[1,,2] ;MUST BE OPERATOR
CAME T1,OURPPN
EDISIX [STOP,,[SIXBIT\?"% N&OT PRIVILEGED TO USE THIS FUNCTION#!\]]
TXO F,QUEFLG ;MARK WE ARE HANDLE QUEUED MAIL
MOVEI S2,QUEPTR ;SET UP HEAD FOR LINKED LIST [44]
FSETUP MQUFIH
SETZ P3, ;FOR FAKEOUT OF MAIL ROUTINES
MOVEI P4,1 ;FOR MAKING UP FILE NAMES
SKIPE .JBDDT ;IF DEBUGGING,
MOVEM T1,MQUFIL+FILPPN ;MAKE US THE QUEUE
FIGET MQUFIL ;OPEN AND SELECT FOR INPUT
SQUEUA: MOVE T1,P4 ;CREATE A FILE NAME
PUSHJ P,OCTNAM
MOVEM T2,MQUFIL+FILNAM
HLLZS MQUFIL+FILEXT
FLOOK MQUFIL ;LOOKUP A FILE - IF FAIL, DONE
SQUSND: PUSHJ P,SQUCLN
HRLZM T1,OURPPN ;FIRST PART OF PPN
CAIE T2,COMMA ;CORRECT DELIMITER?
JRST SQUERR
PUSHJ P,SQUCLN ;REST OF PPN
HRRM T1,OURPPN
CAIE T2,SEMI
JRST SQUERR ;SLIPPED UP SOMEWHERE
PUSHJ P,SQUCLN ;GET HOST NUMBER
MOVEM T1,USRHSN
MOVE T1,[POINT 7,IDENTI] ;A PLACE TO STORE NAME
SQUSRN: RCH T2 ;COLLECT USER NAME
CAIN T2,SEMI
JRST SQUSRO ;END OF USER NAME
CAME T1,[POINT 7,IDENTI+<IDENTL/5>,27]
IDPB T2,T1
JRST SQUSRN
SQUSRO: SETZ T2,
IDPB T2,T1 ;NULL DELIMITER
MOVEI T2,IDENTI ;POINTER TO NAME
MOVEM T2,USRTB1 ;MORE FAKEOUT
MOVEI T2,HDRTIH ;SET UP TEMP FILE
PUSHJ P,SETTMP
MOVEM T2,P1 ;WHICH WILL BECOME THE TEXT
SQUSRD: RCH T1 ;NOW READ THE QUEUED LETTER INTO CORE
WCH T1 ;AND WRITE INTO TEMP FILE
JRST SQUSRD ;UNTIL EOF...
SQUEOF: FICLS MQUFIL ;...WHICH COMES HERE
MOVEI T1,[0] ;ADDRESS OF A NULL WORD
MOVEM T1,HDRNET ;TO FAKE OUT HEADER CHECK
PUSHJ P,SNDNET ;SEND TO NET
JRST SQUFAI ;STILL NOT GOING THROUGH
MOVEI P1,[ASCIZ\Mail successful\] ;PREPARE SUCCESS STORY
; HERE AFTER MAILING A QUEUED FILE, OR DECIDING IT CAN'T BE DONE.
; TELL ORIGINAL SENDER THE FINAL OUTCOME.
SQUNOT: SETZM HDRLOC ;MUST RECALCULATE HEADER
SETO T1, ;MARK FILE AS READY TO BE [44]
PUSHJ P,QFLPUT ;...DELETED [44]
MOVE T1,USRHSN ;[AFAL-14] SET UP SUBJECT HEADER
FSETUP SJBTIH
FOSEL TMPCBL ;AND SELECT FOR OUTPUT
MOVE S0,[POINT 7,SUBJCT]
DISIX [[SIXBIT\Q&UEUED &M&AIL TO %%!\]
WASC IDENTI ;WHO SENDING IT TO
PUSHJ P,ATHOST] ;AND WHERE
WCHI 0 ;GUARANTEE NULL
;SET UP FOR FAKING OUT MAIL
TXO F,FLOFLG ;TO FOOL HEADER - TEMPORARY
IFN FTMSGH,<
SETZM MALSIZ ;FORCE MEASUREMENT OF MAIL
>
SETZ P3,
MOVE T1,OURPPN ;FIND WHO SENDER WAS
MOVEM T1,USRPGN ;AND SEND TO HIM THIS TIME
SETZM USRTB1
MOVE T1,[SIXBIT\[SYSTE\] ;WHAT WE CALL OURSELVES
MOVEM T1,OURNM1
MOVE T1,[SIXBIT\M]MAIL\] ; ..
MOVEM T1,OURNM2
PUSHJ P,SNDLOC ;GO SEND LOCAL MAIL
JRST SQUCON ;CLEAN UP AND CONTINUE
; HERE WHEN ATTEMPT TO SEND QUEUED MAIL FAILED. FIND OUT WHY - MAYBE CAN
; REQUEUE FOR ANOTHER TRY, OR MUST GIVE UP. IF THE LATTER, TELL THE USER.
; NOW CHECK IF PAST TIME TO GIVE UP - ALLOW 5 DAYS = QUEDAY
SQUFAI:
IFN FTR106,<
TXNN F,QUDFLG ;FAIL FOR REQUEUE TYPE REASON?
JRST SQUASH ;NO, CAN'T HANG AROUND
> ;END IFN FTR106
HRRZ T1,MQUFIL+FILDAT ;TWO-PART DATE
LDB T2,[POINT 3,MQUFIL+FILEXT,20] ;HIGH-ORDER PART
DPB T2,[POINT 6,T1,23] ;MERGE PARTS
DATE T2, ;GET CURRENT DATE
ADDI T1,QUEDAY ;ADD LIMIT
CAML T1,T2 ;PAST THE CURRENT DAY?
JRST SQURQU ;NOT YET
CAME T1,T2 ;AT THE CURRENT DAY?
JRST SQUASH ;PAST IT ALTOGETHER
LDB T1,[POINT 11,MQUFIL+FILDAT,23] ;NOW GET TIME
MSTIME T2, ;AND CURRENT TIME
CAMG T1,T2 ;COMPARE WITH TIME OF CREATION
SQUASH: TXZ F,QUDFLG ;QUEUE PERIOD EXPIRED - KILL LETTER
MOVEI P1,[ASCIZ\Unable to send queued mail\] ;POSSIBLE SOB STORY
TXZN F,QUDFLG ;DO WE HAVE TO SAY NO YET?
JRST SQUNOT ;YES - I MEAN NO - CANNOT QUEUE OR SEND
SQURQU: SETZ T1, ;MARK FILE TO BE SAVED [44]
PUSHJ P,QFLPUT ;IN THE LINKED LIST OF STATUS [44]
; HERE AFTER ALL MESSAGES SENT, OR NOT, AND QUEUE DISPOSITION MADE.
SQUCON: MOVE T1,[IF.NEW+<.IUCLS,,CONBLK>] ;[AFAL-14]CLOSE NET CONNECTION
IMPUUO T1,
PUSHJ P,ERRCLS
AOJA P4,SQUEUA ;COUNT AND CONTINUE
;HERE WHEN LOOKUP FAILS - REARRANGE QUEUE
; ALL FILES ARE TO BE RENAMED; EITHER INTO OBLIVION (IF QUEPTR(LINK)
; IS -1 (MAIL SENT), OR TO THE NEXT NUMBER OF QUEPTR(LINK) = 0. THIS
; ENSURES A CONTINUOUS SEQUENCE OF NUMBERS. INTERLOCK IS ON WHILE
; THIS IS BEING DONE.
;ROUTINE ALSO EXPECTS TO RENUMBER AUTOMATICALLY ANY FILES [41]
; THAT HAVE BEEN ADDED TO THE QUEUE WHILE W WERE BUSY. FOR
; THIS PROCESS, INTERLOCK IS TURNED ON.
SQUEND: FREL MQUFIL ;DONE WITH THAT ONE
FSETUP QRNFIH ;SET UP NEW ONE WITH DIFFERENT ERROR POINT
FIGET QRNFIL
IFE FTAFAL,<MOVEI T1,LOKQUE> ;[AFAL-2] [42]
IFN FTAFAL,<SETZ T1,> ;[AFAL-2] ENQ ON PROGRAMMER ZERO
PUSHJ P,SETLOK ;SET INTERLOCK [42]
MOVEI P3,QRNFIL ;SET VALUES FOR RENAMING [41]
MOVEI S2,QUEPTR ;LIST WHICH STATES WHO LIVES AND DIES [41]
PUSHJ P,RENFIL ;GO RENAME ALL FILES [41]
IFE FTAFAL,<MOVEI T1,LOKQUE> ;[AFAL-2] [42]
PUSHJ P,CLRLOK ;CLEAR QUEUE INTERLOCK [42]
JRST STOP
;SUBROUTINE TO READ INPUT UP TO COMMA OR SEMICOLON AND CONVERT TO
; BINARY. ANSWER IN T1, LAST CHAR IN T2.
SQUCLN: SETZ T1,
RCH T2
CAIN T2,SEMI
POPJ P,
CAIN T2,COMMA ;DELIMITER
POPJ P,
SUBI T2,60 ;CONVERT FROM ASCII TO OCTAL
JUMPL T2,SQUERR
CAILE T2,7
JRST SQUERR
ROT T2,-3
LSHC T1,3
JRST SQUCLN+1
SQUERR: EDISIX [STOP,,[SIXBIT\? E&RROR IN QUEUED FILE HEADER#!\]]
; STILL IN IFN FTBCOM
;SUBROUTINES USED BOTH BY QUEUE AND FORWARD [41]
;QNBFND - FIND FIRST FREE FILE IN QUE: OF THE FORM NNN.MQQ OR NNN.MFW
; FOR QUEUE OR FORWARD. FILE NAME, EXT CONTAINED IN FILE SPECS
; POINTED TO BY P1. RETURN WITH FILE SPEC SET UP FOR ENTER.
QNBFND: MOVEI T3,1 ;COUNTER FOR FILE NAME
QNBFDA: MOVE T1,T3 ;NOW LOOK FOR FIRST AVAILABLE FILE
PUSHJ P,OCTNAM ;CONVERT TO SIXBIT
MOVEM T2,FILNAM(P1)
HLLZS FILEXT(P1) ;CLEAR ANY ERROR CODE
MOVE T1,FILPPN(P1) ;CONTINUE BUILDING LOOKUP BLOCK
MOVEM T1,FILPP1(P1)
LOOKUP QUE,FILNAM(P1) ;NOTE CHANNEL IS QUE IN ALL CASES
SKIPA ;ERROR - MAY BE RIGHT ONE
AOJA T3,QNBFDA ;FILE EXISTS - KEEP GOING
HRRZ T1,FILEXT(P1) ;CHECK ERROR CODE
SKIPE T1 ;ZERO = NOT FOUND - OK
EDISIX [STOP,,[SIXBIT\L&OOKUP FAILURE FOR % #!\]
WFNAME (P1)]
MOVX T2,%LDSPP ;GET STANDARD SPOOL PROTECTION
GETTAB T2,
MOVSI T2,(077B8)
MOVEM T2,FILDAT(P1) ;SET UP FOR MAIN ROUTINE
POPJ P, ;AND LET MAIN ROUTINE GO ON FROM HERE
;RENFIL - SUBROUTINE TO RENAME ALL FILES ACCORDING TO WHETHER OR [41]
; NOT STILL NEEDED. DONE WITH INTERLOCK SET BY MAIN ROUTINE; AT REUTRN,
; FILES ARE ARRANGED IN NUMERICAL ORDER WITH UNNEEDED ONES DELETED.
; ARGUMENTS:
; P3 - ADDRESS OF FILE SPEC TO USE
; S2 - ADDRESS OF HEAD OF LINKED LIST OF STATUS; VALUE 0 = KEEP,
; -1 = NOT NEEDED
; FILES ARE OF THE FORM NNN.MQQ OR NNN.MFW, ACCORDING TO (P3).
RENFIL: PUSHJ P,SAVE2##
MOVEI P1,1 ;COUNTER OF ALL FILES
MOVEI P2,1 ;COUNTER OF REQUEUED FILES
MOVE T1,OURPPN
SKIPE .JBDDT ;IF DEBUGGING,
MOVEM T1,FILPPN(P3) ;USE SELF AS QUEUE
RENERN: MOVE T1,P1 ;CREATE A FILE NAME
PUSHJ P,OCTNAM
MOVEM T2,FILNAM(P3)
HLLZS FILEXT(P3)
FLOOK (P3) ;FIND THE NEXT FILE - GO TO SQURFN ON FAIL
MOVE T1,P2 ;FILE IS TO RENAMED TO
PUSHJ P,OCTNAM ;THE NEXT IN LINE
PUSHJ P,QFLGET ;GET NEXT STATUS IN LINKED LIST [44]
EDISIX [ERRFLS,,[SIXBIT\?Q/F &LINKED LIST CONFUSION#!\]]
SKIPE T3,T1 ;SEE IF FILE IS NO LONGER NEEDED [44]
SETZ T2, ;IN WHICH CASE SCRATCH IT
MOVEM T2,FILNAM(P3)
MOVE T1,FILPPN(P3)
MOVEM T1,FILPP1(P3)
RENAME QUE,FILNAM(P3) ;RENAME OR DELETE AS NOTED
JRST ACTLKE ;OOPS....
SKIPN T3 ;IF RENAMED TO A NEW FILE,
AOJ P2, ;UPDATE COUNTER OF NEW FILES
AOJA P1,RENERN ;UPDATE OLD FILE COUNTER AND CONTINUE
SQURFN: FREL (P3) ;HERE WHEN LOOKUP FAILED - THAT'S ALL
POPJ P, ;END O' THE LINE
> ;END IFN FTBCOM
;SUBROUTINES TO MANIPULATE LINKED LISTS [44,45]
;QFLPUT - ADD A NODE TO THE END OF THE LINKED LIST.
; T1 - VALUE TO BE PUT IN (0 OR -1, OR 1 - 2**18-1)
; S2 - ADDRESS OF CURRENT NODE OR HEAD
; RETURN S2 WITH NEW NODE ADDRESS
QFLPUT: PUSH P,T2 ;PRESERVE
MOVE T2,.JBFF## ;PUT AT END OF CURRENT LOWSEG
PUSHJ P,GETCOR ;MAKE SURE HAVE CORE
AOS .JBFF## ;MAKE A NEW END TO LOWSEG
HRLZM T1,(T2) ;STORE VALUE IN LH, LAMBDA LINK
HRRM T2,(S2) ;PUT ADDRESS IN PREVIOUS LINK
MOVE S2,T2 ;RETURN NEW ADDRESS
POP P,T2 ;RECOVERY
POPJ P,
;QFLGET - GET NEXT NODE IN THE LINKED LIST
; S2 - ADDRESS OF CURRENT NODE OR HEAD
; RETURN +0 IF PAST END OF LIST
; +1 - T1 - VALUE (EXTENDED)
; S2 - ADDRESS OF NOW-CURRENT NODE
QFLGET: HRRZ S2,(S2) ;GET LINK ADDRESS
JUMPE S2,CPOPJ## ;LAMBDA
HLRE T1,(S2) ;GET AND EXTEND VALUE
JRST CPOPJ1## ;GOOD RETURN
SUBTTL HELP ROUTINES
IFN FTHELP,<
;PRINT OUT WHATEVER TYPE OF HELP IS CALLED FOR
SWHELP: SETZ T1, ;IN CASE OF NO ARG
CAIE P1,":" ;ARGUMENT?
JRST SWHLPR ;NO - PRINT GENERAL HELP
PUSHJ P,SPNOR1 ;SWALLOW ":" AND SPACES
PUSHJ P,GETSIX ;GET ARGUMENT
MOVE T2,[-NSHLP,,HLPCAT] ;HELP ARGUMENT TABLE
SKIPE T3,T1
PUSHJ P,SIXSRC ;LOCATE STRING OR ABBREV OF IT
EDISIX [STOP,,[SIXBIT\? I&LLEGAL &HELP& ARGUMENT &#!\]
WNAME T3]
HRRZS T1
SUBI T1,HLPCAT ;MAKE POINTER RELATIVE
SWHLPR: MOVE 1,HLPFIL(T1) ;GET ARG FOR HELPER
PUSHJ P,.HELPR## ;PRINT HELP
JRST STOP
;HELP NAMES
HLPCAT: SIXBIT \GENERA\
SIXBIT \SEND\
SIXBIT \RECEIV\
SIXBIT \MSGH\
SIXBIT \ADDITI\
NSHLP==.-HLPCAT
;HELP FILES - ALL IN HLP: AS NNN.HLP
HLPFIL: SIXBIT \MAIL\
SIXBIT \MAIL01\
SIXBIT \MAIL02\
SIXBIT \MSGH\
SIXBIT \MAIL03\
> ;END IFN FTHELP
SUBTTL FTP ROUTINES FOR SENDING MAIL TO ARPANET
IFN FTCIMP,<
;ROUTINE TO OPEN FTP MAIL CONNECTION
; DOES ICP AND "MAIL USER" COMMAND AND WAITS FOR ACKNOWLEDGMENT
; MOVE P3,[INDEX INTO USER TABLE]
; PUSHJ P,FTPOPN
; UNSUCCESSFUL -- MESSAGE PRINTED, CONNECTION CLOSED
; SUCCESSFUL -- OUTPUT DIRECTED TO FTP CONNECTION
FTPOPN:
IFN FTBCOM,<
TXZ F,QUDFLG ;IF ON, MEANS FAILED FOR REQUEUEABLE REASON
>
MOVEI T2,CONBLK ;ADR OF CONNECTION BLOCK
MOVE T1,[SIXBIT\NETMAI\] ;SET LOGICAL NAME
MOVEM T1,.IBDEV(T2)
MOVEI T1,2 ; RELATIVE SOCKET 2, FREE CHOICE
hrroi T1,2 ;[afal-27] RELATIVE SOCKET 2, FREE CHOICE
MOVEM T1,.IBLCL(T2) ; FOR HIGH BITS
MOVE T1,USRHSN(P3) ;[AFAL-14] FOREIGN HOST
MOVEM T1,.IBHST(T2) ;[AFAL-14] STORE IT
;[afal-30]MOVEI T1,8 ;[AFAL-14] BYTE SIZE
;[afal-30]HRLZM T1,.IBBYT(T2)
SETZM .IBRMT(T2) ;CLEAR FOREIGN SOCKET FOR LISTEN
MOVEI T1,3 ;FOREIGN ICP SOCKET (FTP SERVER)
IFN FTBCOM,<
TXNE F,QUEFLG ;IF HANDLING QUEUED MAIL,
TLO T1,400000 ;WANT NO ERROR MSGS IF FAIL
>
PUSHJ P,ICPGET## ;DO ICP
IFN FTBCOM,<
PJRST FTPFQU ;FAILED - MARK FOR QUEUEING AND RETURN
>
IFE FTBCOM,<
POPJ P, ;CAN'T (MESSAGE ALREADY PRINTED)
>
SETZM REPLY ;NOTE NO REPLIES RECEIVED YET
FSETUP FTPIBH ;OK, SETUP FOR I/O
FSETUP FTPOBH
FIGET FTPIBL ;OPEN FTP CONNECTION FOR I/O
FOSEL FTPOBL ;SELECT OUTPUT TOO
PUSHJ P,GETRSP ;WAIT FOR RESPONSE FROM SERVER
PJRST FTPABT ;BAD, ABORT
TXO F,LINFLG ;LINE-AT-A-TIME OUTPUT REQUIRED
FTPOP0: DISIX [[SIXBIT \MAIL %#!\] ;GIVE MAIL COMMAND
WASC @USRTB1(P3)]
FTPOP1: PUSHJ P,GETRSP ;WAIT FOR RESPONSE
JRST [CAIE T1,↑D504 ;BAD, CHECK REPLY CODE
PJRST FTPABT ;FATAL, ABORT
WSIX [SIXBIT\USER NETML#!\] ;MULTICS WANTS LOGIN
JRST FTPOP1] ;SO DO SO AND WAIT MORE
CAIN T1,↑D350 ;OK TO GO AHEAD?
JRST [ TXZ F,LINFLG ;YES, TURN OFF LAAT OUTPUT
JRST CPOPJ1##] ;TAKE SUCCESS RETURN
CAIN T1,↑D230 ;MULTICS SAYING LOGIN OK?
JRST FTPOP0 ;YES, DO MAIL COMMAND AGAIN
CAIN T1,↑D330 ;MULTICS WANTING PASSWORD?
WSIX [SIXBIT\PASS NETML#!\] ;YES, MAKE IT HAPPY
JRST FTPOP1 ;NO, IGNORE
;HERE ON FAILURE OF FIGET (OPEN UUO)
FTPOPE: ERRIOP FTPIBL ;PRINT MESSAGE
IFN FTBCOM,<
TXO F,QUDFLG ;MARK LETTER FOR QUEUEING
>
PJRST FTPABT ;ABORT
;STILL IN IFN FTCIMP
;ROUTINE TO CLOSE FTP MAIL CONNECTION
; TERMINATES MESSAGE AS REQUIRED AND WAITS FOR ACKNOWLEDGMENT,
; THEN CLOSES THE CONNECTION
; PUSHJ P,FTPCLZ
; UNSUCCESSFUL -- MESSAGE PRINTED, CONNECTION CLOSED
; SUCCESSFUL -- CONNECTION CLOSED, NOTHING PRINTED
FTPCLZ: TXO F,LINFLG ;LINE-AT-A-TIME OUTPUT REQUIRED
WSIX [SIXBIT\.#!\] ;PERIOD CRLF TERMINATES
FTPCL1: PUSHJ P,GETRSP ;WAIT FOR RESPONSE
PJRST FTPABT ;BAD, ABORT
CAIE T1,↑D256 ;CODE IMPLYING SUCCESS?
JRST FTPCL1 ;NO, IGNORE
FREL FTPIBL ;OK, CLOSE AND RELEASE CHANNEL
PUSHJ P,CHKUNX ; [57]
MOVE T1,[IF.NEW+<.IUCLS,,CONBLK>] ;[AFAL-14] CLOSE THE RECEIVE CONNECTION
PUSHJ P,IMPCAL##
PUSHJ P,ERRCLS ;ERROR? CLEAN UP
AOS .IBLCL(T1) ;NOW SEND CONNECTION
PUSHJ P,IMPCAL##
PUSHJ P,ERRCLS
JRST CPOPJ1## ;DONE
;STILL IN IFN FTCIMP
;ROUTINE TO GET A REPLY FROM THE FTP SERVER
; PUSHJ P,GETRSP
; ERROR -- CONNECTION CLOSED OR REPLY CODE IN RANGE 400-599
; REPLY CODE RETURNED IN T1, OR -1 IF NONE
; IF QUEUED, QUDFLG IS ON
; SUCCESSFUL -- REPLY CODE IN T1
; THE TEXT OF THE MOST RECENT REPLY IS STORED IN THE REPLY BLOCK.
; UNNUMBERED RESPONSES ARE IGNORED.
; THE ERROR MESSAGE IS ALREADY PRINTED AND REPLY IS ZEROED IF
; THE ERROR IS DUE TO I/O PROBLEMS RATHER THAN A BAD REPLY CODE
GETRSP: SETO T1, ;NOTE NO REPLY CODE YET
GETRS1: RCH T2 ;GET CHAR FROM SERVER
CAIL T2,"0" ;A DIGIT?
CAILE T2,"9"
JRST GETRS2 ;NO
SKIPGE T1 ;YES, FIRST ONE?
SETZ T1, ;YES, INITIALIZE NUMBER
IMULI T1,↑D10 ;APPEND DIGIT
ADDI T1,-"0"(T2)
JRST GETRS1 ;LOOP FOR MORE
;HERE ON FIRST NON-DIGIT
GETRS2: MOVE T3,[POINT 7,REPLY] ;[AFAL-3] INIT BYTE PTR FOR SAVING TEXT
JRST GTRS3B ;[AFAL-3]
GETRS3: SKIPG FTPIBL+FILCTR ;[AFAL-3] ANYTHING FOR US TO READ?
STATZ NET,IO.DAT ;[AFAL-3]
SKIPA ;[AFAL-3] YES, GO AHEAD AND TRY
JRST GETRS5 ;[AFAL-3] NO, DON'T TRY TO READ ANY MORE
RCH T2 ;GET A CHAR
GTRS3B: IDPB T2,T3 ;[AFAL-3] STORE IN REPLY TEXT
CAIE T2,LF ;END OF LINE?
JRST GETRS3 ;NO, REPEAT
SETZ T2, ;APPEND NULL TO REPLY TEXT
IDPB T2,T3
JUMPL T1,GETRSP ;START OVER IF NO REPLY CODE
GETRS4: SKIPG FTPIBL+FILCTR ;ANY MORE FTP INPUT BUFFERED?
JRST GETRS5 ;NO
RCH T2 ;YES, PEEK AHEAD
JUMPE T2,GETRS4 ;FLUSH LEFTOVER NULLS
LCH T2 ;BACKUP IF NON-NULL
GETRS5: CAIL T1,↑D400 ;REPLY CODE IN RANGE 400-599?
CAILE T1,↑D600
JRST CPOPJ1## ;NO, IMPLIES SUCCESS
POPJ P, ;YES, IMPLIES ERROR
;HERE ON INPUT ERROR (FROM RCH OPERATION)
FTPINE: ERRIN FTPIBL ;PRINT APPROPRIATE MESSAGE
JRST FTPIE1
;HERE ON TIMEOUT ERROR (DETECTED IN FTPRCH ROUTINE)
FTPTMO: EWSIX [SIXBIT\? N&O RESPONSE FROM SERVER -- &T&IMEOUT#!\]
JRST FTPIE1
;HERE ON EOF (CONNECTION CLOSED BY SERVER)
FTPEOF: EWSIX [SIXBIT\? FTP &CONNECTION CLOSED BY SERVER#!\]
FTPIE1: SETO T1, ;NOTE FATAL ERROR
SETZM REPLY ;DON'T PRINT SERVER REPLY
TXZN F,FTOFLG ;HAPPENED FROM WITHIN FTPWCH?
IFN FTBCOM,<
PJRST FTPFQU ;MARK FOR QUEUEING
>
IFE FTBCOM,<
POPJ P, ;NO - TAKE ERROR RETURN
>
PUSHJ P,FTPABT ;YES, ABORT CONNECTION
IFN FTBCOM,<
TXO F,QUDFLG ;MARK FOR QUEUEING
>
JRST NTCANT ;BOMB OUT TO TOP LEVEL
IFN FTBCOM,<
FTPFQU: TXO F,QUDFLG ;FTP FAILED FOR A QUEUEABLE REASON - MARK IT
POPJ P, ;AND GIVE BAD RETURN
>
;STILL IN IFN FTCIMP
;ROUTINE TO ABORT FTP CONNECTION
; PUSHJ P,FTPABT
; ALWAYS RETURN HERE
; CLOSES FTP CHANNEL, CLOSES IMP CONNECTION, PRINTS ERROR MESSAGE
; IF THERE IS ONE
FTPABT: FREL FTPIBL ;CLOSE CHANNEL
MOVE T1,[IF.NEW+<.IUCLS,,CONBLK>] ;[AFAL-14] CLOSE NETWORK CONNECTION
IMPUUO T1, ;INPUT
PUSHJ P,ERRCLS
AOS .IBLCL(T1) ;NOW OUTPUT
IMPUUO T1,
PUSHJ P,ERRCLS
SKIPE REPLY ;HAVE ERROR MESSAGE?
EDISIX [CPOPJ##,,[SIXBIT \?"% %!\]
WASC REPLY] ;PRINT ERROR MESSAGE
POPJ P,
;ROUTINE TO CLEAN UP AFTER A NETWORK CLOSE FAILURE
; MOVE T1,[IF.NEW+<.IUCLS,,CONBLK>]
; PUSHJ P,ERRCLS
; ALWAYS RETURN HERE
ERRCLS: TXO T1,IF.NWT ;SPECIFY NO-WAIT OPTION
IMPUUO T1, ;REALLY CLEAN IT UP
JFCL ;PROBABLY CAN'T HAPPEN
TXZ T1,IF.NWT
POPJ P,
;STILL IN IFN FTCIMP
;FTP CHAR-AT-A-TIME INPUT ROUTINE
FTPRCH: MOVEI U3,↑D30 ;INIT TIMEOUT TO 30 SECONDS
FTPRC1: SKIPG FILCTR(U2) ;ANY INPUT ALREADY BUFFERED?
STATZ NET,IO.DAT ;MORE AVAILABLE FROM NET?
PJRST I1BYTE## ;YES, JUST READ IT NORMALLY
SOJL U3,FTPRC2 ;NO, CHECK TIMEOUT
MOVEI U1,1 ;WAIT A WHILE
SLEEP U1,
JRST FTPRC1 ;LOOK AGAIN
;HERE ON TIMEOUT
FTPRC2: MOVEI U1,FTPTMO ;SET SPECIAL ERROR DISPATCH
PJRST UERXIT## ;EXIT VIA UUO HANDLER
;FTP CHAR-AT-A-TIME OUTPUT ROUTINE
FTPWCH: SKIPG FILCTR(U2) ;ABOUT TO DO OUT UUO?
PUSHJ P,FTPWC2 ;YES, CHECK FOR INPUT FIRST
PUSHJ P,O1BYTE## ;WRITE IN NORMAL FASHION
MOVEI U3,(U1) ;COPY CHAR
ANDI U3,177 ;JUST 7 BITS
TXNE F,LINFLG ;NEED TO OUTPUT LINE-AT-A-TIME?
CAIE U3,LF ;YES, AT END OF LINE?
POPJ P, ;NO, NO SPECIAL HANDLING
PUSHJ P,FTPWC2 ;YES, CHECK FOR INPUT FIRST
PUSHJ P,UXCT2## ;CAUSE OUTPUT TO BE SENT
OUT
POPJ P, ;NORMAL OUT
MOVE U1,FILER2(U2) ;ERROR, TAKE ERROR DISPATCH
PJRST UERXIT##
;CHECK FOR SERVER REPLIES BEFORE DOING OUT UUO
FTPWC2: SKIPG FTPIBL+FILCTR ;ANY BUFFERED INPUT?
STATZ NET,IO.DAT ;OR STUFF IN NET BUFFERS?
TXOA F,FTOFLG ;YES, FLAG INPUT BEING DONE HERE
POPJ P, ;NO, DONE
SAVE <T1,T2,T3> ;YES, SAVE AC'S USED BY GETRSP
PUSHJ P,GETRSP ;GET SERVER REPLY
PJRST FTPOE1 ;ERROR, BOMB OUT
RESTORE <T3,T2,T1> ;NOT ERROR, IGNORE
TXZ F,FTOFLG
JRST FTPWC2 ;REPEAT TIL INPUT EXHAUSTED
;ALL OUTPUT ERRORS COME HERE EVENTUALLY
FTPOUE: ERROUT FTPOBL ;PRINT MESSAGE
SETZM REPLY ;NO REPLY TEXT
FTPOE1: PUSHJ P,FTPABT ;CLOSE FTP CONNECTION, ETC.
JRST NTCANT ;BOMB BACK TO TOP LEVEL
> ;END IFN FTCIMP
SUBTTL CHECK MAIL ROUTINE
;HERE IF /CHECKING REQUESTED FOR ALL USERS GIVEN
CHECKU: PUSHJ P,CHKWRN ;WARN IF OTHER FLAGS GIVEN
HRLOI P3,(P3) ;FOR AOBJN POINTER
EQVI P3,0
CHKUSR: SKIPN USRTB1(P3) ;IF NO SUCH USER,
JRST CHKUS3 ;...IGNORE
SKIPN T1,USRHSN(P3) ;GET PROG # OR SITE ADDRESS [AFAL-14]
JUMPE T1,CHKUS1 ;IF LOCAL RECIPIENT, NO PROBLEM [AFAL-14]
EDISIX [CHKUS3,,[SIXBIT\? C&ANT /&CHECK& MAIL FOR %%#!\]
WASC @USRTB1(P3) ;WRITE USERNAME
PUSHJ P,ATHOST] ;AND HOST ADDRESS
CHKUS1: MOVE T1,USRPGN(P3) ;GET THE USER PROGRAMMER NUMBER [AFAL-14]
PUSHJ P,OCTNAM ;CONVERT PROG # TO SIXBIT
FSETUP BOXBLI ;SET UP MAILBOX FILE BLOCK
MOVEM T2,BOXBLK+FILNAM ;PUT SIXBIT PROG # AS FILE NAME
PUSHJ P,SETBOX ;SET UP APPROPRIATE DEFAULTS
IFE FTAFAL,< ;[AFAL-2] ENQ/DEQ
MOVEI T1,LOKMAI ; [42]
>
IFN FTAFAL,<
HRRZ T1,USRPGN(P3) ;ENQ ON PROGRAMMER NUMBER
>
PUSHJ P,SETLOK ;INTERLOCK
MOVEI T1,CHKUS4 ;OPEN/LOOKUP ERROR ROUTINE
HRLI T1,(T1) ;(FOR BOTH KINDS)
MOVEM T1,BOXBLK+FILER1;INTO PROPER PLACE
FIOPEN BOXBLK ;TRY TO OPEN AND LOOKUP
FICLOS BOXBLK ;IT WORKED! SHUT IT DOWN NOW
DISIX [[SIXBIT\M&AIL HAS ARRIVED FOR %%#!\]
WNAME USRTB1(P3)
WNAME USRTB2(P3)]
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] [42]
PUSHJ P,CLRLOK ;UNLOCK MAIL INTERLOCK
CHKUS3: AOBJN P3,CHKUSR ;KEEP LOOPING TILL ALL DONE
JRST STOP ;DONE
;HERE WHEN LOOKUP FAILS FOR SOME REASON
CHKUS4:
IFE FTAFAL,<MOVEI T1,LOKMAI> ;[AFAL-2] [42]
PUSHJ P,CLRLOK ;CLEAR MAIL INTERLOCK
HRRZ T3,BOXBLK+FILEXT;GET ERROR CODE
CAIE T3,ERFNF% ;WAS ERROR "FILE NOT FOUND"?
ERRLK BOXBLK ;NO - GIVE NASTY MESSAGE
DISIX [CHKUS3,,[SIXBIT\N&O MAIL FOR %%#!\]
WNAME USRTB1(P3)
WNAME USRTB2(P3)]
SUBTTL MISCELLANEOUS SUBROUTINES
;ROUTINE TO CHECK USER ACCES TO A FILE VIA CHKACC [46]
;ARGS:
; T1 TYPE OF ACCESS DESIRED (PER CHKACC)
; T2 ADDRESS OF LOWSEG FILE BLOCK
;FILACC ATTEMPTS TO COVER ALL POSSIBLITIES. IF READING/WRITING A NON-DISK
; DEVICE, ACCESS IS AUTOMATICALLY GRANTED. OTHERWISE, CHKACC UUO IS
; INVOKED, TAKING INTO ACCOUNT SUCH THINGS AS ERSATZ DEVICES. FOR
; READING, IT IS ASSUMED THAT THE FILE HAS BEEN LOOKED UP, THOUGH THE
; FILE ACCESS BLOCK, CHANNEL, ETC. ARE COMPLETELY SEPARATE. IF ATTEMPTING
; TO READ A FILE THAT IS NOT THERE, THE ERROR RETURN IS GIVEN. FOR WRITING
; OR APPENDING, IF THE FILE IS NOT FOUND THE UFD PRIVELEGES ARE CHECKED
; FOR WHETHER THE USER CAN CREATE IN UFD.
; THE LOGIC ASSUMES THAT THE CHANGE-PROTECTION PRIVELEGE WILL NOT BE
; CHECKED FOR.
FILACC: MOVE T3,FILDEV(T2) ;GET DEVICE
DEVCHR T3, ;...CHARACTERISTICS
TXNN T3,DV.DSK ;DISK?
JRST CPOPJ1## ;NO - GOOD RETURN - HE CAN DO IT
FSETUP CKCFIH ;SET UP SEPARATE FILE BLOCK, CHANNEL
MOVE T3,FILNAM(T2) ;AND MOVE FILE NAME, ETC. INTO IT
MOVEM T3,CKCFIL+FILNAM
HLLZ T3,FILEXT(T2)
MOVEM T3,CKCFIL+FILEXT
SKIPE T3,FILDEV(T2) ;[AFAL-20] USE THE DEVICE (IN CASE ERSATZ AND
MOVEM T3,CKCFIL+FILDEV;[AFAL-20] NOT ON USER'S SEARCH LIST)
SKIPE T3,FILPPN(T2) ;IF PPN GIVEN,
JRST FILACA ;USE THAT
MOVE T3,FILDEV(T2) ;ELSE GET DEVICE PPN
DEVPPN T3, ;...
MOVE T3,DEFPPN ;SIGH...USE PATH DEFAULT
FILACA: MOVEM T3,CKCFIL+FILPPN ;FINISHING TOUCH
tlnn t3,-1 ;[afal-25] is this just a pointer?
move t3,.PtPPn(t3) ;[afal-25] yes. get real PPn
PUSH P,IFILE## ;BE CLEAN
FIOPEN CKCFIL ;OPEN TO GET PROTECTION CODE
LDB T2,[POINT 9,CKCFIL+FILDAT,8] ;GET THE CODE
HRL T2,T1 ;GET ACCESS DESIRED
FILACK: MOVE T4,OURPPN ;GET SELF - BUILDING CHKACC BLOCK
MOVEI T1,T2 ;ADDRESS OF BLOCK - T3 SET UP BEFORE
CHKACC T1, ;AT LAST!
SETO T1, ;SPOKE TOO SOON - CHKACC NOT IMPL.
FILACX: CLOSE CKC,CL.ACS ;CLOSE OUT WITH NO ACCESS UPDATE
POP P,IFILE## ;KEEP TULIP HAPPY
JUMPE T1,CPOPJ1## ;BROADCAST THE RESULTS
POPJ P, ;BAD ACCESS
;HERE IF LOOKUP FAILED. FIND OUT WHY.
FILACE: HRRZ T2,CKCFIL+FILEXT ;GET ERROR CODE
JUMPN T2,FILACX ;NOT FILE-NOT-FOUND - GIVE UP
CAIN T1,.ACRED ;DID HE ASK TO READ NON-EX FILE?
JRST FILACX ;YES - FORGET IT
;ASSUME WANTED TO WRITE/APPEND. ASK INSTEAD IF CAN CREATE.
MOVEM T3,CKCFIL+FILNAM ;PPN IS NOW FILE NAME
MOVSI T2,'UFD' ;BUILDING FOR A UFD LOOKUP
MOVEM T2,CKCFIL+FILEXT
MOVE T2,[1,,1] ;MFD
MOVEM T2,CKCFIL+FILPP1
LOOKUP CKC,CKCFIL+FILNAM ;DO IT OURSELVES
JRST FILACX ;CAN'T DO ANYTHING RIGHT
LDB T2,[POINT 9,CKCFIL+FILDAT,8] ;GET UFD PROTECTION
LSH T2,↑D9 ;POSITION AS DIRECTORY PROTECTION
HRLI T2,.ACCRE ;ASK IF CAN CREATE IN IT
JRST FILACK
;ROUTINE TO SET SOME THINGS INTO THE MAILBOX FILE BLOCK
SETBOX: MOVE T1,[SIXBIT\MAIL\] ;SEE IF DEVICE 'MAIL' DEFINED
DEVCHR T1,
SKIPE .JBDDT## ;AND DEBUGGING?
JUMPN T1,SETBXM ;YES, USE DEVICE 'MAIL'
IFE FTAFAL,<
MOVX T1,%LDQUE ;NO, USE QUEUE DIRECTORY
GETTAB T1,
CAIA
MOVEM T1,BOXBLK+FILPPN
>
; HRROI T1,.GTSGN ;FIND OUT WHERE MAIL WAS RUN FROM
; GETTAB T1, ;BY GETTING HISEG NUMBER
; JRST SETBX1
; MOVSI T1,(T1) ;AND THEN HISEG DEVICE
; HRRI T1,.GTDEV
; GETTAB T1,
SETBX1: MOVSI T1,'SSL' ;USE 'SSL' FOR DEVICE
JRST SETBX5
;HERE TO USE USER'S DEVICE 'MAIL'
SETBXM: SETZM BOXBLK+FILPPN ;NO SPECIAL PPN
HRRZS BOXBLK+FILSTS ;DISABLE PHYSICAL-ONLY OPEN
MOVE T1,[SIXBIT\MAIL\]
SETBX5: MOVEM T1,BOXBLK+FILDEV ;SET INTO FILE BLOCK
POPJ P,
; CHECK IF USER IS LOGGED IN OR RUNNING VIA FTPSRV.
; IF SO, RETURN; IF NOT, ERROR EXIT.
LGNCHK:
IFN FTCIMP,<
TXNE F,LGIFLG!FTPSVF
>
IFE FTCIMP,<
TXNE F,LGIFLG
>
POPJ P, ;ALL CLEAR
CLRBFI ;WIPEOUT
EDISIX [STOP,,[SIXBIT\?"%L&OGIN PLEASE#!\]]
;CHECK IF OTHER SWITCHES GIVEN ALONG WITH /CHECK
CHKWRN: TXNN F,FILFLG!IDNFLG
POPJ P,
EDISIX [CPOPJ##,,[SIXBIT\"% I&GNORING OTHER FLAGS USED WITH /&CHECK#!\]]
;ROUTINE TO SAVE A COPY OF THE MAIL BEING SENT ON NNNMAI.TMP
; MOVE P1,[POINTER TO TEXT OF MAIL]
; PUSHJ P,SVMAIL
; ALWAYS RETURN HERE
;
; *NOTE* THE FLAG SVMFLG IS USED TO AVOID SAVING THE TEXT MORE THAN
; ONCE, SINCE SVMAIL CAN THEORETICALLY BE CALLED ANY NUMBER OF
; TIMES, UPON FAILURE OF NETMAIL
SVMAIL: TXNN F,FILFLG ;TEXT FROM FILE, DON'T SAVE [57]
TXNE F,SVMFLG ;HAVE WE ALREADY SAVED IT?
POPJ P, ;YEP, DON'T BOTHER TO DO IT AGAIN
TXO F,SVMFLG ;NO, REMEMBER THAT WE'VE DONE IT NOW
FSETUP SVMBLH ;SETUP FILE BLOCK
IFN FTR066,<
SKIPE T1,SVNAME ;GET NAME FOR NNNMAI.TMP
MOVEM T1,SVMBLK+FILNAM;USE IT
> ;END IFN FTR066
MOVE T1,OURPPN ;WRITE ON OWN DIRECTORY
MOVEM T1,SVMBLK+FILPPN
MOVX T1,%LDSPP ;USE SPOOLED FILE PROTECTION
GETTAB T1, ; FOR PRIVACY OF MAIL FILES
MOVSI T1,(077B8)
MOVEM T1,SVMBLK+FILDAT
IFN FTR074,<
LDB T1,[POINT 7,(P1),6] ;GET FIRST CHAR OF TEXT
JUMPE T1,CPOPJ## ;DON'T SAVE IF NULL
> ;END IFN FTR074
FOOPEN SVMBLK ;OPEN FOR OUTPUT
WASC (P1) ;WRITE TEXT OF MAIL
FOCLOS SVMBLK ;CLOSE FILE
POPJ P, ;DONE (SIMPLE, HUH)
;ERRORS PRINT A MESSAGE ADVISING THAT MAIL COULDN'T BE SAVED
; AND GO ON ANYWAY.
SVMOPE: EDISIX [CPOPJ##,,CNTSVM ;OPEN FAILED
IFN FTR066,< WNAME SVNAME> ;WRITE THE REAL FILE NAME
WERENT SVMBLK]
SVMENE: EDISIX [SVMREL,,CNTSVM ;ENTER FAILED
IFN FTR066,< WNAME SVNAME>
WERENT SVMBLK]
SVMOUE: EDISIX [SVMREL,,CNTSVM ;OUT FAILED
IFN FTR066,< WNAME SVNAME>
WERENT SVMBLK]
IFN FTR066,<
CNTSVM: SIXBIT\"% C&AN'T WRITE &%.TMP -- %#!\
> ;END IFN FTR066
IFE FTR066,<
CNTSVM: SIXBIT\"% C&AN'T WRITE &SVMAIL.TMP -- %#!\
> ;END IFE FTR066
SVMREL: FREL SVMBLK
POPJ P,
;ROUTINE TO OPEN AN INCORE TEMP FILE FOR SENDING OUTPUT.
; CAN ONLY BE USED BY ONE FILE AT A TIME. THE INSTRUCTION MUST BE:
; PUSHJ P,PUTTMP
; ARGS: T2 - ADDRESS OF HISEG BLOCK
;RETURNS:
; T2 - ADDRESS OF START OF OUTPUT STRING
; S1 - SET UP AS POINTER
SETTMP: FSETUP (T2) ;SET UP TMP OUTPUT FILE IN CORE
HRRZ T2,1(T2) ;GET ADDRESS OF LOWSEG BLOCK
FOSEL (T2) ;AND SELECT IT AS OUTPUT
MOVE T2,.JBFF## ;FIND FIRST FREE LOCATION
MOVEM T2,S1 ;WHICH WILL BE START OF STRING
HRLI S1,(POINT 7) ;BUILD POINTER FOR I/O
POPJ P, ;RETURN , T2 HAS ADDRESS
;TULIP I/O LEVEL OUTPUT ROUTINE
PUTTMP: TLNE S1,(30B5) ;STARTING A NEW WORD?
JRST PUTTM1 ;NO
PUSH P,T2 ;SAVE A REG
MOVEI T2,1(S1) ;WHILE GETTING NEXT WORD
PUSHJ P,GETCOR ;GET CORE IF NEEDED
AOS .JBFF## ;MOVE FREE CORE VALUE UP
SETZM (T2)
POP P,T2
PUTTM1: IDPB U1,S1 ;WRITE A CHARACTER INTO CORE FILE
POPJ P, ;BACK TO TULIP
;ROUTINE TO GET THE MAIL SYSTEM INTERLOCK
IFE FTAFAL,< ;[AFAL-2] TURN OFF OLD HI-SEG LOCK CODE
SETLOK: PUSHJ P,SAVE2## ;SAVE P1 AND P2
SETZ P1, ;CLEAR WRITE-PROTECT BIT
SETUWP P1,
PJRST LOKFAL ;SOMEONE HAS BEEN MEDDLING
MOVEI P1,↑D10 ;WAIT UP TO 10 SECONDS FOR INTERLOCK
GETLK1: AOSG (T1) ;IS THE INTERLOCK AVAILABLE? [42]
PJRST UWPSET ;YES, NOW WE HAVE IT
SOJL P1,LOKFAL ;TAKE IT ANYWAY IF TIMED OUT
MOVEI P2,1 ;WAIT A SECOND
SLEEP P2, ;ZZZZZZ
JRST GETLK1 ;TRY AGAIN
;ROUTINE TO CLEAR THE MAIL SYSTEM INTERLOCK
CLRLOK: PUSHJ P,SAVE1## ;SAVE P1
SETZ P1, ;CLEAR WRITE-PROTECT BIT
SETUWP P1,
LOKFAL: EDISIX [UWPSET,,[SIXBIT\"% M&AIL INTERLOCK FAILED, CONTINUING#!\]]
SETOM (T1) ;MAKE MAIL INTERLOCK AVAILABLE [42]
UWPSET: MOVEI P1,1 ;SET WRITE-PROTECT AGAIN
SETUWP P1,
JFCL ;DON'T REALLY CARE IF FAILS
POPJ P,
LOKMAI: -1 ;MAIL INTERLOCK FLAG
IFN FTBCOM,<
LOKQUE: -1 ;QUEUE INTERLOCK FLAG [42]
>
>;END IFE FTAFAL [AFAL-2]
IFN FTAFAL,< ;[AFAL-2]
;[AFAL] USE ENQ/DEQ TO GET THE INTERLOCK. WE LOCK ON THE PROGRAMMER
;[AFAL] NUMBER OF THE RECIEVER OF THE MAIL.. THIS MEANS SEVERAL PEOPLE
;[AFAL] CAN BE WRITING MAIL FILES AT ONCE..
SETLOK: PUSHJ P,SAVE1## ;GET AN AC.
MOVEI P1,ENQINT ;SET UP INTERRUPT VECTOR
MOVEM P1,VECBLK+.PSVFL
SETZM VECBLK+.PSVOP
MOVX P1,PS.VPO
MOVEM P1,VECBLK+.PSVFL
SETZM P1,VECBLK+.PSVIS
MOVEI P1,VECBLK ;ENABLE PSI FOR ENQ GRANTED..
PIINI. P1,
EDISIX [STOP,,[SIXBIT\?PIINI. UUO FAILED, CODE %#!\]
WOCT P1]
MOVSI P1,(PS.FON!PS.FAC) ;TURN IT ON
HRRI P1,ENQBLK
PISYS. P1,
EDISIX [STOP,,[SIXBIT\?PISYS. UUO FAILED, CODE %#!\]
WOCT P1]
;SET UP FOR ENQ REQUEST
MOVSI P1,ENQARG ;BLT THE BLOCK TO THE LOW SET..
HRRI P1,ENQLOW
BLT P1,ENQLOW+4
HRRM T1,ENQLOW+3 ;STORE THE SPECIFIED CODE
MOVSI P1,.ENQSI ;DON'T BLOCK, GENERATE PSI WHEN GRANTED
HRRI P1,ENQLOW
ENQ. P1, ;GIVE IT A TRY
SKIPA ;FIND OUT WHY IT FAILED..
POPJ P, ;WE WON, EXIT..
CAIE P1,ENQRU% ;COULD REQUEST BE GRANTED?
EDISIX [STOP,,[SIXBIT\?ENQ. &FAILED, CODE %#!\]
WOCT P1]
;O.K. SOMEBODY ELSE HAD IT.. LET'S SLEEP FOR AWHILE TO SE WHAT HAPPENS..
EDISIX [0,,[SIXBIT\"%W&AITING FOR &I&NTERLOCK#!\]]
MOVEI P1,↑D100 ;WAIT FOR A WHILE.....
MOVEI P2,5 ;TRY THAT MANY TIMES..
ENQSLP: SLEEP P1,
SKIPE ENQFLG ;GOT IT WHILE WE WERE OUT?
JRST GOTENQ ;YES, PROCEED
SOJG P1,ENQSLP ;TRY SOME MORE..
EDISIX [0,,[SIXBIT\"%I&NTERLOCK TIMED OUT#!\]]
PUSHJ P,CLRLOK
JRST STOP ;AND DIE
GOTENQ: EDISIX [0,,[SIXBIT\"%M&AIL NOW INTERLOCKED, PROCEEDING.#!\]]
POPJ P,
;ROUTINE TO CLEAR THE MAIL SYSTEM INTERLOCK
CLRLOK: PUSHJ P,SAVE2##
MOVSI P1,(PS.FOF) ;TURN OF PSI..
PISYS. P1,
JFCL
MOVE P1,[XWD .DEQDR,ENQLOW];RELEASE IT
DEQ. P1,
CAIN P1,ENQNE% ;IGNORE ERROR CAUSED BY ATTEMPTING TO
;DEQUE A REQUEST THAT WAS NEVER ENQUED.
POPJ P, ;EITHER DEQ. O.K. OR DEQUED NON-EX. REQ.
EDISIX [STOP,,[SIXBIT\?DEQ. &FAILED, CODE %#!\]
WOCT P1]
;PSI INTERRUPT HANDLER
ENQINT: PUSH P,T1
SETOB T1,ENQFLG ;TELL THE BACKGROUND.
WAKE T1, ;WAKE ME UP
EDISIX [STOP,,[SIXBIT\?WAKE &UUO FAILED#!\]]
POP P,T1 ;RESTORE OUR AC
DEBRK.
POPJ P, ;PUSHJ'ED TO (?)
EDISIX [STOP,,[SIXBIT\?DEBRK. &FAILED#!\]]
;HIGH SEGMENT VERSION OF THE ENQ ARG BLOCK
ENQARG: XWD 1,5 ;# OF LOCKS,,LEN
XWD 0,1 ;RESERVED,,REQUEST-I.D.
EXP EQ.FBL+.EQFPL ;PRIVILEDGED, NON-FILE LOCK
XWD 505000,0 ;NUMBER INSTEAD OF STRING
EXP 0
;PSI BLOCK
ENQBLK: EXP .PCQUE ;INTERRUPT ON ENQ RESOURCE AVAILABLE
XWD 0,0 ;OFFSET,,REASONS
EXP 0
>;END IFN FTAFAL
;ROUTINE TO EXTRACT JUST A USER'S LAST NAME (STRIP OFF
; INITIALS -- ALLOW NUMERICS IN A NAME (CPR))
; MOVE T1,[FIRST HALF OF NAME]
; MOVE T2,[SECOND HALF OF NAME]
; PUSHJ P,LSTNAM
; ALWAYS RETURN HERE, USER'S INITIALS REPLACED BY SPACES
IFE FTAFAL,< ;[AFAL-5]
LSTNAM: MOVE T3,[POINT 6,T1] ;START BYTE POINTER
LSTNA1: ILDB T4,T3 ;GET A CHAR
CAIL T4,'A' ;A LETTER?
CAILE T4,'Z'
JRST LSTNA2 ;NO, CHECK FOR NUMERICS
LSTNA5: CAME T3,[POINT 6,T2,35] ;YES, AT END?
JRST LSTNA1 ;NO, CONTINUE SCANNING
POPJ P, ;YES, RETURN
LSTNA2: CAIGE T4,'0' ;IS IT NUMERIC?
CAIG T4,'9' ; ...
JRST LSTNA5 ; YES, GO CHECK FOR END
LSTNA4: SETZ T4, ;NOW START REPLACING WITH SPACES
DPB T4,T3
LSTNA3: CAMN T3,[POINT 6,T2,35] ;UNTIL END IS REACHED
POPJ P,
IDPB T4,T3
JRST LSTNA3
>;[AFAL-5]
IFN FTAFAL,< ;[AFAL-5] Rewrite of LSTNAME for AFAL
;[AFAL-5] Ignore leading non-alphanumeric characters.
;[AFAL-5] Trailing alphanumeric characters cause rest of string to
;[AFAL-5] be replaced with blanks.
LSTNAM: skipn t1 ;[afal-22] anything in this word?
jumpe t2,cpopj## ;[afal-22] nothing at all. return
PUSHJ P,SAVE2## ;[AFAL-5]
MOVE P1,[POINT 6, T1] ;[AFAL-5] SOURCE BYTE POINTER
MOVE P2,[POINT 6, T1] ;[AFAL-5] DESTINATION BYTE POINTER
;[AFAL-5] MAIN STRING COPYING LOOP
LSTNA1: ILDB T3,P1 ;[AFAL-5] GET A SOURCE CHARACTER
PUSHJ P,PALPHN ;[AFAL-5] ALPHANUMERIC?
JRST LSTNA2 ;[AFAL-5] NO--
IDPB T3,P2 ;[AFAL-5] YES, COPY TO DESTINATION
CAMN P1,[POINT 6,T2,35] ;[AFAL-5] ANY SOURCE CHARS LEFT?
JRST LSTNA3 ;[AFAL-5] NO, BLANK OUT REST
JRST LSTNA1 ;[AFAL-5] YES, GO EAT THEM
;[AFAL-5] HERE WHEN NON-ALPHANUMERIC CHAR SEEN
LSTNA2: CAMN P2,[POINT 6,T1] ;[AFAL-5] DESTINATION EMPTY?
JRST LSTNA1 ;[AFAL-5] YES, KEEP GOING
;[AFAL-5] HERE TO BLANK OUT REST OF DESTINATION STRING
LSTNA3: SETZ T3, ;[AFAL-5] SIXBIT BLANK
LSTNA4: CAMN P2,[POINT 6,T2,35] ;[AFAL-5] DESTINATION DONE?
POPJ P, ;[AFAL-5] YES, RETURN
IDPB T3,P2 ;[AFAL-5] WRITE A BLANK
JRST LSTNA4 ;[AFAL-5] AND LOOP
;[AFAL-5] PALPHN SKIPS IF T3 HOLDS AN ALPHANUMERIC SIXBIT CHAR
PALPHN: CAIL T3,'A'
CAILE T3,'Z' ;[AFAL-5]
JRST [CAIL T3,'0'
CAILE T3,'9'
POPJ P, ;[AFAL-5] NOT NUMERIC EITHER
JRST CPOPJ1##] ;[AFAL-5] SKIP RETURN
JRST CPOPJ1## ;[AFAL-5] SKIP RETURN
>;[AFAL-5] END OF IFN FTAFAL
;ROUTINE TO CONVERT PROGRAMMER NUMBER TO SIXBIT
; MOVE T1,[PROGRAMMER NUMBER]
; PUSHJ P,OCTNAM
; ALWAYS RETURN HERE, WITH NUMBER LEFT-JUSTIFIED IN T2
OCTNAM: SETZ T2,
LSHC T1,-3
LSH T2,-3
TLO T2,(<'0'>B5)
JUMPN T1,.-3
POPJ P,
;ROUTINE TO CHECK IF NEED MORE CORE. DON'T RETURN IF CAN'T GET. [43]
; ADDRESS OF HIGHEST LOC WANTED IN T2.
GETCOR: CAMG T2,.JBREL## ;WITHIN CURRENT BOUND?
POPJ P, ;YES - OK
PUSH P,T2
CORE T2, ;PLEASE SIR, I WANT SOME MORE
EDISIX [ERRFLS,,[SIXBIT\?I&NSUFFICIENT CORE#!\]]
POP P,T2
POPJ P,
;ROUTINE TO PRINT TIME OF DAY
THSTIM: TXO F,LZEFLG
MSTIME T1,
IDIVI T1,↑D60*↑d1000 ; convert to minutes
IDIVI T1,↑D60 ; into hours and minutes
WDECI 2,(T1)
WDECI 2,(T2)
wchi "-" ;[afal-21] print dash
wname TZone ;[afal-21] print time zone (eg, "EST")
THSTMX: TXZ F,LZEFLG
POPJ P,
THHTIM: TXO F,LZEFLG ;SPECIAL TIME PRINT FOR PRIME HEADER
MSTIME T1,
IDIVI T1,↑D1000 ;FROM MILLI TO SEC
IDIVI T1,↑D60 ;GET SECONDS...
MOVEM T2,T3
IDIVI T1,↑D60 ;HOURS AND MINUTES
DISIX [THSTMX,,[SIXBIT\%:%:%-%!\]
WDECI 2,(T1)
WDECI 2,(T2)
WDECI 2,(T3)
wname TZone ;[afal-21] print time zone (eg, "EST")
]
POPJ P,
;ROUTINE TO PRINT DATE in "DD-MMM-YY" format
; (required format for MSGH header)
THHDAT: TXZ F,LZEFLG ;ENTRYFOR PRIME HEADER DATE
DATE T1, ;[afal-21]
IDIVI T1,↑D<12*31> ;[afal-21]
IDIVI T2,↑D31 ;[afal-21]
DISIX [CPOPJ##,,[sixbit \%-%-%!\]
WDECI 2,1(T3) ;[afal-21]
WSIX MONTAB(T2) ;[afal-21]
WDECI 2,↑D64(T1) ;[afal-21]
] ;[afal-21]
;ROUTINE TO PRINT DATE in " DD MMM YYYY" format
; (require format for arpanet mail date field)
ThsDat: DATE T1, ;[afal-21]
IDIVI T1,↑D<12*31> ;[afal-21]
IDIVI T2,↑D31 ;[afal-21]
DISIX [CPOPJ##,,[sixbit \% % %!\]
WDECI 2,1(T3) ;[afal-21]
WSIX MONTAB(T2) ;[afal-21]
WDECI 4,↑D1964(T1) ;[afal-21]
] ;[afal-21]
MONTAB: SIXBIT \J&AN!\
SIXBIT \F&EB!\
SIXBIT \M&AR!\
SIXBIT \A&PR!\
SIXBIT \M&AY!\
SIXBIT \J&UN!\
SIXBIT \J&UL!\
SIXBIT \A&UG!\
SIXBIT \S&EP!\
SIXBIT \O&CT!\
SIXBIT \N&OV!\
SIXBIT \D&EC!\
;[afal-21] routine to print the day of the week today
ThsDay: movx t1,%cndtm ;[afal-21] get universal date time.
gettab t1, ;[afal-21] from the monitor
popj p, ;[afal-21] we don't know what day it is
hlrzs t1 ;[afal-21] get just days
idivi t1,7 ;[afal-21] convert to day of week in t2
wsix @[ ;[afal-21] output the right text
[sixbit \W&ednesday!\] ;[afal-21] day 0 was WED.
[sixbit \T&hursday!\] ;[afal-21]
[sixbit \F&riday!\] ;[afal-21]
[sixbit \S&aturday!\] ;[afal-21]
[sixbit \S&unday!\] ;[afal-21] wrap around in U.S.
[sixbit \M&onday!\] ;[afal-21] wrap anywhere else
[sixbit \T&uesday!\] ;[afal-21]
](t2) ;[afal-21] day of week ended in T2
popj p, ;[afal-21] done
IFN FTCIMP,<
;ROUTINE TO PRINT " AT <HOSTNAME>" FOR HOST NUMBER IN T1
ATHOST: PUSH P,T1 ;SAVE HOST NUMBER
PUSHJ P,HSTNUM## ;LOOKUP NAME FOR THAT NUMBER
SETZ T1, ;CAN'T ACCESS TABLES
;[afal-24]JFCL ;HOST HAS TO EXIST
setz t1, ;[afal-24] host isn't there
POP P,T4 ;RESTORE HOST NUMBER
SKIPE T1 ;FOUND A NAME?
DISIX [CPOPJ##,,[SIXBIT\ &AT %!\]
WASC (T1)]
ldb t1,[pointr( t4,ih.hst )] ;[afal-17] get host number
andx t4,ih.imp ;[afal-17] leave just imp number
;[afal-17]DISIX [CPOPJ##,,[SIXBIT\ &AT &H&OST %!\]
DISIX [CPOPJ##,,[SIXBIT\ &AT &H&OST %/%!\]
wdec t1 ;[afal-17] print host on imp
WDEC T4] ;NO, PRINT HOST # IN DECIMAL
> ;END IFN FTCIMP
repeat 0,< ;[afal-25] just do it with TULIP
;SUBROUTINE TO PRINT FILE SPECS, ONLY AS MUCH AS NECESSARY.
; USE BLOCK POINTED TO BY T1
WFNAMX: PUSHJ P,SAVE1##
MOVE P1,FILDEV(T1) ;GET DEVICE
CAME P1,[SIXBIT\DSK\] ;AND SEE IF GENERIC STANDARD
DISIX [CPOPJ##,,[SIXBIT\%!\]
WFNAME (T1)] ;DO IT THE TULIP WAY
WNAMX FILNAM(T1) ;STANDARD DEVICE. PRINT NAME, EXT
SKIPN P1,FILPPN(T1) ;GET PPN
POPJ P, ;NONE GIVEN - RETURN
CAMN P1,OURPPN ;IS IT US?
POPJ P, ;YUP
DISIX [CPOPJ##,,[SIXBIT\[%]!\] ;PRINT PPN IN BRACKETS
WPPN P1]
> ;[afal-25] end of REPEAT 0
CHKUNX:
REPEAT 0,< ; [72]
MOVE T1,USRHSN(P3) ;GET HOST [AFAL-14]
PUSHJ P,HSTNAM## ;GET HOST NAME
POPJ P, ;CAN'T ACCESS HOST TABLE
JUMPE T1,CPOPJ## ;HOST NOT FOUND
CAME T2,[SIXBIT \UNIX\]
POPJ P,
> ; [72]
MOVE T3,.JBFF## ;MAKE BYTE POINTER TO FREE CORE
MOVEI T2,21(T3) ;MAKE SURE WE HAVE IT
PUSHJ P,GETCOR
HRLI T3,(POINT 7,)
FSETUP TMPCBH ;SET ERROR DEVICE TO FREE CORE
MOVEI T1,TMPCBL
MOVEM T1,EFILE##
EXCH T3,(P) ;SEE TO IT THAT WE RETURN HERE
HRLI T3,(P)
PUSHJ P,[JRA T3,(T3)] ;CONTINUE PROCESSING
SOS -1(P)
SETZB T1,EFILE## ;SET ERROR DEVICE TO TTY
IDPB T1,T3 ;MAKE IT ASCIZ
POP P,T3
MOVE T2,[POINT 7,[ASCIZ\? NETMAI Close error - no such device\]]
ILDB T1,T2 ;SEE IF IT'S SOMETHING WE REALLY WANT
JUMPE T1,CPOPJ1##
ILDB U1,T3
CAMN U1,T1
JRST .-4
REPEAT 0,< ;IMPERO IS NOT EXTERNAL TO SCN7B
SKIPGE ICPERI## ;IF HANDLING OWN ERROR MESSAGES
JRST [MOVE T3,[PUSHJ P,IMPERO##] ;THIS ROUTINE OUTPUTS MESSAGE
JRST CPOPJ1##]
> ;END REPEAT 0
EWASC @.JBFF## ;OUTPUT THIS MESSAGE
JRST CPOPJ1##
SUBTTL CCTRAP-- CONTROL-C TRAP ROUTINE ;[AFAL-10]
IFN FTAFAL,< ;[AFAL-10] AFAL feature
CCTRAP: ;[AFAL-10] here on ↑C while running
IFN FTCIMP,< ;[AFAL-10] ARPAnet assembly conditional
TXNN F,LOCNET ;[AFAL-10] if not sending mail across net
JRST STOP ;[AFAL-10] then STOP
MOVEI T1,NET ;[AFAL-10] else get NET channel number
DEVCHR T1, ;[AFAL-10] AC is zeroed if channel not open
JUMPE T1,STOP ;[AFAL-10] Channel not open so OK to quit
OUTSTR [ASCIZ/[Aborting ARPAnet connection]
/] ;[AFAL-10] Tell Joe User
SETZM REPLY ;[AFAL-10] Zero non-error reply from NET
PUSHJ P,FTPABT ;[AFAL-10] close ARPA-net connection
> ;[AFAL-10] end IFN FTCIMP
JRST STOP ;[AFAL-10] quit
> ;[AFAL-10] end IFN FTAFAL
SUBTTL INITIAL FILE BLOCKS
;FILE BLOCK FOR READING ACCT.SYS
ACTBLH: FILE ACT,I,ACTBLK,<DEV(SYS),NAME(ACCT),EXT(SYS),STAT(.IOBIN)
,OPEN(ACTOPE),LOOKUP(ACTLKE),INPUT(ACTINE),EOF(ACCEND)>
;FILE BLOCK FOR READING USER FILE SPECIFIED BY /FILE:
FILBLH: FILE FIL,I,FILBLK,<NAME(MAIL),EXT(BOX),OPEN(ACTOPE)
,LOOKUP(ACTLKE),INPUT(ACTINE),EOF(RDNEOF)>
;FILE BLOCK FOR READING INDIRECT MAILING LIST
INDFIH: FILE IND,I,INDFIL,<EXT(MAI),EOF(CPOPJ##),<INST(<PUSHJ P,INFRCH>)>>
;FILE BLOCK FOR ADDING A FIL ON THE FLY
AFLFIH: FILE AFL,I,AFLFIL,<LOOKUP(AFLLER),EOF(AFLEOF)>
;FILE BLOCK FOR WRITING MAILBOX
;[AFAL-11] Added "DEV(SSL)" to line below
BOXBLO: FILE BOX,A,BOXBLK,<DEV(SSL),STAT(UU.PHS),EXT(MAI),<PPN(<QUEPPN>)>
,OPEN(BOXOPE),OUTPUT(BOXOUE)>
;FILE BLOCK FOR OUTPUT TO USER FILE IN MSGH FORMAT; RESULT OF *FILE IN USER LIST
SLFBLH: FILE BOX,A,SLFBLK,<EXT(MSG)>
;FILE BLOCK TO CHECK ACCESS PRIVELEGES
CKCFIH: FILE CKC,I,CKCFIL,<LOOKUP(FILACE)>
;FILE BLOCK FOR READING MAILBOX
;[AFAL-11] Added "DEV(SSL)" to below
BOXBLI: FILE BOX,I,BOXBLK,<DEV(SSL),STAT(UU.PHS),EXT(MAI),<PPN(<QUEPPN>)>
,OPEN(BOXOPE),LOOKUP(BOXLKE)>
;FILE BLOCK FOR WRITING MAI .TMP FILE
IFN FTR067,<
TMPBLH: FILE TMP,O,TMPBLK,<NAME( MSG),EXT(TMP),OPEN(TMPOPE)
,ENTER(TMPENE),OUTPUT(TMPOUE)>
> ;END IFN FTR067
IFE FTR067,<
TMPBLH: FILE TMP,O,TMPBLK,<NAME( MAI),EXT(TMP),OPEN(TMPOPE)
,ENTER(TMPENE),OUTPUT(TMPOUE)>
> ;END IFE FTR067
IFN FTCIMP,<
;FILE BLOCKS FOR FTP I/O TO NET
FTPIBH: FILE NET,I,FTPIBL,<DEV(NETMAI),OTHER(FTPOBL)
,OPEN(FTPOPE),INPUT(FTPINE),EOF(FTPEOF)
,<INST(<PUSHJ P,FTPRCH>)>>
FTPOBH: FILE NET,O,FTPOBL,<DEV(NETMAI),OTHER(FTPIBL)
,OPEN(FTPOPE),OUTPUT(FTPOUE)
,<INST(<PUSHJ P,FTPWCH>)>>
>
;PSEUDO-FILE BLOCK FOR ASSEMBLING PIP COMMAND FILE
TMPCBH: PFILE TMPCBL,<IDPB U1,T3>
;PSEUDO-FILE BLOCK FOR RESCANNING USER NAME STRING
TMPIBH: PFILE TMPCBL,<ILDB U1,S1>
;PSEUDO-FILE BLOCK FOR HOLDING COMMAND STRING ON INIDRECT LIST
TMPCMF: PFILE TMPCML,<ILDB U1,TMPPTR>
;PSEUDO-FILE BLOCK FOR COUNTING NUMBER OF CHARS IN MAIL
TMPSIZ: PFILE TMPCBL,<AOS MALSIZ>
;PSEUDO-FILE FOR WRITING HEADERS
HDRTIH: PFILE TMPCHL,<PUSHJ P,PUTTMP>
;PSEUDO-FILE FOR WRITING MAIL TEXT INTO CORE
TXTTIH: PFILE TXTCBL,<PUSHJ P,PUTTMP>
;FILE FOR WRITING NNNMAI.TMP
SVMBLH: FILE SVM,O,SVMBLK,<NAME(SVMAIL),EXT(TMP)
,OPEN(SVMOPE),ENTER(SVMENE),OUTPUT(SVMOUE)>
IFN FTBCOM,<
;FILE TO WRITE A LETTER INTO THE QUEUE
;[AFAL-11] Inserted "DEV(SSL)" into line below
QUEFIH: FILE QUE,O,QUEFIL,<DEV(SSL),EXT(MQQ),<PPN(<QUEPPN>)>>
;FILE TO LOOK FOR QUEUED FILES
;[AFAL-11] Inserted "DEV(SSL)" into line below.
MQUFIH: FILE QUE,I,MQUFIL,<DEV(SSL),EXT(MQQ),<PPN(<QUEPPN>)>,LOOKUP(SQUEND),EOF(SQUEOF)>
;FILE TO RENAME QUEUED FILES
;[AFAL-11] Inserted "DEV(SSL)" into line below
QRNFIH: FILE QUE,I,QRNFIL,<DEV(SSL),EXT(MQQ),<PPN(<QUEPPN>)>,LOOKUP(SQURFN)>
;TEMP FILE TO WRITE A SUBJECT FIELD FOR QUEUE
SJBTIH: PFILE TMPCBL,<IDPB U1,S0>
> ;END IFN FTBCOM
SUBTTL LOW SEGMENT
RELOC 0
LOWBEG:
PDS: BLOCK PDSIZE ;STACK
ERRPDS: BLOCK 1 ;SAVED P FOR RECOVERY FROM FTP ERRORS
IFN FTAFAL,< ;[AFAL-2]
VECBLK: BLOCK 4 ;[AFAL] PSISER INTERRUPT VECTOR
ENQFLG: BLOCK 1 ;[AFAL] FLAG INDICATING WE GOT OUR RESOURCE
ENQLOW: BLOCK 5 ;[AFAL] LOW SEG VERSION OF ENQ ARG BLOCK
>;END IFN FTAFAL [AFAL-2]
IFN FTAFAL,< ;[AFAL-10] ↑C .JBINT BLOCK
CCTRTB: BLOCK 4 ;[AFAL-10]
>;end of [AFAL-10]
IFN FTR105,<
PTHBLK: BLOCK 4 ;RENAME BLOCK WITH ROOM FOR PATH
> ;END OF IFN FTR105
APath: block .PtMax ;[afal-25] block for storing paths.
;[afal-25] all paths read in SCNPPN are
;[afal-25] stored here.
AFLBUF: BLOCK 406 ;I/O BUFFERS FOR ADDED FILE
FILBLK: BLOCK FBSIZE ;FOR READING USER FILE (/FILE:)
ACTBLK: ;FOR READING ACCT.SYS
TMPBLK: ;FOR WRITING PIP .TMP FILE
SVMBLK: BLOCK FBSIZE ;FOR SAVING MAIL ON NNNMAI.TMP
BOXBLK: BLOCK FBSIZE ;FOR MESSING WITH MAILBOXES
SLFBLK: BLOCK FBSIZE ;FOR SENDING A COPY TO A USER FILE
INDFIL: BLOCK FBSIZE ;FOR INDIRECT MAILING LIST
IFN FTBCOM,<
QUEFIL: ;OUTPUT BLOCK FOR QUEUED FILE
QRNFIL: ;BLOCK FOR RENAMING FILES
MQUFIL: BLOCK FBSIZE ;INPUT BLOCK FOR QUEUED FILE
QUEPTR: BLOCK 1 ;POINTER TO QUELST
>
AFLFIL: BLOCK FBSIZE ;FOR ADDING A FIL ON THE FLY
CKCFIL: BLOCK FBSIZE ;FOR CHECKING FILE ACCESS PRIVS
TXTCBL: BLOCK PBSIZE ;FOR WRITING TEXT OF MAIL
TMPCHL: BLOCK PBSIZE ;FOR BUILDING HEADERS, ETC.
TMPCBL: BLOCK PBSIZE ;FOR BUILDING PIP COMMAND FILE
TMPCML: BLOCK PBSIZE ;FOR COMMAND STRING WHILE PROCESSING INDIRECT
TMPBUF: BLOCK 20 ;COMMAND FILE TEXT GOES HERE
CMDHLD: BLOCK 30 ;HOLD COMMAND STRING
HDRLOC: BLOCK 1 ;ADDRESS OF LOCAL MAIL HEADER
IFN FTCIMP,<
HDRNET: BLOCK 1 ;ADDRESS OF NET MAIL HEADER
CONBLK: BLOCK .IBSIZ ;FTP CONNECTION BLOCK
FTPIBL: BLOCK FBSIZE ;FTP NETWORK FILE INPUT BLOCK
FTPOBL: BLOCK FBSIZE ;FTP NETWORK FILE OUTPUT BLOCK
>
OURPPN: BLOCK 1 ;USER'S OWN PPN (NOT DEFAULT)
DEFPPN: BLOCK 1 ;DEFAULT DISK PPN
OURNM1: BLOCK 1 ;SENDING USER'S NAME
OURNM2: BLOCK 1 ; ..
TZone: block 1 ;[afal-21] time zone text (eg, "EST")
IFN FTR066,<
SVNAME: BLOCK 1 ;UNIQUE NAME FOR SVMAIL.TMP
> ;END IFN FTR066
LHOSTN: BLOCK 1 ;LOCAL HOST NUMBER
IFE FTAFAL,< ;[AFAL-14]
HOSTN1: BLOCK 1 ;FIRST PART OF FOREIGN HOST NAME
HOSTN2: BLOCK 1 ;SECOND PART
> ;[AFAL-14] END OF IFE FTAFAL
IFN FTAFAL,< ;[AFAL-14]
HOSTN: BLOCK HSTWDS ;[AFAL-14] HOST NAME (ASCIZ)
> ;[AFAL-14] END OF IFN FTAFAL
CCSPAC: BLOCK 1 ;USED IN FORMATTING "CC:" TEXT
USRCCN: BLOCK 1 ;NUMBER OF USERS SEEN BEFORE /CC SWITCH
CCTOHD: BLOCK 1 ;POINTER TO CURRENT TO/CC HEADER
TMPPTR: BLOCK 1 ;POINTER TO HELD COMMAND LIST
DATE: BLOCK 1 ;CURRENT DATE, FOR XPD TEST
IFN FTMSGH,<
MALSIZ: BLOCK 1 ;PERMANENT COUNT OF CHARACTERS
>
USRTB1: BLOCK USRTBL ;FIRST PART OF EACH USER'S NAME
;OR PTR TO NAME STRING IF TO NET
USRTB2: BLOCK USRTBL ;SECOND PART
USRPGN: BLOCK USRTBL ;PROGRAMMER NUMBER OF EACH USER
USRHSN: BLOCK USRTBL ;[AFAL-14] HOST ADDRESS
IFN FTR101,<
USRMAT: BLOCK USRTBL ;POSSIBLE MATCH FOR ABBREVIATED NAME
;OR -1 IF NOT UNIQUE
USRAB1: BLOCK USRTBL ;FIRST PART OF NAME FOR WHICH
;GIVEN NAME IS ABBREVIATION
USRAB2: BLOCK USRTBL ;SECOND PART
> ;END IFN FTR101
IDENTI: BLOCK IDENTL/5+1 ;ADDITIONAL IDENTIFICATION
SUBJCT: BLOCK SUBJSL/5+1 ;SUBJECT STRING
REPLY: BLOCK 40 ;TEXT OF REPLY FROM FTP SERVER
IFN DEBUG,< ;[AFAL-16]
POKBLK: BLOCK 3 ;[AFAL-16] POKE. arg block
> ;[AFAL-16] End of IFN
ifn FtCImp,< ;[afal-17] needed to parse host names
HstStr: block 1 ;[afal-17] pointer to start of host name
; in a name string.
> ;[afal-17] end of ifn FtCImp
LOWEND: RELOC
END MAIL