Trailing-Edge
-
PDP-10 Archives
-
T10_T20_MS_V10_SRCS_830128
-
dmailr.mac
There are no other files named dmailr.mac in the archive.
;GEM:<LCAMPBELL>DMAILR.MAC.195 7-Jun-82 11:16:27, Edit by LCAMPBELL
; Move flags page to page 600 to avoid DNINI clobberage (DNINI uses
; page 600 as buffer for DECNET-HOSTS.TXT)
;GEM:<LCAMPBELL>DMAILR.MAC.193 18-May-82 17:51:16, Edit by LCAMPBELL
; Bump version number to reflect newer DNCONN
;GEM:<LCAMPBELL>DMAILR.MAC.192 4-Feb-82 13:29:43, Edit by LCAMPBELL
;Reduce string space again, the host table is in DNCONN, not DMAILR, now
;GEM:<LCAMPBELL>DMAILR.MAC.191 29-Oct-81 17:04:42, Edit by LCAMPBELL
; Increase string space from 10 pages to 40 pages (ENet is getting big)
;<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 DMAILR - DECNET Mail User Process
SUBTTL Larry Campbell
SEARCH MACSYM,MONSYM,DNCUNV
SALL
.DIRECTIVE FLBLST
.REQUIRE SYS:MACREL,DNCONN
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
CX=16
P=17
.VER==5
.EDT==^D195
LOC 137
EXP <.VER>B11+.EDT
RELOC
;MACROS
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 <?DMAILR: >
MOVE T1,LOGJFN
HRROI T2,[ASCIZ \STRING\]
SETZB T3,T4
SOUT
TMSG < because: >
MOVE T1,LOGJFN
HRLOI T2,.FHSLF
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 <?DMAILR: 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 <DMAILR version VER(EDT) started
>>
;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==666 ;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==10000 ;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)
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
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]
SETZB F,NODNAM ;clear node name, flag bits
MOVE T1,[NODNAM,,NODNAM+1]
BLT T1,NODNAM+4 ; ..
MOVEI T1,.PRIOU ;assume logging to TTY
MOVEM T1,LOGJFN
MOVEI T1,.FHSLF ;get our capabilities
RPCAP
MOVE T1,[SIXBIT /DMAILR/] ; assume nonprivileged name
TXNE T3,SC%WHL!SC%OPR ; WHOPER?
JRST [ MOVE T1,[SIXBIT /SDMALR/] ; 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: SETZM DNBLK ; Zero arg block
MOVE T1,[DNBLK,,DNBLK+1]
BLT T1,DNBLK+DN.INF
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]
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<IFN,JFN> ;indexable file handle,JFN
TRVAR<<STRING,16>,DIRNUM,<DIRSTR,^D8>> ;fspec string, dirnum, dir str
TXZ F,F%STAY ;assume MAILER.FLAG bit won't stay lit
MOVEM T1,DIRNUM ;preserve directory number
MOVE T2,T1 ;get directory name
HRROI T1,DIRSTR ;put it here
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
FILUP2: HRROI T1,STRING ;where to build filespec string
HRROI T2,[ASCIZ /PS:</] ;first part of filespec
SETZB T3,T4
SOUT ;start building filespec
HRROI T2,DIRSTR ;directory string
SOUT
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 IFN,T1 ;save indexable file handle
CALL DTSTMP ;time stamp log file
TMSG <Unspooling mail from >
MOVE T1,LOGJFN ;where to put username
HRROI T2,DIRSTR ;username string
SETZB T3,T4
SOUT
TCRLF
MOVE T1,IFN ;get JFN of mail back
JRST FILUP1 ;go to it
FILOOP: MOVE T1,IFN ;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
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?
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
;Send one file to appropriate host, JFN of file in T1
; P4 negative flags end of file
; Returns: +1: failure
; +2: success
SNDFIL: STKVAR <ERRPTR,MJFN,NJFN,<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
SETZM ERRMSG ; ..
MOVE T1,[ERRMSG,,ERRMSG+1]
BLT T1,ERRMSG+NERMSG-1 ;zero error message save area
HRROI T1,ERRMSG ;init pointer to error message string
MOVEM T1,ERRPTR ; ..
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 >
HRROI T1,HNAM ; Where to build hostname string
MOVE T2,MJFN ;mail file JFN
MOVX T3,<1B11> ;type extension only
SETZ T4,
JFNS
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]
SETZM DNBLK ; Zero DNCONN arg block
MOVE T1,[DNBLK,,DNBLK+1]
BLT T1,DNBLK+DN.INF
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,^D201 ; Object type 201 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
SETZ P4, ; Success - clear end of file flag
HRROI T2,[ASCIZ /Sender: /]
SETZB T3,T4
SOUT ;A little insurance against forgeries here
ERJMP ESEND
HRROI T2,DIRSTR
SOUT
ERJMP ESEND
HRROI T2,[ASCIZ / at /]
SOUT
ERJMP ESEND
HRROI T2,NODNAM
SOUT
ERJMP ESEND
HRROI T2,[ASCIZ /
/]
SOUT
ERJMP ESEND
; JRST SNDFL2 ; Go send the message
SNDFL2: MOVE T1,MJFN ;mail file JFN
HRROI T2,LINBUF ;line buffer
MOVEI T3,^D100 ;maximum byte count
MOVEI T4,12 ;end on line feed
SIN
ERJMP [PUSH P,T2 ;save string pointer
MOVEI T1,.FHSLF ;this fork
GETER ;get last error code
HRRZS T2 ; ..
CAIE T2,IOX4 ;end of file?
JRST [ TMSG <%I/O error reading from mail file>
POP P,T2 ;flush stack
JRST SNDERR] ;clean up and return failure
SETO P4, ;flag end of file
POP P,T2 ;restore string pointer
MOVEI T1,12 ;insure ends with line feed
IDPB T1,T2 ; ..
JRST .+1]
MOVE T1,NJFN ;net JFN
HRROI T2,LINBUF
MOVEI T3,^D100 ;max byte count
MOVEI T4,12
SOUTR ;shove it down the net's throat
ERJMP ESEND
JUMPGE P4,SNDFL2 ;repeat for all lines in file
MOVE T2,[POINT 7,[177],28] ;point to a rubout
MOVNI T3,1 ;send one byte
SETZ T4,
SOUTR ;SOUTR to force net output
ERJMP ESEND
SETZ P4, ;reset EOF flag
JRST SNDFL4 ; go read what other end has to say
ESEND: TCRLF
CALL DTSTMP
TMSG <%Can't output to net link because: >
MOVE T1,LOGJFN
HRLOI T2,.FHSLF
SETZ T3,
ERSTR
JFCL
JFCL
MOVE T1,NJFN ; get file status of net link
GTSTS
TXZ T2,GS%ERR ; clear error bit
STSTS ; ..
JFCL ; fall through to try to read error message
; ..
; ..
SNDFL4: SETZM LINBUF ;zero out LINBUF
MOVE T1,[LINBUF,,LINBUF+1]
BLT T1,LINBUF+^D99
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>
JRST SNDERR] ;clean up and return bad
SETO P4, ;flag end of file
JRST .+1] ;rejoin main flow
CALL CHKERR ;check for error message
JRST [ TXO F,F%ERRF ; error found, flag that
TCRLF ;start message on new line
CALL DTSTMP ;date-time stamp it
JRST .+1]
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
JUMPGE P4,SNDFL4 ;repeat until EOF
; ..
; ..
;All done - close net link and delete queued mail
TXNN F,F%PACK ; If no positive ack
TXNE F,F%ERRF ; and no negative ack either
SKIPA ; ..
JRST [ TCRLF ; then assume not delivered
CALL DTSTMP
TMSG <%No acknowledgement received, requeuing.>
JRST SNDERR]
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
SNDERR: MOVE T1,NJFN ;get net JFN
CALL CLZLNK ;close it
JFCL ;what can you do?
RET ;failure return
;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
;Close net link, JFN in T1
CLZLNK: STKVAR <NJF>
MOVEM T1,NJF
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
;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
JFCL
TMSG < > ;delimit rest of line
RET
;Check message returned from server for error indications (?)
;Returns: +1: there were errors
; +2: ok, no errors
CHKERR: DMOVE T1,LINBUF ; See if this is a positive ack
CAMN T1,[ASCII /sent /]
CAME T2,[ASCIZ /OK/]
SKIPA
TXO F,F%PACK ; It is, flag that we found it
MOVE T4,[POINT 7,LINBUF]
MOVEI T3,^D500 ;maximum bytes to check
CHKER1: ILDB T1,T4 ;get a byte
JUMPE T1,RSKP ;end of text, no errors found
CAIN T1,"?" ;error?
JRST R ;yes, return error found
SOJG T3,CHKER1 ;no, keep looking
RETSKP
;Open SYSTEM:DMAILR.LOG
OPNLOG: MOVX T1,GJ%SHT
HRROI T2,[ASCIZ /DECNET-LOG:DMAILR.LOG/]
GTJFN ;try logical name first
ERCAL [MOVX T1,GJ%SHT
HRROI T2,[ASCIZ /SYSTEM:DMAILR.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 DMAILR 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
;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
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
;Mark a host as dead. Call with mail file JFN in T1.
HSTDED: ACVAR<P1>
MOVE P1,T1 ;copy JFN
MOVEI T1,<<HOSTNN+5>/5> ; room for a hostname and null
CALL ALLSTR ;allocate string space
RET ;ignore failures
MOVE T2,P1 ;get JFN
MOVE P1,T1 ;save string address
HRRO T1,T1 ;form string pointer
MOVX T3,<1B11> ;extension only
JFNS
MOVEI T1,DEDHST ;dead host table
HRLZ T2,P1 ;address of string
TBADD ;add to table
ERJMP .+1 ;ignore failures
RET
;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 <%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: TRVAR <UNDJFN,CPYJFN,<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
>
HRROI T1,STRNG1 ;build filename string for notification file
HRROI T2,[ASCIZ /[--NOTIFICATION--]./]
SETZB T3,T4
SOUT
HRROI T2,NODNAM ;our node name (mailing to this node)
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>
CALL BLDMSG ;build lossage message
TXO T1,CO%NRJ ;close, but keep JFN
CLOSF
YECCH<Can't CLOSF MAIL.CPY>
; ..
; ..
MOVEM T1,CPYJFN ;save JFN of notification
CALL SNDFIL ;send it to the user
JRST [ CALL DTSTMP ;stamp the log file
TMSG <Can't notify user >
MOVE T1,LOGJFN ;where to type username
MOVE T2,UNDJFN ;bad mail file
MOVX T3,<1B5> ;directory name only
SETZ T4,
JFNS ;put name into log file
TMSG < about undelivered mail.
>
MOVE T1,CPYJFN ;JFN of MAIL.CPY
TXO T1,CO%NRJ ;keep it lying around a bit
CLOSF
JFCL ;just do our darndest
MOVE T1,CPYJFN
DELF ;delete the crud
JFCL
RET]
MOVE T1,CPYJFN ;release the notification file JFN
RLJFN
JFCL
RET
;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
JFCL ;this can't happen
HRROI T2,[ASCIZ /
From: DECNET mail process
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
PUSH P,T1 ; Save notification JFN for a moment
MOVE 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"
POP P,T1 ; Write date/time into message
ODTIM
JFCL ;this can't happen
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
RET ;return
;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