Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

;<4.UTILITIES>ARMAIL.MAC.8,  3-Jan-80 15:24:46, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>ARMAIL.MAC.7, 15-Nov-79 14:32:06, EDIT BY R.ACE
;REQUIRE SYS:MACREL
;<4.UTILITIES>ARMAIL.MAC.6, 15-Nov-79 12:21:11, EDIT BY R.ACE
;TCO 4.2567 - ALLEVIATE PROBLEM OF HANGING MAIL.EXE
;<4.UTILITIES>ARMAIL.MAC.5, 19-Oct-79 16:51:59, EDIT BY DBELL
;TCO 4.2537 - HAVE CALLERS OF MTLST SET UP T2 WITH MLTYPE
;<4.UTILITIES>ARMAIL.MAC.4, 18-Oct-79 15:38:06, EDIT BY DBELL
;TCO 4.2533 - EXPUNGE MAIL-SENDING-TEMPORARY.FILE AFTER USE ROUTINE WAIT
;<4.UTILITIES>ARMAIL.MAC.3,  7-Jun-79 06:20:55, EDIT BY R.ACE
;MISCELLANEOUS COSMETIC CLEANUP
;<4.UTILITIES>ARMAIL.MAC.2, 10-Mar-79 13:35:01, Edit by KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<ARC-DEC>ARMAIL.MAC.16, 27-Nov-78 08:47:00, EDIT BY CALVIN
; Cause uses of GJBLK to find deleted files as well as invisible
;<ARC-DEC>ARMAIL.MAC.11, 20-Nov-78 19:50:40, Edit by CALVIN
; FIX UP SAVACS
;[BBN-TENEXD]<3A-CRDAVIS>ARMAIL.MAC.12, 10-Nov-78 19:08:28, Ed: CRDAVIS
; Added code to save and restore all AC's used in ARMAIL.
; Added 2nd arg to specify whether or not to used offline file message file.
;[BBN-TENEXD]<3A-CRDAVIS>ARMAIL.MAC.10, 10-Nov-78 05:41:18, Ed: CRDAVIS
; Change default mail type to DEC.
; Set generation retention count of work file to 0.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	TITLE ARMAIL
	SUBTTL Mail sending utilities for the Archive/Virtual Disk system
	SALL
	.DIRECTIVE FLBLST	;SUPPRESS ASCIZ MACHINE CODE EXPANSION

	SEARCH MONSYM,MACSYM
	.REQUIRE SYS:MACREL

	INTERN MLTOWN,MLTLST,MLDONE,MLINIT

	T1=1
	T2=2
	T3=3
	T4=4
	Q1=5
	AP=16
	P=17


	; Type of mail delivery (value of MLTYPE)

	.MLNON==0		; No mail 
	.MLDEC==1		; DEC mail
	.MLNET==2		; ARPANET mail


	; Legal values of T2 on entry

	.MLOFL==:0		; Use offline file msg file if there
	.MLNFL==:1		; No offline file msg file


	NTOLST==^D100		; Size of To: list area

DIRNAM:	BLOCK ^D39		; Filespec area
DIRPTR:	BLOCK 1			; Ptr to end of directory string
TOLST:	BLOCK NTOLST		; Area for To: list
RECIP:	BLOCK ^D10		; Area for single recipient
MLFRK:	BLOCK 1			; Fork handle
MLJFN:	BLOCK 1			; JFN of mail program
NOOFL:	BLOCK 1			; Nonzero => no offline file msg file
CPYSTD:	BLOCK 1			;ASSEMBLY AREA FOR CPYST
CPYSTP:	BLOCK 1			;BYTE POINTER TO CPYSTD
CPYJFN:	BLOCK 1			;JFN FOR MAIL.CPY
MLRPID:	BLOCK 1			;PID OF [SYSTEM]MAILER OR -1 IF UNAVAILABLE
SCNUD:	BLOCK 10		;TEMP AREA FOR USER NAME STRING

				; GTJFN argument block
GJBLK:	GJ%OLD+GJ%DEL+GJ%XTN	; Old file, long arg block
	.NULIO,,.NULIO		; No input/recognition
	0			; Set to default device
	0			; Set to default directory
	0			; Set to default name
	0			; Set to default extension
	0			; No default protection
	0			; No default account
	0			; No JFN
	G1%IIN			; File may be invisible

MLTYPE:	.MLDEC			; Type of mail system used

OWNFIL:	ASCIZ"DIRECTORY.OWNER"	; Name of directory owner file
ERRFIL:	ASCIZ"SYSTEM:UNDELIVERABLE-OFFLINE-FILE-MSGS.TXT"
SNDFIL:	ASCIZ"MAIL-SENDING-TEMPORARY.FILE"
MSGFIL:	ASCIZ"OFFLINE-FILE-MSGS"
GVPFIL:	ASCIZ"SYSTEM:FAILED.MAIL"
CRLF:	BYTE (7) 15,12,0,0,0

; MLTOWN sends mail to the "owner" of a file.
; If a DIRECTORY.OWNER file exists in the same directory as the
; file in question, the contents of DIRECTORY.OWNER is used as the
; recipient list and is passed to MLTLST.  Otherwise, a single
; recipient consisting of the un-punctuated directory name is used,
; and passed to MLTLST.
;
; Call:	AC 1 = pointer to 3 word block, as follows:
;		0:  directory # where file resides (see note below)
;		1:  string pointer to Subject: field
;		2:  string pointer to Text: field
;       AC 2 = .MLOFL (0) to use OFFLINE-FILE-MSGS.TXT if possible, or
;	       .MLNFL (1) to just use MAIL.TXT.
;
; Note: This routine clobbers word 0 of the arg block pointed to by AC1

MLTOWN:	SKIPN MLTYPE		; Want mail at all?
	RET			; No
	MOVEM T2,NOOFL		; Save OFL flag
	CALL SAVACS		; Be transparent
	PUSH P,T1		; Save arg ptr
	MOVE T2,0(T1)		; Get directory #
	HRROI T1,DIRNAM		; Place for file spec
	DIRST			; Make a string
	 JRST ERRSND		; Send to system file if bad dir
	MOVEM T1,DIRPTR		; Save updated string ptr
	HRROI T2,OWNFIL		; Name of dir owner file
	SETZB T3,T4
	SOUT			; Append to dir name
	IDPB T3,T1		; Finish it off
	SETZM GJBLK+.GJDEV	; No default device
	SETZM GJBLK+.GJDIR	; No default directory
	SETZM GJBLK+.GJNAM	; No default name
	SETZM GJBLK+.GJEXT	; No default extension
	MOVEI T1,GJBLK		; Point to GTJFN arg block
	HRROI T2,DIRNAM		; Point to file spec
	GTJFN			; Owner file exist?
	 JRST NOOWN		; Nope
	PUSH P,T1		; Save JFN
	MOVX T2,<FLD(7,OF%BSZ)+OF%RD>
	OPENF			; Open for read
	 JRST [	POP P,T1
		JRST NOOWN]
	HRROI T2,TOLST		; Space for owner list
	MOVEI T3,NTOLST*5	; Max # of bytes
	MOVEI T4,15		; Terminate on CR
	SIN			; Read the owner list
	SETZ T3,
	DPB T3,T2		; Make it ASCIZ
	POP P,T1		; Restore JFN
	CLOSF			; Done with it
	 JFCL
	POP P,T1		; Get arg ptr back
	HRROI T2,TOLST		; Point to owner list
	MOVEM T2,0(T1)		; Smash 1st arg
	MOVE T2,MLTYPE		;GET MAIL TYPE
	JRST MTLST		; Go mail it to that list


; Come here if no "owner" file exists in the directory.  We will
; simply use the directory name as the name of the recipient.

NOOWN:	MOVE T1,[POINT 7,DIRNAM] ; Point to file spec
	MOVE T2,[POINT 7,TOLST]	; Point to destination
	SETZ T4,		; Don't copy chars
ULOOP:	ILDB T3,T1		; Get a byte
	CAIN T3,"<"
	JRST [	SETO T4,	; Start copying
		JRST ULOOP]
	CAIN T3,">"
	JRST UDONE		; Reached end of dir name
	SKIPE T4		; Should we copy it?
	IDPB T3,T2		; Yes, do so
	JRST ULOOP		; Back for more
UDONE:	SETZ T3,
	IDPB T3,T2		; Finish off user name
	POP P,T1		; Get arg ptr back
	HRROI T2,TOLST		; Get pointer to user name
	MOVEM T2,0(T1)		; Smash 1st arg
	JRST MTLST		; Go mail it

; 
; MLTLST sends mail to a specified To: list.  If DEC mail is being
; used, the recipient list is fed directly to the MAIL program.  If
; ARPANET mail is being used, and the recipient list consists of a
; single, local recipient, an attempt is made to mail to the file
; OFFLINE-FILE-MSGS.TXT in the user's directory.  If that fails,
; MAIL.TXT is tried.  If that fails, sending to
; SYSTEM:UNDELIVERABLE-OFFLINE-FILE-MSGS.TXT is attempted.  In case of
; error while trying to deliver the mail (DEC or ARPANET), the input
; to the mail program is written to the file SYSTEM:FAILED.MAIL.
; 
; Call:	AC 1 = pointer to 3 word block, where
; 		0:  String pointer to recipient list
; 		1:  String pointer to subject field
; 		2:  String pointer to text field
;       AC 2 = .MLOFL or .MLNFL

MLTLST:	MOVEM T2,NOOFL		; Save OFL flag
	CALL SAVACS		; Be transparent

	; Enter here from MLTOWN

MTLST:	SKIPN T2,MLTYPE		; Want mail at all?
	RET			; Just return
	CAIN T2,.MLDEC		; DEC mail?
	JRST SEND		; Go send as is
	HRLI T2,(POINT 7)	; Make string pointer
	HRR T2,0(T1)		; To recipient list
	MOVE T3,[POINT 7,RECIP]	; Space for recipient
	SETZM RECIP		; Initialize

SCNLST:	ILDB T4,T2		; Get next character
	JUMPE T4,ENDSCN		; End of string?
	CAIE T4,"@"		; Check for characters
	CAIN T4,"*"		; which force us to
	JRST SEND		; send as is
	CAIN T4,","
	JRST SEND
	CAIL T4,"a"		; Uppercase recipient
	CAILE T4,"z"
	CAIA
	TRZ T4,40
	IDPB T4,T3		; Accumulate recipient name
	JRST SCNLST

ENDSCN:	PUSH P,T1		; Save arg ptr
	SKIPN RECIP		; Anything there?
	JRST ERRSND		; Bad
	SETZ T4,
	IDPB T4,T3		; Finish off string

	HRROI T2,[ASCIZ"PS"]	; Default device
	MOVEM T2,GJBLK+.GJDEV
	HRROI T2,RECIP		; Default directory
	MOVEM T2,GJBLK+.GJDIR
	HRROI T2,[ASCIZ"TXT"]	; Default extension
	MOVEM T2,GJBLK+.GJEXT

	HRROI T2,MSGFIL		; Name of offline messages file
	MOVEM T2,GJBLK+.GJNAM
	MOVEI T1,GJBLK
	HRROI T2,CRLF		; Use default
	SKIPN NOOFL		; Just use MAIL.TXT?
	GTJFN			; No, try MSGFIL
	 CAIA
	JRST HAVFIL		; That worked
	HRROI T1,[ASCIZ"MAIL"]	; Try MAIL.TXT
	MOVEM T1,GJBLK+.GJNAM
	MOVEI T1,GJBLK
	GTJFN
	 JRST ERRSND		; If that fails, send to system file
	RLJFN			; Don't really need the file
	 JFCL

GOSEND:	POP P,T1		; Get arg ptr back
	HRROI T2,RECIP		; Pointer to recipient
	MOVEM T2,0(T1)		; Smash 1st arg
	JRST SEND		; Go mail it

HAVFIL:	PUSH P,T1		; Save JFN
	MOVE T1,[POINT 7,RECIP]	; Place for recipient
	MOVEI T2,"*"		; Output * for SNDMSG
	BOUT
	POP P,T2		; Get JFN back
	MOVX T3,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF>
	SETZ T4,
	JFNS			; Make *Filespec
	MOVE T1,T2
	RLJFN			; Don't need file anymore
	 JFCL
	JRST GOSEND

ERRSND:	MOVE T1,MLTYPE		;GET MAIL TYPE
	CAIE T1,.MLNET		;NET MAIL?
	JRST GIVUP1		;NO, GIVE UP
	MOVX T1,GJ%OLD+GJ%SHT	; Attempt delivery to system msg file
	HRROI T2,ERRFIL
	GTJFN			; Try to get system message file
	 JRST GIVUP1		; Can't, write message to file
	JRST HAVFIL

;T1/ POINTER TO ARGUMENT BLOCK (MLTLST STYLE)

SEND:	PUSH P,T1		; Save argument pointer
	MOVE T2,MLTYPE
	CAIN T2,.MLDEC		;DEC MAIL?
	JRST [	CALL DECM	;YES, TALK TO MAILER DIRECTLY
		 JRST GIVUP1	;FAILED
		ADJSP P,-1	;SUCCEEDED, ADJUST STACK
		RET]		;RETURN
	MOVX T1,GJ%FOU+GJ%NEW+GJ%SHT
	HRROI T2,SNDFIL		; Temp file for mail program input
	GTJFN
	 JRST GIVUP1		; Can't get temp file, write out message
	MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
	OPENF			; Open for write
	 JRST GIVUP1
	HRLI T1,.FBBYV
	MOVX T2,FB%RET
	SETZ T3,
	CHFDB			; Set retention count to 0
	HRRZS T1		; Get rid of FDB offset
	POP P,AP		; Get arg ptr back
	CALL OUTMSG		; Stuff message into file
	MOVE T2,MLTYPE		; Type of mail system
	CAIN T2,.MLDEC		; DEC mail?
	SKIPA T2,[POINT 7,[BYTE (7) "Z"-100,0,0,0,0]]
	HRROI T2,[BYTE (7) "Z"-100,"Q",15,12,0]
	SOUT			; Terminate the input
	TXO T1,CO%NRJ		; Please keep JFN
	CLOSF
	 JRST GIVUP2
	TXZ T1,CO%NRJ
	MOVX T2,<FLD(7,OF%BSZ)+OF%RD>
	OPENF			; Re-open file for read
	 JRST GIVUP2
	PUSH P,T1		; Save JFN
	SKIPE MLFRK		; Have a fork?
	JRST SEND1		; No thanks, I just had one
	MOVX T1,CR%CAP		; Want same caps
	SETZ T2,		; No ACs
	CFORK			; Create a fork
	 JRST GIVUP4
	MOVEM T1,MLFRK		; Save fork handle
	MOVE T2,[.NULIO,,.NULIO]
	SPJFN
	MOVE T3,MLTYPE
	MOVX T1,GJ%OLD+GJ%SHT
	HRROI T2,[ASCIZ"SYS:SNDMSG.EXE"]
	CAIN T3,.MLDEC
	HRROI T2,[ASCIZ"SYS:MAIL.EXE"]
	GTJFN			; Locate the mail program
	 JRST GIVUP4
	MOVEM T1,MLJFN		; Save program's JFN
	HRL T1,MLFRK		; Get handle,,JFN
	GET			; Load the fork

SEND1:	MOVE T1,MLFRK
	CALL WAIT
	POP P,T2
	HRLS T2
	HRRI T2,.NULIO
	SPJFN
	SETZ T2,
	SFRKV
	RET


WAIT:	PUSH P,T1
	WFORK
	GPJFN
	CAMN T2,[.NULIO,,.NULIO]
	JRST WAIT9
	HLRZ T1,T2
	TXO T1,CO%NRJ
	CLOSF
	 JFCL
	HLRZ T1,T2
	TXO T1,DF%EXP
	DELF
	 JFCL
	MOVE T1,0(P)
	MOVE T2,[.NULIO,,.NULIO]
	SPJFN
WAIT9:	POP P,T1
	RET

; OUTMSG does the work of outputting the fields of a message to a file.
; Call:	AC 1 = Destination designator
;	AC 16 = Pointer to MLTLST argument block

OUTMSG:	MOVE T2,0(AP)		; Get recipient list
	SETZB T3,T4
	SOUT			; Output the list
	HRROI T2,CRLF
	SOUT			; End the To: list
	HRROI T2,CRLF
	SOUT			; No Cc: list
	MOVE T2,1(AP)		; Get subject string
	SOUT
	HRROI T2,CRLF
	SOUT			; End the subject
	MOVE T2,2(AP)		; Get the text of the message
	SOUT			; Output that
	RET


; MLDONE is used to kill the fork used to run the mail sending program.
; It should be called after all sending is complete.
; MLINIT initializes some data used by the MLTLST and MLTOWN.
; It should be called before any sending is attempted.

MLDONE:	SKIPE T1,MLJFN		; Have JFN for mail program?
	CLOSF			; Close the file
	 JFCL
	SKIPN T1,MLFRK		; Do we have a fork?
	JRST MLINIT
	CALL WAIT
	KFORK
MLINIT:	SETZM MLFRK		; Handle is invalid now
	SETZM MLJFN		; So is JFN
	RET

; Branch to one of the GIVUP routines as a last ditch effort to avoid
; losing the mail, which may contain the only copy of tape pointers
; for archived files.  Here we try to write out the input to the
; mail sending program in a file, so that someone can look at it later.

GIVUP1:	POP P,AP		; Get arg ptr back
GIVUP2:	MOVX T1,GJ%FOU+GJ%NEW+GJ%SHT
	HRROI T2,GVPFIL
	GTJFN			; Locate error file 
	 RET
	MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
	OPENF			; Open it for write
	 RET
	CALL OUTMSG		; Output the message
	CLOSF			; Close the file
	 JFCL
	RET

GIVUP3:	PUSH P,T1		; Save JFN of temp file
	JRST GIVUP5
GIVUP4:	MOVE T1,0(P)		; Get JFN
	TXO T1,CO%NRJ		; Keep the JFN around
	CLOSF			; Make sure it is closed
	 JFCL
GIVUP5:	MOVX T1,GJ%FOU+GJ%NEW+GJ%SHT
	HRROI T2,GVPFIL
	GTJFN			; Locate error file
	 JRST GIVUP9
	MOVE T2,T1		; Move destination JFN to T2
	POP P,T1		; Get back old JFN
	RNAMF			; Do the rename
	 JFCL
	RET

GIVUP9:	POP P,T1		; Get JFN of old file
	RLJFN			; Release it
	 JFCL
	RET

; Routine to save and restore the AC's.

SAVACS:	EXCH T1,0(P)		; Save T1, get return addr
	PUSH P,T2
	PUSH P,T3
	PUSH P,T4
	PUSH P,AP
	PUSH P,[SVACRT]		; Save return addr
	PUSH P,T1		; RETURN ADDR
	MOVE T1,-6(P)		; RESTORE T1
	RET			; "RETURN" TO CALLER
SVACRT:	CAIA
	AOS -5(P)		; ROUTINE SKAP
	POP P,AP
	POP P,T4
	POP P,T3
	POP P,T2
	POP P,T1
	RET

SUBTTL Routines To Send Message Via DEC Mail

;DECM - SEND DEC-STYLE MAIL TO ONE OR MORE USERS
; T1/ ADDRESS OF MLTLST-STYLE ARGUMENT BLOCK
;RETURNS +1: COULD NOT COMMUNICATE WITH [SYSTEM]MAILER
;	 +2: MESSAGE SUCCESSFULLY PASSED TO MAILER (NOTE THAT THIS
;	     ROUTINE DOESN'T CARE WHAT HAPPENS AFTER THE MESSAGE
;	     HAS BEEN PUT IN MAILER'S HANDS)

DECM:	SAVEAC <Q1>
	STKVAR <ARGPTR,<IPCFM,15>,<PDB,4>>
	MOVEM T1,ARGPTR		;SAVE ADDRESS OF ARGUMENT BLOCK
	SETZM CPYJFN		;NO JFN CURRENTLY ON MAIL.CPY
	SETZM .IPCFS+PDB	;SET NO PID OBTAINED FOR ME YET

;SET UP PDB FOR SENDING MESSAGE TO [SYSTEM]MAILER

	CALL GTMLR		;GET MAILER'S PID
	 JRST DECMX1		;CAN'T, SO FAIL
	MOVEM T1,.IPCFR+PDB	;MAKE MAILER THE RECEIVER
	MOVX T1,IP%CPD		;REQUEST MONITOR TO CREATE A PID
	MOVEM T1,.IPCFL+PDB
	MOVEI T1,IPCFM		;GET ADDRESS OF IPCF MESSAGE
	MOVEM T1,.IPCFP+PDB	;(SIZE WILL BE FILLED IN LATER)

;BUILD FILESPEC IN IPCFM FOR MAIL.CPY IN LOGGED-IN DIRECTORY

	SETO T1,		;THIS JOB
	HRROI T2,T4		;GET 1 WORD INTO T4
	MOVEI T3,.JILNO		;WANT LOGGED-IN DIRECTORY #
	GETJI			;GET IT
	 JRST DECMX1		;SHOULD NEVER FAIL
	MOVE T2,T4		;GET DIR #
	HRROI T1,IPCFM		;STRING GOES HERE
	DIRST			;CONVERT LOGGED-IN DIR # TO STRING
	 JRST DECMX1		;SHOULD NEVER FAIL
	HRROI T2,[ASCIZ/MAIL.CPY/]
	SETZ T3,
	SOUT			;APPEND NAME AND EXTENSION

;OPEN MAIL.CPY

	GJINF			;GET CONNECTED DIRECTORY # IN T2
	SETZ T1,		;NO FLAGS
	DELDF			;EXPUNGE DELETED MAIL.CPY'S
	MOVX T1,GJ%SHT+GJ%FOU
	HRROI T2,IPCFM		;GET POINTER TO FILESPEC I JUST BUILT
	GTJFN			;GET JFN ON MAIL.CPY
	 JRST DECMX1		;FAILED
	MOVEM T1,CPYJFN		;REMEMBER JFN
	MOVE T2,[FLD(^D36,OF%BSZ)+OF%WR] ;BYTE SIZE, MODE
	OPENF			;OPEN FOR OUTPUT
	 JRST DECMX1		;FAILED
	SETZ T1,
	CALL CPY1		;NO FLAGS FOR MAILER

;PARSE USER NAME STRING AND WRITE "TO" USER NUMBERS TO MAIL.CPY

	MOVE T1,ARGPTR		;GET ADDRESS OF ARGUMENT BLOCK
	MOVE T1,(T1)		;GET POINTER TO USER NAME LIST
	TLC T1,-1
	TLCN T1,-1		;IN FORM -1,,ADDR ?
	HRLI T1,(POINT 7)	;YES, CONVERT IT
	SETZ Q1,		;INITIALIZE COUNT OF USER NAMES
DECM1:	CALL SCNU		;SCAN A USER NAME
	EXCH T1,T2		;GET USER # IN T1, STRING POINTER IN T2
	JUMPN T1,[CALL CPY1	;IF USER # OBTAINED, WRITE IT TO FILE
		AOJA Q1,.+1]	;COUNT VALID USER #
	MOVE T1,T2		;PREPARE FOR NEXT CALL TO SCNU
	CAIE T3,","		;COMMA AFTER USER NAME?
	CAIN T3," "		; OR BLANK?
	JRST DECM1		;YES, TRY FOR ANOTHER USER NAME
	JUMPE Q1,DECMX1		;END OF LIST, ERROR IF NO VALID NAMES
	SETZ T1,
	CALL CPY1		;TERMINATE "TO" LIST
	CALL CPY1		;NULL "CC" LIST

;WRITE SUBJECT AND MESSAGE FIELDS TO MAIL.CPY

	SETZ T1,
	CALL CPYST		;INITIALIZE FOR COPYING STRINGS
	HRROI T1,[ASCIZ/SUBJECT: /]
	CALL CPYST		;WRITE NOISE
	MOVE Q1,ARGPTR		;GET ADDRESS OF ARGUMENT BLOCK
	MOVE T1,1(Q1)		;GET POINTER TO SUBJECT
	CALL CPYST		;OUTPUT SUBJECT FIELD
	HRROI T1,[ASCIZ/

/]
	CALL CPYST		;OUTPUT CRLF CRLF
	MOVE T1,2(Q1)		;GET POINTER TO MESSAGE
	CALL CPYST		;OUTPUT MESSAGE
	MOVEI T1,1
	CALL CPYST		;FINISH UP PARTIAL WORD

;CLOSE MAIL.CPY

	MOVE T1,CPYJFN		;GET JFN OF MAIL.CPY
	TXO T1,CO%NRJ		;KEEP JFN
	CLOSF			;CLOSE MAIL.CPY
	 JFCL

;BUILD IPCF MESSAGE IN IPCFM CONTAINING FILESPEC OF MAIL.CPY
;AND STORE LENGTH OF MESSAGE INTO PDB

	HRROI T1,IPCFM		;DESTINATION
	MOVE T2,CPYJFN		;MAIL.CPY JFN
	MOVE T3,[111110,,1]	;DEV,DIR,NAME,EXT,GEN,PUNCTUATE
	JFNS			;GET FILESPEC
	SETZ T2,
	IDPB T2,T1		;TIE IT OFF
	SUBI T1,-1+IPCFM	;GET # OF WORDS IN FILESPEC
	HRLM T1,.IPCFP+PDB	;STORE MESSAGE LENGTH INTO PDB

;SEND MESSAGE OFF TO MAILER

	MOVEI T1,4		;PDB SIZE
	MOVEI T2,PDB		;PDB ADDRESS
	MSEND			;SEND MESSAGE TO MAILER
	 JRST DECMX1		;IT FAILED
	JRST DECMX2		;IT SUCCEEDED

;EXITS FROM DECM:
; DECMX1 - ERROR
; DECMX2 - SUCCESS

DECMX1:	TDZA Q1,Q1		;REMEMBER FAILURE
DECMX2:	MOVEI Q1,1		;REMEMBER SUCCESS
	SKIPE T1,CPYJFN		;HAVE JFN ON MAIL.CPY?
	JRST [	GTSTS		;YES, GET STATUS
		HRLI T1,(CO%NRJ) ;SET TO KEEP JFN
		TXNE T2,GS%OPN	;JFN OPEN?
		CLOSF		;YES, CLOSE IT
		 JFCL
		MOVE T1,CPYJFN	;GET JFN AGAIN
		HRLI T1,(DF%NRJ) ;SET TO KEEP JFN
		SKIPN Q1	;FAILURE RETURN?
		DELF		;YES, DELETE FILE
		 JFCL
		MOVE T1,CPYJFN	;GET JFN ONE MORE TIME
		RLJFN		;DISCARD IT
		 JFCL
		JRST .+1]
	SKIPE T1,.IPCFS+PDB	;DID I HAVE A PID?
	CALL RELPID		;YES, RELEASE IT
	JUMPN Q1,RSKP		;SUCCESSFUL RETURN
	RET			;ERROR RETURN

;CPY1 - WRITE 1 WORD TO MAIL.CPY FILE
; T1/ WORD TO BE WRITTEN
;RETURNS +1: ALWAYS, ALL AC'S PRESERVED

CPY1:	CALL SAVACS		;SAVE AC'S
	MOVE T4,T1		;COPY THE DATA TO BE WRITTEN
	MOVE T1,CPYJFN		;GET JFN ON FILE
	MOVE T2,[POINT 36,T4]	;GET POINTER TO DATA
	MOVNI T3,1		;WRITE 1 WORD
	SOUT			;WRITE TO FILE
	 ERJMP .+1
	RET


;CPYST - WRITE ASCIZ STRING TO MAIL.CPY FILE
;	   WE NEED THIS BECAUSE MAIL.CPY IS OPEN IN 36-BIT BYTE MODE
; T1/ 0 TO INITIALIZE CPYST MEMORY, OR
;     1 TO OUTPUT LAST PARTIAL WORD, OR
;     STRING POINTER TO TEXT TO BE OUTPUT
;RETURNS +1: ALWAYS

CPYST:	JUMPE T1,[MOVE T1,[POINT 7,CPYSTD] ;INITIALIZATION CALL
		MOVEM T1,CPYSTP	;SET UP POINTER TO BUILDING AREA
		SETZM CPYSTD	;CLEAR BUILDING AREA
		RET]
	CAIN T1,1		;WRAP-UP CALL?
	JRST [	SKIPE T1,CPYSTD	;YES, DOES A PARTIAL WORD EXIST?
		CALL CPY1	;YES, OUTPUT IT
		RET]

;T1/ POINTER TO STRING TO BE OUTPUT

	TLC T1,-1
	TLCN T1,-1		;OF FORM -1,,ADDR ?
	HRLI T1,(POINT 7)	;YES, CONVERT TO PDP-10 BYTE POINTER
	MOVE T3,T1		;MOVE POINTER OVER TO T3
CPYST1:	ILDB T2,T3		;GET A CHARACTER FROM INPUT STRING
	JUMPE T2,R		;END OF STRING, RETURN
	IDPB T2,CPYSTP		;TRANSFER CHARACTER TO BUILDING AREA
	MOVE T2,CPYSTP
	TLNE T2,760000		;BUILDING AREA FULL?
	JRST CPYST1		;NO, PROCESS NEXT CHARACTER
	SOS CPYSTP		;YES, RESET POINTER TO BUILDING AREA
	MOVE T1,CPYSTD		;GET CONTENTS OF BUILDING AREA
	CALL CPY1		;WRITE BUILDING AREA TO FILE
	SETZM CPYSTD		;CLEAR IT FOR NEW DATA
	JRST CPYST1		;GET NEXT CHARACTER

;GTMLR - GET MAILER'S PID
;RETURNS +1: ERROR (E.G. PID NOT DEFINED)
;	 +2: SUCCESS, T1/ MAILER'S PID

GTMLR:	STKVAR <<GTMPDB,4>,<GTMANS,2>>
	SKIPE T1,MLRPID		;FIRST TIME THROUGH?
	JRST [	CAMN T1,[-1]	;NO, WHAT DO I KNOW ABOUT MAILER?
		RET		;COULDN'T GET MAILER'S PID
		RETSKP]		;DID GET MAILER'S PID
	SETOM MLRPID		;SET MAILER'S PID CURRENTLY UNKNOWN

;ASK <SYSTEM>INFO FOR MAILER'S PID

	MOVX T1,IP%CPD		;ASK MONITOR TO CREATE PID
	MOVEM T1,.IPCFL+GTMPDB
	SETZM .IPCFS+GTMPDB	;MONITOR WILL SUPPLY SENDER'S PID
	SETZM .IPCFR+GTMPDB	;RECEIVER IS <SYSTEM>INFO
	MOVE T1,[5,,[.IPCIW	;PACKET TO REQUEST PID FOR MAILER
		     0
		     ASCIZ/[SYSTEM]MAILER/]]
	MOVEM T1,.IPCFP+GTMPDB
	MOVEI T1,4		;PDB LENGTH
	MOVEI T2,GTMPDB		;PDB ADDRESS
	MSEND			;SEND IT OFF
	 JRST [	MOVE T1,.IPCFS+GTMPDB ;FAILED, GET CREATED PID
		CALLRET RELPID]	;RELEASE PID AND TAKE ERROR RETURN

;RECEIVE REPLY FROM INFO

	SETZM .IPCFL+GTMPDB	;NO FLAGS
	MOVE T3,.IPCFS+GTMPDB	;GET MY PID
	MOVEM T3,.IPCFR+GTMPDB	;MAKE ME THE RECEIVER
	MOVSI T3,2		;GET SIZE OF ANSWER
	HRRI T3,GTMANS		;GET ADDRESS OF ANSWER
	MOVEM T3,.IPCFP+GTMPDB	;SET UP POINTER TO ANSWER IN PDB
	MRECV			;RECEIVE REPLY FROM INFO
	 JRST [	MOVE T1,.IPCFR+GTMPDB ;ERROR
		CALLRET RELPID]	;RELEASE PID AND FAIL
	MOVE T1,.IPCFR+GTMPDB	;GET MY PID
	CALL RELPID		;DON'T NEED IT ANY MORE

;CHECK COMPLETION CODE FROM INFO

	MOVE T1,.IPCFL+GTMPDB	;GET FLAGS WORD FROM PDB
	TRNE T1,IP%CFE		;ERROR?
	RET			;YES, FAIL
	MOVE T1,1+GTMANS	;GET PID OF INFO
	MOVEM T1,MLRPID		;REMEMBER IT FOR FUTURE REFERENCE
	RETSKP			;RETURN SUCCESS

;SCNU - SCAN STRING FOR USER NAME
; T1/ STRING POINTER TO USER NAME STRING
;RETURNS +1: ALWAYS
; T1/ BYTE POINTER TO CHARACTER FOLLOWING USER NAME
; T2/ USER NUMBER OR 0 IF NO VALID USER NAME WAS FOUND
; T3/ CHARACTER FOLLOWING USER NAME

;NOTE:	THIS ROUTINE ASSUMES THAT USER NAMES CONTAIN ONLY UPPER CASE
;	LETTERS, LOWER CASE LETTERS, DIGITS, AND PERIODS

SCNU:	STKVAR <<RDAT,3>>
	MOVEM T1,RDAT		;STORE CALLER'S STRING POINTER
	SETZM 1+RDAT		;CLEAR THE USER #
	MOVE T1,[POINT 7,SCNUD]	;SET UP POINTER TO TEMP AREA

;SCAN STRING COPYING USER NAME INTO TEMP AREA (SCNUD) FOR RCUSR JSYS

SCNU1:	ILDB T2,RDAT		;GET A CHARACTER FROM STRING
	IDPB T2,T1		;TRANSFER TO TEMP AREA
	CAIN T2,.CHCNV		;QUOTING CHARACTER?
	JRST [	ILDB T2,RDAT	;YES, GET CHARACTER FOLLOWING IT
		DPB T2,T1	;OVERWRITE QUOTING CHARACTER
		JRST SCNU1]	;CONTINUE
	CAIL T2,"a"		;LOWER CASE?
	CAILE T2,"z"
	SKIPA
	SUBI T2,40		;YES, CONVERT TO UPPER CASE
	CAIL T2,"A"		;UPPER CASE?
	CAILE T2,"Z"
	SKIPA
	JRST SCNU1		;YES, CONTINUE SCAN
	CAIL T2,"0"		;NUMERIC?
	CAILE T2,"9"
	SKIPA
	JRST SCNU1		;YES, CONTINUE SCAN
	CAIN T2,"."		;PERIOD?
	JRST SCNU1		;YES, CONTINUE SCAN

;END OF USER NAME FOUND

	MOVEM T2,2+RDAT		;REMEMBER LAST CHARACTER FOR CALLER
	SETZ T2,
	DPB T2,T1		;TIE OFF USER NAME IN TEMP AREA
	MOVX T1,RC%EMO		;FLAGS (EXACT MATCH ONLY)
	HRROI T2,SCNUD		;GET POINTER TO TEMP AREA
	RCUSR			;CHECK OUT USER NAME
	 ERJMP SCNU2		;ERROR
	TXNN T1,RC%NOM		;VALID USER NAME?
	MOVEM T3,1+RDAT		;YES, RETURN USER # TO CALLER
SCNU2:	DMOVE T1,RDAT		;LOAD UP AC'S TO RETURN TO CALLER
	MOVE T3,2+RDAT
	RET

;RELPID - RELEASE A PID
; T1/ PID (IF PID IS ZERO, NO ACTION IS TAKEN)
;RETURNS +1: ALWAYS

RELPID:	SKIPN T4,T1		;IS THE PID ZERO?
	RET			;YES, NO ACTION
	MOVEI T3,.MUDES		;MUTIL FUNCTION CODE
	MOVEI T2,T3		;ARGUMENT BLOCK ADDRESS
	MOVEI T1,2		;ARGUMENT BLOCK LENGTH
	MUTIL			;RELEASE THE PID
	 JFCL
	RET

	END