Trailing-Edge
-
PDP-10 Archives
-
T10_DECMAIL_MS_V11_FT1_860414
-
10,7/mail/ms/msdlvr.mac
There are 7 other files named msdlvr.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
; 1983,1984,1985,1986 Maynard, Massachusetts, USA
TITLE MSDLVR - MS module that actually initiates mail delivery
SEARCH GLXMAC,MSUNV
PROLOG (MSDLVR)
CPYRYT
MSINIT
.DIRECTIVE FLBLST
SALL
;Define globals
GLOBS ; Storage
GLOBRS ; Routines
;Routines defined herein
INTERNAL DELIVR, BLDHDR, SAVMSG, SAVMS0, SAVDRF
;Routines defined elsewhere
;MSLCL.MAC
EXTERNAL SNDLCL
;MSNET.MAC
EXTERNAL SNDNET
TOPS20< EXTERNAL MAIFLG >
;MSTXT.MAC
EXTERNAL TXTOUT
;MSUTL.MAC
EXTERNAL COUNTS, CRIF, FSCOPY, MOVST1, MOVSTR, TSOUT, UPDTOR
;Global data items defined elsewhere
;MS.MAC
EXTERNAL PERSON, MYHSPT, MYHDPT, RPRHNP, FRMLCL ;
;MSHTAB.MAC
EXTERNAL HOSTAB
SUBTTL DELIVR - Initiate mail delivery
DELIVR: PUSH P,L ; [JCR]Destroyed by SNDLCL
CALL SNDLCL ; Send local mail if any
JRST [ POP P,L ; [JCR]Restore L
RET ] ; [JCR]Failure, pass it on
POP P,L ; Restore l
Repeat 0,<
TXNE F,F%XMLR ; XMAILR support?
JRST [ CALL XMAILR ; Yes, queue XMAILR mail
RET ; Pass failure on up
JRST SNDMS2] ; Light mailer flags and finish
>;End TOPS20
DELIV0: HLRZ W,TOPTRS ; Get CC list
JUMPE W,SNDMS1 ; None
MOVEI U,TCPAG+NTCENT ; Start of list
CALL SNDNET ; Send it off
RET ; Failure, pass it on
SNDMS1: HRRZ W,TOPTRS ; Get TO list
MOVEI U,TCPAG
CALL SNDNET ; Send to list
RET ; Failure, pass it on
TOPS10< RETSKP > ; We must be done here
TOPS20< TXNN F,F%QDEC ; Any DECNET mail queued?
JRST SNDMS2 ; No
HLLZ C,@HOSTAB ; Yes - clear done flags in host table
MOVN C,C ; Form AOBJN pointer to host table
HRR C,HOSTAB ; ..
ADDI C,1 ; Skip header word
MOVX B,NT%DON ; ..
HRRZ A,(C) ; Get node block pointr
ANDCAM B,N.FLGS(A) ; Clear "done" flag
AOBJN C,.-2 ; ..
SNDMS2: TXNN F,F%QDEC!F%QARP!F%QXML ; Any queued mail at all?
RETSKP ; No, just return OK
CALLRET MAIFLG ; TOPS20: set mailer flags and return
>;End TOPS20
SUBTTL Sending subroutines - BLDHDR - build message header
;Build text of headers at HDRPAG - returns with OO pointing to last byte
; Called only for netmail (because in local mail MAILER builds header)
; F%DNNM = queueing DECNET mail, so use DECNET name of this host
BLDHDR: MOVE A,[POINT 7,HDRPAG]
MOVEI B,[ASCIZ /Date: /]
TXNE F,F%REDI
MOVEI B,[ASCIZ /Resent-date: /]
CALL MOVSTR
TOPS20<
SETO B, ; Current time
MOVX C,<OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL>
ODTIM ; "12 Dec 1977 1906-PST"
>;End TOPS20
TOPS10<
MOVEM A,UPDPTR ; Because of GLXLIB AC conventions
$TEXT (UPDTOR,<^H[-1]^A>) ; Current time
MOVE A,UPDPTR ; Put byte pointer back where MOVSTx expect it
>;End TOPS10
MOVEI B,[ASCIZ /
From: /]
TXNE F,F%REDI
MOVEI B,[ASCIZ /
Resent-from: /]
CALL MOVSTR
SKIPN B,PERSON ; Any personal name string?
JRST BLDHD0 ; No, skip this
HRLI B,(POINT 7,) ; Yes, form kosher bp
CALL SPCCHK ; Any special characters here?
JRST [ MOVEI C,42 ; Yes, open quote
IDPB C,A ; ..
CALL MOVSTR ; Move the personal name
MOVEI C,42 ; Close quote
IDPB C,A ; ..
JRST BLDH00]
CALL MOVSTR ; ..
BLDH00: MOVEI B,[ASCIZ / </] ; And delimit real address with wedges
CALL MOVSTR ; ..
BLDHD0: MOVEI B,MYDIRS ; My address
CALL MOVSTR ; Put it in
MOVEI B,MYHNAM ; Add "at FOO"
TXNE F,F%DNNM ; Writing DECNET or ARPANET mail?
MOVEI B,MYHDEC ; DECNET -- use DECNET name for this host
TXNE F,F%XMTO ; XMAILR-style hostnames?
JRST [ MOVEI B,[ASCIZ /@/]
CALL MOVSTR ; Yes, must delimit hostname
MOVEI B,177 ; with rubouts
IDPB B,A ; ..
MOVE B,[POINT 7,MYHNAM,27]
CALL MOVST1
MOVEI B,[BYTE (7) 177 (29) 0]
JRST .+1]
CALL MOVSTR ; ..
MOVEI B,[ASCIZ />/] ; Wedge might be needed
SKIPE PERSON ; Doing personal name?
CALL MOVSTR ; Yes, add the wedge
MOVEM A,OBPTR ; Get pointer set up right
CALL MOVTO ; Do to
CALL MOVCC ; and CC
TXO F,F%F1 ; Want crlf
CALL MOVOPT ; Move header options
TXNE F,F%REDI ; Don't move subject for REDISTRIBUTEed msgs
JRST BLDHD1 ; nor message-ID nor reply-to
CALL MOVSUB ; Insert subject
CALL MOVMID ; Move message-ID
MOVEI B,REPLIN ; Any reply lines?
SKIPE REPLIN ; ..
CALL MOVSB2 ; Yes, move 'em on out
BLDHD1: MOVEI B,[BYTE (7) 15, 12, 0]
CALL MOVSB2 ; And a blank line
SETZ A,
IDPB A,OBPTR ; Mark end of this with a null
RET
SUBTTL Sending subroutines - SAVMSG - Save outgoing message in file
;Call with FOB size and address in A and B
; Skip return iff successful
; F%F1 = do not set "seen" bit in message flags
SAVMS0: TXO F,F%F2 ; Don't write the message bits
SETZM FRMLCL ; From MSLCL
JRST SAVMS1 ; Jump to common code
SAVMSG: TXZ F,F%F2 ; In case left lying around by errors
SETOM FRMLCL ; From SAVE OUTGOING-MESSAGES
SETZM SVMIFN ; Remember no IFN yet
MOVE C,B ; Preserve FOB address in case of error
$CALL F%AOPN ; ..
JUMPF [ MOVE A,FOB.FD(C) ; Error, point to FD for file
CALL CRIF
$TEXT (KBFTOR,<?Can't open file ^F/(A)/ for write because: ^E/[-1]/>)
RET]
SAVMS1: MOVEM A,SVMIFN ; Save the IFN
TXZ F,F%XMTO ; Insure no rubouts in headers
PUSH P,F ; Save state of F%F1
CALL BLDHDR ; Build header text
POP P,F ; Restore flags
TXZE F,F%F2 ; Do we want to write the message bits?
JRST SAVMS2 ; Nope, skip this
MOVE A,OBPTR ; Compute no. of bytes in headers
BP2CHR ; First get byte no. of last byte
MOVEM V,OBPTR ; Save it
MOVE A,[POINT 7,HDRPAG] ; And byte no. of first byte
BP2CHR ; ..
MOVE B,OBPTR
SUB B,V ; Compute length of header
SUBI B,1 ; Don't count the null
ADD B,TXTTOT ; plus total length of text
SKIPN RPRHNP ; If REPAIR, there are no trailing dashes
ADDI B,NTRAIL ; and length of trailer (dashes)
SKIPE A,CLZTXT ; and length of closing text if any
JRST [ PUSH P,B ; Save length
HRLI A,(POINT 7,)
CALL COUNTS
POP P,B ; Restore length
ADDI B,4(A) ; Add length of closing string + CRLFs
JRST .+1]
SKIPE RPRHNP ;
ADDI B,RPRLEN ;
TXNN F,F%F1 ; Want the "seen" bit on?
$TEXT (SAVMSW,<^H/[-1]/,^D/B/;000000004001>) ; Write header line
; "Seen" bit and "return receipt sent" bit
TXZE F,F%F1 ; Don't light "seen" bit
$TEXT (SAVMSW,<^H/[-1]/,^D/B/;000000000000>) ; Write header line
SAVMS2: MOVE A,SVMIFN ; For calls to TSOUT on next page
TXZ F,F%F3 ; Put the trailing dashes in
; CALLRET SAVDRF ; Write body of message and return
SUBTTL Sending subroutines - SAVDRF - write current draft
;Write current draft to file, IFN in A
; Skip return iff success
; F%F2 = must DEQ file before closing (OBSOLETE - Let me know if its not-Ned)
; F%F3 = don't add trailing dashes
SAVDRF: STKVAR <SVIFN>
MOVEM A,SVIFN ; Save IFN for later
SETZB C,D
HRROI B,HDRPAG ; Start of headers
CALL TSOUT ; Do a SOUT
JUMPF SVDERR ; Error writing queue file
SKIPE RPRHNP ; Repaired mail?
CALL REPTEL ; Yes, indicate so
JUMPF SVDERR ; Error writing REPAIR line
CALL TXTOUT ; Write text to IFN in A
JUMPF SVDERR
MOVE A,SVIFN
TXNE F,F%F3 ; Unless saving draft,
JRST SAVD1A ; ..
SKIPN CLZTXT ; Add closing text if any exists
JRST SAVDR0 ; None exists, skip this
MOVE B,[POINT 7,[BYTE (7) 15, 12, 0]] ; Precede with CRLF
SETZB C,D
CALL TSOUT
JUMPF SVDERR
MOVE B,CLZTXT ; Get pointer to closing text
HRLI B,(POINT 7,) ; ..
CALL TSOUT ; ..
JUMPF SVDERR
MOVE B,[POINT 7,[BYTE (7) 15, 12, 0]]
CALL TSOUT
JUMPF SVDERR
SAVDR0: SKIPE RPRHNP ; Don't add dashes if from REPAIR
JRST SAVDR1 ; Checkpoint the file
HRROI B,TRAILR ; Add trailing dashes
SETZB C,D ; ..
CALL TSOUT ; ..
JUMPF SVDERR
SKIPA ;
SAVDR1: AOS RPRHNP ; Delete REPAIR file, if any
SAVD1A: $CALL F%CHKP ; Update file
JUMPT SAVDR3 ; Proceed if no error
SKIPE FRMLCL ; From MSLCL?
JRST SAVDR3 ; No, so don't check for empty file
MOVE A,SVIFN ; F%CHKP clobbers this
MOVEI B,FI.SIZ ; Want the file size
$CALL F%INFO ; SIZEF% from GLXLIB
JUMPG A,SAVDR3 ; Not empty, so o.k.
JRETER (Error writing message)
$TEXT (KBFTOR,<
[Your message could not be sent due to your POBOX being over quota.
To become under quota, remove or delete files from your POBOX.]
>)
MOVE A,SVIFN ; Pick up the IFN
SAVDR2: $CALL F%DREL ; Delete the empty MAI file
RET ; Return an error
SAVDR3: MOVE A,SVIFN ; F%CHKP clobbers this
$CALL F%REL ; Close file
RETSKP ; OK
SVDERR: JRETER (Error writing message)
MOVE A,SVIFN ; Get IFN of losing file
SKIPN FRMLCL ; From SNDLCL?
JRST SAVDR2 ; Yes, so delete the MAI file
$CALL F%RREL ; abort this opening
SKIPE RPRHNP ;
AOS RPRHNP ; Delete REPAIR file, if any
RET ; Failure return
SVERR: JRETER (Error writing message)
SKIPE A,SVMIFN ; If a file is open,
$CALL F%RREL ; abort this opening
RET
;SAVMSW - Routine called by $TEXT macro above to write byte to output file
SAVMSW: MOVE B,A ; Adjust AC usage
MOVE A,SVMIFN ; File to write to
$CALL F%OBYT
RET
REPTEL: SETZB C,D
HRROI B,REPALN ;Point to the REPAIR line
CALL TSOUT ; Do a SOUT
RET
REPALN: ASCIZ/[THIS MESSAGE HAS BEEN REMAILED WITH A CORRECTED DISTRIBUTION LIST]
/
RPRLEN=^D71
END
; Edit 2431 to MSDLVR.MAC by TGRADY on 13-Aug-85
; Fix Saved outgoing messages in SAVMSG/MSDLVR.MAC
; *** Edit 2484 to MSDLVR.MAC by SANTEE on 21-Nov-85
; Clean up the various edit histories.
; *** Edit 2486 to MSDLVR.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2606 to MSDLVR.MAC by PRATT on 9-Dec-85
; Fix more problems with Redistribute
; *** Edit 2607 to MSDLVR.MAC by SANTEE on 10-Dec-85
; Make MS/MX get along well together. Have MS write dashes at the end of
; messages. While we're there remove some of the NETMAI code.
; *** Edit 2613 to MSDLVR.MAC by JROSSELL on 14-Dec-85
; Repair the REPAIR command
; *** Edit 2618 to MSDLVR.MAC by JROSSELL on 18-Dec-85
; Don't add dashes if message is from the REPAIR command
; *** Edit 2653 to MSDLVR.MAC by JROSSELL on 10-Feb-86
; Correct the message length for saved outgoing REPAIRED mail
; *** Edit 2654 to MSDLVR.MAC by JROSSELL on 12-Feb-86
; If an unprivileged user is over quota, delete the empty .MAI file and do not
; send a message to MX. Inform the user of being over quota.
; *** Edit 2656 to MSDLVR.MAC by SANTEE on 18-Feb-86
; Improper error returned sometimes after delivering mail. Leaving user in MS
; SEND>> mode. TOPS-10 only.
; *** Edit 2657 to MSDLVR.MAC by MAYO on 18-Feb-86
; Teach MS to type recipient names that aren't receiving mail (when rejected by
; MX).
; *** Edit 2673 to MSDLVR.MAC by JROSSELL on 5-Mar-86
; Do not increment the repair flag (RPRHNP) when saving drafts.