1 REM RSX11-M Network Mail server in BASIC+2 & An adaptation of the RSTS BASIC Plus program & By David Mitton TW/E07 & & Auto-Forwarding added by John R. Covert ZK1-3/H1 & & This program receives connects from Mail programs on adjacent & nodes and forwards the mail to the next node or deposits it locally & if to someone on this node. This program is compatible with & the Mail protocol used on VAX and RSTS mail systems. & & Digital Equipment Corp assumes no responsibility for the & functionality or suitability of this program. This is & strickly a hack program and is not supported. & 100 ! Define arrays and constants & \ Version$="V2.2" ! 13-May-81 DJM updated for DECUS & \ rcv.id$='MAIL' & \ NETLUN%= 12% ! Network data queue & \ MAILUN%= 11% ! Mail file lun & mailuser filter & \ TMPLUN%= 10% ! Temporary file lun & \ ACNLUN%= 10% ! Accounting file lun & \ dim #10%, acn.rec$(1000)=128% !Dimension accounting file & \ ACCLUN%= 10% ! Network access control file lun & \ LOGLUN%= 9% ! Mail error log lun & \ MAXLNKS%=8% ! Max network links allowed & \ DIM IOSB%(1%),MSTAT%(2%) ! Status arrays & \ TRUE%=-1% \ FALSE%=NOT TRUE% ! Logical values & \ MBOX$=STRING$(114%,0%) ! Connect message & \ MSIZE%=LEN(MBOX$) ! buffer size & \ CONBLK$=STRING$(114%,0%) ! Connect block outgoing & \ REC$=STRING$(132%,0%) ! Record buffer & \ underscore%=ascii("_") ! value of underscore & \ dollar%=ascii("$") ! value of dollar sign & \ lparen%=ascii("(") ! value of left paren & \ crlf$=chr$(13%)+chr$(10%) ! Carriage return & line feed & 1000 dim addr$(100), addr%(100), ula$(100), uic%(100), count%(100), & notify%(1%), SENDBUF%(12%), rec%(2%) 1050 DIM IATRL%(5),IPARML%(5),IUICP%(1) ! jrc 1100 on error goto 19000 1110 CALL OPNNTW BY REF(NETLUN%,IOSB%(),MSTAT%(),1%) ! Open the network & \ IF IOSB%(0%)<>1% Then err.msg$='Network open failed' & \ gosub 10300 \ goto 9000 1200 RECLEN%=6% & \ CALL GLNNTW BY REF(IOSB%(),RECLEN%,REC$) ! Get our node name & \ nfn.lcl.nod$=left$(rec$,reclen%) 1999 REM Receive connect message 2000 max.addr%=0% \ max.ula%=0% \ local%=0% \ filter.open%=false% & \ err.ms2$='' 2010 CALL GNDNTW BY REF(IOSB%(),CTYPE%,MSIZE%,MBOX$,0%,-1%,0%) & \ IF IOSB%(0%)<>1% then ERR.MSG$='Get net data failed' & \ gosub 10300 \ goto 9000 2012 IF CTYPE%<>1% then & err.msg$='other than connect init received' & \ gosub 10300 \ goto 9000 2020 n$=mid$(mbox$,25%,6%) 2030 net.from.node$=EDIT$(n$,1%+2%+4%+32%) 2033 if len(net.from.node$)=0% then net.from.node$='?unkn?' 2045 max.ula%=1% \ ula$(1%)=net.from.node$ \ ula%=1% 2049 rem Confirm connect 2050 CALL ACCNTW BY REF(ula%,IOSB%(),MBOX$,0%,0%) & \ IF IOSB%(0%)<>1% then & err.msg$='connect confirm failed' & \ gosub 10300 \ goto 7000 3000 ula%=1% \ gosub 10100 ! Get sender 3010 net.from.name$=m$ ! save the string 3020 ula%=1% \ gosub 10100 \ goto 3500 unless ascii(m$) ! Get addressee& ! Quit if EOL 3030 net.to.name$=m$ ! Outbound routing string & \ filter.done%=false% & ! Return to next line if filter entry found 3040 m%=instr(1%,net.to.name$,'::') ! Look for node seperator 3050 goto 4000 unless m% ! Goto 4000 if local (ie no node) 3059 ! Parse routing string 3060 net.to.node$=left(net.to.name$,m%-1%) ! take just node name 3070 net.to.node$=right(net.to.node$,2%) if ascii(net.to.node$)=underscore% 3080 net.to.name$=right(net.to.name$,m%+2%) & \ go to 3040 if net.to.node$=nfn.lcl.nod$ 3090 goto 3220 if net.to.node$=ula$(ula%) for ula%=2% to max.ula% 3095 net.to.node$=right(net.to.node$,2%) if ascii(net.to.node$)=dollar% 3100 ! Build Connect block 3110 CALL BACC BY REF(STAT%,CONBLK$,0%,0%,0%,0%,0%,0%) 3120 n$=net.to.node$ \ nlen%=len(n$) 3140 CALL BFMT0 BY REF(STAT%,CONBLK$,nlen%,N$,27%) & 3149 ! connect to outbound node 3150 CALL CONNTW BY REF(max.ula%+1%,IOSB%(),CONBLK$) & \ goto 3200 if IOSB%(0%) > 0% & \ ula%=1% & \ err.msg$='Connection to '+net.to.node$+':: failed ("'+ & net.to.name$+'")' 3160 err.ms2$='%Status= '+num1$(IOSB%(0%))+', Status2= '+num1$(IOSB%(1%))& \ IF IOSB%(0%)<>-7% then goto 3170 else & if IOSB%(1%) = 2% then err.ms2$='?no such node.' else & if IOSB%(1%) = 3% then err.ms2$='?node shutting down.' else & if IOSB%(1%) = 39% then err.ms2$='?node unreachable.' else & if IOSB%(1%) = 4% then err.ms2$='?slave mail does not exist.' else& if IOSB%(1%) = 6% then err.ms2$='?slave mail is too busy.' else& if IOSB%(1%) = 34% then err.ms2$='?unable to login at remote.' else& if IOSB%(1%) = 38% then err.ms2$='?slave mail did not respond.' 3170 gosub 10500 & \ goto 3020 3200 if net.from.node$=nfn.lcl.nod$ then m$=net.from.name$ & else m$=net.from.node$+'::'+net.from.name$ 3210 max.ula%=max.ula%+1% \ ula%=max.ula% \ count%(ula%)=0% & \ ula$(ula%)=net.to.node$ \ gosub 10200 ! Send sender 3220 m$=net.to.name$ 3230 addr%(max.addr%+1%)=ula% \ gosub 10200 ! Send addressee 3240 gosub 10700 ! Receive and pass on confirm 3250 goto 3020 if e% ! if error, disconnect 3260 max.addr%=max.addr%+1% \ count%(hold.ula%)=count%(hold.ula%)+1% 3270 addr$(max.addr%)=net.to.name$ 3280 goto 3020 ! Go back and do next addressee 3499 ! addressee list done, start relaying message 3500 close #mailun% if filter.open% 3505 for ula%=2% to max.ula% 3510 m$=chr$(0%) \ gosub 10200 ! Send EOL to all nodes 3520 next ula% 3530 goto 6000 unless max.addr% 3540 if local% then & open 'MAIL.TMP' for output as file #tmplun%, TEMPORARY & \ print #tmplun%,'From: '+net.from.node$+'::'+net.from.name$ & +date$(0%)+' '+time$(0%) 3560 gosub 3900 ! Get addressee text line 3570 if local% then print #tmplun%,'To: '+net.line$ 3580 gosub 3900 ! Get subject line 3590 if local% then print #tmplun%,'Subject: '+net.line$ \ print #tmplun% 3600 gosub 3900 ! Get a text line, do this until end (null) 3610 if ascii(net.line$) or len(net.line$)<>1% then & print #tmplun%, net.line$ if local% & \ goto 3600 3699 ! Message here, relay to locals 3700 for addr%=1% to max.addr% 3710 goto 5040 unless addr%(addr%) 3720 ula%=addr%(addr%) 3730 gosub 10700 3800 next addr% 3810 goto 6000 3899 ! receive one line and send to all nodes 3900 ula%=1% \ gosub 10100 3910 net.line$=m$ 3920 for ula%=2% to max.ula% 3930 if count%(ula%) then m$=net.line$ \ gosub 10200 3940 next ula% 3950 return 4000 ! Confirm local recipient & \ goto 4070 if filter.done% \ filter.done%=true% ! Only once & \ net.to.name$=edit$(net.to.name$,2%+4%+8%+32%+128%) & \ m$="" \ goto 4090 if net.to.name$="" & \ if filter.open% then restore #mailun% else & OPEN 'LB:[1,2]MAILUSER.DAT' FOR INPUT AS FILE #mailun%, & ACCESS READ \ filter.open%=true% ! jrc 4010 linput #mailun%, m$ \ m%=instr(1%,m$,'->') \ goto 4010 unless m% & \ goto 4088 if m%=1% ! line begins w/->, filter is absolute & \ goto 4010 if net.to.name$ <> left(m$,m%-1%) & \ net.to.name$=right(m$,m%+2%) & \ goto 4089 if ascii(net.to.name$)=lparen% \ goto 3040 4070 m$=net.to.name$ \ gosub 12000 4080 goto 4090 if e% ! if error, say so & \ max.addr%=max.addr%+1% ! otherwise, record this user & \ local%=-1% & \ addr%(max.addr%)=0% & \ addr$(max.addr%)=acn.disk$+':'+acn.uic$ & \ uic%(max.addr%)=acn.uic% & \ m$='' & \ ula%=1% & \ gosub 10400 & \ goto 3020 4088 err.msg$='"'+net.to.name$+'"'+right(m$,3%) \ go to 4095 4089 err.msg$=net.to.name$ \ go to 4095 4090 if acnok% then err.msg$='Unknown addressee "'+m$+'"' & else err.msg$='Account file open failure, try later - "'& +m$+'"' 4095 ula%=1% \ gosub 10500 & \ goto 3020 5040 open addr$(addr%)+'MAIL.TXT' for output as file #mailun% & \ restore #tmplun% & \ linput #tmplun%, mail.tmp.file$ 5050 print #mailun%, mail.tmp.file$ & \ linput #tmplun%, mail.tmp.file$ & \ goto 5050 5055 IPARML%(I%)=0% FOR I%=2% TO 5% ! jrc & \ CALL GETADR BY REF(IPARML%(),0%,IATRL%()) & \ IPARML%(0%)=0% & \ CALL GETADR BY REF(IATRL%(),0%,IUICP%()) & \ IATRL%(0%)=1025% !.BYTE 1,4 - WRITE UIC/PRO & \ IATRL%(2%)=0% & \ IUICP%(0%)=uic%(addr%) \ IUICP%(1%)=-249% ! [D,RWED,,] & \ CALL WTQIO BY REF(5888%,mailun%,1%,0%,IOSB%(),IPARML%(),IDS%) 5060 print #mailun% & \ close #mailun% & \ goto 5080 5070 err.msg$='Mail failed to deliver to '+addr$(addr%) & \ ula%=1% \ gosub 10500 & \ goto 3800 5080 ! Notify the terminal using ancilliary task & \ SENDBUF%(0%)=UIC%(addr%) & \ NOTIFY%(0%)=20852 ! Task name "MAL..." in RAD50 & \ NOTIFY%(1%)=-19588 & \ m$=net.from.node$+'::'+net.from.name$ \ m%=-1% \ i%=1% 5083 work%=i% \ i%=m%+2% \ m%=instr(i%,m$,'::') \ goto 5083 if m% & \ m$=right(m$,work%) \ m%=1% \ m1%=len(m$) 5086 for i%=1% to 12% & \ work%=0% \ work%=ascii(mid(m$,m%,1%)) if m1%>=m% & \ m%=m%+1% \ work%=work%+256%*ascii(mid(m$,m%,1%)) if m1%>=m% & \ m%=m%+1% \ SENDBUF%(i%)=work% & \ next i% 5088 CALL SEND BY REF(NOTIFY%(),SENDBUF%()) & \ CALL REQUES BY REF(NOTIFY%()) 5090 ula%=1% \ gosub 10400 ! go back and do another & \ goto 3800 6000 ! ***** disconnect all up to max.ula% ***** 6020 CALL DSCNTW BY REF(ula%,IOSB%()) for ula%=1% to max.ula% 6099 goto 9000 7000 ! ***** abort all up to max.ula% ***** 7010 CALL ABTNTW BY REF(ula%,iosb%()) for ula%=1% to max.ula% 9000 ! ***** close up and exit ***** 9010 CALL CLSNTW BY REF(IOSB%()) 9020 goto 32767 10000 ! ***** subroutines ***** 10100 CALL RECNTW BY REF(ula%,IOSB%(),132%,REC$) ! receive from ula% into m$ & \ IF IOSB%(0%)<1% and IOSB%(0%)<>-4 then & err.msg$='Receive failed' & \ gosub 10300 & \ goto 7000 10150 m$=left$(rec$,iosb%(1%)) 10160 return 10200 ! send m$ to ula% 10220 m$=" " if len(m$)=0% \ MSZ%=LEN(M$) & \ CALL SNDNTW BY REF(ula%,IOSB%(),MSZ%,M$) 10230 return unless IOSB%(0%)<>1% 10240 if IOSB%(0%)<-3% then & err.msg$='"'+m$+'"'+crlf$+'send failed' & \ gosub 10300 \ goto 7000 10270 err.msg$='Link service failed' & \ gosub 10300 & \ goto 7000 10299 ! Record errors 10300 close #loglun% & \ open 'MAIL.LOG' as file #loglun%, SEQUENTIAL, ACCESS APPEND 10310 print #loglun%, rcv.id$; ' '; version$; ' '; date$(0%); ' '; time$(0%) 10312 print #loglun%, "On:"; nfn.lcl.nod$; " From:"; net.from.node$; & " To:"; net.to.node$ 10320 print #loglun%, err.msg$; ' On lun:'; ula% 10330 print #loglun%, "IOSB%()= ";IOSB%(0%);" ";IOSB%(1%) 10360 print #loglun% 10370 close #loglun% 10380 return 10400 m$='' unless notify% ! send success w/m$ to ula% 10405 m$=chr$(1%)+string$(3%,0%)+m$ 10410 gosub 10200 10420 return 10500 m$=string$(4%,0%) ! send failure w/err.msg$ to ula% 10510 gosub 10200 10520 m$='?MAIL('+nfn.lcl.nod$+'::)-'+err.msg$ 10530 gosub 10200 \ if len(err.ms2$) then m$=err.ms2$ \ gosub 10200 & \ err.ms2$='' 10540 m$=chr$(0%) 10550 gosub 10200 10560 return 10700 hold.ula%=ula% \ gosub 10100 ! forward status from ula% to 1% 10710 ula%=1% \ gosub 10200 10720 e%=0% 10730 return if (ascii(m$) and 1%) 10740 ula%=hold.ula% \ gosub 10100 10745 m$='?MAIL('+nfn.lcl.nod$+'::)'+m$ if ascii(m$) and e%=0% 10750 ula%=1% \ gosub 10200 10760 e%=-1% 10770 return if (ascii(m$)=0%) and (len(m$)=1%) 10780 goto 10740 12000 ! RSX accounting file access subroutine & ! lookup user by name or [uic] in m$ & acnok%=true% & \ OPEN "LB:[0,0]RSX11.SYS" as file #ACNLUN%, & VIRTUAL, & ACCESS READ 12020 if left$(m$,1%)="[" goto 12040 12030 m$=edit$(m$,2%+4%+8%+32%+128%) & \ goto 12090 if m$="" & \ acn.lname$="" \ i%=-1% 12032 i%= i%+1% & \ acn.lname$=mid$(acn.rec$(i%),13%,14%) & \ goto 12032 if acn.lname$<>m$ & \ acn.grp$=mid$(acn.rec$(i%),1%,3%) & \ acn.memb$=mid$(acn.rec$(i%),4%,3%) & \ goto 12080 12040 m%=instr(1%,m$,',') & \ if m% then & net.grp%=val(mid(m$,2%,m%-2%)) & \ m1%=instr(m%,m$,']') & \ if m1% then & net.memb%=val(mid(m$,m%+1%,m1%-(m%+1%))) & \ goto 12050 12045 goto 12090 12050 acn.grp%=0% \ acn.memb%=0% \ i%=-1% 12052 i%=i%+1% & \ acn.grp$=mid$(acn.rec$(i%),1%,3%) & \ acn.memb$=mid$(acn.rec$(i%),4%,3%) & \ acn.grp%=val(acn.grp$) \ acn.memb%=val(acn.memb$) & \ goto 12052 if net.grp%<>acn.grp% or net.memb%<>acn.memb% & \ acn.lname$=mid$(acn.rec$(i%),13%,14%) & \ goto 12080 12080 acn.fname$=mid$(acn.rec$(i%),27%,12%) & \ acn.disk$=mid$(acn.rec$(i%),47%,4%) & \ acn.uic$='['+acn.grp$+','+acn.memb$+']' & \ grp%=fnoct%(acn.grp$) \ memb%=fnoct%(acn.memb$) & \ if grp%<128% then grp%=grp%*256% & else grp%=(((grp%-128%)*256%)-16384%)-16384% 12085 acn.uic%=grp%+memb% & \ close #acnlun% & \ e%=false% \ return 12089 acnok%=false% 12090 close #acnlun% & \ e%=true% \ return 13000 def fnocts$(bin%) ! convert binary to octal characters 13010 work%=bin% \ octs$='' 13020 work2%=work%/8% 13030 octs$=NUM1$(work%-(work2%*8%))+octs$ 13040 work%=work2% 13050 goto 13020 if work% > 0% 13060 fnocts$=octs$ 13070 fnend 14000 def fnoct%(work$) !Get real value of octal string (<32768) 14010 work%=0% 14030 work%=(work%*8%)+val(mid$(work$,i%,1%)) for i% = 1% to len(work$) 14040 fnoct%=work% 14050 fnend 15000 ! reserved for FNTIME$ (in ARC module) 16000 ! reserved for 80 char print (in ARC module) 19000 ! Errors & ! 19100 ! 19110 if (Erl=12032 or erl=12052) then resume 12090 19115 if erl=4010% then resume 4070 ! eof on MAILUSER.DAT 19120 if (erl=5040% or erl=5050%) and err=11% then resume 5055 19130 if erl=5040% or erl=5050% or erl=5060% then resume 5070 19140 if erl=>10300 and erl<10370 then resume 10370 19150 if erl=12000% then resume 12089 19999 on error goto 0 32767 end