Trailing-Edge
-
PDP-10 Archives
-
tops20_v7_0_tcpip_distribution_tape
-
tcpip-sources/mmailr-armail.mac
There are 2 other files named mmailr-armail.mac in the archive. Click here to see a list.
TITLE ARMAIL - Mail sending routines for Archive system
SUBTTL Vince Fuller/VAF/MRC
SALL
SEARCH MONSYM,MACSYM
.REQUIRE SYS:MACREL
IFNDEF OT%822,OT%822==:1
STDAC.
.MLOFL==:1 ;Ignored, kept for compatibility
.MLNFL==:2 ;Ditto
LCLHST: BLOCK 10 ;Name of the local host
LCLUSR: BLOCK 10 ;Current user name
M1NAME: ASCIZ/MAILQ:[--QUEUED-MAIL--].NEW-/ ;First part of MMAILR name
M2NAME: ASCIZ/-ARMAIL.-1/ ;Second part
MOPTST: ASCIZ/=DELIVERY-OPTIONS:MAIL
/
MFNAME: ASCIZ/SYSTEM:FAILED.MAIL.-1/ ;Where to put failed mail
SUBTTL MLTLST - Send mail to a list of recepients
;Accepts: T1/ pointer to 3 word block
; 0: Byte pointer to recepient list
; 1: Byte pointer to subject field
; 2: Byte pointer to text field
; T2/ .MLOFL or .MLNFL (ignored, but kept for compatability)
MLTLST::SAVEAC <T1,T2,T3,T4,Q1,Q2> ;Some ACs to work with
STKVAR <<NAMBUF,20>,<USRNAM,10>,<HSTNAM,10>,MLFJFN>
SKIPN LCLUSR ;Do we have a local user string yet?
CALL MLINIT ;Nope - get it now
MOVE Q2,T1 ;Save block pointer temporarily
GTAD% ;Get current time
MOVE Q1,T1 ;Save it for a sec
HRROI T1,NAMBUF ;Point at name buffer
HRROI T2,M1NAME ;First part of file name
SETZ T3,
SOUT% ;Copy first part of name
MOVE T2,Q1 ;Current time
MOVEI T3,^D8 ;In octal
NOUT% ;Append to name
ERJMP .+1
HRROI T2,M2NAME ;Second part of name
SETZ T3,
SOUT% ;Append it on
MOVX T1,<GJ%SHT!GJ%FOU> ;Short form, use next generation
HRROI T2,NAMBUF ;Where we put the name
GTJFN% ;Attempt GTJFN
ERJMP MFAIL ;Failed... Maybe do something with mail
MOVEM T1,MLFJFN ;Save the JFN
MOVX T2,FLD(7,OF%BSZ)!OF%WR
OPENF% ;Try to open it
ERJMP MFAIL0 ;Handle it
MOVEI T2,.CHFFD ;^L at beginning
BOUT%
HRROI T2,MOPTST ;Options part of mail file header
SETZ T3,
SOUT% ;Write it first
ERJMP MFAIL1
MOVE Q1,(Q2) ;Get pointer to recepient list
TLC Q1,-1 ;If it was -1, then 0
TLCN Q1,-1 ;Skip & restore if not -1
HRLI Q1,440700 ;Finish fixing it
DO.
SETZM USRNAM ;No user string yet
SETZM HSTNAM ;Or host string
MOVEI T4,USRNAM ;Get username address
HRLI T4,(POINT 7,) ;Make a byte ptr
DO.
ILDB T2,Q1 ;Get next char from recepient list
CAIE T2,"@" ;Did we hit host name delimiter?
CAIN T2,"," ;Or a list separator?
IFSKP.
ANDN. T2 ;No, how about end of list?
CAIN T2," " ;Or space separator?
ANSKP.
IDPB T2,T4 ;No to all, add char to username string
LOOP. ;And loop for next
ENDIF.
ENDDO.
SETZ T3,
IDPB T3,T4 ;Terminate username string
CAIE T2,"@" ;Did the username end in an @?
IFSKP. ;Yes - host name coming, then
MOVEI T4,HSTNAM ;Address of host name buffer
HRLI T4,(POINT 7,) ;Make a byte ptr
DO.
ILDB T2,Q1 ;Get next char from recepient string
CAIE T2,"," ;Comma list separator?
CAIG T2," " ;Or space separator/end of string?
EXIT. ;Done with host name, then
IDPB T2,T4 ;Put character into host name string
LOOP. ;And loop for next char
ENDDO.
SETZ T3,
IDPB T3,T4 ;Terminate string with a null
ENDIF.
MOVE T4,T2 ;Remember terminating character
MOVEI T2,.CHFFD ;Control-L
BOUT% ;Put into mail file
HRROI T2,HSTNAM ;Host name of address
SKIPN HSTNAM ;Null?
HRROI T2,LCLHST ;Yes - use local host name
SETZ T3,
SOUT% ;Write host name to file
HRROI T2,[ASCIZ/
/]
SOUT%
HRROI T2,USRNAM ;Username of address
SOUT%
HRROI T2,[ASCIZ/
/]
SOUT%
JUMPN T4,TOP. ;Loop until at end of recepient list
ENDDO.
HRROI T2,[BYTE(7).CHFFD,.CHCRT,.CHLFD,"D","a","t","e",":"," ",0]
SETZ T3,
SOUT%
SETO T2, ;Current time
MOVX T3,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; RFC 822 standard date/time
ODTIM% ;Write it
HRROI T2,[ASCIZ/
From: /]
SETZ T3,
SOUT%
HRROI T2,LCLUSR ;My user name
SOUT%
HRROI T2,[ASCIZ/@/]
SETZ T3,
SOUT%
HRROI T2,LCLHST ;Local host name
SETZ T3,
SOUT%
HRROI T2,[ASCIZ/
Subject: /]
SOUT%
MOVE T2,1(Q2) ;Get subject ptr from argument block
SOUT%
HRROI T2,[ASCIZ/
To: /]
SOUT%
MOVE T2,(Q2) ;Get recepient ptr from arg block
SOUT%
HRROI T2,[ASCIZ/
/]
SOUT%
MOVE T2,2(Q2) ;Get pointer to message text
SOUT%
CLOSF% ;And close file
ERJMP CLFAIL ;Close failed - RLJFN
RET
;Come here to try and write the message to a failed mail file
MFAIL1: MOVE T1,MLFJFN ;Get back jfn
CLOSF% ;Try to close
TRNA ;Failed - try RLJFN
JRST MFAIL ;Enter routine for handling failure
MFAIL0: MOVE T1,MLFJFN
RLJFN% ;First release jfn in T1
ERJMP .+1 ;Ignoring errors
MFAIL: MOVX T1,GJ%SHT!GJ%FOU ;Short form, next generation
HRROI T2,MFNAME ;Name of failed mail file
GTJFN% ;Try for it
RET ;Failed - give up
MOVEM T1,MLFJFN ;Save this JFN
MOVX T2,FLD(7,OF%BSZ)!OF%WR
OPENF% ;Try to open
IFSKP.
HRROI T2,[ASCIZ/To: /]
SETZ T3,
SOUT%
HRROI T2,USRNAM ;aUser name string
SOUT%
HRROI T2,[ASCIZ/@/]
SOUT%
HRROI T2,HSTNAM ;Host name to send to
SKIPN HSTNAM ;Anything there?
HRROI T2,LCLHST ;Use local host
SOUT% ;Write it
HRROI T2,[ASCIZ/
Subject: /]
SOUT%
MOVE T2,1(Q2) ;Get pointer from block
SOUT%
HRROI T2,[ASCIZ/
/]
SOUT%
MOVE T2,2(Q2) ;Text pointer
SOUT%
IORX T1,CO%NRJ ;Close, but don't release
CLOSF% ;Try to close
ANSKP.
HRLI T1,.FBBYV ;FDB word to change
MOVX T2,<FB%RET> ;Retention count
SETZ T3, ;Want infinite
CHFDB% ;Set it
ERJMP .+1 ;Shouldn't happen...
RLJFN% ;And dispose of the JFN
ERJMP .+1
RET ;done
ELSE.
CLFAIL: MOVE T1,MLFJFN ;Get back JFN
RLJFN% ;And dispose of it
ERJMP .+1
RET
ENDIF.
SUBTTL MLTOWN - Send mail to owner of directory
;Accepts: T1/ pointer to 3 word block
; 0: directory # where file resides
; 1: byte pointer to subject field
; 2: byte pointer to text field
; T2/ .MLOFL or .MLNFL (ignored, but kept for compatability)
;
;Finds owner of directory (if possible) and calls MLTLST to send to him.
;The "Owner" of a directory is defined as follows:
; For a non files-only directory, it is the directory itself.
; For a files-only directory, it is determined by:
; 1) Finding the first superior that is not files-only
; or
; 2) Using the owner group list of the directory or the first superior
; that has an owner group list if the directory has none.
MLTOWN::SAVEAC <T1,T2,T3,T4,Q1>
STKVAR <<DIRBLK,.CDDGP+1>,<OGPBLK,25>,<OWNLST,100>,<DIRNAM,12>>
MOVE Q1,T1 ;Save argument block ptr
HRROI T1,DIRNAM ;Set up initial name
MOVE T2,(Q1) ;Get directory number
DIRST%
ERJMP MLTODF ;Shouldn't happen...
MOVE T1,(Q1) ;Get directory number from argblk
DO.
SETZM DIRBLK ;Clear first word
MOVSI T2,DIRBLK ;Address of GTDIR block
HRRI T2,1+DIRBLK ;Next word
BLT T2,.CDDGP+DIRBLK ;Clear out the block
MOVEI T2,DIRBLK ;Address of GTDIR block
MOVEI T3,.CDDGP+1 ;Length of GTDIR block
MOVEM T3,(T2) ;Set it
MOVEI T3,100 ;Length of owner (directory) group block
MOVEM T3,OGPBLK ;Set it
MOVEI T3,OGPBLK ;Address of owner (directory) group block
MOVEM T3,.CDDGP(T2) ;Set it in DIRBLK
GTDIR% ;Get info about this directory
ERJMP MLTODF ;Default it, then
MOVE T2,.CDMOD(T2) ;Get mode word
IFXE. T2,CD%DIR!CD%RLM ;Not files- or mail-only?
MOVE T2,T1 ;Directory number
HRLI T2,500000 ;Make user name
HRROI T1,OWNLST ;Point at string buffer
DIRST% ;Translate
ERJMP MLTOFO ;Strange error that can occur...
JRST MLTODN ;Go send it
ENDIF.
MLTOFO: MOVE T4,OGPBLK ;Get directory group list
SUBI T4,1 ;Make count
JUMPE T4,MLTONO ;No owners...
MOVEI T1,OWNLST ;Owner list address
HRLI T1,(POINT 7,) ;Make a byte ptr
SETZM OWNLST ;Say none yet
DO.
MOVEI T2,OGPBLK ;Get owner group address
ADD T2,T4 ;Add offset
MOVE T2,(T2) ;Get the owner
TXZN T2,400000 ;Really an owner?
IFSKP. ;Yes
MOVEI T3,"," ;Separator...
SKIPE OWNLST ;Is this the first one?
IDPB T3,T1 ;Nope - add a separator
HRLI T2,500000 ;Make a user number
DIRST% ;Append on to the owner list string
ERJMP .+1 ;Shouldn't fail (and we don't care if it does)
ENDIF.
SOJG T4,TOP. ;Loop for all directory group entries
ENDDO.
SKIPE OWNLST ;Did we set up owners?
JRST MLTODN ;OK - send mail to them
MLTONO: MOVEI T1,DIRNAM ;Point at directory name
HRLI T1,(POINT 7,) ;Make byte ptr
SETZ T2, ;Where we will save the byte ptr
DO.
ILDB T3,T1 ;Read a char
CAIN T3,"." ;Found dot?
MOVE T2,T1 ;Remember where
JUMPN T3,TOP. ;Loop if no null
ENDDO.
IFN. T2 ;Found any dots?
MOVEI T4,76 ;Close-bracket
DPB T4,T2 ;Terminate directory name
IDPB T3,T2 ;End the string.
SETZB T1,T3
HRROI T2,DIRNAM
RCDIR% ;Translate directory name to number
ERJMP MLTODF ;Failed - quit
IFXE. T1,RC%NOM!RC%AMB ;Really ok?
MOVE T1,T3 ;Put in right AC
LOOP. ;And try again
ENDIF.
ENDIF. ;At top level - fall through to default
ENDDO.
MLTODF: HRROI T1,OWNLST ;Point at owner/recepient list
HRROI T2,[ASCIZ/GRIPE/] ;Default it
SETZ T3,
SOUT% ;Set it up
MLTODN: MOVE T1,Q1 ;Get back block address
MOVEI T3,OWNLST ;Address of owner/recepient list
HRLI T3,(POINT 7,) ;Make a byte pointer
MOVEM T3,(T1) ;Set it in the argument block
CALLRET MLTLST ;Go send mail
SUBTTL Initialization & dummy MLDONE
;MLINIT initializees the ARMAIL package. Sets up LCLUSR and LCLHST to be the
;local username (person running program) and local host, respectively. MLINIT
;should be called before any use is made of ARMAIL. It will be called from
;MLTLST if LCLUSR is not yet defined.
MLINIT::SAVEAC <T1,T2,T3> ;Save temps
GJINF% ;Get job info
MOVE T2,T1 ;Get user number here
HRROI T1,LCLUSR ;Point at buffer
DIRST% ;Translate me
ERJMP .+1 ;This should never fail
HRROI T1,LCLHST ;Where to put name
CALL $GTLCL## ;Try to get local host name
SETZM LCLHST ;No local host name, then
RET
;MLDONE used to do some random stuff to clean up after using ARMAIL. Since
;none of that is necessary, it is now a NOP.
MLDONE::RET ;Do nothing.
END