TITLE ARMAIL - Mail sending routines for Archive system
	SUBTTL Vince Fuller/VAF/MRC
	SALL
	SEARCH MONSYM,MACSYM
	.REQUIRE SYS:MACREL
	.REQUIRE SYS:HSTNAM
	EXTERN $GTLCL
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