Trailing-Edge
-
PDP-10 Archives
-
T10_T20_MS_V10_SRCS_830128
-
mailex.mac
There are no other files named mailex.mac in the archive.
;<LCAMPBELL>MAILEX.MAC.2 27-Dec-82 09:13:12, Edit by LCAMPBELL
; Add authenticated "Sender" field to prevent mail forgery
;<LCAMPBELL>MAILEX.MAC.3 12-Feb-82 15:11:08, Edit by LCAMPBELL
; Replace HRLI at ALLIN that got removed somehow... this fixes Judy's
; CC bug.
; UPD ID= 27, SNARK:<6.UTILITIES>MAILEX.MAC.2, 4-Feb-82 17:56:33 by MURPHY
;Put ERJMP after TTMSG to prevent crashes.
;----- (author unknown)
;Fix bug when "to" list empty
;Don't build headers here, and allow null "to" list if cc non-null
; UPD ID= 1469, SNARK:<5.UTILITIES>MAILER.MAC.3, 21-Jan-81 22:22:07 by ZIMA
; TCO 5.1237 - fix 4.1.1081 to remove security bug.
; UPD ID= 945, SNARK:<5.UTILITIES>MAILER.MAC.2, 21-Aug-80 00:30:31 by LCAMPBELL
; UFPGS MAIL.TXT in case of system crash shortly after mail delivery
; UPD ID= 930, SNARK:<4.1.UTILITIES>MAILER.MAC.4, 20-Aug-80 12:47:56 by MILLER
;FIX TYPEO
; UPD ID= 273, SNARK:<4.1.UTILITIES>MAILER.MAC.3, 19-Feb-80 10:26:06 by MILLER
;MORE TCO 4.1.1081 FIXES
; UPD ID= 264, SNARK:<4.1.UTILITIES>MAILER.MAC.2, 15-Feb-80 10:04:24 by MILLER
; TCO 4.1.1081. DO CHKAC ON COPY FILE
;<4.UTILITIES>MAILER.MAC.36, 20-Sep-79 13:20:35, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.35, 20-Sep-79 13:18:36, Edit by LCAMPBELL
; Remove initial dashes from msgs (violates RFC733)
;<4.UTILITIES>MAILER.MAC.34, 19-Sep-79 12:32:41, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.33, 19-Sep-79 12:28:10, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.32, 19-Sep-79 12:25:17, Edit by LCAMPBELL
; If MAIL.TXT busy, wait for up to 20 seconds before giving up
;<4.UTILITIES>MAILER.MAC.31, 16-Aug-79 14:35:13, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.30, 16-Aug-79 14:25:23, Edit by LCAMPBELL
; Insure CRLF before =======
;<4.UTILITIES>MAILER.MAC.29, 16-Aug-79 11:34:53, Edit by LCAMPBELL
; Eliminate ALL nulls from mail
;<4.UTILITIES>MAILER.MAC.28, 15-Aug-79 18:14:32, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.27, 15-Aug-79 18:07:42, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.26, 15-Aug-79 18:01:42, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.24, 15-Aug-79 17:28:17, Edit by LCAMPBELL
;<4.UTILITIES>MAILER.MAC.23, 15-Aug-79 17:26:10, Edit by LCAMPBELL
; TCO 4.2402 - Don't insert spurious nulls into MAIL.TXT
;<4.UTILITIES>MAILER.MAC.22, 25-Jun-79 17:12:08, Edit by LCAMPBELL
; Prettier date/time in headers
;<4.UTILITIES>MAILER.MAC.21, 29-May-79 09:55:43, Edit by OSMAN
;TCO 4.2260 - Don't check TT%DAM when outputting mail announcement
;<4.UTILITIES>MAILER.MAC.20, 4-May-79 14:43:48, Edit by LCAMPBELL
; Don't put unwanted dashes into header
;<4.UTILITIES>MAILER.MAC.19, 1-May-79 13:26:27, EDIT BY OSMAN
;tco 4.2242 - Don't go arggggggh when bogus user number received
;<4.UTILITIES>MAILER.MAC.18, 4-Apr-79 13:28:26, Edit by LCAMPBELL
; Upper/lowercase header fields
;<4.UTILITIES>MAILER.MAC.17, 12-Mar-79 14:23:54, Edit by LCAMPBELL
; At OVRQTA, save D before IDIVI, since remainder goes in D
;<4.UTILITIES>MAILER.MAC.16, 10-Mar-79 14:06:09, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>MAILER.MAC.15, 9-Mar-79 10:28:57, EDIT BY MILLER
;ONE MORE CHANGE TO OVRQTA. DO PAGE COMPUTATIONS CORRECTLY
;<4.UTILITIES>MAILER.MAC.14, 9-Mar-79 10:18:17, EDIT BY MILLER
;MORE FIXED. GET PAGE NUMBER CORRECTLY AT OVRQTA
;<4.UTILITIES>MAILER.MAC.13, 8-Feb-79 10:15:55, EDIT BY MILLER
;FIX OVER QUOTA HANDLING (AGAIN). USE CHFDB TO SET EOF POINTER
;<4.UTILITIES>MAILER.MAC.12, 23-Jan-79 16:09:18, Edit by KONEN
;UPDATE VERSION NUMBER FOR RELEASE 4
;<4.UTILITIES>MAILER.MAC.11, 23-Oct-78 19:52:38, Edit by HESS
;TCO 4.2062 - ADD COMMA TO END OF TO: AND CC: LINES THAT ARE CONTINUED
;<4.UTILITIES>MAILER.MAC.10, 20-Oct-78 10:52:58, Edit by HESS
;TCO 4.2056 CHECK 'REFUSE SYSTEM-MESSAGES' AND SET LAST WRITER STRING
;<4.UTILITIES>MAILER.MAC.9, 21-Sep-78 11:07:31, EDIT BY MILLER
;TCO 1897 AGAIN. MAKE SURE JFN IS IN A AT OVRQT1
;<4.UTILITIES>MAILER.MAC.8, 19-Jul-78 19:44:21, EDIT BY MILLER
;TURN ON CAPS BEFORE DOING CHFDB
;<4.UTILITIES>MAILER.MAC.7, 3-Apr-78 09:51:56, EDIT BY MILLER
;TCO 1897. FIX QUOTA PROBLEM
;<4.UTILITIES>MAILER.MAC.6, 3-Apr-78 09:48:00, EDIT BY MILLER
;OPENF MAIL FILE FOR READ AND WRITE
;<4.UTILITIES>MAILER.MAC.5, 3-Apr-78 09:42:46, EDIT BY MILLER
;FIX TYPEO
;<4.UTILITIES>MAILER.MAC.4, 3-Apr-78 09:42:12, EDIT BY MILLER
;COMPUTE EOF OF MAIL FILE FROM FDB DATA
;<4.UTILITIES>MAILER.MAC.3, 31-Mar-78 13:11:54, EDIT BY MILLER
;<4.UTILITIES>MAILER.MAC.2, 31-Mar-78 13:07:05, EDIT BY MILLER
;<4.UTILITIES>MAILER.MAC.1, 31-Mar-78 13:05:21, EDIT BY MILLER
;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 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE MAILEX - New IPCF Mailer
SEARCH MONSYM,MACSYM
SALL
.REQUIRE SYS:MACREL
IFNDEF .PSECT,<
.DIRECT .XTABM>
; VERSION NUMBER DEFINITIONS
VMAJOR==5 ;MAJOR VERSION OF MAILER
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==14 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
VMAILR== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
;DEFINE REGISTERS
A==1
B==2
C==3
D==4
W==5
W1==6
W2==7
W3==10
W4==11
W5==12
W6==13
P==17
NOACK==2 ;NO MESSAGES COULD BE SENT
NOACK1==1 ;ONE OR MORE IDS WERE BAD
NOACKQ==1 ;QUOTA EXCEEDED
NOACKB==0 ;STANDARD MEANINGLESS ERROR
.IPCSN==67 ;INFO WEND NAME FUNCTION
MAXTRY==5
SYSCOD==-2 ;SPECIAL CODE FOR SYSTEM MESSAGE
MESS==10000 ;MESSAGE BUFFER
USERS==^D512
USRBLK=11000
FILBUF==USRBLK+USERS
FILSIZ==^D50
BIGBUF==FILBUF+FILSIZ
SIZE==^D500000/5 ;SIZE OF MESSAGE BUFFER
AREA==BIGBUF+SIZE ;FREE SPACE AREA
FRESIZ==5000 ;LEAVE LOTS OF ROOM
EOFPTR: BLOCK 1 ;HOLD EOF VALUE
GETSIZ: BLOCK 2 ;TO HOLD FDB DATA
FREHD: Z AREA
FLAGWD: 0 ;FLAG WORD
CONDIR: BLOCK 1 ;SAVE CONNECTED DIR HERE
SYSDIR: BLOCK 1 ;REMEMBER SYSTEM NUMBER HERE
SYSDI1: BLOCK 1 ;DIR OF SYSTEM
STACK: BLOCK 20 ;PDL FOR MAILER
DEFPKT: ;PACKET TO DEFINE MAILER
4 ;ASSIGN TO THIS JOB
0
ASCIZ /[SYSTEM]MAILEX/ ;MY NAME
ENDPKT: ;END OF PACKET
SAVPID: Z 0 ;SAVE USSER'S PID
JFN: Z 0 ;WHERE TO DAVE JFN
SAV: BLOCK 1 ;SAVE SP
GTINF: BLOCK <.JICPJ-.JITNO+1> ;GETJI STORES DATA HERE
USRBUF: ASCII /PS:</
BLOCK 11 ;WHERE TO FORM USER NAME FOR RCDIR
ERRORS: Z 0 ;ERROR COUNT
MYPID: Z 0 ;MY ID
SENDQ: Z 0
ERRSTK: BLOCK ^D200
LEVTAB: ADD1
ADD1
ADD1
CHNTAB: 1,,GOTONE
ADD1: Z 0
FRMNAM: BLOCK 1
FRMMSG: BLOCK 30 ;HOLD FROM MESSAGE HERE
FRMSTR: BLOCK 5 ;User name part of from message
FRMCNT: BLOCK 1 ;Number of bytes in FRMSTR
CHKBLK: .CKAWR ;NEED WRITE ACCESS
BLOCK .CKAUD ;REMAINDER OF BLOCK
OPDEF RET [POPJ P,]
OPDEF CALL [PUSHJ P,]
RELOC 1000-140 ;SSTART ON A CLEAN PAGE
;CODE
;PROGRAM ENTRY VECTOR
ENTVEC: JRST MAILER ;STARTING LOCATION
JRST MAILER ;REENTER LOCATION
VMAILR ;VERSION NUMBER
ALLOC: SETZB W4,W5 ;POINTER AND SIZE OF BLOCK
MOVEI W,FREHD ;WHERE IT ALL STARTS
LOOK: HRRZ W2,(W) ;WHERE NEXT BLOCK IS
JUMPE W2,FINAL ;AT THE END. LOOK AT WHAT WE HAVD
HLRZ W1,(W2) ;COUNT
CAIN W1,(A) ;EXACT MATCH?
JRST USEIT ;YES. DO IT
CAIG W1,(A) ;BIG ENOUGH?
JRST NOPE ;NO. FOO
;FOUND A CANDIDATE. SEE IF HE'S BETTER THAN THE LAST
SKIPE W5 ;GOT ONE YET?
CAIGE W1,(W5) ;YES. THIS ONE BETTER?
SKIPA W5,W1 ;YES. USE IT
JRST NOPE ;NO
MOVE W4,W ;REMEMBER POINTER
NOPE: HRRZ W,(W) ;GET NEXT BLOCK
JRST LOOK ;GO PROCESS IT
FINAL: SKIPN W1,W5 ;FOUND A GOOD ONE?
RET ;NO. BOMB TIME
MOVE W,W4 ;POINTER
USEIT: HRRZ W4,(W) ;AREA TO ALLOCATE
MOVNI W1,(A) ;NUMBRE OF WORDS NEEDED
HRLZS W1 ;NEGATIVE TO LEFT HALF
ADD W1,(W4) ;DO IT
ADDI W4,(A) ;WHERE NRW BLOCK IS
TLNE W1,-1 ;ANYTHING LEFT?
MOVEM W1,(W4) ;YES. MAKE IT A NEW BLOCK
HRRZ W5,(W)
HRLZM A,(W5) ;ASSIGNED BLOCK
HRRM W4,(W) ;LINK IN NEW FREE BLOCK
MOVEI A,(W5) ;WHAT WE ASSIGNED
AOS (P)
RET ;GOOD RETURN
;THIS IS THE DEALLOCATE CODE. INPUT IS A=POINTER TO BLOCK
DEALL: MOVEI W,FREHD
LOOK1: HRRZ W1,(W) ;BLOCK HEAD
JUMPE W1,HERE ;IF AT THE END IT GOES HERE
CAIL W1,(A) ;PAST THIS BLOCK?
JRST HERE ;YES. PU IT IN HERE
MOVE W,W1 ;NO. STEP
JRST LOOK1 ;GO DO MORE
HERE: CAIN W,FREHD ;AT THE TOP?
JRST LNKDWN ;YES. CANT MERGE UP
HLRZ W1,(W) ;GET SIZE OF PREVIOUS
ADDI W1,(W) ;TO THE END
CAIE W1,(A) ;UP TO THE BLOCK RELEASING?
JRST LNKDWN ;NO. LINK IT IN
HLRZ W2,(A) ;DO THE MERGE
HLRZ W1,(W)
ADDI W1,(W2) ;NEW TOTAL SIZE
SETZM (A) ;BLOT OUT THIS HEADER
HRLM W1,(W) ;NEW COUNT
JRST SEEDWN ;TRY TO MERGE DOWN
LNKDWN: HRRZ W2,(W) ;LINK TO NEXT
HRRM A,(W) ;PUT THIS NEW BLOCK IN
HRRM W2,(A) ;AND PUT OLD LINK IN IT
MOVE W,A ;NEW BASE BLOCK
SEEDWN: HLRZ W1,(W) ;COUNRT
ADDI W1,(W) ;END OF THIS BLOCK
HRRZ W2,(W) ;NEXT BLOCK
CAIE W1,(W2) ;THIS IT?
RET ;NO. DONE
HLRZ W3,(W2) ;YES. MUST MERGE THEM
HLRZ W1,(W) ;COUNT OF PREVIOUS
ADDI W3,(W1) ;NEW COUNT OF MERGED BLOCKS
HRLM W3,(W)
HRRZ W3,(W2) ;ITS LINK
HRRM W3,(W) ;NEW DOWN LINK FOR THIS GUY
SETZM (W2) ;CLEAR IT
RET ;ALL DONE
DOUSR: MOVEI W,0 ;WORK
MOVEI C,"," ;FOR CONVENIENCE
TOPOF: SKIPN B,(D) ;WORK TO DO?
POPJ P, ;NO. GO BACK
SKIPE W ;NEED A COMMA?
IDPB C,A ;YES. PUT IT IN
CAMN B,[SYSCOD] ;IS THIS SYSTEM?
JRST SPCUSR ;YES. GO DO IT
MOVEM A,SAV ;SAVE BYTE POINTER IN CASE FAILING DIRST CLOBBERS IT
DIRST ;CONVERT TO A STRING
JRST BAH ;WONT CONVERT
CAMN B,SYSDIR ;IS THIS SYSTEM?
JRST [ MOVE B,[SYSCOD] ;YES. GET INTERNAL VALUE
MOVEM B,0(D) ;STORE IT
JRST .+1] ;AND PROCEED
TOPOF1: AOS W
ADDI D,1 ;NEXT ONE
CAIGE W,7 ;MOR ON THIS LINE?
JRST TOPOF ;YES
HRROI B,[ASCIZ /,
/]
SETZ C, ; STOP ON NULL
SKIPE (D) ; only do this if usernames still left
SOUT
JRST DOUSR
BAH: AOS W1,ERRORS ;A BADDY
SETOM (D) ;DONT TRY AGAIN
AOS D ;DO NEXT ONE NEXT
HRRZM A,ERRSTK-1(W1) ;PUT IN REASON
AOS W1,ERRORS ;NEXT LOC
MOVEM B,ERRSTK-1(W1)
SKIPE W ;AT START OF LINE?
BKJFN ;NO. ERASE THE COMMA
JFCL ;WILL WORK
MOVE A,SAV ;GET BYTE POINTER THAT FAILING DIRST CLOBBERED
JRST TOPOF
;SPECIAL USER CODE FOUND
SPCUSR: HRROI B,[ASCIZ /SYSTEM/] ;YES. GET THE NAME
SETZ C,
SOUT ;PUT IT IN
MOVEI C,"," ;PUT BACK THE PUNCTUATION
JRST TOPOF1 ;AND GO BACK IN
MAILER: RESET
HRROI A,FRMMSG ;GET FROM MESSAGE BUFFER
HRROI B,[ASCIZ /
[You have a message from /]
SETZ C,
SOUT ;MOVE MESSAGE TO THE BUFFER
MOVEM A,FRMNAM ;SAVE PLACE TO PUT NAME
MOVE P,[IOWD 20,STACK]
MOVX A,RC%EMO ;EXACT MATCH PLEASE
HRROI B,[ASCIZ /SYSTEM/] ;GET USER CODE FOR SYSTEM
RCUSR ;GET IT
ERJMP [ SETZ C, ;NO SUCH DIR
JRST .+1] ;AND MERGE IN
TXNE A,RC%NOM!RC%AMB ;FOUND IT?
SETZ C, ;NO
MOVEM C,SYSDIR ;REMEMBER THE NUMBER
MOVX A,RC%EMO ;EXACT MATCH AGAIN
HRROI B,[ASCIZ /PS:<SYSTEM>/]
RCDIR ;NOW GET DIRECTORY DESCRIPTOR
ERJMP [ SETZ C,
JRST .+1] ;NO SUCH DIR
TXNE A,RC%NOM!RC%AMB ;DID IT MATCH
SETZ C, ;NO
MOVEM C,SYSDI1 ;SAVE DIRECTORY NUMBER
MOVEI A,400000 ;SELF
MOVE B,[LEVTAB,,CHNTAB] ;INT LOCS
SIR
MOVSI B,(1B0) ;ENABLE 0 ONLY
AIC
EIR ;TRUN IT ALL ON
MOVSI A,FRESIZ ;SIZE OF FREE AREA
MOVEM A,AREA ;INITIALIZE FREE AREA
MOVSI W,(1B5) ;GET ME A PID
SETZB W1,W2 ;ZERO FOR TWO PIDS
MAIL1: MOVE W3,[ENDPKT-DEFPKT,,DEFPKT]
MOVEI A,4
MOVEI B,W ;THE PACKET
MSEND ;DO IT
JRST [ MOVEI A,^D500 ;SLEEP FOR AWHILE
DISMS
SKIPN W1 ;GOT A PID?
JRST MAILER ;NO. START OVER
SETZ W, ;YES. INIT HEADER
JRST MAIL1] ;AND SEND IT AGAIN
MOVEM W1,MYPID ;SAVE ASSIGNED PID
;NOW GET SOME MESSAGES TO ACT UPON
MAIN: MOVEI A,7
MOVEI B,D
MOVE W,MYPID ;RECEIVE ON MY ID
MOVEI D,.MUQRY ;DO A QUERY
MUTIL ;DO IT
JRST NONE ;NONE WAITING
MOVEI A,7
MOVEI B,W ;FOR GETTING THE MESSAGE
MOVE W3,[1000,,MESS] ;FO THE MESSAGE
MOVE W2,MYPID ;RECEIVER'S PID
SETZ W6, ;MAKE SURE IPCF STORES HERE
MRECV ;GET A MESSAGE
JFCL ;????????
;RECEIVED A MESSAGE. SEE WHAT IT IS
TRNN W,7B32 ;MAYBE FROM INFO?
JRST NOTINF ;NO GO ON
TRNN W,77B29 ;AN ERROR CONDITION?
JRST MAIN ;NO. DONT LOOK AT IT
MOVE B,W
ANDI B,7B32 ;LOOK AT SENDER INFO
CAIE B,20 ;FORM INFO?
JRST MAIN ;NO. MUST BE A LOST MESSAGE
ANDI W,77B29 ;LOOK AT ERROR
CAIE W,<.IPCSN>B29 ;INFO RESSTART?
JRST [ HRROI A,[ASCIZ /
?MAILER: UNKNOWN ERROR CONDITION FROM INFO
/]
PSOUT
HALTF]
SETZB W,W2 ;YES. MUST START AGAIN
MOVE W1,MYPID
JRST MAIL1 ;SEND OFF MY NAME THEN
;NO MESSAGES WAITING
NONE: SKIPE SENDQ ;REPLIES WATING?
JRST DOQ1 ;YES. GO DO THEM
MOVEI W,.MUPIC ;ENABLE FOR INTS
MOVE W1,MYPID
SETZ W2, ;ON CHANNEL 0
MOVEI A,3
MOVEI B,W ;WHERE THE PACKET ISS
MUTIL ;DO IT
JFCL
WAIT ;WAIT HERE FOR INT
GOTONE: SETO W2, ;RELEASE CHANNEL
MUTIL
JFCL
MOVEI A,MAIN ;MAIN LOOP
MOVEM A,ADD1
DEBRK ;GO GET IT
;MESSAGE NOT FROM INFO. MUST BE WORK TO DO
NOTINF: MOVEM W1,SAVPID ;NO. SAVE IT FOR LATER
SKIPN W6 ;GOT A CONNECTED DIR IN W6?
JRST [ HLRZ W6,W4 ;NO. ASSUME OLD STYLE IPCF THEN
HRRZS W4 ;AND ISOLATE USER NUMBER
JRST .+1] ;AND PROCEED
MOVEM W6,CONDIR ;SAVE CONNECTED DIR HERE
SETZM ERRORS ;NO ERRORS TO START
MOVSI A,100001 ;OLD FILE
HRROI B,MESS ;WHERE THE FILE NAME IS
SETZM JFN ;NO JFN TO START
GTJFN ;GET THE FILE NAME
JRST NACK ;CANT DO IT
MOVEM A,JFN ;STASH AWAY JFN
MOVE B,[440000,,200000] ;OPENF BITS
OPENF ;GET FILE
JRST [ MOVE A,JFN
RLJFN
JFCL
SETZM JFN ;NO FILE OPENED
JRST NACK] ;CANT DO IT
; ..
;FILE IS OPENED. CHECK FOR WRITE ACCESS BEFORE PROCEEDING
; ..
MOVEM A,CHKBLK+.CKAUD ;JFN
MOVX A,CK%JFN+.CKAUD+1 ;FLAGS AND BLOCK LENGTH
MOVEI B,CHKBLK ;ADDRESS OF ARGUMENT BLOCK
MOVEM W4,CHKBLK+.CKALD ;STORE USER NUMBER
MOVEM W6,CHKBLK+.CKACD ;STORE CONNECTED DIR
MOVEM W5,CHKBLK+.CKAEC ;STORE ENABLED CAPS
CHKAC ;CHECK ACCESS
ERJMP [ ;FAILED
CHKFAI: MOVE A,JFN ;GET THE JFN
CLOSF ;CLOSE IT NOW
NOP
SETZM JFN ;NO JFN
JRST NACK] ;AND GIVE UP
JUMPE A,CHKFAI ;FAIL IF CHKAC SAID NO ACCESS
; ..
;GOT FILE OPEN. NOW BUILD MESSAGE
; ..
SETZM ERRORS ;NO ERRORS
MOVE A,FRMNAM ;GET PLACE TO PUT NAME IN FROM MESSAGE
MOVE B,W4 ;USER NUMBER
DIRST ;PUT IT IN
MOVE A,FRMNAM ;FAILED, GET BYTE POINTER BACK (ERROR CODE CLOBBERED IT)
PUSH P,A
HRROI A,FRMSTR ;Place to put just username
MOVE B,W4 ;User number
DIRST
JFCL
MOVE A,[POINT 7,FRMSTR] ;Now count the bytes in FRMSTR
CALL COUNTS
MOVEM A,FRMCNT ; ..
POP P,A
HRROI B,[ASCIZ /]
/]
SETZ C,
SOUT ;TERMINATE THE MESSAGE
IDPB C,A ;AND APPEND A NULL
;NOW GET LIST OF TO'S
MOVE A,JFN ;THE FILE'S JFN
BIN ;GET FLAG WORD FIRST
MOVEM B,FLAGWD ;SAVE IT FOR POSTERITY
MOVE B,[POINT ^D36,USRBLK] ;WHERE TO PUT THEM
MOVEI C,USERS-1 ;MAX NUMBER
SETZ D,
SIN ;READ IN USER'S TO SEND TO
JUMPN C,ALLIN ;IF ALL IN GO
MOVEI B,(B) ; SKIP OVER THE EXTRAS
SIN ;SKIP OVER THE REST OF THEM
ALLIN: HRLI B,(POINT ^D36,) ; Step on the null terminator
SKIPN USRBLK ; If null To list,
MOVE B,[POINT ^D36,USRBLK] ; reuse zeroed first word
MOVEI C,USERS-1 ;Now get cc list
SETZ D,
SIN
JUMPN C,ALLIN0
MOVEI B,(B) ;If too many
SIN
ALLIN0: MOVEI D,(B) ;SAVE END VALUE
GTSTS ;GET FILE STATUS
CAIE D,USRBLK ;NO USER'S GIVEN?
TLNE B,1000 ;EOF?
JRST NACK ;YES. BOMB
MOVE A,JFN ;FILE JFN
MOVEI B,7 ; set to 7-bit bytes
SFBSZ ; so ASCII SIN will work
JFCL
HRROI B,BIGBUF ;Where to put message
MOVE C,[SIZE*5] ;MAXIMUM SIZE OF MESSAGE
SETZM D ;STOP ON A NULL
SIN ;GET MESSAGE
MOVNI W,1 ; backup over null at end of msg text
ADJBP W,B ; ..
MOVE B,W ; ..
LDB A,B ; get ending byte of mail
CAIE A,12 ; line feed?
JRST [ MOVEI A,15 ; no, append CRLF to mail
IDPB A,B ; ..
MOVEI A,12 ; ..
IDPB A,B ; ..
JRST .+1]
; ..
;BIGBUF NOW CONTAINS THE ENTIRE MESSAGE. USRBLK CONTAINS THE
;LIST OF USERS TO GET THIS MESSAGE. SEND IT TO EACH
OVER: PUSHJ P,DELFIL ;GET RID OF THE FILE
MOVE A,[POINT 7,[ASCIZ / ========
/]]
SETZ C,
SIN ;TIE OFF THE MESSAGE
MOVEI W,(B) ;GET FINAL WORD
SUBI W,BIGBUF ;CALCULATE NUMBER OF complete WORDS
IMULI W,5 ;calculate number of bytes
LDB B,[POINT 6,B,5] ; get bits to the right of last byte
IDIVI B,^D7 ; compute no. of unused bytes in this word
MOVEI C,^D5 ; bytes in a word
SUB C,B ; compute bytes used in this word
ADD W,C ; adjust char count for partial word
;NOW W HAS COUNT OF CHARACTERS IN MSG
;NOW SET TO SEND SOME MESSAGES
MOVEI D,USRBLK ;WHERE THE USER NAMES ARE STORED
SNDOFF: SKIPN B,(D) ;GET USER
JRST FINIS ;ALL DONE
AOS D ;BUMP TO THE NEXT
CAMN B,[-1] ;BAD ENTRY?
JRST SNDOFF ;YES
CAME B,[SYSCOD] ;IS IT SYSTEM?
JRST NOSYS3 ;NO. NO SPECIAL CHECKING THEN
TRNE W5,600000 ;YES. IS THIS FROM A PRIVILEGED GUY?
JRST NOSYS3 ;YES. ALLOW IT THEN
MOVE W1,CONDIR ;GET CONNECTED DIR
CAME W1,SYSDI1 ;IS IT SYSTEM?
CAMN W4,SYSDIR ;LOGGED IN AS SYSTEM?
JRST NOSYS3 ;YES. ALLOW THIS SEND THEN
MOVEI A,CAPX1 ;NO. MUST BE PRIVILEGED
JRST OOPS2 ;TELL USER OF THE PROBLEM
NOSYS3: CAMN B,[SYSCOD]
JRST [ HRROI B,[ASCIZ /PS:<SYSTEM>MAIL.TXT/] ;YES
MOVX A,GJ%DEL!GJ%SHT+1 ;GET GTJFN BITS
JRST NOSYS2] ;GO DO IT THEN
MOVEI C,"<"
MOVE A,[POINT 7,FILBUF]
IDPB C,A
MOVE C,A ;SAVE BYTE POINTER IN CASE DIRST FAILS
DIRST ;PUT IN DIRECTORY NUMBER
MOVE A,C ;DIRST SHOULDN'T FAIL, BUT IF IT DOES...
MOVEI C,">"
IDPB C,A
HRROI B,[ASCIZ /MAIL.TXT/]
SETZ C,
SOUT ;BUIL FILL FILE SPEC
HRROI B,FILBUF
MOVX A,GJ%OLD!GJ%DEL!GJ%SHT+1 ;GTJFN BITS
NOSYS2: GTJFN ;GET FILE HANDLE
JRST OOPS2 ;CAN'T DO IT
MOVE C,A
MOVEI W1,^D40 ; Number of 1/2 sec waits if file busy
NOSYS1: MOVE B,[070000,,300000] ;WRITE AND READ
OPENF
JRST [ CAIN A,OPNX9 ; File busy error?
SOJGE W1,[MOVEI A,^D500 ; Yes, wait 1/2 second
DISMS ; Unless timed out (SOJG)
MOVE A,C ; Fetch JFN again
JRST NOSYS1] ; Go try again
EXCH A,C
RLJFN ;ERROR
JFCL
MOVE A,C ;ERROR CODE AGAIN
JRST OOPS2] ;AND GO GIVE ERROR
TXNN W5,SC%WHL!SC%OPR ;PRIVILEGED USER?
CALL CAPOFF ;NO. TURN OFF LOCAL CAPS THEN
;HAVE FILE OPENED .NOW WRITE IT
MOVE A,C ;THE JFN
PUSH P,C ;SAVE IN CASE OF ERROR
MOVE B,[2,,.FBBYV] ;GET 2 WORDS
MOVEI C,GETSIZ ;WHERE TO GET IT
GTFDB ;READ FILE DATA
LOAD C,FB%BSZ,GETSIZ ;GET FILE BYTE SIZE
CAIN C,7 ; already the right byte size?
JRST [ MOVE B,GETSIZ+1 ; yes, use exact byte count
JRST OKSIZ]
MOVEI B,44 ;BITS PER WORD
IDIVI B,0(C) ;COMPUTE TOTAL BYTES PER WORD
EXCH B,GETSIZ+1 ;GET BYTES IN B
IDIV B,GETSIZ+1 ;COMPUTE WORDS
IMULI B,5 ;NOW COMPUTE # OF CHARACTERS
OKSIZ: MOVEM B,EOFPTR ;SAVE IT
SFPTR ;SET TO EOF
JFCL
SETOM B ;GET DATE AND TIME
MOVSI C,(OT%TMZ) ;IN THIS FORM
ODTIM
ERJMP OVRQTA ;ERROR
MOVEI B,","
BOUT ;SEPARATE TIME FROM COUNT
ERJMP OVRQTA ;ERROR
RFPTR ;READ POSITION IN FILE
JFCL
ADDI B,6 ;AT LEAST 6 DIGITS FOR COUNT
IDIVI B,5 ;GET PART OF WORD IN C
MOVNS C ;GET NEGITIVE OF REMAINDER
ADDI C,5+6 ;GET WIDTH OF COUNT FIELD
HRL C,C ;GET IN RIGHT POSITION FOR NOUT
TXO C,NO%LFL!NO%ZRO ;PUT IN LEADING ZEROS
MOVE B,W ;NUMBER OF CHARS
ADD B,FRMCNT ; plus user name length
ADDI B,^D10 ; plus "Sender: " and CRLF
HRRI C,12 ;IN DECIMAL
NOUT
ERJMP OVRQTA ;ERROR
POP P,A ;RESTORE JFN
HRROI B,[ASCIZ /;000000000000
Sender: /]
MOVEI C,0 ;PUT ON THE FLAG FIELD
SOUT
ERJMP OVRQT1 ;ERROR
HRROI B,FRMSTR ;Real sender field
SOUT
ERJMP OVRQT1
HRROI B,[ASCIZ /
/]
SOUT
ERJMP OVRQT1
MOVE B,[POINT 7,BIGBUF]
MOVN C,W ;GET NEGATIVE WORD COUNT
SOUT ;WRITE ALL WORDS
ERJMP OVRQT1 ;ERROR
CALL CAPON ;ALL CAPS ON NOW
PUSH P,D
CALL UPDFIL ; Update file pages in case of crash
POP P,D
HRLI A,.FBCTL ;CHANGE STATUS BITS
MOVX B,FB%DEL ;CHANGE DELETED BIT
SETZ C, ;MAKE IT A ZERO(UNDELETE)
TXO A,CF%NUD ;DONT'T UPDATE DIR (SFUST/CLOSF WILL)
CHFDB ;DO IT
MOVX B,FB%PRM ;CHANGE PERMANENT BIT
MOVX C,FB%PRM ;TO BE SET
CHFDB
PUSH P,A ;SAVE JFN
MOVE B,W4 ;USER NUMBER OF SENDER
HRROI A,FILBUF ;PUT STRING HERE
DIRST
JFCL
HRROI B,FILBUF ;POINT AT IT
POP P,A ;RESTORE JFN
HRLI A,.SFLWR ;SET LAST WRITER
SFUST ; TO BE SENDER
MOVEI A,(A) ;JFN ONLY
CLOSF ;CLOSSE THE OUTPUT FILE
JFCL
; ..
;ROUTINE TO SEND MESSAGES TO ANY LOGGED IN USERS
MOVE A,-1(D) ;GET USER
CAME A,[SYSCOD]
IFSKP.
SETO A, ;IS SYSTEM
HRROI B,[ASCIZ /
[New Message-of-the-Day available]
/]
TTMSG ;DO IT
ERJMP .+1 ;IGNORE ERRORS
JRST SNDOFF ;AND DONE
ENDIF.
SETZ W6, ;INIT JOB NUMBER FOR SCAN
TOPDIR: MOVEI A,0(W6) ;JOB NUMBER
MOVE B,[-<.JICPJ-.JITNO+1>,,GTINF] ;GET VALUES FROM MONITOR
MOVEI C,.JITNO ;GET TERM # AND LOGGED IN DIR
GETJI ;GET THEM
ERJMP [ CAIN A,GTJIX3 ;OUT OF RANGE?
JRST SNDOFF ;YES. ALL DONE
AOJA W6,TOPDIR] ;NO. DO NEXT ONE THEN
SKIPL GTINF+<.JICPJ-.JITNO> ;IS THIS A PTY?
AOJA W6,TOPDIR ;YES. SKIP IT THEN
DMOVE A,GTINF ;GET GETJI DATA IN REGS
JUMPL A,[AOJA W6,TOPDIR] ;IF DETACHED, GO ON.
CAME B,-1(D) ;IS THIS LOGGED INTO THE SAME DIR?
AOJA W6,TOPDIR ;NO. SKIP IT THEN
TRO A,(1B0) ; MAKE IT A DEVICE DESIGNATOR
RFMOD ; GET MODE BITS
TXNN B,TT%ALK ; IS HE ACCEPTING?
AOJA W6,TOPDIR ;NO. DON'T TELL HIM THEN
MOVEI B,.MORNT ;SEE IF HE WANTS MESSAGES
MTOPR
JUMPN C,INCDIR ;JUMP IF NO MESSAGE
HRROI B,FRMMSG ;GET MESSAGE BLOCK
TTMSG ;SEND TO THIS USER
ERJMP .+1 ;IGNORE ERRORS
INCDIR: AOJA W6,TOPDIR ;DO ALL JOBS
;Routine to force write of pages just written in case of crash
;Call: A/ JFN
;Return +1: always, A preserved
UPDFIL: STKVAR <TEMP2>
RFBSZ ; Get byte size
JFCL
MOVEI C,^D36 ; Bits in a word
IDIVI C,(B) ; Compute bytes in a word
MOVEM C,TEMP2 ; Save for later
RFPTR ; Get EOF pointer
JFCL
IDIV B,C ; Compute words in file
SKIPN C ; Even number of words?
SUBI B,1 ; Yes, don't cross over to nonex. page
MOVE C,EOFPTR ; Get original EOF pointer
IDIV C,TEMP2 ; Compute original word count
LSH B,-^D9 ; Compute page number just written
LSH C,-^D9 ; Compute original last page number
MOVE D,B ; Copy page no. just written
SUBI D,(C) ; Pages written
ADDI D,1 ; Plus one for partial page
HRLZS A ; JFN in LH for UFPGS
HRRI A,(C) ; First page to update
MOVEI B,(D) ; Page count
TXO B,UF%NOW ; Don't block
UFPGS ; Write these pages to disk
ERJMP [HRROI A,[ASCIZ /UFPGS failure/]
ESOUT
HALTF]
HLRZS A ; Restore A to good state
RET ; and return
;HERE ON QUOTA ERROR
; A/ JFN
OVRQTA: POP P,A ;GET THE JFN
OVRQT1: CALL CAPON ;MAKE SURE ALL CAPS ARE ENABLED
RFBSZ ;GET CURRENT BYTE SIZE
NOP
MOVEI C,^D36
PUSH P,D ;SAVE THIS REG
IDIVI C,0(B) ;COMPUTE BYTES PER WORD
PUSH P,C ;SAVE THIS FOR LATER
RFPTR ;GET CURRENT EOF POINTER
JFCL
IDIV B,0(P) ;COMPUTE WORDS
LSH B,-11 ;MAKE IT A PAGE NUMBER
MOVE C,EOFPTR ;GET ORIGINAL EOF POINTER
IDIV C,0(P) ;COMPUTE WORD #
ADJSP P,-1 ;CLEAN UP STACK
POP P,D ;RESTORE REG
LSH C,-11 ;GET PAGE NUMBER
SUB B,C ;COMPUTE # OF PAGES ADDED
JUMPE B,OVRQT2 ;IF NONE, ALL SET
EXCH B,C ;GET ARGS IN PROPER REGS
TXO C,1B0 ;REPEAT COUNT FOR PMAP
HRL B,A
ADDI B,1 ;STARTING PAGE
SETOM A
PMAP ;ZAP THE FILE PAGES
HLRZ A,B ;JFN AGAIN
;EXTRA PAGES NOW DELETED. CHANGE FDB
OVRQT2: HRLI A,.FBBYV ;MAKE SURE BYTE SIZE IS CORRECT
MOVX B,FB%BSZ ;SET BYTE SIZE
MOVX C,FLD(7,FB%BSZ) ;SET IT TO 7-BIT BYTES
CHFDB ;DO IT
ERJMP OVRQT0 ;IF FAILED, SKIP IT
HRLI A,.FBSIZ ;NOW SET THE SIZE
SETOM B ;SET ENTIRE WORD
MOVE C,EOFPTR ;AND BACK TO ORIGINAL COUNT
CHFDB ;DO IT
ERJMP OVRQT0 ;IF FAILED, FILE IS SCREWED UP
OVRQT0: HRRZS A ;GET JFN ONLY
CLOSF ;CLOSE THE FILE
JFCL
MOVSI B,NOACKQ ;QUOTA FAILURE
JRST OOPS ;AND DONE
;ROUTINES TO ADD ERROR ENTRIES TO RETURN MESSAGE. AN ENTRY IS OF
;THE FORM:
; WORD 0 FLAGS,,CODE
; WORD 1 USER I.D.
;THE FLAGS DEFINE THE TYPE OF THE FAILURE. IF NOACKB IS SET IN THE
;FLAGS, THE CODE WROD IS A STANDARD JSYS ERROR CODE OR A 0
;IF AN INDETERMINATE ERROR OCCURRED.
OOPS2: MOVEI B,0(A) ;GET ERROR CODE
TLOA B,NOACKB ;STANDARD ERROR CODE WITH RH CODE TOO
OOPS1: MOVSI B,NOACKB ;STAMDARD ERROR CODE
OOPS: AOS W1,ERRORS
MOVEM B,ERRSTK-1(W1) ;PUT IT IN
AOS W1,ERRORS
MOVE B,-1(D) ;GET USER CODE
MOVEM B,ERRSTK-1(W1) ;STORE IT
JRST SNDOFF
DELFIL: SKIPN A,JFN ;FILE TO DELETE?
POPJ P, ;NO. GO BACK IMMEDIATELY
PUSH P,B ;SAVE BUFFER POINTER
MOVE B,FLAGWD ;GET FLAG WORD
TRNN B,1 ;WANT IT DELETED?
DELF ;YES. SO DO IT
MOVE A,JFN ;GET JFN BACK IF IT FAILED
CLOSF ;AND CLOSE IT
JFCL ;AGAIN, DONT CARE
SETZM JFN ;NO MORE FILE
POP P,B ;GET IT BACK
POPJ P, ;ALL DONE THIS OPERATION
;ROUTINE TO CONVERT A USER NUMBER INTO A DIRECTORY NUMBER.
;ACCEPTS: A/ USER NUMBER
;RETURNS: +1 WITH A/DIRECTORY NUMBER
USRDIR: MOVE B,A ;MOVE USER NUMBER
MOVE A,[POINT 7,USRBUF,27] ;WHERE TO FORM STRING
DIRST ;GET THE USER NAME
JRST POPJ1 ;WHO KNOWS HOW THIS CAN HAPPEN
MOVEI B,">" ;TO TIE IT OFF
IDPB B,A ;END OF STRING
SETZ B,
IDPB B,A ;FINAL STRING
HRROI B,USRBUF ;THE WHOLE THING
MOVX A,RC%EMO ;GET THE NUMBER
RCDIR ;GET IT
ERJMP POPJ1 ;WHO KNOWS
TXNE A,RC%AMB!RC%NOM ;DID IT FIND IT?
JRST POPJ1 ;NO. BOMB OUT
MOVE A,C ;THE NUMBER
AOS (P) ;SKIP RETURN
POPJ1: RET ;AND DONE
;ALL MESSAGES SENT. NOW SEND OFF THE REPLY.
NACK: SETZM ERRORS
PUSHJ P,DELFIL ;GET RID OF THE INPUT FILE
MOVEI W,<NOACK>B29 ;TOTAL WIPEOUT
SKIPA
FINIS: SETZ W,
SKIPE ERRORS ;ANY ERRORS FOUND?
MOVEI W,<NOACK1>B29 ;YESS. SAY SO
MOVE W1,MYPID
MOVE W2,SAVPID ;WHO SENT IT
HRL W3,ERRORS ;GET COUNT
SKIPN ERRORS
MOVSI W3,1 ;MUST BE A MESSSAGE
HRRI W3,ERRSTK ;COMPLETE THE MESSSAGE
SKIPE SENDQ ;A SEND QUEUE AROUND?
JRST QUEIT ;YES. GO QUEUE THIS ONE
MOVEI A,4
MOVEI B,W
SENDM: MSEND ;SEND IT OFF
JRST [ CAIE A,IPCFX4 ;PID DROPPED?
CAIN A,IPCFX5 ;OR DISABLED?
JRST .+1 ;YES
JRST ADDQ] ;NO. ADD IT TO THE QUEUE
CAIN B,W ;FROM THE QUEUE?
JRST MAIN ;NO. GO ON
MOVEI B,(W4) ;THE PACKET
;REQUEST FORM SEND Q
KILLIT: HRRZ A,-4(B) ;QUEUE LINK
HRRM A,SENDQ
SKIPN A
SETZM SENDQ ;QUEU IS EMPTY
MOVEI A,-4(B) ;BLOCK HEAD
CALL DEALL ;RELEASE IT
SKIPN SENDQ ;MORE ON THE QUEUE?
JRST MAIN ;NO. ALL DONE
;ROUTINES TO HANDLE SEND FAILURES
DOQ1: MOVEI A,^D500 ;DELAY FOR A WHILE
DISMS ;""
DOQ: HRRZ B,SENDQ ;TOP OF SEND QUEUE
MOVE W1,2(B) ;HEADER
MOVE W3,1(B) ;RECEIVE QUEUE
MOVE W2,MYPID
HLRZ W4,(B) ;COUNT
SUBI W4,4 ;SIZE OF THE MESSAGE
HRLZS W4
MOVEI W4,4(B) ;WHERE THE MESSAGE STARTS
MOVEI B,W1 ;WHERE THE HEADER IS
JRST SENDM ;SEND IT
ADDQ: CAIE B,W ;NEED TO QUEU IT?
JRST NOQ ;NO
QUEIT: CALL ONQ ;YES. PUT IT ON THE QUEUE
JRST [ HRROI A,[ASCIZ /
?MAILER: FREE SPACE EXHAUSTED
/]
PSOUT
HALTF]
JRST DOQ ;GO SEND SOME
NOQ: CAIE A,IPCFX7 ;HISS FAULT?
JRST MAIN ;NO. GO DO MORE INPUT
MOVE B,W4 ;GETPOINTER
AOS W4,-1(B) ;UP RETRY COUNT
CAIL W4,MAXTRY ;MAXIMUM RETRYS/
JRST KILLIT ;YES. ZAP IT
HRRZ W4,-4(B) ;UNQUEUE IT
HRRM A,SENDQ ;PUT NEXT ON THE TOP
SKIPN A ;QUEUE NOW EMPTY?
SETZM SENDQ ;YES
MOVEI A,-4(B) ;BLOCK HEAD
CALL INITQ ;PUT IT ON THE QUEUE
JRST MAIN ;TRY MORE
;THIS ROUITNE QUEUES ENTRIES ON THJE SEND QUEUEU
ONQ: HLRZ B,W3 ;SIZE NEEDED
MOVEI A,4(B) ;TOTAL SIZE NEEDED
PUSH P,W ;SAEV HEADER
CALL ALLOC ;GET SPACE
RET ;FAIL RETURN
SETZM 3(A) ;INIT RETRY COUNT
POP P,W
MOVEM W,2(A) ;SAVE HEADER
MOVE W,SAVPID
MOVEM W,1(A) ;SAVE DESTINATION PID
MOVSI W,ERRSTK ;WHERE MESSAGE COMES FORM
HRRI W,4(B) ;WHERE IT IS GOING
MOVE W1,ERRORS ;NUMBER OF WORDS
ADDI W1,-1(B) ;LAST WORD STORED
BLT W,(W1) ;DO IT
INITQ: HLRZ C,SENDQ ;GET TAIL
HRLM A,SENDQ ;NEW TAIL
SKIPN C ;QUEUE EMPTY?
MOVEI C,SENDQ ;YES
HRRM A,(C) ;AMKE THE LINK
AOS (P)
RET ;AND DONE
;Count the bytes in an ASCIZ string
;Call: A/ Byte pointer to string
; CALL COUNTS
;Return +1: always
; A/ count
COUNTS: MOVE B,A
SETZ A,
COUNT0: ILDB C,B
JUMPE C,R
AOJA A,COUNT0
;ROUTINES TO MANIPULATE LOCAL CAPS
;TURN OFF LOCAL CAPS
CAPOFF: SAVEAC <A,B,C>
MOVEI A,.FHSLF ;SELF
RPCAP ;GET CURRENT CAPS
HLLZS C ;TURN OFF SPECIAL CAPS
EPCAP ;DO IT
RET ;DONE
;TURN ON LOCAL CAPS
CAPON: SAVEAC <A,B,C>
MOVEI A,.FHSLF
RPCAP ;GET LOCAL CAPS
MOVE C,B ;GET ALL CAPS
EPCAP
RET ;DONE
END <3,,ENTVEC>