Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mm-dom/vmail.mac
There are 6 other files named vmail.mac in the archive. Click here to see a list.
Title VMAIL - MMAILR / TOPS-20 Mail-11 Listener
Subttl LCampbell/GStevens/DDyer-Bennet/MDLyons/JHTorrey/PLBudne/MRCrispin
Search Macsym,Monsym
.require Sys:Macrel
Sall
.directive Flblst
.text "/NOINITIAL"
.text "VMAIL/SAVE"
IFNDEF OT%822,OT%822==:1
; This program is derived from the VMAIL distributed on the
; "integration tools tape". It listens on DECnet object 27 for mail
; from the VMS MAIL Utility. When a VMS user says "MAIL NODE::USER" A
; connection is established then and there, and text is sent one line
; at a time. A problem is that this server is single thread, and one
; VMS user can tie up the port, making all other mail to the '20
; fail!!
; At the current time the addressee must be a valid TOPS-20 username,
; since the destination is stored as a user number. I never finished
; an interface to MMAILBOX to vaildate full MMAILR addresses.
; Another interesting problem is that there may be no reply path for
; mail. I had thought of taking the VMAILR program and hacking it to
; be the delivery agent for a #Special domain. At BU we run software
; tools mail on most VMS systems, so this is not a problem.
IFNDEF FTRCVD,FTRCVD==1 ;INCLUDE RECIEVED: HEADER
IFNDEF MBXF,MBXF==0 ;INCOMPLETE!!
IFN MBXF,<
.REQUIRE VMAMBX ;INTERFACE TO MMAILBOX
EXTERNAL MBXFRK,MBXVFY
> ;MBXF
T1==1
T2==2
T3==3
T4==4
T5==5
P1==6
P2==7
P3==10
P4==11
P5==12
Ptr==13 ;Global Byte Pointer To Receive Mail
Cnt==14 ;Global Byte Count For Same
Cx==16
P==17
.ver==6
.mvr==1
.edt==^D82
Loc 137
Exp <.ver>B11+<.mvr>B17+1B18+.edt
Reloc
Define Jerr(String),<
Xlist
IFJER.
Hrroi T1,[Asciz /VMAIL error: /]
Esout
Hrroi T1,[Asciz /String/]
Psout
Hrroi T1,[Asciz / because: /]
Psout
Movx T1,.priou
Hrloi T2,.fhslf
Erstr
Erjmp .+2
Erjmp .+1
Call Dtstmp ;; Log This Lossage Also
Log <String>
Log < Because: >
Move T1,LogJFN
Hrloi T2,.fhslf
Erstr
Erjmp .+2
Erjmp .+1
Jrst Fatal
ENDIF.
List
>
Define Log(String),< ;; Put Message Into Log File
Xlist
Hrroi T1,[Asciz \String\] ;; So It Can Type Slashes
Call Logmsg
List
>
Define Debug(String),<
Skipn Dbugsw
IFSKP.
Hrroi T1,[Asciz /String/]
Psout
ENDIF.
>
Define Debstr(String),<
Skipn Dbugsw
IFSKP.
Hrroi T1,String
Psout
ENDIF.
>
Define Clrbuf(bufnam,Buflen),<
Setzm Bufnam
Move T1,[Bufnam,,Bufnam+1]
Blt T1,Bufnam+buflen-1
>
Define Nchar,<
Move T1,NetJFN
Bin
Move T1,T2
>
Define Nrecord(Buffer,Nchar),<
Move T1,NetJFN
Hrroi T2,Buffer
Movni T3,Nchar
Setz T4,
Sinr
Jerr <SINR failed at Nrecord>
>
Define Vaxsuccess,<
Move T1,NetJFN
Hrroi T2,[Ascii//]
Movei T3,-4
Setz T4,
Soutr
>
Define Vaxerr(Errmsg),<
Move T1,NetJFN
Hrroi T2,[Ascii//]
Movei T3,-4
Setz T4,
Soutr
Move T1,NetJFN
Hrroi T2,[Asciz /Errmsg/]
Setzb T3,T4
Sout
Hrroi T2,Atmbuf
Setzb T3,T4
Sout
Hrroi T2,[Asciz/ At Node /]
Setzb T3,T4
Sout
Hrroi T2,ournam
Setzb T3,T4
Soutr ; force string transmission
Hrroi T2,[0]
Movei T3,-1
Setz T4,
Soutr
>
Define Die(String),< ;; Fatal Internal Error
Xlist
Jrst [ Hrroi T1,[Asciz /VMAIL fatal internal error: /]
Esout
Hrroi T1,[Asciz /String/]
Psout
Hrroi T1,[Asciz /
/]
Psout
Call Dtstmp ;; Time Stamp It
Hrroi T1,[Asciz /Fatal error: /]
Call Logmsg
Hrroi T1,[Asciz /String/]
Call Logmsg
Jrst Fatal]
List
>
Define Herald(Ver,Edt),<
Xlist
; Tmsg <VMAIL version Ver(Edt) running>
Hrroi T1,[Asciz /VMAIL version Ver(Edt) running/]
Call Logmsg
List
>
Define Log(String),<
Xlist
Hrroi T1,[Asciz \String\]
Call Logmsg
List
>
;Storage
Tmplen==500 ; Temporary Storage
Natmbf==100 ; Length Of Atom Buffer In Words
Bbflen==300000 ;[154] Length Of Big Mail Buffer
Nfrmbf==70 ; Length Of Sender Name Buffer
Timen==^D<10*60*1000> ; Milliseconds Before Sender Declared Tardy
Stklen==200 ; Size Of Stack
Dbugsw: 0 ; -1 If Debug
Atmbuf: Block Natmbf ; Atom Buffer
Subbuf: Block Natmbf ; Subject Buffer
Toocnt: Block 1 ; Count of recipients per line in TOOBUF
Tooptr: Block 1 ; Pointer to current position in TOOBUF
Toobuf: Block Natmbf ; To Names Buffer
Bigbuf: Block Bbflen ; Where It All Is Combined To
Nodstr: Block ^D200 ; String space for recipient nodes/USERS
NODPTR: BLOCK 1 ;[BUDD] BP INTO NODSTR
Ulist: Block ^D200 ; Where To Store Mailbox Directory Numbers
Frmbuf: Block Nfrmbf ; Where To Put Sender'S Name Plus Host
Frmnam: Block Nfrmbf ; Where To Put Sender'S Name
Ournam: Block 2 ; Our Host Name
Hstnam: Block 2 ; Host name we are sending to
Usrnum: Block 1 ; User number we are sending to
MYPID: BLOCK 1 ;[BUDD] OUR IPCF PID
BUFFER: BLOCK 10 ;[BUDD] IPCF BUFFER
IPCBLK: BLOCK 4 ;[BUDD] IPCF DESCR BLOCK
OURJOB: BLOCK 1 ;[BUDD] OUR JOB NUMBER
QUEJFN: BLOCK 1 ;[BUDD] MMAILR QUEUE JFN
Filnam: Block 1 ;[BUDD] File name for MMAILR QUEUE FILE
Temp1: Block Tmplen
Temp2: Block Tmplen
Stack: Block Stklen ; One Stack For Each Fork
NetJFN: Block 1 ; Network File JFN
LogJFN: Block 1 ; Log File JFN
LOGP: BLOCK 1 ; Non-zero if keeping logs
Ntime: Block 1 ; Time Receipt Of Mail Initiated (For Status)
Elptim: Block 1 ; Elapsed Time For Receipt Of Mail
Kepliv: Block 1 ; Keep alive count for dead mans timer
Bytcnt: Block 1 ; Length Of Mail In Bytes
Capenb: Block 1 ; Saved Capabilities
IFN MBXF,< ;[BUDD]
GOTMBX: BLOCK 1 ;[BUDD] -1 IF HAVE MBX FORK
> ;[BUDD] MBX
Pc1: Block 1 ; Pc Save Location For Psi Level
Pc2: Block 1
Pc3: Block 1
Levtab: Pc1
Pc2
Pc3
Chntab: 2,,Conect ; Connect Initiate On Level 2
1,,Timout ; Timeout Psi On Level 1
Xlist ; Nothing Else
Repeat ^d34,<Exp 0>
List
VMAIL:: Reset
Move P,[-Stklen,,Stack]
GJINF ;[BUDD]
Movem T3,OurJob ;[BUDD]
Movx T1,.ndgln ; Get Local Node Name Function
Move T2,[Point 7,Ournam]
Movem T2,1(P) ; Put Pointer On Stack
Movei T2,1(P) ; And Point To It
Node ; Get Node Name
ifjer.
tmsg <?No DECnet in this monitor>
haltf%
endif.
IFN MBXF,SETZM GOTMBX ;[BUDD] CLEAR MBX AVAIL FLAG
Movx T1,.fhslf ; This Process
Move T2,[Levtab,,Chntab]
Sir ; Init Psi System
Eir
Call Opnlog ; Open Log File
Movem T1,LogJFN ; Save JFN
Call Dtstmp ; Time Stamp It
Herald \.ver,\.edt
Log< on node >
; Tmsg < on node >
; Hrroi T1,Ournam
; Psout
; Tmsg <
;>
Hrroi T1,Ournam
Call Logmsg
VMAIL0: Call Opnlsn ; Open Connection And Set Interrupt Up
Move T1,LogJFN ; Close Log File For Perusers
Closf
Erjmp .+1
Wait ; For Connect Initiate
;Here When Connection Initiated
Conect: Move P,[-Stklen,,Stack] ; Reset Stack
Call Timeit ; Time This Guy
Call Opnlog ; Open Log File
Movem T1,LogJFN
Call Dtstmp ; Time Stamp This Transaction
Log <----Connect from >
Debug <----Connect from >
Call T4nhst ; Type Foreign Host Name At Log File
Clrbuf Subbuf,Natmbf
Move T1,NetJFN ; Accept Connection
Movx T2,.mocc
Setzb T3,T4 ; No Additional Data
Mtopr
Jerr <Couldn't accept net connection>
Conct1: Move T1,NetJFN ; Get network link status
Movei T2,.morls
Mtopr
Jerr <Couldn't get link status>
TXNE T3,MO%ABT ; [154] Has the link been aborted?
JRST DMPLNK ; [154] Yes, get rid of it.
Txne T3,Mo%con ; Skip if link not connected
Jrst Conct2
Movei T1,^D1000 ; Wait a second and try again
Disms
Jrst Conct1
Conct2: Movx T1,.hpelp ; Elapsed Time Since System Startup
Hptim ; Snarf It
Jerr <HPTIM failed>
Movem T1,Ntime ; Remember Time This Reception Started
Call Parse ; Parse The Mail
Jrst Errxit ; Failed, Quit Now
Call Dtstmp ; Time Stamp Log
Log <Message from >
Hrroi T1,Frmbuf ; Sender'S Name
Call Logmsg ; Log It
Log < received >
Call Lstats ; Log Statistics
Call Mailit ; Send The Mail Off
Die <Failure returned from MAILIT>
Errxit: Call Clznet ; Close And Reopen Net Link
Call Cncltm ; Cancel Timeout Request
Call Dtstmp
Log <----Connection closed>
Move T1,LogJFN
Closf ; Close Log File For Perusers
Erjmp .+1
Debrk ; Return To Background
; Parse Mail Received. Place Sender Name In Frmbuf, Recipient Directory
; Numbers In Ulist, Terminated With A Zero Entry
; Headers Must Appear In The Following Order.
; From, To, Cc
; Returns +1: Failure
; +2: Success
;
;PROGRAM FLOW DESCRIPTION NOT ALL ITEMS IN FLOW ARE IN THIS ROUTINE BUT
;IT DOES REPRESENT THE PROCEDURE TO SEND TO A VAX WHICH IS WHY IT IS
;INCLUDED HERE
;
; RECEIVE FROM FIELD FROM VAX
; PARSE FROM FIELD CONVERTING IT TO MS TYPE FIELD IN FRMBUF
; REPEAT UNTIL NULL RECEIVED
; : RECEIVE A RECIPIENT NAME FOR VERIFICATION
; : IF NULL RECEIVED
; : : THEN
; : : : EXIT REPEAT LOOP
; : ENDIF
; : PARSE USER NAME AND NODE
; : IF NODE SAME AS THIS NODE
; : : THEN
; : : : IF USER IS ON THIS SYSTEM
; : : : : THEN
; : : : : : SEND SUCCESS CODE TO VAX
; : : : : : PUT USER NUMBER INTO ULIST
; : : : : ELSE
; : : : : : SEND FAILURE CODE TO VAX
; : : : : : SEND ERROR MESSAGE TO VAX
; : : : : : SEND NULL TERMINATING ERROR MESSAGE TO VAX
; : : : : : RETURN FROM ROUTINE
; : : : ENDIF
; : : ELSE
; : : : SEND SUCCESS TO VAX (MESSAGE WILL BE QUEUED)
; : : : PUT -1 INTO ULIST
; : : : PUT NODE NAME INTO NODLST
; : ENDIF
; END REPEAT
; RECEIVE TO FIELD FROM VAX
; PARSE TO FIELD CONVERTING IT TO MS TYPE FIELD IN TOOBUF
; RECEIVE SUBJECT FIELD FROM VAX
; BEGIN FORMATING MESSAGE INTO MS TYPE MESSAGE
; REPEAT UNTIL NULL RECEIVED
; : RECEIVE A LINE FROM VAX
; : IF NULL RECEIVED
; : : THEN
; : : : EXIT REPEAT LOOP
; : ENDIF
; : OUTPUT TO MS MESSAGE BUFFER
; END REPEAT
; REPEAT UNTIL NULL DETECTED
; : GET FIRST ITEM IN ULIST
; : IF FIRST ITEM IN ULIST = -1
; : : THEN
; : : : GET NODE FROM NODLST
; : : : PUT MAIL INTO FILE FOR DMAILR
; : : : SET FLAG IN DECNET-FLAGS SO FILE GETS SENT
; : : ELSE
; : : : PUT MAIL INTO USERS MAIL FILE
; : : : SPLAT OBNOXIOUS MESSAGE ACCRESS USERS SCREEN
; : ENDIF
; : IF NO ERROR
; : : THEN
; : : : SEND POSITIVE ACKNOWLEDGEMENT TO VAX
; : : ELSE
; : : : SEND NEGATIVE ACKNOWLEDGEMENT TO VAX
; : : : SEND ERROR MESSAGE TO VAX
; : : : SEND NULL TERMINATOR TO VAX
; : ENDIF
; END REPEAT
; RETURN +2
Parse: Clrbuf Frmnam,Nfrmbf
Move T1,NetJFN ; Save It
Movei T2,.morss ; Read Max Record Size
Mtopr
Jerr <Couldn't read max record size> ; This could fail...
Nrecord <Frmnam>,<Nfrmbf*5-1> ; Read From Field
Hrroi T1,Temp1 ; Setup Default Host
Hrroi T2,Hstnam
Setzb T3,T4
Sout
Hrroi T1,Frmbuf ;Parse from field, results to FRMBUF
Move T2,[Point 7,Frmnam]
Call Prsnam
Setzm Toobuf ; Clear first location of TOOBUF
Hrroi T1,Toobuf ; Setup pointer to TOOBUF
Movem T1,Tooptr
Movei T1,3 ; Setup count of recipients per line in TOOBUF
Movem T1,Toocnt
MOVEI T1,NODSTR ;[BUDD]
Movem T1,NodPTR ;[BUDD]
Movsi P1,-^D100 ; Maximum Of 100 Names In List
Parse3: Clrbuf Atmbuf,Natmbf ; Clear receive area
Nrecord <Atmbuf>,<Natmbf*5-1> ; Receive recipient from VAX
Aos Kepliv ; Increment keep alive count
Skipn Atmbuf ; Skip if not end of list
Jrst Parse6 ; End of recipient list
Call Prsusr ; Parse recipient
Jrst [ Call Dtstmp ; None Found, Complain
Vaxerr <%Network mail error: No such user >
Log <%Network mail error: No such user >
Hrroi T1,Atmbuf ; Also Log Losing Name
CallRet Logmsg]
Movem T1,Ulist(P1) ; Save number returned for mailing
Vaxsuccess ; Send VAX the success code
Aobjn P1,Parse3 ; Jump if not too many recipients
Call Dtstmp ; Woops, Too Many
Hrroi T1,Atmbuf ; Also Tell Log File
CallRet Logmsg
Parse6: Setzm Ulist(P1) ; Tie Off Recipient List
;
; Now Get Mailed To Field With Node Name And Subject
;
Clrbuf Atmbuf,Natmbf
Nrecord <Atmbuf>,<Natmbf*5-1>
Nrecord <Subbuf>,<Natmbf*5-1>
; Now Conbine It All Into Bigbuf
Setzm Bytcnt
Hrroi T1,Bigbuf
IFN FTRCVD,< ;[BUDD]
Hrroi T2,[Asciz /Received: from /] ;[BUDD] now, write Received line
Setz T3, ;[BUDD]
SOUT ;[BUDD]
Hrroi T2,HSTNAM ;[BUDD]
SOUT ;[BUDD]
HRROI T2,[ASCIZ ' by '] ;[BUDD]
SOUT ;[BUDD]
HRROI T2,OURNAM ;[BUDD]
SOUT ;[BUDD]
Hrroi T2,[Asciz ' using MAIL-11 '] ;[BUDD]
SOUT ;[BUDD]
Seto T2, ;[BUDD] output current date/time
MovX T3,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822
ODTIM ;[BUDD] RFC 822 standard date
JERR <ODTIM in recieved line failed> ;[BUDD]
Hrroi T2,CRLF0 ;[BUDD]
Setz T3, ;[BUDD]
SOUT ;[BUDD]
> ;IFN FTRCVD
Hrroi T2,[Asciz /Date: /]
Setz T3,
Sout
Seto T2,
MovX T3,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822
Odtim
Jerr <Couldn't get current date-time at PARSE6+n>
Hrroi T2,[Asciz/
From: /]
Setz T3,
Sout
Hrroi T2,Frmbuf
Setz T3,
Sout
Hrroi T2,[Asciz/
To: /]
Setzb T3,T4
Sout
Hrroi T2,Toobuf
Setzb T3,T4
Sout
Hrroi T2,[Asciz/
Subject: /]
Setzb T3,T4
Sout
Hrroi T2,Subbuf
Setzb T3,T4
Sout
Hrroi T2,[Asciz/
Mailed-to: /] ;[BUDD]
Setzb T3,T4
Sout
Hrroi T2,Atmbuf
Setz T3,
Sout
Hrroi T2,CRLF0
SOUT
Hrroi T2,CRLF0
SOUT
Move T5,T1
Repeat: Clrbuf Temp1,Tmplen ; Clear storage area
Nrecord <Temp1>,<Tmplen*5-1> ; Get a message line from the VAX
Aos Kepliv ; Increment keep alive count
Camn T3,[-<tmplen*5-1>] ; Blank line ?
Jrst Crlf ; Yes, output CRLF
Skipn Temp1 ; End of message ?
Jrst Done ; Yes
Move T1,T5 ; Output message line to BIGBUF
Hrroi T2,Temp1
Setzb T3,T4
Sout
Jerr <SOUT failed at REPEAT+a few> ; [151] Add error check
Move T5,T1
Crlf: Move T1,T5 ; Output CRLF to BIGBUF
Hrroi T2,[Asciz/
/]
Setzb T3,T4
Sout
Jerr <SOUT failed at CRLF+3> ;[152] Add error check
Move T5,T1
Jrst Repeat
Done: Move T1,T5 ; Close off message
Hrroi T2,[Asciz /
/]
Setzb T3,T4
Sout
Call Gtbfsz ; Get Buffer Size Into Bigbug
Debug <
>
Debstr <Bigbuf>
Retskp ; All Done!
;
;Store Size Of Bigbuf Into Bytcnt
;
Gtbfsz: Setz T3,
Setz T2,
Move T1,[Point 7,Bigbuf]
Geta: Ildb T2,T1
Jumpe T2,Go
Addi T3,1
Jrst Geta
Go: Movem T3,Bytcnt
Jrst R
;Routine to parse a node and user name and convert it to a TOPS-20
;string compatable with MS
;
;CALL:
; T1 = STRING POINTER TO THE DESTINATION
; T2 = STRING POINTER TO FIELD RECEIVED
; CALL PRSNAM
;
;VARIABLES RETURNED ON SUCCESSFUL COMPLETION
; DESTINATION CONTAINS THE MS STRING
; TEMP1 = HOST
; TEMP2 = USER NAME
; T1 = UPDATED STRING POINTER
;
;RETURNS:
; +1 ALWAYS
PRSNAM:
ACVAR <SPTR,DPTR> ; STORAGE FOR SOURCE/DEST. POINTERS
MOVEM T1,DPTR ; SAVE DESTINATION POINTER
MOVEM T2,SPTR ; SAVE SOURCE POINTER
PRSNM1: MOVE T1,[POINT 7,TEMP2] ; GET POINTER TO WHERE TO STORE STRING
PRSNM2: ILDB T3,SPTR ; GET CHARACTER
JUMPE T3,PRSNMD ; NULL, DONE
CAIN T3," " ; SPACE SEPARATOR?
JRST PRSNM3 ; YES, LOOK FOR PERSONAL NAME
CAIE T3,":" ; END OF NODE SPECIFIER?
IFSKP.
ILDB T3,SPTR ; YES, EAT NEXT COLON
SETZ T3, ; TERMINATE STRING
IDPB T3,T1
HRROI T1,TEMP1 ; UPDATE ORIGINATING HOST
HRROI T2,TEMP2
SOUT
JRST PRSNM1
ENDIF.
IDPB T3,T1 ; SAVE CHARACTER IN TEMP2
JRST PRSNM2
PRSNM3: SETZ T3, ; TERMINATE STRING
IDPB T3,T1
PRSNM4: ILDB T3,SPTR ; GET CHARACTER FROM INPUT STRING
JUMPE T3,PRSNMD ; STRING EXHAUSTED
CAIE T3,42 ; IS CHARACTER START OF PERSONAL NAME?
JRST PRSNM4 ; NO, LOOP TILL STRING EXHAUSTED OR '"' FOUND
MOVE T1,DPTR ; GET DESTINATION POINTER
MOVE T2,SPTR ; GET SOURCE POINTER
SETZ T3,
MOVEI T4,42 ; TILL '"'
SOUT
MOVEI T2," " ; CHANGE '"' TO SPACE
DPB T2,T1
MOVEI T2,"<" ; OUTPUT START OF USERNAME at NODE STRING
IDPB T2,T1
CALL PRSNMS ; CALL ROUTINE TO OUTPUT USERNAME at NODE
MOVEI T2,">" ; OUTPUT END OF USERNAME at NODE STRING
IDPB T2,T1
SETZ T2, ; TERMINATE THE OUTPUT STRING
IDPB T2,T1
RET ; SUCCESS RETURN
PRSNMD: IDPB T3,T1 ; TERMINATE STRING
MOVE T1,DPTR ; BUILD STRING IN DESTINATION BUFFER
CALLRET PRSNMS
ENDAV.
;Routine to create user name at node string in output buffer.
;
;CALL:
; T1 = STRING POINTER TO WHERE TO STORE THE OUTPUT
; TEMP2 = USER NAME
; TEMP1 = NODE NAME
; CALL PRSNMS
;
;VARIABLES RETURNED:
; T1 = UPDATED STRING POINTER
;
;RETURNS:
; +1 ALWAYS
PRSNMS: HRROI T2,TEMP2 ; OUTPUT USER NAME
SETZB T3,T4
SOUT
;; HRROI T2,[ASCIZ/ at /] ; OUTPUT SEPARATOR
;; SOUT
MOVEI T2,"@"
BOUT
HRROI T2,TEMP1 ; OUTPUT NODE NAME
SOUT
HRROI T2,[asciz/.#DECnet/]
SOUT
RET ; SUCCESS RETURN
;Routine to parse addressing of VAX mail and build TO string in TOOBUF
;
;CALL:
; ATMBUF = ADDRESS STRING RECEIVED FROM THE VAX
; CALL PRSUSR
;
;VARIABLES RETURNED ON SUCCESS:
; TEMP1 = NODE OF RECIPIENT
; TEMP2 = NAME OF RECIPIENT
; T1 = USER NUMBER IF ON CURRENT NODE OR
; PTR TO NODE // '\0' // USER FOR 4N HOST
;
;RETURNS:
; +1: ERROR, MAIL WAS ADDRESSED TO THIS NODE AND USER WAS UNKNOWN
; +2: OK, ALL RETURNED VARIABLES VALID
PRSUSR:
MOVE T1,TOOPTR ; GET POINTER TO TOOBUF
SKIPN TOOBUF ; SKIP IF TOOBUF NOT EMPTY
JRST PRSUS1
SOSE TOOCNT ; SUBTRACT FROM COUNT/LINE - SKIP IF .NE. 0
IFSKP.
HRROI T2,[BYTE (7) ",", "M"-100, "J"-100, "I"-100]
SETZ T3,
SOUT
MOVEI T2,3 ; RESET COUNT OF USERS PER LINE IN TOOBUF
MOVEM T2,TOOCNT
JRST PRSUS1
ENDIF.
HRROI T2,[ASCIZ/, /] ; OUTPUT SEPARATOR
SETZ T3,
SOUT
PRSUS1: MOVEM T1,TOOPTR ; SAVE STRING DESTINATION POINTER
HRROI T1,TEMP1 ; SETUP DEFAULT HOST
HRROI T2,OURNAM
SETZ T3,
SOUT
MOVE T1,TOOPTR ; GET DESTINATION POINTER
MOVE T2,[POINT 7,ATMBUF] ; GET POINTER IN INPUT STRING
CALL PRSNAM ; GET TOPS-20 MS STRING
MOVEM T1,TOOPTR ; SAVE POINTER TO TOOBUF
HRROI T1,OURNAM ; GET POINTER TO THIS SYSTEMS NODE NAME
HRROI T2,TEMP1 ; GET HOST NAME FROM FIELD
STCMP ; IS MESSAGE FOR THIS HOST ?
JUMPE T1,PRSUS2 ; JUMP IF FOR THIS HOST
;MAIL IS FOR A REMOTE HOST. GET HOST,,USER STRING POINTERS
HRRZ T4,NODPTR ;GET POINTER TO STRING SPACE
HRRO T1,T4 ;PUT NODE NAME INTO NODE STRING SPACE
HRROI T2,TEMP1
SETZ T3,
SOUT
IDPB T3,T1 ;GET TERMINATOR
HRROI T2,TEMP2 ;GET USER
SOUT
IDPB T3,T1
HRRZM T1,NODPTR
MOVE T1,T4 ;GET STRING POINTER
RETSKP ; RETURN ADDRESS
;MAIL IS FOR THIS SYSTEM. CHECK TO SEE IF USER NAME IS VALID.
PRSUS2:
IFE MBXF,<
HRROI T2,TEMP2 ; POINT TO USER NAME STRING
MOVX T1,RC%EMO ; EXACT MATCH ONLY
RCUSR ; IS THIS USER NAME VALID ?
ERJMP R ; NO, ERROR
TXNE T1,RC%NOM ; SKIP IF USERNAME FOUND
RET ; NO SUCH USER - ERROR
MOVE T1,T3 ; RETURN USER NUMBER IN T1
> ;IFE MBXF
IFN MBXF,<
PRINTX NEED CODE AT PRSUS2
> ;IFN MBXF
RETSKP ; RETURN SUCCESS
; Here To create MMAILR queue file
; Returns +1: Problems Of Some Sort
; +2: Ok
Mailit: Hrroi T1,FILNAM
Hrroi T2,[Asciz 'MAILQ:[--QUEUED-MAIL--].NEW-']
Setz T3,
SOUT
Move T2,T1
GTAD
Exch T1,T2
Movei T3,10
NOUT
Trn
Hrroi T2,[Asciz '-VMAIL-J']
Setz T3,
SOUT
Move T2,OURJOB
Move T3,[3,,^D10]
NOUT
Trn
Hrroi T2,[Asciz '.-1;P770000']
Setz T3,
SOUT
Idpb T2,T3
Movsi T1,(GJ%SHT+GJ%FOU)
Hrroi T2,FILNAM
GTJFN
JERR <Could not get queue JFN>
Movem T1,QUEJFN
Move T2,[fld(7,OF%BSZ)+OF%WR]
OPENF
JERR <Could not open queue JFN>
Hrroi T2,[Asciz '
=NET-MAIL-FROM-HOST:']
Setz T3,
SOUT
Hrroi T2,HstNam
SOUT
Hrroi T2,CRLF0
SOUT
Hrroi T2,[Asciz '
=RETURN-PATH:']
SOUT
Hrroi T2,FRMBUF
SOUT
Hrroi T2,CRLF0
SOUT
;; This is not documented -- but it makes MMAILR splat your TTY right!
Hrroi T2,[Asciz '
_']
SOUT
Hrroi T2,HstNam
SOUT
Hrroi T2,[ASCIZ/.#DECnet
/]
SOUT
Move T3,[Point 7,FrmNam]
DO.
Ildb T2,T3
Jumpe T2,ENDLP.
Cain T2," "
EXIT.
BOUT
LOOP.
OD.
Hrroi T2,CRLF0
Setz T3,
SOUT
Setzb P1,P2 ; Init Index And Failure Flag
Mailt1: Move T1,Ulist(P1) ; Get Next Recipient
Jumpe T1,Mailt5 ; End Of List
Call Sendit ; ADD NAME TO TOP OF QUEUE FILE
TRN
Mailt2: Vaxsuccess
Aoja P1,Mailt1
Mailt5: Jumpn P2, Rskp ; Don'T Log Success on error
;; Skipe P1 ; Anything Sent?
;; IFSKP.
;; Call Dtstmp ; Yes, Loc Lack Of Local Users
;; Log <No local electronic recipients>
;; ENDIF.
Move T1,QUEJFN ; Get MMAILR queue JFN
;;[76] Hrroi T2,CRLF0
;;[76] Setz T3,
;;[76] SOUT ;Sendit now has been fixed!!
Movei T2,"L"-100
BOUT
Hrroi T2,CRLF0
SOUT
Move T2,[Point 7,Bigbuf] ; Shove message into queue file
Movn T3,Bytcnt ; Get negative byte count
SOUT
Erjmp .+1
CLOSF
TRN
CALL WAKEUP
Retskp
; Append Mail To User'S Mail File
; Call With User Number Of Recipient In T1
Sendit: Stkvar <Usrno>
Movem T1,Usrno ; Save Recipients User Number
Jumpg T1,Quefil ; 4n host
Move T1,QueJFN ; Get QUEUE file
Movei T2,"L"-100 ; Get <FF>
BOUT
Hrroi T2,OurNam
Setz T3,
SOUT
Hrroi T2,CRLF0
SOUT
Move T2,UsrNo
DIRST
ERJMP .+1 ;[76] DIRST% always gives +1 return
Hrroi T2,CRLF0
SOUT
Retskp
;Sending to a remote host.
Quefil: MOVE T1,QUEJFN
MOVEI T2,"L"-100
BOUT
HRRO T2,USRNO ;GET HOST BP
SETZ T3,
SOUT
MOVEM T2,USRNO ;SAVE BP TO USER
HRROI T2,CRLF0
SOUT
MOVE T2,USRNO ;GET USER BP
SOUT
HRROI T2,CRLF0
SOUT
RETSKP ;all done
;Here to copy (and quote) "from" string into area pointed to by T1
; Quotes all characters (to save trouble of checking need for it)
QUOTE: MOVE T2,[POINT 7,FRMBUF]
TLC T1,-1 ; lh of byte pointer all ones?
TLCN T1,-1 ; ..
HRLI T1,(POINT 7,) ; yes, make real byte pointer
MOVEI T4,<24*5>-1 ; maximum characters allowed in string
QUOTE1: MOVEI T3,"V"-100 ; quote character
IDPB T3,T1 ; stuff it
ILDB T3,T2 ; next char of source string
IDPB T3,T1 ; stuff it
JUMPE T3,[MOVNI T2,1 ; if zero, back up over last ctrl-V
ADJBP T2,T1 ; ..
DPB T3,T1 ; wipe it out with null
RET] ; and return
SOJGE T4,QUOTE1 ; insure no overflow
DIE <QUOTE overflow>
;Open Log File
Opnlog: MOVX T1,.NULIO ; No logs unless
SKIPN LOGP ; LOGP is set non-zero
RET ; Oh well
Movx T1,Gj%sht ; Try Logical Name First
Hrroi T2,[Asciz /MAIL:VMAIL.LOG/]
GtJFN
Erjmp Opnerr
Movx T2,<070000,,0>+Of%app
Openf ; Open For Append
Erjmp Opnerr
Ret
Opnerr: Hrroi T1,[Asciz /VMAIL: Can't open log file because: /]
Esout
Movx T1,.priou
Hrloi T2,.fhslf
Erstr
Erjmp .+1
Erjmp .+1
Jrst Fatal
;Time Stamp Log File
Dtstmp: Move T1,LogJFN
HRROI T2,[ASCIZ/
/]
SETZ T3,
SOUT%
Jerr <Can't write to log file>
Seto T2, ; Current Time
Odtim
IFJER.
Hrroi T1,[Asciz /VMAIL: Odtim Failed: /]
Esout
Movx T1,.priou
Hrloi T2,.fhslf
Erstr
Erjmp .+2
Erjmp .+1
Tmsg <
DTSTMP called from >
Movx T1,.priou ; Type Pc Of Caller On Terminal
Hrrz T2,(P)
Movx T3,^D8 ; In Octal
Nout
Erjmp .+1
Jrst Fatal ; Go Fire Up The World Again
ENDIF.
Movei T2," " ; Space
Bout
Ret
;Write Asciz String Pointed To By T1 To Log File
Logmsg: Move T2,T1 ; Copy String Pointer
Move T1,LogJFN
Setzb T3,T4
Sout
Jerr <Can't write to log file>
Move T1,T2
Ret
;Write Statistics To Log File
Lstats: Stkvar<Elptm0>
; Move T1,LogJFN
; Move T2,Elptim ; Elapsed Time For Mail Receipt
; Fltr T2,T2 ; Flost It
; Fdvr T2,[100000.0] ; Compute Seconds
; Movx T3,<1b1+Fl%one+Fl%pnt+3b23+3b29>
; Flout ; Type Seconds
; Erjmp [Haltf] ; Never Happens
; Movem T2,Elptm0 ; Save Time
; Log < seconds, >
Log < : >
Move T1,LogJFN
Move T2,Bytcnt ; Byte Count
Movx T3,^D10 ; Base 10
Nout
Jerr <NOUT failure>
Log < chars
>
; Move T1,LogJFN
; Fltr T2,Bytcnt ; Float Byte Count
; Fdvr T2,Elptm0 ; Compute Bytes Per Second
; Movx T3,<1b1+Fl%one+Fl%pnt+5b23+3b29>
; Flout
; Jerr <FLOUT failure>
; Log < chars/sec/
;>
Ret
;Close Net Connection And Reopen It. Re-Enable For Interrupts
; On Connect Initiate Messages
CLZNET: MOVEI T1,^D4000 ; Give pipe four seconds to empty
DISMS ; ..
MOVE T1,NETJFN ; normal close
CLOSF
IFJER.
CALL DTSTMP ; We should complain about these
LOG <%Close error for net link: >
MOVE T1,LOGJFN
HRLOI T2,.FHSLF
ERSTR
ERJMP .+1
ERJMP .+1
MOVE T1,NETJFN
TXO T1,CZ%ABT ; Try real hard to close it
CLOSF ; so we don't eat all job 0 JFNs
ERJMP .+1
MOVE T1,NETJFN
RLJFN
ERJMP .+1
ENDIF.
CALL OPNLSN ; open connection again
RET ; return
;Open The Net Connection And Listen For Connect Initiates
Opnlsn: Movx T1,Gj%sht
Hrroi T2,[Asciz /Srv:27/] ; Magic Number For Vax Mail Server
GtJFN
Jerr <Can't get net JFN for server>
Movx T2,Of%rd!Of%wr!<100000,,0>
Openf
Jerr <Can't open net JFN>
Movem T1,NetJFN
Movx T2,.moacn ; Enable For Psi On Network Transitions
Movx T3,0b8+<.mocia>B17+<.mocia>B26 ; Channel Zero
Mtopr
Jerr <Can't enable for PSI on network transitions>
Movx T1,.fhslf
Movx T2,1b0 ; Activate Channel Zero
Aic
Ret
;Log Name Of Foreign Host
T4nhst: Setzm Hstnam ; Zero This String
Setzm 1+Hstnam ; ..
Move T1,NetJFN ; Get Net JFN
Movx T2,.morhn ; Return Host Name
Hrroi T3,Hstnam ; Where To Put It
Mtopr
IFJER.
Hrroi T1,[Asciz /???/]
Callret Logmsg ; Log confusion
ENDIF.
Hrroi T1,Hstnam ; Copy Name To Log File
Skipe Dbugsw
Psout
Hrroi T1,Hstnam ; Copy Name To Log File
Call Logmsg ; ..
Ret
;Set Up To Time Out If Network Too Slow
Timeit: Move T1,[.fhslf,,.timel]
Move T2,[Timen] ; Milliseconds To Allow
Movei T3,1 ; Channel One
Timer
Jerr <Can't time myself>
Movx T1,.fhslf ; Activate Timer Channel
Movx T2,<1b1>
Aic
Ret
;Cancel Above Timer Request
Cncltm: Move T1,[.fhslf,,.timal] ; Remove All Pending Timer Requests
Movei T3,1 ; For This Channel
Timer
Jerr <Can't remove pending timer request>
Ret
;Here On Timeout
Timout:
; Call Dtstmp
Skipn KEPLIV ; Skip if still alive
Die <Timeout Occured> ; [153] No activity, dead
Setzm KEPLIV ; Clear keep alive flag
Push P,T1 ; Save ACs before calling Timeit
Push P,T2
Push P,T3
Call Timeit ; Start new timer
Pop P,T3 ; Restore ACs before resuming
Pop P,T2
Pop P,T1
Debrk ; Allow things to continue
;Here If Net Link Dies While Outputting To It
Dmplnk: Cis ; Zap Things
Movx T1,Cz%abt ; Abort The Net JFN
Hrr T1,NetJFN ; ..
Closf ; ..
Erjmp .+1 ; Don'T Care
Call Dtstmp
Log <----Connection aborted
>
Movx T1,.fhslf ; Deactivate Connect Initiate Channel
Movx T2,<1b0> ; ..
Dic ; ..
Call Cncltm ; Cancel Pending Timer Requests
Move T1,LogJFN ; Close Log File
Closf
Erjmp .+1
; Jrst VMAIL0 ; Go Wait For New Mail
Jrst VMAIL ; Restart on connection abort
;Here On Fatal Wipeout (Jsys Which Can'T Fail Does, For Instance)
Fatal: Movx T1,.fhslf
Dir ; Disbale Interrupts
Cis ; Clear Interrupts
; Remove out-of-synch message on fatal error
;; Move T1,NetJFN ; Type A Record To Force Net Buffers Out
;; Hrroi T2,[Asciz /
;;?VMAIL Internal Error/]
;; Setzb T3,T4 ; Add Question Mark So Mail Isn'T Requeued
;; Soutr ; ..
;; Erjmp .+1
;; Movei T1,^D5000 ; Wait Five Seconds
;; Disms
skipe t1,logJFN
Closf
Erjmp .+1
setzm logJFN
Movx T1,.fhslf!cz%abt ; Abort All JFNs
Clzff ; ..
ERJMP .+1 ; Ignore errors in the fatal error routine
Call Opnlog ; Reopen Log File
Movem T1,LogJFN
Call Dtstmp
Log <Error restart...
>
Tmsg <VMAIL error restart...
>
Move T1,LogJFN
CLOSF%
ERJMP .+1
Movei T1,^D5000 ; Wait Some More
Disms
Jrst VMAIL ; And Fire Up The World Again
;Disable Capabilities So Quota-Checking Happens
Capoff: Push P,T1 ; Don'T Clobber
Movx T1,.fhslf ; Get My Caps
Rpcap
Movem T3,Capenb ; Remember For Later
Setz T3, ; No Caps At All
Epcap
Pop P,T1 ; Restore
Ret
;Re-Enable Caps
Capon: Push P,T1 ; No Clobberage
Movx T1,.fhslf
Move T3,Capenb ; Caps We Had Before
Epcap
Pop P,T1
Ret
CRLF0: ASCIZ /
/
; FROM DMASER.MAC
A==1
B==2
C==3
WAKEUP: SKIPE T2,MYPID ; have a PID already?
TDZA T1,T1 ; yes, use it
MOVX T1,IP%CPD ; no, create a PID
MOVEM T1,IPCBLK+.IPCFL
MOVEM T2,IPCBLK+.IPCFS ; PID to use if one there
SETZM IPCBLK+.IPCFR ; send to INFO
MOVX T1,<.IPCI2+3,,BUFFER> ; length of INFO msg,,where INFO msg is
MOVEM T1,IPCBLK+.IPCFP
MOVX T1,.IPCIW ; return PID associated with name
MOVEM T1,BUFFER+.IPCI0
SETZM BUFFER+.IPCI1 ; duplicate copy not needed
DMOVE T1,[ASCII/[SYSTEM]MM/] ; 1st part of PID to look up
DMOVEM T1,BUFFER+.IPCI2
MOVE T1,[ASCII/AILR/] ; 2nd part of PID to look up
MOVEM T1,BUFFER+.IPCI2+2
MOVX T1,.IPCFP+1 ; length of block
MOVEI T2,IPCBLK ; get MMailr's PID
MSEND%
ERJMP R ; looks like INFO isn't there
MOVE T1,IPCBLK+.IPCFS ; get the PID I made
MOVEM T1,MYPID ; remember it for next time
DO.
SETZM IPCBLK+.IPCFL ; no flags
SETZM IPCBLK+.IPCFS ; any sender
MOVE T1,MYPID ; I'm the receiver
MOVEM T1,IPCBLK+.IPCFR
MOVX T1,<10,,BUFFER> ; place to put the reply
MOVEM T1,IPCBLK+.IPCFP
MOVX T1,.IPCFP+1 ; length of block
MOVEI T2,IPCBLK ; get reply from INFO
MRECV%
ERJMP R ; failure irrelevant here
LOAD T1,IP%CFC,IPCBLK+.IPCFL ; see who sent message
CAIE T1,.IPCCC ; from <SYSTEM>IPCF?
CAIN T1,.IPCCF ; no, from <SYSTEM>INFO?
IFSKP.
LOOP. ; no, get another message
ENDIF.
ENDDO.
JN <IP%CFE,IP%CFM>,IPCBLK+.IPCFL,R ; give up if undeliverable
SETZM IPCBLK+.IPCFL ; no flags
MOVE T1,MYPID ; I'm the sender
MOVEM T1,IPCBLK+.IPCFS
MOVE T1,BUFFER+.IPCI1 ; MMailr is the recipient
MOVEM T1,IPCBLK+.IPCFR
MOVX T1,<1,,BUFFER> ; one word from BUFFER
MOVEM T1,IPCBLK+.IPCFP
MOVX T1,'PICKUP' ; magic word to wake up MMailr
MOVEM T1,BUFFER
MOVX C,^D20
DO.
MOVX T1,.IPCFP+1 ; length
MOVEI T2,IPCBLK ; send wakeup to MMailr
MSEND%
IFJER.
MOVEI T1,^D1000 ; failed, wait a bit
DISMS%
SOJG C,TOP. ; try a few times
RET ; failed, give up
ENDIF.
ENDDO.
MOVX T1,.MUQRY ; query function for MUTIL%
MOVEM T1,BUFFER
MOVE T1,MYPID ; query packets for our PID
MOVEM T1,BUFFER+1
MOVX C,^D20 ; number of retries
DO.
MOVX T1,.IPCFP+2 ; number of words to return
MOVEI T2,BUFFER ; argument block in BUFFER
MUTIL%
IFJER.
MOVEI T1,^D1000 ; wait a bit
DISMS%
SOJG C,TOP. ; retry a few times
RET
ENDIF.
ENDDO.
DO.
SETZM IPCBLK+.IPCFL ; no flags
SETZM IPCBLK+.IPCFS ; sender is filled in by monitor
MOVE T1,MYPID ; I'm the receiver
MOVEM T1,IPCBLK+.IPCFR
MOVX T1,<10,,BUFFER> ; where MMailr reply will go
MOVEM T1,IPCBLK+.IPCFP
MOVX T1,.IPCFP+1 ; size of block
MOVEI T2,IPCBLK ; get reply from MMailr
MRECV%
ERJMP .+1 ; error uninteresting here
LOAD T1,IP%CFC,IPCBLK+.IPCFP ; get sender code
IFN. T1 ; special sender?
CAIE T2,.IPCCF ; from <SYSTEM>INFO
CAIN T2,.IPCCP ; or private <SYSTEM>INFO?
LOOP. ; yes, try for another message
ENDIF.
ENDDO.
RET
End VMAIL