Trailing-Edge
-
PDP-10 Archives
-
integ_tools_tops20_v7_30-apr-86_dumper
-
tools/vmail/vmailr.mac
There are 5 other files named vmailr.mac in the archive. Click here to see a list.
; MRFORT::MSC:<BUDNE>VMAILR.MAC.25 31-Oct-83 LQ+3D.9H.47M.35S., by BUDNE
; Make GETTOK handle embedded quotes. Add WARN MACRO.
; Add many ENDAV.'s and ENDAV.'s [342] = 226.
;<STEVENS.VMAILR>VMAILR.MAC.94 29-Jun-82 10:04:00, Edit by STEVENS
; Remove limit on TO field sent to VAX. Handled by limiting the
; size for the TO field string.
;<STEVENS.VMAILR>VMAILR.MAC.93 29-Jun-82 08:54:00, Edit by STEVENS
; Limit TO field sent to VAX to 128 characters.
; Limit storage into TOOBUF in routine GETOCC to prevent TOOBUF
; overflow. Reduced size of TOOBUF from 1000 to 35.
;<STEVENS.VMAILR>VMAILR.MAC.92 19-Jun-82 21:04:00, Edit by STEVENS
; Modified NOTIFY to put message into PS:<SPOOL> for DMAILR to process.
;<STEVENS.VMAILR>VMAILR.MAC.91 19-Jun-82 20:06:00, Edit by STEVENS
; Changed JRST at end of SNDVR1 from SNDVER to SNDVR1.
;<STEVENS.VMAILR>VMAILR.MAC.90 19-Jun-82 19:58:00, Edit by STEVENS
; Fixed message when error occured in parsing CC field.
; Changed ERRPTR in SNDFIL routine to an AC variable so subroutine
; SNDVR1 could access it.
; Merged routine BLDMSG into NOTIFY routine and changed TRVAR to
; a STKVAR call to that previous TRVAR variables don't get lost.
;<STEVENS.VMAILR>VMAILR.MAC.89 27-May-82 16:15:00, Edit by STEVENS
; Overflowed halfword so created INTVL1 and compared to it in
; routine HICCUP
;<STEVENS.VMAILR>VMAILR.MAC.88 27-May-82 15:56:00, Edit by STEVENS
; Fixed forced sleep time by putting the ^D's that were needed.
;<STEVENS.VMAILR>VMAILR.MAC.87 26-May-82 22:39:00, Edit by STEVENS
; Changed name of privledged job from SDMALR to SVMALR to prevent
; confusion between the twenty mailer and the vaxen.
;<STEVENS.VMAILR>VMAILR.MAC.86 26-May-82 21:45:00, Edit by STEVENS
; Added code in routine HICCUP to limit how often the mailer can
; be awaken as a result of a network topology change. Current
; setting is 10 seconds since last run.
;<STEVENS.VMAILR>VMAILR.MAC.85 25-May-82 20:37:00, Edit by STEVENS
; Cleared T3 and T4 before doing SOUT near GTOCC1.
;<STEVENS.VMAILR>VMAILR.MAC.84 25-May-82 20:16:00, Edit by STEVENS
; Added space before personal name field in GETFRM routine.
; Added code to gobble closing ">" for personal name in TO field
; in GETOCC routine.
;<STEVENS.VMAILR>VMAILR.MAC.83 19-May-82 22:16:00, Edit by STEVENS
; Added code at SNDVX6 to find body of message by looking for
; the blank line that terminates the header.
;<STEVENS.VMAILR>VMAILR.MAC.82 19-May-82 21:53:00, Edit by STEVENS
; Removed all to SKPLIN at end of GETNAM.
;<STEVENS.VMAILR>VMAILR.MAC.81 19-May-82 21:42:00, Edit by STEVENS
; Fixed error in outputing username in routine GETFRM.
;<STEVENS.VMAILR>VMAILR.MAC.80 19-May-82 21:38:00, Edit by STEVENS
; Added routine (GETNAM) to get username, host, personal name from
; mail file. Modified GETFRM and GETOCC to use the routine
; created.
;<STEVENS.VMAILR>VMAILR.MAC.79 19-Apr-82 21:46:00, Edit by STEVENS
; Fixed close quote of personal name in GETFRM routine.
;<STEVENS.VMAILR>VMAILR.MAC.78 19-Apr-82 21:26:00, Edit by STEVENS
; Output personal name in GETFRM before finding host name.
;<STEVENS.VMAILR>VMAILR.MAC.77 19-Apr-82 21:06:00, Edit by STEVENS
; Create AC variable in GETFRM to store personal name pointer.
;<STEVENS.VMAILR>VMAILR.MAC.76 19-Apr-82 20:54:00, Edit by STEVENS
; 1 Modified GTALPH to allow underscore in name.
; 2 Decreased max characters in SNDVX5 to field in hopes of solving
; missing to field.
; 3 Changed "RET" to "RETSKP" in SNDFIL to get blank lines out of log
; file.
; 4 Modified GETFRM to include personal name a-la RSTS.
;<STEVENS.VMAILR>VMAILR.MAC.75 15-Jan-82 13:46:00, Edit by STEVENS
; Removed changes made to FIXHST in last edit and added code in
; SNDVAX routine to put the current node name in HSTBUF if node
; message is from is not the current node.
;<STEVENS.VMAILR>VMAILR.MAC.74 11-Jan-82 10:35:00, Edit by STEVENS
; Fixed routing string by adding code to FIXHST routine to put the
; current node into the routing string if message is not from the
; current host. Also added null terminator to text lines in CPYLIN
; routine.
;<STEVENS.VMAILR>VMAILR.MAC.73 17-Dec-81 09:24:00, Edit by STEVENS
; Repaired bug in SNDVAX routine for when mail is not from the node
; that is attempting mail transmission. SIN call after STCMP of
; node name not properly setup.
;<STEVENS.VMAILR>VMAILR.MAC.72 16-Dec-81 17:27:00, Edit by STEVENS
; Added null sting terminator to node name string in GRTNOD routine
;<STEVENS.VMAILR>VMAILR.MAC.71 16-Dec-81 12:46:00, Edit by STEVENS
; Comented out skipl in SCANEM missed when moby scan turned off
;<STEVENS.VMAILR>VMAILR.MAC.70 10-Dec-81 09:37:00, Edit by STEVENS
; Setup default node routed to in SNDVAX before calling FIXHST
; in case node is an immediate neighbor.
;<STEVENS.VMAILR>VMAILR.MAC.69 09-Dec-81 13:30:00, Edit by STEVENS
; Limit length of TO field to 255 characters in SNDVAX routine
;<STEVENS.VMAILR>VMAILR.MAC.68 09-Dec-81 10:50:00, Edit by STEVENS
; Renamed TEMP2 to RTENAM (Name of host routed to)
; Added code in SNDVAX routine to send node name when addressing
; a remote node. This happens when the host we want to go to is
; not the host we got to. This is required in order to use the
; EMS gateaway at TELC.
;<STEVENS.VMAILR>VMAILR.MAC.67 24-Nov-81 10:28:00, Edit by STEVENS
; Corrected minor bug in GETFRM routine
;<STEVENS.VMAILR>VMAILR.MAC.66 24-Nov-81 08:31:00, Edit by STEVENS
; Corrected problem in skiping over personal name
;<STEVENS.VMAILR>VMAILR.MAC.65 23-Nov-81 10:10:00, Edit by STEVENS
; Ignore personal name in from field
; Scan to find subject field
;<STEVENS.VMAILR>VMAILR.MAC.64 20-Nov-81 09:29:00, Edit by STEVENS
; Cleaned up notification routine some more
;<STEVENS.VMAILR>VMAILR.MAC.63 20-Nov-81 08:58:00, Edit by STEVENS
; REPAIRED BUG IN NOTIFICATION OF FAILURE
;<STEVENS.VMAILR>VMAILR.MAC.62 20-Nov-81 08:40:00, Edit by STEVENS
; Disable Moby scan and clearing of decnet-flag bits
; This is to prevent conflict with DMAILR
;<LCAMPBELL.DECNET>DMAILR.MAC.190 26-May-81 18:00:00, Edit by LCAMPBELL
; Do physical-only open for SYSTEM:DECNET-MAILER.FLAGS
;<LCAMPBELL.DECNET>DMAILR.MAC.189 19-May-81 12:52:16, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>DMAILR.MAC.188 19-May-81 12:49:07, Edit by LCAMPBELL
; Rip pass-through code out and put it in a separate module
TITLE VMAILR - DECNET Mail User Process
SUBTTL Larry Campbell
SEARCH MACSYM,MONSYM,DNCUNV
SALL
NOSYM
.DIRECTIVE FLBLST
.REQUIRE SYS:MACREL,VNCONN
EXTERNAL .DNINI,.DNCON ; Entry points in DNCONN
T1=1
T2=2
T3=3
T4=4
P1=5
P2=6
P3=7
P4=10
F=11
PTR=13 ; global byte pointer to received mail
CNT=14 ; global byte count for same
CX=16
P=17
.VER==5
.EDT==342 ;226 DECIMAL
LOC 137
EXP <.VER>B11+.EDT
RELOC
;MACROS
Define Clrbuf(Bufnam,Buflen),<
Setzm Bufnam
Move T1,[Bufnam,,Bufnam+1]
Blt T1,Bufnam+Buflen-1
>
Define Nrecord(Buffer),<
Move T1,Njfn
Hrroi T2,Buffer
Movni T3,4
Setz T4,
Sinr
Erjmp Fatal
>
Define Nsuccess,<
Move T1,Njfn
Hrroi T2,[0]
Movei T3,1
Setz T4,
Soutr
>
Define Nsend(Record),<
Move T1,Njfn
Hrroi T2,Record
Setzb T3,T4
Soutr
Erjmp Fatal
>
Define Find(String),< ;; Search for the given string
Xlist
Move T1,[Point 7,[Asciz/String/]]
Call Findit ;; Call string compare routine
List
>
DEFINE TMSG(STRING),<
XLIST
MOVE T1,LOGJFN
HRROI T2,[ASCIZ \STRING\]
SETZB T3,T4
SOUT
ERJMP [HRROI T1,[ASCIZ \
?TMSG failure\]
PSOUT
HALTF]
LIST
>
DEFINE YECCH(STRING),<
XLIST
ERJMP [ TCRLF
TXNE F,F%WEEL
CALL DTSTMP
TMSG <?VMAILR: >
MOVE T1,LOGJFN
HRROI T2,[ASCIZ \STRING\]
SETZB T3,T4
SOUT
TMSG < because: >
MOVE T1,LOGJFN
HRLOI T2,.FHSLF
SETZ T3,
ERSTR
JFCL
JFCL
MOVE T1,LOGJFN ;; insure log file gets written
CLOSF ;; ..
JFCL
TXNN F,F%WEEL ;;if SYSJOB, never stop
HALTF
JSP CX,BEGIN ]
LIST
>
DEFINE BLECH(STRING),<
XLIST
JRST [ TMSG <?VMAILR: Fatal internal error: >
MOVE T1,LOGJFN
HRROI T2,[ASCIZ \STRING\]
SETZB T3,T4
SOUT
MOVE T1,LOGJFN ;;in case SOUT trashes T1 with error code
CLOSF
JFCL
TXNN F,F%WEEL ;; if SYSJOB, never stop
HALTF
JSP CX,BEGIN]
LIST
>
DEFINE TCRLF,<TMSG <
>>
DEFINE HERALD(VER,EDT),<
TMSG <VMAILR version VER(EDT) started
>>
;[342]
DEFINE WARN(MESS) <
HRROI T2,[ASCIZ \%VMAILR: MESS\]
>
;Flag bits
F%WEEL==1B0 ; WHEEL
F%RNAM==1B1 ; Rename required
F%PACK==1B2 ; Postive acknowledgement received
F%ERRF==1B3 ; Error message received
F%STAY==1B4 ; "stay lit" flag for mailer flags bit
;Parameters
SLPTIM==^D1800000 ;milliseconds to sleep between scans
MAXDIR==4000 ;maximum number of dirs scannable
PDLLEN==200 ;length of stack
FLGPAG==600 ;page into which we map DECNET-MAILER.FLAGS
FLGADR==FLGPAG*1000 ;address of DECNET-MAILER.FLAGS
NERMSG==50 ;no. of words for error msg from 4n host
XSAGE==7,,0 ;excessive age for queued mail (one week)
MOBYN==1,,0 ;how often to do moby scans (once per day)
STRN==40000 ;words of string space
HOSTNN==^D39 ;maximum chars in hostname
;Storage
STACK: BLOCK PDLLEN
LOGJFN: BLOCK 1 ;JFN on which to type most things
NODNAM: BLOCK 5 ;our node name
FLGJFN: BLOCK 1 ;JFN of PS:<SYSTEM>DECNET-MAILER.FLAGS
ERRMSG: BLOCK NERMSG ;last fatal error message from other host
DIRS: BLOCK MAXDIR ;list of directories to scan
LINBUF: BLOCK ^D100 ;line buffer for stuff from mail file
DEDHST: BLOCK 100 ;list of hosts known to be inaccessible or down
STRSP0: BLOCK 1 ;pointer to dead host name string space
STRSPC: BLOCK STRN ;dead host name string space
MOBY: BLOCK 1 ;-1 => time for moby scan (ALL directories)
;STORAGE FOR VAX MESSAGE CHANGES
NJFN: BLOCK 1 ;Network JFN
MJFN: BLOCK 1 ;Mail file JFN
HOSTBA: BLOCK 1 ;Address of host TBLUK table
AROUTE: BLOCK 1 ;Pointer to routing string being used
BLNKBF: ASCIZ / / ;Blank string for null records
BYTCNT: BLOCK 1 ;Lenght of message
TOOPTR: BLOCK 1 ;Pointer to To Buffer
TOOBUF: BLOCK 35 ;To buffer
ATMBUF: BLOCK 20 ;Atom buffer
FRMBUF: BLOCK 20 ;From buffer
SUBBUF: BLOCK 20 ;Subject buffer
TEMP1: BLOCK 20 ;Temporary buffer
RTENAM: BLOCK 20 ;Temporary buffer
USER: BLOCK 20 ;User name or recipient buffer
HSTBUF: BLOCK 20 ;Host buffer
BIGBUF: BLOCK 40000 ;Storage for message file
LEVTAB: PC1
0
0
CHNTAB: 1,,HICCUP ;net topology changed routine
REPEAT ^D35,<EXP 0>
PC1: BLOCK 1
SCNFLG: BLOCK 1 ;-1 => work in progress
INTRVL: EXP SLPTIM ;sleep interval
INTVL1: EXP ^D10*^D60*^D1000 ;FORCED SLEEP INTERVAL (10 MINUTES)
SCNTOD: BLOCK 1 ;TOD (msec) of last scan
DNBLK: BLOCK DN.INF+1 ; Arg block for DNCONN utility
BEGIN: RESET
MOVE P,[IOWD PDLLEN,STACK]
CLRBUF NODNAM,5 ;clear node name, flag bits
MOVEI T1,.PRIOU ;assume logging to TTY
MOVEM T1,LOGJFN
MOVEI T1,.FHSLF ;get our capabilities
RPCAP
MOVE T1,[SIXBIT /VMAILR/] ; assume nonprivileged name
TXNE T3,SC%WHL!SC%OPR ; WHOPER?
JRST [ MOVE T1,[SIXBIT /SVMALR/] ; yes, declare different name
TXO F,F%WEEL ; remember that
JRST .+1]
MOVE T2,T1 ; private name also
SETSN
JFCL
MOVX T1,.NDGLN ;function to get local node name
MOVEI T2,T3 ;arg block
HRROI T3,NODNAM ;where to put node name
NODE
YECCH <Impossible NODE failure>
TXNE F,F%WEEL ; WHEEL or OPERATOR?
JRST [ HERALD \.VER,\.EDT ; yes, announce our name and version
CALL OPNLOG ; open log file
MOVEM T1,LOGJFN
CALL TOPLGY ; set up to interrupt on
; network topology change
CALL DTSTMP ; start log file
HERALD \.VER,\.EDT
JRST .+1]
MOVX T1,GJ%SHT!GJ%PHY ;find mailer flags, physical-only please
HRROI T2,[ASCIZ /SYSTEM:DECNET-MAILER.FLAGS.1;P777777/]
GTJFN
YECCH<Can't find SYSTEM:DECNET-MAILER.FLAGS.1>
MOVX T2,<440000,,0>!OF%RD!OF%WR!OF%THW
OPENF ;open thawed (so updates OK)
YECCH<Can't OPENF PS:<SYSTEM>DECNET-MAILER.FLAGS>
MOVEM T1,FLGJFN ;remember handle
HRLZ T1,T1 ;from file page zero
MOVE T2,[.FHSLF,,FLGPAG] ;to fork page FLGPAG
MOVX T3,PM%RD!PM%WR ;read and write access
PMAP ;get the page in
; SETOM MOBY ;always do moby scan first time
; ..
; ..
BEGIN2: SETOM SCNFLG ;flag scan in progress
CALL SCANEM ;check for queued mail and process it
TXNN F,F%WEEL ;if not wheel,
JRST [ HALTF ;all done
JSP CX,BEGIN]
MOVE T1,LOGJFN ;close log file for readers
CLOSF
JFCL
CALL OPNLOG ;open it again
MOVEM T1,LOGJFN ;save new JFN
SETZM SCNFLG ;note that we're now idle
MOVE T1,INTRVL ;how long to sleep before checks
BEGIN3: DISMS
TIME ;current TOD
MOVE T3,SCNTOD ;get TOD of last scan
SUB T1,T3 ;difference
CAML T1,INTRVL ;have we waited the full interval yet?
JRST BEGIN2 ;yes, go scan again
MOVE T2,INTRVL
SUB T2,T1 ;how much longer to wait
MOVE T1,T2 ;be patient
JRST BEGIN3
;Check for queued mail and handle (called also at net topology change)
SCANEM: TIME ;get current TOD
MOVEM T1,SCNTOD ;remember
MOVEI T1,100 ;empty dead host table
MOVEM T1,DEDHST ;because we don't know anything yet
MOVEI T1,STRSPC ;reset string space area
MOVEM T1,STRSP0 ; ..
GTAD ;get current time
MOVE T2,FLGADR+777 ;and time of last moby scan
SUB T1,T2 ;compute difference
; SKIPL T1 ;if unreasonable,
; CAML T1,[MOBYN] ;time for one yet?
; SETOM MOBY ;yes
CALL DIRLST ;build list of directories to scan
JUMPE T1,R ;none, just return
MOVN P1,T1 ;save negative count
TXNN F,F%WEEL ;if not WHEEL,
JRST SCANM1 ; skip the logging
CALL DTSTMP ;time stamp the log file
HRROI T3,[ASCIZ /----Beginning periodic scan
/]
MOVEI T1,.FHSLF ;see if running as an interrupt routine
RWM ; ..
SKIPE T2 ;if so, get different message
HRROI T3,[ASCIZ /----Network topology changed, beginning scan
/]
MOVE T2,T3 ;put string pointer in right AC
MOVE T1,LOGJFN ;write to the log file
SETZB T3,T4
SOUT
SKIPN MOBY ;moby scan?
JRST SCANM1 ;no, skip this
CALL DTSTMP
HRROI T2,[ASCIZ /----Scanning all directories
/]
SETZB T3,T4
SOUT
SCANM1: CLRBUF DNBLK,DN.INF+1 ; Zero arg block
MOVE T1,LOGJFN ; Where to type stuff
MOVEM T1,DNBLK+DN.ERR
MOVEM T1,DNBLK+DN.WRN
MOVEM T1,DNBLK+DN.INF
MOVEI T1,DNBLK ; Arg block address
CALL .DNINI ; Init connect utility
JRST [ CALL DTSTMP ; Hmm, flag error
TMSG <%Problem initializing routing database>
JRST .+1]
MOVEM T1,HOSTBA ;Save host table address
HRLZ P1,P1 ;make AOBJN pointer
SCANM2: MOVE T1,DIRS(P1) ;get next directory number
CALL CHKDIR ;check for queued mail, send if found
AOBJN P1,SCANM2
SETZM MOBY
TXNN F,F%WEEL ;if not WHEEL,
RET ; then all done
CALL DTSTMP ; else time stamp log file
TMSG <----End of scan
>
RET
;Check directory whose number is in T1 for queued mail
CHKDIR: ACVAR<IFH,JFN> ;[342] Indexable File Handle,JFN
TRVAR<<STRING,16>,DIRNUM> ;place to build string, dirnum
TXZ F,F%STAY ;assume MAILER.FLAG bit won't stay lit
MOVEM T1,DIRNUM ;preserve directory number
FILUP2: HRROI T1,STRING ;where to build filespec string
HRROI T2,[ASCIZ /PS:</] ;first part of filespec
SETZB T3,T4
SOUT ;start building filespec
MOVE T2,DIRNUM ;get user number
DIRST ;convert to string
JRST [ CAIN T1,DIRX2 ; Insufficient system resources?
TXO F,F%STAY ; Yes, don't flush this from queue
JRST ALLDON] ; Wrap up
HRROI T2,[ASCIZ />[--DECNET-MAIL--].*/]
SETZB T3,T4 ;finish off filespec string
SOUT ; ..
SETZ T2, ;insure ASCIZ
IDPB T2,T1 ; ..
MOVE T1,[GJ%SHT+GJ%IFG+GJ%OLD+<0,,-3>] ;all generations
HRROI T2,STRING ;point to filespec we built
GTJFN ;get indexable file handle
ERJMP [TXNN F,F%RNAM ;any renames done?
TXNE F,F%WEEL ; or doing this for system?
JRST ALLDON ;yes, quit
TMSG <%No queued DECNET mail>
HALTF
JSP CX,BEGIN]
MOVE IFH,T1 ;[342] save indexable file handle
CALL DTSTMP ;time stamp log file
TMSG <Unspooling mail from >
MOVE T1,LOGJFN ;where to put username
MOVE T2,DIRNUM ;user number
DIRST ;log it
YECCH<DIRST failure while logging>
TCRLF
MOVE T1,IFH ;[342] get JFN of mail back
JRST FILUP1 ;go to it
FILOOP: MOVE T1,IFH ;[342] get indexable file handle
GNJFN ;get next file
ERJMP ALLDON ;no more
FILUP1: HRRZ JFN,T1 ;isolate and preserve JFN
HRRZS T1 ;pass JFN only
CALL SNDFIL ;send to appropriate host and delete
JRST [ MOVE T1,JFN
TXO T1,CO%NRJ ;keep JFN lying around
CLOSF
JFCL
PUSH P,T1 ;save offending JFN
TCRLF
TXNN F,F%RNAM ;need to be renamed?
JRST [ TXO F,F%STAY ;no, keep flag lit for retries
POP P,T1 ;flush stack
JRST FILOOP] ;check some more
POP P,T1 ;get JFN back
CALL RNAMIT ;yes, rename to prevent retries
RLJFN ;release JFN
YECCH<RLJFN failure after RNAMIT>
JRST FILUP2] ;and check for more mail to send
JRST FILOOP ;do for all files
;Let dmailr handle clearing the flag bits to prevent conflict
ALLDON:
; MOVE T4,[ANDCAM T3,FLGADR(T1)] ; assume we'll be clearing the bit
; TXNE F,F%STAY ;should flag bit stay lit 'cuz of err?
TXNN F,F%STAY ;should flag bit stay lit 'cuz of err?
RET ;return without changing flags
MOVE T4,[IORM T3,FLGADR(T1)] ; yes, light it (in case not lit now)
HRRZ T1,DIRNUM ;get directory number
IDIVI T1,^D36 ;get word number in DECNET-MAILER.FLAGS
MOVSI T3,400000 ;bit zero
MOVN T2,T2 ;negate bit number
LSH T3,(T2) ;position bit correctly
XCT T4 ; light or clear it appropriately
RET ;all done
ENDAV. ;[342] {IFH,JFN}
ENDTV. ;[342] {STRING,DIRNUM}
;Send one file to appropriate host, JFN of file in T1
; P4 negative flags end of file
; Returns: +1: failure
; +2: success
SNDFIL: ACVAR <TOCNT,ERRPTR> ; Count of the number of recipients
STKVAR <<HNAM,20>> ; Error msg ptr, mail JFN, net JFN, hostname
HRRZM T1,MJFN ;save mail file JFN
TXZ F,F%RNAM!F%ERRF!F%PACK ; No errors, no renames, no acks, yet
CLRBUF ERRMSG,NERMSG ;zero error message save area
HRROI T1,ERRMSG ;init pointer to error message string
MOVEM T1,ERRPTR ; ..
HRROI T1,HNAM ; Where to build hostname string
;Check to see if host is in the VAX router table. If not, return and do
;nothing. DMAILR will handle it.
MOVE T2,MJFN ;mail file JFN
MOVX T3,<1B11> ;type extension only
SETZ T4,
JFNS
MOVE T1,HOSTBA ;Is this host in the table?
HRROI T2,HNAM
TBLUK
TXNN T2,TL%EXM ;Skip if node is in routing table
RETSKP ;No, Must not be for a VAX let DMAILR handle it
MOVE T1,MJFN ;mail file JFN
MOVX T2,<070000,,0>+OF%RD ;open for ASCII read
OPENF
ERJMP [TXNE F,F%WEEL
CALL DTSTMP
TMSG <%Can't open mail file
>
RET] ;failure return
CALL DTSTMP ;put date/time stamp in log file
TMSG <Sending to >
MOVE T1,LOGJFN ; Move hostname to log file
HRROI T2,HNAM
SETZB T3,T4
SOUT
TMSG <, >
MOVE T1,MJFN ;mail file JFN
CALL CHKOLD ;see if old and dusty yet
RET ;yes, don't bother with it
MOVE T1,MJFN ;mail file JFN
CALL HSTCHK ;host considered up?
JRST [ TMSG <known inaccessible, skipped.>
RET]
CLRBUF DNBLK,DN.INF+1 ; Zero DNCONN arg block
MOVE T1,LOGJFN ; Place all messages in log file
MOVEM T1,DNBLK+DN.ERR
MOVEM T1,DNBLK+DN.WRN
MOVEM T1,DNBLK+DN.INF
HRROI T1,HNAM ; Pointer to host name
MOVEM T1,DNBLK+DN.HST
MOVEI T1,^D27 ; Object type 27 decimal
MOVEM T1,DNBLK+DN.ROB
SETZ T1, ; Assume defaults for flags
TXNE F,F%WEEL ; Are we the system unspooler?
TXO T1,DN%DTS!DN%SPL ; Yes, light time-stamp and spool flags
MOVEM T1,DNBLK+DN.FLG ; ..
MOVEI T1,7 ; Byte size
MOVEM T1,DNBLK+DN.BSZ ; ..
MOVEI T1,DNBLK ; Pass arg block address
CALL .DNCON ; Attempt the connect
JRST [ MOVE T1,MJFN ; Failed - mark host dead
CALL HSTDED
RET] ; and give failure return
MOVEM T1,NJFN ; Remember the JFN we just won
MOVEI T2,2(T2) ; Point to routing string
HRLI T2,(POINT 7,,6) ; Form byte pointer to routing string
MOVEM T2,AROUTE ; Save address of routing string
SETZ P4, ; Success - clear end of file flag
; JRST SNDFL2 ; Go send the message
SNDFL2:
;
;PROGRAM FROM FOR SENDING DATA TO VAX
;
;STEP DESCRIPTION:
; BEGIN SNDVAX
; : EXTRACT FROM THE MAIL FILE WHO THE MAIL IS FROM
; : ADD ROUTINE LIST TO STRING WHERE NEEDED
; : SEND FROM STRING TO VAX *I/O*
; : REPEAT UNTIL NO MORE RECIPIENTS
; : : EXTRACT FROM THE MAIL FILE ONE OF THE RECIPIENTS
; : : ADD TO LIST OF RECIPIENTS ALONG WITH NODE NAME
; : : IF RECIPIENT IS ON NODE WERE SENDING TO
; : : : SEND RECIPIENTS NAME TO NODE FOR ACKNOWLEDGEMENT
; : : : RECEIVE ACKNOWLEDGEMENT FROM REMOTE NODE
; : : : IF BAD ACKNOWLEDGEMENT
; : : : : REPORT ERROR
; : : : ENDIF
; : : ENDIF
; : END REPEAT
; SEND NULL TO REMOTE HOST
; SEND TO STRING CREATED DURING REPEAT LOOP
; GET SUBJECT OF MESSAGE
; SEND SUBJECT OF MESSAGE
; SKIP 2 LINES IN MAILE FILE TO GET OVER THE GARBAGE
; SEND THE TEXT OF THE MESSAGE TO THE REMOTE HOST IN LINE MODE
; SEND A NULL TO THE REMOTE HOST
; REPEAT UNTIL ONE ACK RECEIVED FOR EACH RECIPIENT
; : RECEIVE AN ACKNOWLEDGEMENT FROM THE REMOTE HOST
; : IF BAD ACKNOWLEDGEMENT
; : : GET ERROR MESSAGE FROM REMOTE HOST
; : : LOG ERROR MESSAGE INTO THE LOG FILE
; : ENDIF
; END REPEAT
;
SNDVAX: CLRBUF BIGBUF,40000 ; CLEAR THE INPUT BUFFER
MOVE T1,MJFN ; READ 40000 CHARACTERS FROM
HRROI T2,BIGBUF ; THE MAIL FILE
MOVEI T3,40000
SETZ T4,
SIN
ERJMP [MOVEI T1,.FHSLF ;this fork
GETER ;get last error code
HRRZS T2 ; ..
CAIE T2,IOX4 ;end of file?
JRST [ MOVE T1,ERRPTR ; BUILD MESSAGE TO USER
WARN <I/O error reading mail file: >
JRST ESEND ]
SETO P4, ;flag end of file
MOVEI T1,12 ;insure ends with line feed
IDPB T1,T2 ; ..
JRST .+1]
MOVN CNT,T3 ; CREATE THE COUNT OF THE NUMBER
ADDI CNT,40000 ; OF BYTES READ
MOVEM CNT,BYTCNT
MOVE PTR,[POINT 7,BIGBUF,6] ; CREATE POINTER TO INPUT BUFFER
CALL GETFRM ; GET WHO MAIL IS FROM
JRST [ MOVE T1,ERRPTR ; BUILD MESSAGE TO USER
WARN <Error parsing FROM field of message>
JRST ESEND1 ]
HRROI T1,NODNAM ; POINT TO OUR NODE NAME
HRROI T2,HSTBUF ; HOST MESSAGE IS FROM
STCMP ; IS MESSAGE FROM OUR HOST ?
TXNN T1,<SC%SUB> ; YES
JRST [ HRROI T1,HSTBUF ; GET TO END OF STRING
HRROI T2,HSTBUF
SETZB T3,T4
SIN
BKJFN
JFCL
HRROI T2,FRMBUF ; ADD ROUTE TO FRMBUF
SETZB T3,T4
SOUT
HRROI T1,FRMBUF
HRROI T2,HSTBUF
SETZB T3,T4
SOUT
HRROI T1,HSTBUF ; PUT CURRENT NODE NAME IN HSTBUF
HRROI T2,NODNAM
SETZB T3,T4
SOUT
HRROI T2,[ASCIZ/::/] ; WITH NODE DESIGNATOR
SOUT
JRST .+1 ]
HRROI T1,RTENAM ; CREATE DEFAULT NODE ROUTED TO
HRROI T2,HNAM
SETZB T3,T4
SOUT
HRROI T2,[ASCIZ/::/] ; WITH NODE DESIGNATOR
SOUT
CALL FIXHST ; DEVELOPE ROUTING STRING SO
; VAX CAN GET BACK TO US
JRST [ MOVE T1,ERRPTR ; BUILD ERROR MESSAGE TO USER
WARN <Error encountered in routing file>
JRST ESEND1 ]
NSEND <FRMBUF> ; SEND SENDER TO VAX W ROUTING
MOVSI TOCNT,-^D100 ; MAXIMUM OF 100 NAMES IN LIST
SETZM TOOBUF
SETZM TOOBUF+^D25
MOVE T1,[POINT 7,TOOBUF]
MOVEM T1,TOOPTR ; SETUP POINTER TO TO BUFFER
SNDVX1: FIND <TO:> ; FIND "TO:" LIST
JRST [ CALL SKPLIN ; NOT ON THIS LINE, TRY NEXT
JRST [ MOVE T1,ERRPTR ; NO TO FIELD FOUND, -ERROR-
WARN <No recipients specified>
JRST ESEND1 ]
JRST SNDVX1 ] ; GO TRY AGAIN
SNDVX2: CALL GETOCC ; PARSE TO FIELD AND BUILD TO STRING
JRST [ MOVE T1,ERRPTR ; ERROR PARSING "TO" FIELD
WARN <Error parsing TO field of mail file>
JRST ESEND1 ]
JUMPE T1,SNDVX3 ; DONE PROCESSING TO FIELD - LOOK FOR CC
HRROI T1,HNAM ; POINT TO OUR NODE NAME
HRROI T2,HSTBUF ; HOST MESSAGE IS FOR
STCMP ; IS MESSAGE FOR OUR HOST ?
TXNN T1,<SC%SUB> ; YES
JRST SNDVX2 ; NO, GET NEXT RECIPIENT
HRROI T1,HSTBUF ; HOST MESSAGE IS FOR
HRROI T2,RTENAM ; HOST ROUTED TO
STCMP ; DID WE ROUTE TO INTENDED HOST ?
; (**THIS IS TO ALLOW USE OF OTHER GATEAWAYS**)
JUMPE T1,SNDLC1 ; YES, SEND LOCAL ADDRESS
MOVE T1,NJFN ; SEND REMOTE NODE NAME
HRROI T2,HSTBUF
SETZB T3,T4
SOUT ; USE SOUT SO IT WILL GET CONCATENATED
; WITH USERNAME
SNDLC1: NSEND <USER> ; SEND RECIPIENT TO VAX
NRECORD <TEMP1> ; GET ACKNOWLEDGEMENT
HLRZ T1,TEMP1
CAIE T1,4000 ; WAS IT GOOD ?
JRST [ TXO F,F%ERRF ; SET FATAL ERROR FLAG
JRST SNDVER ] ; FETCH ERROR MESSAGE
AOBJN TOCNT,SNDVX2 ; LOOP TILL DONE
JRST [ MOVE T1,ERRPTR ; TOO MANY RECIPIENTS
WARN <Too many recipients. Please split message>
JRST ESEND1 ]
SNDVX3: FIND <CC:> ; FIND "CC:" LIST
JRST SNDVX5 ; ABSENCE OF CC FIELD OK
SNDVX4: CALL GETOCC ; PARSE TO FIELD AND BUILD TO STRING
JRST [ MOVE T1,ERRPTR ; ERROR PARSING "TO" FIELD
WARN <Error parsing CC field of mail file>
JRST ESEND1 ]
JUMPE T1,SNDVX5 ; DONE PROCESSING CC FIELD
HRROI T1,HNAM ; POINT TO OUR NODE NAME
HRROI T2,HSTBUF ; HOST MESSAGE IS FOR
STCMP ; IS MESSAGE FOR OUR HOST ?
TXNN T1,<SC%SUB> ; YES
JRST SNDVX4 ; NO, GET NEXT RECIPIENT
HRROI T1,HSTBUF ; HOST MESSAGE IS FOR
HRROI T2,RTENAM ; HOST ROUTED TO
STCMP ; DID WE ROUTE TO INTENDED HOST ?
; (**THIS IS TO ALLOW USE OF OTHER GATEAWAYS**)
JUMPE T1,SNDLC2 ; YES, SEND LOCAL ADDRESS
MOVE T1,NJFN ; SEND REMOTE NODE NAME
HRROI T2,HSTBUF
SETZB T3,T4
SOUT ; USE SOUT SO IT WILL GET CONCATENATED
; WITH USERNAME
SNDLC2: NSEND <USER> ; SEND RECIPIENT TO VAX
NRECORD <TEMP1> ; GET ACKNOWLEDGEMENT
HLRZ T1,TEMP1
CAIE T1,4000 ; WAS IT GOOD ?
JRST [ TXO F,F%ERRF ; SET FATAL ERROR FLAG
JRST SNDVER ] ; FETCH ERROR MESSAGE
AOBJN TOCNT,SNDVX4 ; LOOP TILL DONE
JRST [ MOVE T1,ERRPTR ; TOO MANY RECIPIENTS
WARN <Too many recipients. Please split message>
JRST ESEND1 ]
SNDVX5: NSUCCESS ; SEND NODE RECIPIENT LIST TERMINATOR
MOVE T1,NJFN
HRROI T2,TOOBUF
SETZB T3,T4 ; THIS WAY A NULL WON'T GET SENT
SOUTR ; SEND RECIPIENT LIST
ERJMP FATAL
CALL GETSUB ; GET SUBJECT FIELD
JRST [ MOVE T1,ERRPTR ; ERROR PARSING SUBJECT FIELD
WARN <Error parsing SUBJECT field in mail file>
JRST ESEND1 ]
NSEND <SUBBUF> ; SEND SUBJECT FIELD
; FIND START OF MESSAGE BY LOCATING FIRST BLANK LINE
LDB T1,PTR ; GET CHARACTER FROM BUFFER
SNDVX6: CAIN T1,.CHCRT ; SKIP IF LINE IS NOT BLANK
JRST SNDPA0 ; EAT BLANK LINE
CALL SKPLIN ; SKIP TO NEXT LINE
JRST [ MOVE T1,ERRPTR ; ERROR FINDING MESSAGE BODY
WARN <Unable to find body of message>
JRST ESEND1 ]
JRST SNDVX6
; NOW GET THE MESSAGE, ONE LINE AT A TIME
SNDPA0: CALL SKPLIN ; SKIP TO NEXT LINE
JRST SNDONE ; NO MORE LINES, DONE!
SNDPA1: CLRBUF ATMBUF,20
MOVE T2,[POINT 7,ATMBUF] ; COPY REST OF THIS LINE INTO ATMBUF
SNDPA2: CALL CPYLIN ; COPY LINE INTO ATMBUF
JUMPE T1,[ SKIPE P4 ; SKIP IF NOT EOF
JRST SNDON1
PUSH P,T2 ; GET ANOTHER HUNK FROM THE MAIL FILE
MOVE T1,MJFN
HRROI T2,BIGBUF
MOVEI T3,40000
SETZ T4,
SIN
ERJMP [MOVEI T1,12 ;insure ends with line feed
IDPB T1,T2 ; ..
MOVEI T1,.FHSLF ;this fork
GETER ;get last error code
HRRZS T2 ; ..
CAIE T2,IOX4 ;end of file?
JRST [ POP P,T2
MOVE T1,ERRPTR ; BUILD MESSAGE TO USER
WARN <I/O error reading mail file: >
JRST ESEND ]
SETO P4, ;flag end of file
JRST SNDPAX]
SNDPAX: POP P,T2
MOVN CNT,T3 ; CREATE THE COUNT OF THE NUMBER
ADDI CNT,40000 ; OF BYTES READ
MOVEM CNT,BYTCNT
MOVE PTR,[POINT 7,BIGBUF,6] ; CREATE POINTER TO INPUT BUFFER
JRST SNDPA2 ] ; BACK FOR REST OF LINE
SKIPN ATMBUF ; DON'T BOTHER WITH NULL RECORDS
JRST [ NSEND <BLNKBF>
JRST SNDPA0]
NSEND <ATMBUF>
JRST SNDPA0
SNDONE: SKIPE P4 ; SKIP IF NOT EOF
JRST SNDON1
MOVE T1,MJFN ; GET ANOTHER BLOCK OF DATA FROM MAIL FILE
HRROI T2,BIGBUF
MOVEI T3,40000
SETZ T4,
SIN
ERJMP [MOVEI T1,.FHSLF ;this fork
GETER ;get last error code
HRRZS T2 ; ..
CAIE T2,IOX4 ;end of file?
JRST [ MOVE T1,ERRPTR ; BUILD MESSAGE TO USER
WARN <I/O error reading mail file: >
JRST ESEND ]
SETO P4, ;flag end of file
MOVEI T1,12 ;insure ends with line feed
IDPB T1,T2 ; ..
JRST .+1]
MOVN CNT,T3 ; CREATE THE COUNT OF THE NUMBER
ADDI CNT,40000 ; OF BYTES READ
MOVEM CNT,BYTCNT
MOVE PTR,[POINT 7,BIGBUF,6] ; CREATE POINTER TO INPUT BUFFER
JRST SNDPA0 ; BACK FOR REST OF LINE
SNDON1: NSUCCESS
HRLZS TOCNT ; CREATE AOBJN COUNT FOR NUMBER OF RECIPIENTS
MOVNS TOCNT
SNDON2: SETZM TEMP1 ; GET RESPONSE
MOVE T1,NJFN
HRROI T2,TEMP1
MOVNI T3,4
SETZ T4,
SINR
ERJMP [MOVEI T1,.FHSLF ; THIS FORK
GETER ; GET LAST ERROR CODE
HRRZS T2 ; ..
CAIE T2,IOX5 ; DATA OR DEVICE ERROR??? !WHY!!!
JRST FATAL
JRST SNDON3 ] ; THINGS PROBABLY WENT OK
HLRZ T1,TEMP1
CAIE T1,4000 ; WAS IT GOOD ?
CALL SNDVR1 ; LOG ERROR AND CHECK FOR MORE ACKS
SNDON3: AOBJN TOCNT,SNDON2 ; LOOP UNILL ALL ACK's RECEIVED.
TMSG <sent OK>
; JRST DONE ; ALL DONE!
DONE: MOVE T1,NJFN ;get net JFN
CALL CLZLNK ;close net link
JFCL ;*** temp until I figure out pass-through's weirdness
TXNE F,F%ERRF ;if any errors occurred,
JRST [ TXO F,F%RNAM ;remember to rename mail file
RET] ;failure return
MOVE T1,MJFN ;mail file JFN
TXO T1,CO%NRJ ;don't release JFN
CLOSF
ERJMP [TCRLF
CALL DTSTMP
TMSG <Can't close mail file>
MOVE T1,MJFN
RLJFN
JFCL
RET]
MOVE T1,MJFN
TXO T1,DF%NRJ ;keep JFN around
DELF ;delete the unsent mail file
ERJMP [TCRLF
CALL DTSTMP
TMSG <%Can't delete mail file>
MOVE T1,MJFN
RLJFN
JFCL
RET] ;give failure return
TMSG <, deleted.
>
RETSKP
SNDVER: CALL SNDVR1 ; LOG ERROR
JRST DONE ; ABORT
SNDVR1: CLRBUF LINBUF,^D100 ;zero out LINBUF
MOVE T1,NJFN ;net JFN
HRROI T2,LINBUF ;where to read stuff
SETZB T3,T4 ;read what server has to say
SINR ; ..
ERJMP [MOVEI T1,.FHSLF ;this fork
GETER ;get last error code
HRRZS T2 ; ..
CAIE T2,IOX4 ;end of file?
CAIN T2,IOX5 ;*** temporary until I figure out
SKIPA ;*** why PSTHRU always causes IOX5's
JRST [ TCRLF
CALL DTSTMP ;time stamp log file
TMSG <%I/O error reading reply from mail server>
POP P,T1 ;throw away return
JRST SNDERR] ;clean up and return bad
SETO P4, ;flag end of file
JRST .+1] ;rejoin main flow
HLR T1,LINBUF
JUMPE T1,R ;END OF MESSAGE
TXO F,F%ERRF ; error found, flag that
TCRLF ;start message on new line
CALL DTSTMP ;date-time stamp it
MOVE T1,LOGJFN ;type it out
HRROI T2,LINBUF
SETZB T3,T4
SOUT
MOVE T1,ERRPTR ;also save in error message area
HRROI T2,LINBUF
SETZB T3,T4 ; ..
SOUT ; ..
MOVEM T1,ERRPTR ;save current error message pointer
JRST SNDVR1 ;repeat until EOF
;FATAL ERROR OCCURED DURING TRANSMISSION OF MAIL
ESEND1: SETZB T3,T4
SOUT ; OUTPUT ERROR STRING
JRST ESEND2
ESEND: SETZB T3,T4
SOUT ; OUTPUT ERROR STRING
BKJFN ; BACK UP POINTER OVER NULL
JFCL
HRLOI T2,.FHSLF ; LAST ERROR, THIS PROCESS
SETZ T3,
ERSTR
JFCL
JFCL
ESEND2: TXO F,F%ERRF ; SET FATAL ERROR FLAG
ESEND3: TCRLF
CALL DTSTMP
MOVE T1,LOGJFN ; OUTPUT ERROR MESSAGE TO LOG FILE
HRROI T2,ERRMSG
SETZB T3,T4
SOUT
JRST DONE
;FATAL NETWORK ERROR - MAIL REQUEUED
FATAL: MOVE T1,ERRPTR
HRROI T2,[ASCIZ/%VMAILR: Fatal network error: /]
SETZB T3,T4
SOUT
BKJFN ;BACK UP POINTER OVER THE NULL
JFCL
HRLOI T2,.FHSLF
SETZ T3,
ERSTR
JFCL
JFCL
TCRLF
CALL DTSTMP
MOVE T1,LOGJFN
HRROI T2,ERRMSG
SETZB T3,T4
SOUT
SNDERR: MOVE T1,NJFN ;get net JFN
CALL CLZLNK ;close it
JFCL ;what can you do?
RET ;failure return
ENDAV. ;[342] {TOCNT,ERRPTR}
ENDSV. ;[342] {HNAM}
;ROUTINE TO GET THE NAME OF WHO SENT THIS MAIL
;
;CALL:
; PTR = POINTER TO THE MAIL FILE
; CALL GETFRM
;RETURNS:
; FRMBUF= USER FROM WHO THE MAIL WAS FROM
; HSTBUF= HOST NAME FROM WHICH THE MAIL WAS SENT
GETFRM:
FIND <FROM:> ; FIND SENDER
JRST [ CALL SKPLIN ; NOT IN THIS LINE, TRY NEXT
RET ; OOPS... NO FROM
JRST GETFRM ] ; TRY NEXT LINE
CALL GETNAM ; GET USERNAME, HOST, AND PERSONAL NAME
RET ; TEXT EXHAUSTED
CLRBUF FRMBUF,20
MOVE T1,[POINT 7,FRMBUF]
HRROI T2,USER ; USERNAME FIELD
SETZB T3,T4
SOUT ; OUTPUT TO FROM BUFFER
SKIPE TEMP1 ; SKIP IF PERSONAL NAME FIELD
JRST [HRROI T2,[ASCIZ/ "/] ; START OF PERSONAL NAME
SETZB T3,T4
SOUT ; OUTPUT STARTING QUOTE
HRROI T2,TEMP1 ; OUTPUT PERSONAL NAME FIELD
SOUT
BKJFN ; BACKUP OVER SPACE
RET ; FATAL INTERNAL ERROR
MOVEI T2,42 ; OUTPUT END OF PERSONAL NAME
BOUT
CALLRET SKPLIN] ; SKIP TO NEXT LINE AND RETURN
GTFRM5: CALLRET SKPLIN ; SKIP TO NEXT LINE AND RETURN
;Routine to fix the host routing string so that VAX's can find the
;return path on reply.
;
;CALL:
; AROUTE= STRING POINTER TO ROUTING STRING USED BY THE
; ROUTER FOR THE CONNECTION
; CALL FIXHST
;USED:
; TEMP1 = TEMPORARY STORAGE FOR HOST NAME IN ROUTE
; RTENAM= TEMPORARY STORAGE FOR HOST NAME IN ROUTE
;RETURNS:
; FRMBUF= WHO MESSAGE IS FROM WITH ROUTING AS REQUIRED
; RTENAM= FINAL NODE IN ROUTING STRING
FIXHST:
STKVAR <ARPTR>
MOVE T2,AROUTE ; GET STRING POINTER TO ROUTING STRING
MOVE T1,[POINT 7,TEMP1] ; GET PLACE TO STORE STRING
CALL GRTNOD ; GET NODE NAME
JRST RSKP ; NO ERROR, IMMEDIATE NEIGHBOR
FIXHS1: MOVE T1,[POINT 7,RTENAM] ; GET PLACE TO STORE NEXT NODE NAME
CALL GRTNOD ; GET NODE NAME
JRST R ; FATAL ERROR IN ROUTING TABLE
LDB T1,T2 ; GET NEXT CHARACTER IN ROUTING TABLE
SKIPN T1 ; SKIP IF NOT ALL NODES READ
JRST FIXHS2 ; ALL NODES READ, ROUTING COMPLETE
MOVEM T2,ARPTR ; SAVE POINTER TO ROUTING STRING
HRROI T1,TEMP1 ; GET TO END OF STRING
HRROI T2,TEMP1
SETZB T3,T4
SIN
BKJFN
JFCL
HRROI T2,HSTBUF ; TACK FIRST NODE READ ONTO BEGINNING
SETZB T3,T4
SOUT ; OF HSTBUF AND PREPARE TO LOOP
HRROI T1,HSTBUF
HRROI T2,TEMP1
SETZB T3,T4
SOUT
HRROI T1,TEMP1
HRROI T2,RTENAM
SETZB T3,T4
SOUT
MOVE T2,ARPTR
JRST FIXHS1
FIXHS2: HRROI T1,HSTBUF
HRROI T2,HSTBUF
SETZB T3,T4
SIN
BKJFN
JFCL
HRROI T2,FRMBUF ; TACK ROUTING STRING ONTO BEGINNING
SETZB T3,T4
SOUT ; OF FRMBUF
HRROI T1,FRMBUF
HRROI T2,HSTBUF
SETZB T3,T4
SOUT
RETSKP
ENDSV. ;[342] {ARPTR}
;Routing to get routing node.
;Get a node name from the routing string being used.
;
;CALL:
; T1 = POINTER TO ROUTING STRING
; T2 = POINTER TO WHERE TO STORE NODE NAME
; CALL GRTNOD
;RETURNS:
; +1: ROUTING STRING EXHAUSTED
; +2: OK, NODE RETURNED
GRTNOD:
LDB T3,T2 ; GET A CHARACTER FROM ROUTING STRING
CAIN T3,0 ; SKIP IF STRING NOT EXHAUSTED
JRST R
GRTND1: IDPB T3,T1 ; PUT CHARACTER IN OUTPUT STRING
ILDB T3,T2 ; GET CHARACTER FROM ROUTING STRING
CAIN T3,0 ; SKIP IF NOT END OF STRING
JRST RSKP ; END OF STRING - RETURN SUCCESS
CAIE T3,":" ; SKIP IF A NODE SEPARATOR
JRST GRTND1 ; LOOP TILL DONE
IDPB T3,T1 ; PUT INTO OUTPUT STREAM
ILDB T3,T2 ; SHOULD BE FOLLOWED BY ANOTHER COLON
CAIE T3,":" ; CHECK FOR IT
RET ; SOMETHING IS WRONG
IDPB T3,T1 ; SAVE IN OUTPUT STRING
SETZ T3, ; OUTPUT NULL TERMINATOR FOR ASCIZ STRING
IDPB T3,T1
IBP ,T2 ; POINT TO NEXT BYTE TO GET
JRST RSKP ; NODE SEPARATOR - RETURN SUCCESS
;Routine to parse TO/CC field in the mail file and build the TO string.
; Parses one user per call and returns the user and node.
;
;CALL:
; PTR = POINTER TO THE MAIL FILE
; TOOPTR = POINTER TO TOO BUFFER
; CALL GETOCC
;VARIABLES RETURNED:
; TOOBUF = STRING OF USERS MAIL ADDRESSED TO
; HSTBUF = HOST USER IS TO RECEIVE MAIL ON
; USER = USER TO RECEIVE MAIL
; TOOPTR = POINTER TO TOOBUF
;RETURNS:
; +1: ERROR ENCOUNTERED IN MAIL FILE
; +2: T1=0 LIST EXHAUSTED OR T1<>0 VALID VARIABLES RETURNED
GETOCC:
CALL SKPBLK ; SKIP OVER WHITE SPACE
RET ; TEXT EXHAUSTED
LDB T1,PTR ; GET CHARACTER FROM MAIL FILE
CAIN T1,.CHLFD ; IS CHARACTER A LINE FEED - END OF FIELD
JRST [ CALL SKPLIN ; YES, SKIP TO NEXT LINE
RET ; INPUT TEXT EXHAUSTED
SETZ T1, ; NOTE END OF FIELD
RETSKP ] ; RETURN SUCCESS
CAIN T1,";" ; IS CHARACTER AN ADDRESS LIST TERMINATOR ?
JRST [ CALL SKPLIN ; YES, SKIP TO NEXT LINE
RET ; INPUT TEXT EXHAUSTED
SETZ T1, ; NOTE END OF FIELD
RETSKP ] ; RETURN SUCCESS
CAIN T1,"," ; IS CHARACTER A COMMA - MORE RECIPIENTS
JRST [ CALL GETCHR ; FLUSH COMMA
RET ; TEXT EXHAUSTED
CALL SKPBLK ; SKIP TO START OF NEXT RECIPIENT
RET ; TEXT EXHAUSTED
LDB T1,PTR ; GET FIRST NON-BLANK CHARACTER
CAIN T1,.CHLFD ; END OF LINE ?
JRST [ CALL SKPLIN ; YES, LIST CONT'D ON NEXT LINE
RET ; TEXT GONE - ERROR
CALL SKPBLK ; SKIP BLANKS
RET ; TEXT GONE - ERROR
JRST GETOCC ]
JRST .+1 ]
CALL GETNAM ; GET USERNAME, HOST, AND PERSON NAME
RET ; TEXT EXHAUSTED
SKIPE TOOBUF+^D25 ; SKIP IF ROOM IN "TO" BUFFER
JRST GTOCC2 ; DON'T BOTHER ADDING MORE TO STRING
SKIPN TOOBUF
JRST GTOCC1
MOVEI T1,"," ; OUTPUT A COMMA
IDPB T1,TOOPTR
MOVEI T1," " ; FOLLOWED BY A SPACE
IDPB T1,TOOPTR
GTOCC1: MOVE T1,TOOPTR ; GET DESTINATION STRING POINTER
HRROI T2,HSTBUF ; OUTPUT HOST NAME TO TOOBUF
SETZB T3,T4
SOUT
HRROI T2,USER ; OUTPUT USER NAME TO TOOBUF
SOUT
MOVEM T1,TOOPTR ; SAVE UPDATED POINTER
GTOCC2: RETSKP
;ROUTINE TO EXTRACT USER-PERSONAL-NAME, USER-NAME, HOST FROM BUFFER
;
;CALL:
; PTR = POINTER TO THE MAIL FILE
; CALL GETNAM
;VARIABLES RETURNED:
; USER = USER NAME EXTRACTED FROM MAIL FILE
; HSTBUF= HOST FOR USER NAME
; TEMP1 = USER'S PERSONAL NAME
;RETURNS:
; +1: ERROR ENCOUNTERED IN MAIL FILE
; +2: VARIABLES RETURNED
GETNAM:
ACVAR <TPTR> ; TEMPORARY POINTER TO PERSONAL NAME STRING
STKVAR <FCNT,FPTR> ; TEMPORARY POINT AND COUNT STORAGE
GTNAM1: CLRBUF TEMP1,20 ; CLEAR TEMPORARY BUFFER
MOVE TPTR,[POINT 7,TEMP1] ; CREATE IDPB POINTER TO TEMP. BUFFER
CALL SKPBLK ; SKIP OVER WHITE SPACE
RET ; TEXT EXHAUSTED
MOVEM CNT,FCNT ; SAVE COUNT
MOVEM PTR,FPTR ; AND POINTER
LDB T1,PTR ; GET A CHARACTER FROM MAIL FILE
GTNAM2: CAIN T1,":" ; ADDRESS LIST TERMINATOR?
JRST [CALL GETCHR ; YES, THROW IT AWAY
RET ; ERROR - TEXT EXHAUSTED
JRST GTNAM1 ]
CAIN T1,"<" ; SCAN FOR REAL NAME FIELD
JRST GTNAM4 ; REAL FIELD FOUND
CAIE T1,.CHLFD ; END OF LINE (LINE FEED)?
CAIN T1,.CHCRT ; END OF LINE (CARRIAGE RETURN)?
JRST GTNAM3 ; YES, MUST HAVE BEEN REAL FIELD
CAIE T1,"," ; NAME SEPARATOR?
CAIN T1,";" ; END OF ADDRESS LIST?
JRST GTNAM3 ; YES, MUST HAVE BEEN REAL FIELD
IDPB T1,TPTR ; SAVE CHAR IN CASE PERSONAL NAME FIELD
CALL GETCHR ; GET NEXT CHARACTER
RET ; ERROR, TEXT EXHAUSTED
JRST GTNAM2
GTNAM3: MOVE CNT,FCNT ; RESTORE ORIGINAL COUNT
MOVE PTR,FPTR ; RESTORE ORIGINAL POINTER
SETZM TEMP1 ; NO PERSONAL NAME FIELD
JRST GTNAM5
GTNAM4: CALL GETCHR ; GOBBLE SPACE OR "<"
RET
GTNAM5: CLRBUF USER,20 ; CLEAR USERNAME STORAGE AREA
MOVE T1,[POINT 7,USER] ; AND POINT TO IT
CALL GETTOK ; GET NAME
RET ; INVALID CHARACTER ENCOUNTERED
CALL SKPBLK ; SKIP WHITE SPACE
RET ; TEXT EXHAUSTED
FIND <AT>
RET ; NO AT ?
CALL GETNOD ; GET NODE SENT FROM
RET ; TEXT EXHAUSTED
LDB T1,PTR ; GET A CHARACTER FROM MAIL FILE
CAIN T1,">" ; END OF FIELD WITH PERSONAL NAME?
JRST GETCHR ; YES, GOBBLE ">" AND RETURN
RETSKP ; NO, RETURN SUCCESS
ENDAV. ;[342] {TPTR}
ENDSV. ;[342] {FCNT,FPTR}
;Get the subject field and store it
;
;CALL:
; PTR = POINTER TO THE MAIL FILE
; CALL GETSUB
;VARIABLES RETURNED:
; SUBBUF= STRING CONTAINING THE SUBJECT OF THE MESSAGE
;RETURNS:
; +1: ERROR ENCOUNTERED WHILE GETTING SUBJECT FIELD
; +2: OK, SUBJECT FIELD IN SUBBUF
GETSUB:
STKVAR <SCNT,SPTR> ; TEMPORARY STORAGE FOR COUNT AND POINTER
MOVEM CNT,SCNT ; SAVE COUNT
MOVEM PTR,SPTR ; AND POINTER
GETSB1: FIND <SUBJECT:> ; FIND SUBJECT FIELD
JRST [ CALL SKPLIN ; NOT IN THIS LINE, TRY NEXT
JRST NOSUB ; NO SUBJECT, THAT'S OK
JRST GETSB1 ] ; TRY NEXT LINE
CALL SKPBLK ; SKIP WHITE SPACE
RET ; TEXT EXHAUSTED
CLRBUF SUBBUF,20
MOVE T2,[POINT 7,SUBBUF] ; COPY REST OF THIS LINE INTO SUBBUF
CALL CPYLIN ; ..
CALLRET SKPLIN
NOSUB: MOVE CNT,SCNT ; RESTORE COUNT
MOVE PTR,SPTR ; AND POINTER
MOVE T1,BLNKBF
MOVEM T1,SUBBUF ; PUT A BLANK STRING IN THERE
RETSKP
ENDSV. ;[342] {SCNT,SPTR}
;Routine to get the node name from the mail file.
;
;CALL:
; PTR = POINTER TO MAIL FILE POSITIONED AT NODE NAME TO GET
; CALL GETNOD
;VARIABLES RETURNED:
; HSTBUF= NODE NAME WITH DOUBLE COLON TACKED ON THE END
;RETURNS:
; +1: ERROR PARSING NODE NAME
; +2: OK, NODE NAME IN HSTBUF
GETNOD:
MOVE T1,[POINT 7,HSTBUF] ; GET DESTINATION STRING POINTER
CALL GETTOK ; GET NODE NAME
RET ; ERROR ENCOUNTERED WHILE GETTING NODE
MOVX T2,":" ; GET A COLON
IDPB T2,T1 ; PUT IT ON THE END OF THE NODE NAME
IDPB T2,T1
SETZ T2, ; ENSURE ASCIZ STRING
IDPB T2,T1
RETSKP
;SKIP TO FIRST NONBLANK CHARACTER.
;SKIP OVER CNTRL-V'S, SPACES, AND CARRIAGE RETURNS.
;
;CALL:
; PTR = STRING POINTER TO TEXT THAT BLANKS ARE TO
; BE SKIPPED IN
; CALL SKPBLK
;RETURNS:
; +1: TEXT EXHAUSTED
; +2: OK, PTR POINTS AT FIRST NONBLANK CHARACTER
SKPBLK: LDB T1,PTR ; GET CHAR
CAIN T1,"" ; IGNORE CONTROL-V'S
JRST SKPBL1
CAIE T1,.CHCRT ; IGNORE RETURNS
CAIN T1," " ; AND BLANKS
SKIPA
RETSKP
SKPBL1: CALL GETCHR ; SKIP TO NEXT
RET ; TEST GONE, ERROR
JRST SKPBLK
;SKIP TO BEGINNING OF NEXT LINE. SKIP OVER ALL CHARACTER ON A LINE
;UNTIL A CARRIAGE RETURN IS SEEN.
;
;CALL:
; PTR = STRING POINTER TO TEXT THAT A LINE IS
; BE SKIPPED IN
; CALL SKPLIN
;RETURNS:
; +1: NO MORE TEXT LEFT
; +2: OK, PTR POINTS TO BEGINNING OF LINE
SKPLIN: LDB T1,PTR ; GET NEXT CHAR
CAIN T1,.CHLFD ; DID WE JUST EAT AN EOL?
CALLRET GETCHR ; YES, SKIP OVER IT AND RETURN
CALL GETCHR ; NO, EAT NEXT CHAR
RET ; TEXT EXHAUSTED
JRST SKPLIN ; NO, EAT ANOTHER
;COPY A LINE OF TEXT FROM ONE AREA OF MEMORY TO ANOTHER.
;
;CALL:
; T2 = STRING POINTER TO WHICH TEXT IS TO BE STORED
; CALL CPYLIN
;RETURN:
; +1: ALWAYS
CPYLIN: LDB T1,PTR ; GET A BYTE
CPYLN1: JUMPE T1,R ; RETURN IF NULL FOUND
CAIE T1,15 ; QUIT ON CR OR LF
CAIN T1,12
JRST CPYLNR
IDPB T1,T2 ; STUFF THIS ONE
CALL GETCHR ; FLUSH CHARACTER
JRST [ SETZ T1, ; ERROR - TEXT EXHAUSTED
RET ]
JRST CPYLN1
CPYLNR: SETZ T3, ; PUT NULL TERMINATOR ON STRING
IDPB T3,T2
RET
;GET A CHARACTER
;
;CALL:
; PTR = STRING POINTER FROM WHICH A CHARACTER IS TO BE TAKEN
; CALL GETCHR
;RETURNS
; +1: NO MORE TEXT LEFT
; +2: OK, CHARACTER GOTTEN IN T1
GETCHR: JUMPE CNT,R ; ANY TEXT LEFT?
ILDB T1,PTR ; YES, SNARF CHAR
SOJA CNT,RSKP ; DECREMENT COUNT AND RETURN
;SEARCH FOR A STRING. CALLED BY FIND MACRO
;
;CALL:
; T1 = POINTER TO STRING TO FIND
; CALL FINDIT
;RETURNS:
; +1: STRING NOT FOUND, PTR AND CNT PRESERVED
; +2: STRING FOUND, PTR AND CNT UPDATED TO POINT PAST STRING
FINDIT: PUSH P,PTR ; SAVE CURRENT POINTER INFO
PUSH P,CNT ; IN CASE STRING NOT FOUND
MOVE P3,T1 ; COPY T1 TO SAFE PLACE
FINDT1: LDB T2,PTR ; FETCH A CHAR FROM SOURCE
CAIL T2,"a" ; IF LOWERCASE,
CAILE T2,"z" ; ..
SKIPA ; ..
TRZ T2,40 ; THEN UPPERIZE IT
ILDB T3,P3 ; FETCH CHAR FROM TEST STRING
JUMPE T3,[ADJSP P,-2 ; TEST STRING GONE, MATCH FOUND
RETSKP] ; FLUSH OLD POINTERS AND GIVE OK RETURN
CAIL T3,"a" ; UPPERIZE IT ALSO
CAILE T3,"z" ; ..
SKIPA ; ..
TRZ T3,40 ; ..
CAME T2,T3 ; MATCHING SO FAR?
JRST FINDTX ; NO, QUIT NOW AND RESTORE POINTERS
CALL GETCHR ; SKIP TO NEXT CHAR IN MAIL
SKIPA ; NONE LEFT, FAIL
JRST FINDT1 ; MORE TO LOOK AT, KEEP GOING
FINDTX: POP P,CNT ; NO MATCH, RESTORE POINTERS
POP P,PTR ; AND GIVE BAD RETURN
RET
;GET TOKEN - ALPHANUMERIC STRING - AND STORE IN ATMBUF
;
;CALL:
; PTR = STRING POINTER TO GET TOKEN FROM
; T1 = STRING POINTER WHERE TOKEN IS TO BE STORED
; CALL GETTOK
;VARIABLES RETURNED:
; PTR = UPDATED TO REFLECT TEXT TAKEN
; T1 = UPDATED TO END OF TEXT INSERTED
;RETURNS:
; +1: TEXT EXHAUSTED
; +2: OK
GETTOK: ACVAR <PTR1,CNT1>
MOVE PTR1,T1 ; SAVE POINTER
CALL SKPBLK ; SKIP BLANKS
RET ; TEXT GONE, QUIT
MOVEI CNT1,^D132 ; MAX CHARS IN TOKEN
LDB T1,PTR ; SEE IF THIS USERNAME IS A QUOTED STRING
CAIE T1,42 ; DOES IT START WITH DOUBLE QUOTE?
JRST GETTK2 ; NO, DO ORDINARY THING
GETTK1: CALL GETCHR ; GET NEXT CHR
RET ; TEXT EXHAUSTED
CAIE T1,42 ; [342] QUOTE?
JRST GETTK0 ; [342] NO, JUST COPY
CALL GETCHR ; [342] GET NEXT CHAR
RET ; [342] NONE
CAIE T1,42 ; [342] DOUBLE QUOTE?
JRST GETTK3 ; [342] NO, THE END
GETTK0: SOJLE CNT1,R ; [342] STORE IF THERE IS ROOM
IDPB T1,PTR1 ; [342] IN WE GO!
JRST GETTK1 ; [342] KEEP GOIN
GETTK2: CALL GTALPH ; GET AN UPPERCASE ALPHANUMERIC CHAR
RET
JUMPE T1,GETTK3 ; NONALPHANUMERIC
IDPB T1,PTR1 ; STORE
SOJG CNT1,GETTK2 ; GO FOR MORE
RET ; ERROR - TOO MANY CHARACTERS
GETTK3: MOVE T1,PTR1 ; RETURN UPDATED POINTER IN T1
CAIE CNT1,^D132 ; DID WE FIND ANYTHING?
RETSKP ; YES, EVERTHING'S COOL THEN
LDB T1,PTR ; NO, 1ST CHR OF NAME BAD -- RETRIEVE IT
GETTK4: IDPB T1,PTR1 ; SAVE BAD NAME FOR ERROR MESSAGE
GETTK5: CALL GETCHR ; GET NEXT CHR OF BAD NAME
RET ; SKIP TO COMMA OR EOL THEN, THIS NAME IS BAD
CAIE T1,"," ; ..
CAIN T1,12 ; ..
RET ; OK, GIVE BAD RETURN NOW
SOJG CNT1,GETTK4 ; BE CAREFUL NOT TO OVERFLOW ATOM BUFFER
JRST GETTK5 ; FULL, JUST TOSS CHARS INTO BIT BUCKET NOW
ENDAV. ; [342] {PTR1,CNT1}
;GET ALPHNUMERIC CHARACTER. CTRL-V AND DOT ARE CONSIDER ALPHANUMERIC.
;
;CALL:
; PTR = STRING POINTER TO GET ALPHANUMERIC CHARACTER FROM
; CALL GTALPH
;RETURNS:
; +1: TEXT EXHAUSTED
; +2: T1=0 IF NEXT CHAR NO ALPHANUMERIC
; T1 CONTAINS CHAR IF ALPHANUMERIC
GTALPH: LDB T1,PTR ; SNIFF AT THIS CHAR
CAIN T1,"_" ; ALLOW UNDERSCORE
JRST GTALP1 ; ..
CAIN T1,"-" ; ALLOW HYPHENS
JRST GTALP1 ; ..
CAIE T1,"." ; ALSO DOTS
CAIN T1,"" ; AND CTRL-V'S
JRST GTALP1 ; ..
CAIL T1,"A" ; UPPERCASE ALPHABETIC?
CAILE T1,"Z" ; ..
SKIPA ; NO, CHECK SOME MORE
JRST GTALP1 ; YES, PASS IT THRU
CAIL T1,"a" ; LOWERCASE?
CAILE T1,"z" ; ..
SKIPA ; NO, CHECK MORE CASES
JRST [ TRZ T1,40 ; YES, UPPERIZE IT
JRST GTALP1] ; AND PASS IT
CAIL T1,"0" ; DIGIT?
CAILE T1,"9" ; ..
JRST [ SETZ T1, ; NO, INDICATE NONALPHANUMERIC
RETSKP]
GTALP1: PUSH P,T1 ; SAVE THIS CHAR
CALL GETCHR ; CHAR OK, SKIP TO NEXT
JFCL ; NEXT CALL WILL CATCH THIS
POP P,T1 ; RETURN CHAR SKIPPED
RETSKP
;Rename [--DECNET-MAIL--].host to ]--UNDELIVERABLE-DECNET-MAIL--[.host
; because of fatal error detected by server
; Call with JFN in T1
RNAMIT: ACVAR <SJFN> ;source JFN
STKVAR <<STR1,30>> ;where to build filespec string
HRRZ SJFN,T1 ;save JFN
SETZM STR1 ;clear string space
HRLI T1,STR1 ;zap from here
HRRI T1,1+STR1 ; to here
BLT T1,27+STR1 ; stop here
HRROI T1,STR1 ;where to build new filespec
MOVE T2,SJFN ;JFN of bad mail
MOVX T3,<1B2+1B5+JS%PAF> ;return and punctuate device and directory
JFNS ; ..
YECCH<JFNS failure at RNAMIT>
HRROI T2,[ASCIZ /]--UNDELIVERABLE-DECNET-MAIL--[./]
SETZB T3,T4 ;add filename and dot
SOUT ; ..
YECCH<SOUT failure at RNAMIT>
MOVE T2,SJFN ;now add original extension
MOVX T3,<1B11> ; ..
JFNS
YECCH<JFNS failure at RNAMIT 2>
HRROI T2,[ASCIZ /.-1/] ;new generation
SOUT
MOVX T1,GJ%SHT ;get a JFN for the new filespec
HRROI T2,STR1 ;where the spec was built
GTJFN
YECCH<GTJFN failure at RNAMIT>
MOVE T2,T1 ;new JFN
MOVE T1,SJFN ;old JFN
RNAMF ;rename it
YECCH<RNAMF failure at RNAMIT>
MOVE SJFN,T2 ;save new JFN
MOVE T1,T2 ;copy JFN
TXO T1,CF%NUD+(.FBBYV) ;don't clank disk, word to change
MOVSI T2,770000 ;generation-retention-count field
SETZ T3, ;zero (keep all generations)
CHFDB ;do it
MOVE T1,SJFN ;pass new JFN to NOTIFY
CALL NOTIFY ;notify user of lossage
MOVE T1,SJFN ;return new JFN
RET
ENDAV. ;[342] {SJFN}
ENDSV. ;[342] {STR1}
;Close net link, JFN in T1
CLZLNK: STKVAR <NJF>
MOVEM T1,NJF
TXO T1,CZ%ABT ;Abort the link so program doesn't hang
CLOSF
ERJMP CLZLN0
RETSKP ;OK, that was easy
CLZLN0: CAIN T1,DCNX11 ;if error is "link aborted",
JRST CLZLN1 ; don't complain
TCRLF
CALL DTSTMP ;time stamp log file
TMSG <%Close error for net link because:>
MOVE T1,LOGJFN
HRLOI T2,.FHSLF
ERSTR
JFCL
JFCL
CLZLN1: MOVE T1,NJF ;Try like hell to get rid of this JFN
TXO T1,CZ%ABT ; ..
CLOSF
JFCL
RET
ENDSV. ;[342] {NJF}
;Place date/time stamp in log file
DTSTMP: TXNN F,F%WEEL ;only if system scanning
RET
MOVE T1,LOGJFN ;put into log file
SETO T2, ;current date/time
SETZ T3, ; everything
ODTIM
TMSG < > ;delimit rest of line
RET
;Open SYSTEM:VMAILR.LOG
OPNLOG: MOVX T1,GJ%SHT
HRROI T2,[ASCIZ /DECNET-LOG:VMAILR.LOG/]
GTJFN ;try logical name first
ERCAL [MOVX T1,GJ%SHT
HRROI T2,[ASCIZ /SYSTEM:VMAILR.LOG/]
GTJFN
YECCH<Can't get JFN for log file>
RET]
MOVX T2,<070000,,0>!OF%RD!OF%WR!OF%APP
OPENF ;open it
ERJMP [CAIN T1,OPNX9 ;invalid simultaneous access?
JRST [ TMSG <?LOG file already open, please DISABLE first.>
HALTF
JSP CX,BEGIN]
TMSG <?Can't open log file because: >
MOVX T1,.PRIOU
HRLOI T2,.FHSLF ;type last error for this fork
ERSTR
JFCL
JFCL
HALTF
JSP CX,BEGIN]
HRRZ T1,T1 ;return JFN only
RET
;Build list of directories to scan, return how many in T1
DIRLST: TXNE F,F%WEEL ;doing whole system?
JRST DIRLS2 ;yes, handle differently
SETO T1, ;no, get our logged-in directory number
MOVE T2,[-1,,P1] ;return result in P1
MOVX T3,.JIUNO
GETJI
YECCH<GETJI failure>
MOVEM P1,DIRS ;one directory only (ours)
MOVEI T1,1 ; ..
RET
DIRLS2: MOVSI P1,-777 ;words in DECNET-MAILER.FLAGS
MOVSI P2,-MAXDIR ;words in directory list we build
SKIPE MOBY ;doing moby scan?
CALL LMOBY ;yes, set lots of bits
DIRLS3: SKIPE T1,FLGADR(P1) ;any flags set in this word?
JRST DIRLS4 ;yes, examine it
DIRLS6: AOBJN P1,DIRLS3 ;no, check next word
HRRZ T1,P2 ;number of dirs to scan
RET ;done
DIRLS4: JFFO T1,.+2 ;get bit number
JRST DIRLS6 ;no more bits in this word
HRRZ T3,P1 ;get word number
IMULI T3,^D36 ;times bits per word
ADD T3,T2 ;plus this bit position
HRLI T3,500000 ;plus magic number field
MOVEM T3,DIRS(P2) ;save directory number
MOVSI T3,400000 ;bit zero
MOVN T2,T2 ;get negative bit position
LSH T3,(T2) ;create bit we just handled
TDZ T1,T3 ;clear it
AOBJN P2,DIRLS4 ;move to next slot in directory list
CALL DTSTMP ;stamp the log file
TMSG <%Too many directories with queued mail, rebuild VMAILR with bigger MAXDIR
>
HRRZ T1,P2 ;number of dirs to scan
RET ;quit now
;Set lots of bits in MAILER.FLAGS so race conditions don't rip us off
LMOBY: ACVAR<USR>
MOVX T1,RC%AWL
HRROI T2,[ASCIZ /*/]
RCUSR ;begin stepping through all user directories
MOVE USR,T3
LMOBY1: HRRZ T1,USR ;set this bit
IDIVI T1,^D36 ;in this word
MOVX T3,1B0 ;make a bit
MOVN T2,T2 ;negate shift amount
LSH T3,(T2) ;position bit correctly
IORM T3,FLGADR(T1) ;set it
MOVX T1,RC%STP!RC%AWL
HRROI T2,[ASCIZ /*/]
MOVE T3,USR
RCUSR ;step to next user
TXNE T1,RC%NMD ;any more directories?
JRST [ GTAD ;no, get current time
MOVEM T1,FLGADR+777 ;remember time we did this
RET]
MOVE USR,T3
JRST LMOBY1
ENDAV. ;[342] {USR}
;Set up to interrupt on network topology change
TOPLGY: MOVX T1,.NDSIC ;function to set channel to interrupt on
MOVEI T2,T3 ; when net topology changes
SETZ T3, ;interrupt on channel zero
NODE ;do it
ERJMP [MOVE T1,INTRVL ;since we can't be topology-driven,
LSH T1,-2 ;quarter the sleep interval
MOVEM T1,INTRVL ; ..
RET]
MOVEI T1,.FHSLF ;set up interrupt system
MOVE T2,[LEVTAB,,CHNTAB]
SIR
EIR
MOVX T2,1B0
AIC
RET ;all set!
;Here when net topology changes
HICCUP: SKIPE SCNFLG ;is scan in progress?
DEBRK ;yes, forget it then
SETOM SCNFLG ;flag scan in progress
PUSH P,T1 ;Save registers used
PUSH P,T2
PUSH P,T3
TIME ;current TOD
MOVE T3,SCNTOD ;get TOD of last scan
SUB T1,T3 ;difference
CAMGE T1,INTVL1 ;have we waited the full 10 seconds yet?
JRST [ POP P,T3 ;No, wait some more
POP P,T2
POP P,T1
DEBRK ]
POP P,T3 ;Restore ACs saved
POP P,T2
POP P,T1
MOVEI T1,^D5000 ;wait 5 seconds for net to settle down
DISMS
CALL SCANEM ;do the heavy stuff
MOVE T1,LOGJFN ;close log file for perusers
CLOSF
JFCL
CALL OPNLOG ;open it again
MOVEM T1,LOGJFN ;save new JFN
SETZM SCNFLG ;clear scan in progress flag
DEBRK ;and return to background
;See if a host is up.
;Call: T1/ JFN of mail file (extension is host name)
; CALL HSTCHK
;Returns +1: host considered dead
; +2: host considerd up
HSTCHK: STKVAR<<STRING,<<HOSTNN+5>/5>>>
MOVE T2,T1 ;put JFN in right AC
HRROI T1,STRING ;where to put host name
MOVX T3,<1B11> ;extension (host name) only
JFNS
MOVEI T1,DEDHST ;dead host table
HRROI T2,STRING ;name of this host
TBLUK ;is it known dead?
TXNN T2,TL%EXM ;exact match for any name?
RETSKP ;no, consider it up
RET ;yes, consider it down
ENDSV. ;[342] {STRING}
;Mark a host as dead. Call with mail file JFN in T1.
HSTDED: ACVAR <Q1> ;[342] CHANGE FROM P1
MOVE Q1,T1 ;[342] copy JFN
MOVEI T1,<<HOSTNN+5>/5> ; room for a hostname and null
CALL ALLSTR ;allocate string space
RET ;ignore failures
MOVE T2,Q1 ;[342] get JFN
MOVE Q1,T1 ;[342] save string address
HRRO T1,T1 ;form string pointer
MOVX T3,<1B11> ;extension only
JFNS
MOVEI T1,DEDHST ;dead host table
HRLZ T2,Q1 ;[342] address of string
TBADD ;add to table
ERJMP .+1 ;ignore failures
RET
ENDAV. ;[342] {Q1}
;Allocate c(T1) words of storage
; Returns +1: failure
; +2: OK, address in T1
ALLSTR: MOVE T2,STRSP0 ;current free space
ADDI T2,(T1) ; plus amount requested
CAIL T2,STRSPC+STRN ;overflow?
RET ;yes, fail
MOVE T2,STRSP0 ;no, get address of this string
PUSH P,T2 ;save for a bit
SETZM (T2) ;zero it
HRLZI T3,(T2) ;build BLT pointer
HRRI T3,1(T2) ; ..
ADDI T2,-1(T1) ;last word to zero
BLT T3,(T2)
ADDM T1,STRSP0 ; ..
POP P,T1 ;return address of chunk
RETSKP
;Check to see if queued mail too old to bother with
;Call:
; T1/ JFN of queued mail
;Returns +1: too old, give up
; +2: OK
CHKOLD: MOVE T2,[1,,.FBWRT] ;get last write date
MOVEI T3,T4 ; into T4
GTFDB
GTAD ;get current time/date
SUB T1,T4 ;compute age
CAMG T1,[XSAGE] ;too old?
RETSKP ;no, send it
TCRLF ;new line
CALL DTSTMP ;time-stamp log file
TMSG <%VMAILR: Queued mail is too old -- renamed>
TXNN F,F%WEEL ;system scanning?
CALL [ TMSG < to ]--UNDELIVERABLE-DECNET-MAIL--[>
RET] ;no, be wordier for lusers
HRROI T1,ERRMSG ;no, build reason string
HRROI T2,[ASCIZ /unsent mail is over one week old./]
SETZB T3,T4
SOUT
TXO F,F%RNAM ; Remember to rename queued mail
RET ; failure return
;Notify user of lossage reported by foreign host (eg., bad username)
; Cause of error is string stored in ERRMSG
; We will construct a mail file containing the reason and
; call SNDFIL to mail it to the sucker
;Call with: JFN of [--UNDELIVERABLE-MAIL--] file in T1
NOTIFY: STKVAR <UNDJFN,CPYJFN,OURDIR,TEMPT1,<STRNG1,10>> ;undeliverable mail JFN, MAIL.CPY JFN, filename string
TXNN F,F%WEEL ;only need to do this if WHEEL
RET ;not WHEEL, user will get this typed
MOVEM T1,UNDJFN ;save UNDELIVERABLE-MAIL JFN
CALL DTSTMP ;log this notification
TMSG <Notifying user of lossage
>
; SETO T1, ;build filename string for notification file
; HRROI T2,OURDIR ; Results to OURDIR
; MOVEI T3,17
; GETJI
; YECCH<GETJI failure>
MOVX T1,RC%EMO ; EXACT MATCH ONLY
HRROI T2,[ASCIZ/PS:<SPOOL>/] ; GET DIRECTORY NUMBER OF SPOOL
SETZ T3
RCDIR
TXNE T1,<RC%NOM!RC%AMB!RC%NMD> ; SKIP IF NO ERRORS
YECCH <Rcdir failure while translating PS:<SPOOL>>
MOVEM T3,OURDIR ; SAVE DIRECTORY NUMBER
HRROI T1,STRNG1
MOVE T2,OURDIR ; Get name of forwarding directory
DIRST
YECCH <Dirst Failure>
HRROI T2,[ASCIZ/[--Decnet-Mail--]./]
SETZB T3,T4
SOUT
HRROI T2,NODNAM ; Our node name (mailing to this node)
SOUT
HRROI T2,[ASCIZ/.-1/]
SETZB T3,T4
SOUT
MOVX T1,GJ%SHT ;short form
HRROI T2,STRNG1 ;string we built
GTJFN
YECCH<Can't GTJFN for MAIL.CPY>
MOVX T2,<070000,,0>+OF%WR ;open for write, 7-bit bytes
OPENF
YECCH<Can't OPENF MAIL.CPY>
;Build message to notify user of lossage. Write the message into
; the JFN in T1.
BLDMSG: HRROI T2,[ASCIZ /Date: /]
SETZB T3,T4
SOUT ;start building text of mail
SETO T2,
MOVX T3,<OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL> ; "12 Dec 1977 1906-PST"
ODTIM
HRROI T2,[ASCIZ /
From: DECnet mail process (VMAILR)
To: /] ;more text
SETZB T3,T4
SOUT
MOVE T2,UNDJFN ;get bad mail JFN
MOVX T3,<1B5> ;output directory name only
SETZ T4,
JFNS
HRROI T2,[ASCIZ / at /] ;delimit node name
SETZB T3,T4 ; ..
SOUT
HRROI T2,NODNAM ;our node name
SETZB T3,T4 ; ..
SOUT
HRROI T2,[ASCIZ /
Subject: Undeliverable mail
I'm sorry, but your mail to /]
SETZB T3,T4 ;more noise
SOUT
MOVE T2,UNDJFN
MOVX T3,<1B11> ;type extension (host name)
SETZ T4,
JFNS
HRROI T2,[ASCIZ /, which was queued for
transmission /]
SETZB T3,T4
SOUT
MOVEM T1,TEMPT1 ; Save notification JFN for a moment
HRRZ T1,UNDJFN ; JFN of queued mail
MOVE T2,[1,,.FBWRT] ; Get last write date
MOVEI T3,T2 ; Into T2
GTFDB ; ..
MOVX T3,<OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL> ; "12 Dec 1977 1906-PST"
MOVE T1,TEMPT1 ; Write date/time into message
ODTIM
HRROI T2,[ASCIZ /, encountered problems because:
/]
SETZB T3,T4
SOUT ;header now done
HRROI T2,ERRMSG ;now type the error message
SOUT
HRROI T2,[ASCIZ /
You may use the REPAIR command in MS to correct the problem
and resubmit the mail. If the problem was a user or users being
over quota, then all other users have received copies of the message.
Otherwise, nobody on the host named above has received the message.
--------
/]
SOUT
CLOSF
YECCH<Can't CLOSF MAIL.CPY>
MOVE T4,[IORM T3,FLGADR(T1)] ; light it (in case not lit now)
HRRZ T1,OURDIR ;get directory number
IDIVI T1,^D36 ;get word number in DECNET-MAILER.FLAGS
MOVSI T3,400000 ;bit zero
MOVN T2,T2 ;negate bit number
LSH T3,(T2) ;position bit correctly
XCT T4 ; light or clear it appropriately
RET
ENDSV. ;[342] {UNDJFN,CPYJFN,OURDIR,TEMPT1,STRNG1}
;Table of reasons for disconnection from net link
REASON: [ASCIZ /No special error/] ;0
[ASCIZ /Resource allocation failure/] ;1
[ASCIZ /Destination node does not exist/] ;2
[ASCIZ /Node shutting down/] ;3
[ASCIZ /Destination process does not exist/] ;4
[ASCIZ /Invalid name field/] ;5
[ASCIZ /Destination process queue overflow/] ;6
[ASCIZ /Unspecified error/] ;7
[ASCIZ /Third party aborted the logical link/] ;8
[ASCIZ /User abort/] ;9
FUNNY ;10
[ASCIZ /Undefined error code/] ;11
FUNNY ;12
FUNNY ;13
FUNNY ;14
FUNNY ;15
FUNNY ;16
FUNNY ;17
FUNNY ;18
FUNNY ;19
FUNNY ;20
[ASCIZ /Connect initiate with illegal destination address/] ;21
FUNNY ;22
FUNNY ;23
[ASCIZ /Flow control violation/] ;24
FUNNY ;25
FUNNY ;26
FUNNY ;27
FUNNY ;28
FUNNY ;29
FUNNY ;30
FUNNY ;31
[ASCIZ /Too many connections to node/] ;32
[ASCIZ /Too many connections to destination process/] ;33
[ASCIZ /Access not permitted/] ;34
[ASCIZ /Logical link services mismatch/] ;35
[ASCIZ /Invalid account/] ;36
[ASCIZ /Segment size too small/] ;37
[ASCIZ /Process aborted/] ;38
[ASCIZ /No path to destination node/] ;39
[ASCIZ /Link aborted due to data loss/] ;40
[ASCIZ /Destination logical link address does not exist/] ;41
[ASCIZ /Confirmation of disconnect initiate/] ;42
[ASCIZ /Image data field too long/] ;43
NREASN==.-REASON
FUNNY: ASCIZ /Unknown DECnet disconnect reason code/
END BEGIN