Trailing-Edge
-
PDP-10 Archives
-
BB-4172G-BM
-
language-sources/armail.mac
There are 40 other files named armail.mac in the archive. Click here to see a list.
;<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