Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/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
	HRLI B,(POINT 7,)	; Make it a pointer
	SETZ D,			; Indicate no special characters
	CALL SPCCHK		; Any special characters in my user name?
	SKIPA D,[""""]		; Yes, we'll have to quote it then
	SKIPA			; No, don't quote our name
	IDPB D,A		; Put the quote
	CALL MOVSTR		; And now the user name
	SKIPE D			; Were we quoting our name
	IDPB D,A		; Yes, put the ending quote
	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.
; *** Edit 2722 to MSDLVR.MAC by SANTEE on 16-Jun-86
; If our username has special characters in it quote the username in the FROM
; field.