C++ C C >>>>> CB/Vax Manager Version 3.0 <<<<< C C The CB/Vax Manager program. See CB.FOR for additional documentation C and modification history. C C-- program cbmgr include 'CBcommon.for/list' include 'sys$library:foriosdef.for' include '($syidef)' include '($jpidef)' include '($iodef)' include '($brkdef)' integer*4 read_code real seconds structure /status_block/ integer*2 iostat, 1 msg_len integer*4 reader_pid end structure record /status_block/ iostatus integer sys$crembx,sys$ascefc,sys$waitfr,sys$qio character null*1 null = char(0) crlf = char(10)//char(13) numactive = 0 c Find out our node name and set up pointers for file locations c of the other nodes. sta = lib$getsyi(syi$_nodename,,nodename,,,) i=1 do j=1,numnodes if(node_names(j).ne.nodename) then othern(i)=j*20-20 i=i+1 else mynode=j*20-20 end if end do c create our mailbox. sta = sys$crembx(%val(1),mb_chan,,,,,'CB_MBX') call setup_other_nodes seconds=1. c begin the read and process loop 2000 continue read_code=io$_readvblk .or. io$m_now len = 255 2010 sta = sys$qio( ,%val(mb_chan),%val(read_code),iostatus,,, 1 %ref(text),%val(len),,,,) if(iostatus.iostat.eq.2160) then istat=get_other_node() if (istat.ne.0) go to 2020 istat=lib$wait(seconds) go to 2010 endif if (.not. sta) call lib$signal (%val(sta)) if (.not. iostatus.iostat) call lib$signal(%val(iostatus.iostat)) call send_to_other_nodes 2020 continue msgtype = ichar(text(1:1)) if(msgtype.eq.1) then call new_person ! 1 - add a new user else if (msgtype.eq.2) then call message ! 2 - message to broadcast else if (msgtype.eq.3) then call person_leaving(0) ! 3 - person has exited. else if (msgtype.eq.4) then call ustat ! 4 - ustat request else if (msgtype.eq.5) then call status ! 5 - status request else if (msgtype.eq.6) then call tune ! 6 - tune request else if (msgtype.eq.7) then call chg_handle ! 7 - new handle else if (msgtype.eq.8) then call setup_scramble ! 8 - scramble/unscramble request else if (msgtype.eq.9) then call squelch_it ! 9 - squelch request else if (msgtype.eq.10) then call summon !10 - summon user to CB else if (msgtype.eq.99) then sta = sys$delmbx(%val(mb_chan)) ! 99 - command to die do k=1,100 write(2,rec=mynode*5+k)0 end do unlock(unit=2) close(unit=1) close(unit=2) call exit end if c ************************* ! any other message type is ignored. go to 2000 end subroutine new_person include 'CBcommon.for' include '($brkdef)' character*16 his_term character*16 his_handle integer*4 dvi_items(4) logical*1 bad_handle crlf = char(10)//char(13) C Check to see if maxpeople are already on CB. if so, we can't handle C any more, and the user will have to try again. But we can't force C him out unless we do lots of rewriting (version 3??). So we just C tell him to /EXIT. if he stays in, he doesn't get any messages. if (numactive .ge. maxpeople) then istat=sys$brkthru(,'%Sorry, CB/Vax is full now. Please '// 1 '/EXIT and try again later.'//crlf, text(2:17), 2 %val(brk$c_device),,,,,,,) return end if bad_handle = .false. his_handle = text(21:36) do I = 1, numactive if(terminal(i).eq.text(2:17)) call person_leaving(-1) if (handle(i).eq.text(21:36)) then call sys$brkthru(,'Someone else already has '// 1 'that handle!'//crlf,text(2:17), 2 %val(brk$c_device),,,,,,,) bad_handle = .true. go to 2150 end if end do 2150 continue if (bad_handle) then his_handle = text(2:17) end if numactive = numactive + 1 terminal(numactive) = text(2:17) handle(numactive) = his_handle channel(numactive,1) = ichar(text(18:18)) channel(numactive,2) = ichar(text(19:19)) channel(numactive,3) = ichar(text(20:20)) squelch(numactive) = ' ' scramble_type(numactive) = text(51:51) scramble_key(numactive) = text(43:50) username(numactive) = text(52:63) write(2,rec=numactive+mynode*5)terminal(numactive), 1 channel(numactive,1),handle(numactive),username(numactive), 2 scramble_type(numactive) unlock(unit=2) C Get the owner PID of the terminal. We save this so we can check later C to make sure he still owns the terminal. if(text(37:42).eq.nodename) then dvi_items(1) = (65536*'0E'X) + 4 dvi_items(2) = %loc(owner) dvi_items(3) = 0 dvi_items(4) = 0 call sys$getdvi(,,terminal(numactive),dvi_items,,,,) pid(numactive)=owner else pid(numactive)=0 endif sta = str$trim(his_handle,his_handle,hlen) istat=sys$brkthru(,crlf//'Welcome to channel 1, '// 1 his_handle(1:hlen)//crlf 2 //'(Channel) users tuned in',text(2:17), 3 %val(brk$c_device),,,,,,,) call status return end subroutine person_leaving(arg_type) C C "arg_type" is one of: C 0 ==> Normal exit requested. C -1 ==> Abnormal exit requested. Don't give a message. C include 'CBcommon.for' include '($brkdef)' character*16 his_term crlf = char(10)//char(13) our_index = get_index(text(2:17)) if(our_index.eq.0) return c Slide the last person in where we are leaving. if (our_index .lt. numactive) then terminal(our_index) = terminal(numactive) handle(our_index) = handle(numactive) channel(our_index,1) = channel(numactive,1) channel(our_index,2) = channel(numactive,2) channel(our_index,3) = channel(numactive,3) pid(our_index) = pid(numactive) squelch(our_index) = squelch(numactive) scramble_type(our_index) = scramble_type(numactive) scramble_key(our_index) = scramble_key(numactive) username(our_index) = username(numactive) write(2,rec=mynode*5+our_index)terminal(our_index), 1 channel(our_index,1),handle(our_index), 2 username(our_index),scramble_type(our_index) end if write(2,rec=mynode*5+numactive)0 unlock(unit=2) numactive = numactive - 1 if (arg_type .eq. 0) then call sys$brkthru(,crlf//'Thanks for using CB!', 1 text(2:17),%val(brk$c_device),,,,,,,) end if C if there's nobody left running CB, then go away quietly. if ( numactive.lt.1) then sta = sys$delmbx(%val(mb_chan)) do k=1,100 write(2,rec=mynode*5+k)0 end do unlock(unit=2) close(unit=1) close(unit=2) call exit end if return end subroutine message include 'CBcommon.for' include '($brkdef)' character*16 his_term character*16 his_handle character*255 msg, sendtxt integer*4 dvi_items(4) data dvi_items/'0E0004'X,0,0,0/ c dvi_items(1) = (65536*'0E'X) + 4 dvi_items(2) = %loc(owner) c dvi_items(3) = 0 c dvi_items(4) = 0 crlf = char(10)//char(13) his_term = text(2:17) msg = text(52:) his_chan = ichar(text(18:18)) his_handle = text(21:36) his_scramble=ichar(text(51:51)) sta = str$trim(his_handle,his_handle,len_handle) sta = str$trim(msg,msg,mlen) if(his_scramble.eq.1.or.his_scramble.eq.2) then call lib$sys_fao('(!UL,!AD) !AD', len, sendtxt, 2 %val(his_chan), %val(len_handle), %ref(his_handle), 3 %val(mlen), %ref(msg)) else call lib$sys_fao('(!UL,!AD) !AD', len, sendtxt, %val(his_chan), 1 %val(len_handle), %ref(his_handle), %val(mlen), %ref(msg)) endif do 2240 i = 1, numactive if(channel(I,1).eq.99) go to 2230 st=ichar(scramble_type(i)) if ((terminal(i).eq.his_term).or. 1 ((channel(i,1).ne.his_chan).and. 2 (channel(i,2).ne.his_chan).and. 3 (channel(i,3).ne.his_chan).and. 4 (channel(i,2).ne.99))) go to 2240 if (squelch(i).eq.his_handle) go to 2240 if ((his_scramble.eq.1.or.his_scramble.eq.2).and. 1 ((st.ne.1.and.st.ne.2.and.st.ne.3).or. 3 (scramble_key(i).ne.text(43:50)))) go to 2240 if ((his_scramble.eq.0.or.his_scramble.eq.3).and. 1 st.ne.0.and.st.ne.2.and.st.ne.3) go to 2240 c Make sure the same person still owns the terminal. if not, then c automatically exit him from CB. 2230 continue call sys$getdvi(,,terminal(i),dvi_items,,,,) if (owner .ne. pid(i)) then text(2:17) = terminal(i) call person_leaving(-1) go to 2240 end if if(username(i).ne.'BBS') then call sys$brkthru(,crlf//sendtxt(1:len), terminal(i), 1 %val(brk$c_device),,,,,,,) else call sys$brkthru(,crlf//sendtxt(1:len)//crlf,terminal(i), 1 %val(brk$c_device),,,,,,,) end if 2240 continue return end subroutine status include 'CBcommon.for' include '($brkdef)' integer*4 on_chan(maxchannel) character*132 part_msg, msg character his_handle*16,his_term*16,his_username*12,his_st*1 external get_index crlf = char(10)//char(13) our_index = get_index(text(2:17)) our_chan = channel(our_index,1) our_chan2 = channel(our_index,2) our_chan3 = channel(our_index,3) do I = 1, maxchannel on_chan(i) = 0 end do record=1 0010 read(2,rec=record)his_term,his_chan,his_handle,his_username, 1 his_st if(his_chan.eq.0) then record=(((record)/100)+1)*100+1 if(record.gt.numnodes*100) go to 20 go to 10 end if on_chan(his_chan) = on_chan(his_chan) + 1 record=record+1 go to 10 0020 mlen = 1 do I = 1, maxchannel if (on_chan(i) .gt. 0) then call lib$sys_fao('(!UL)!UL', part_len, part_msg, 1 %val(i), %val(on_chan(i))) msg(mlen:mlen + part_len) = part_msg mlen = mlen + part_len if (our_chan .eq. i) then msg(mlen:) = '#' mlen = mlen + 1 else if(our_chan2 .eq. i .or. our_chan3 .eq. i) then msg(mlen:) = '*' mlen = mlen + 1 end if msg(mlen:) = ',' mlen = mlen + 1 end if end do call sys$brkthru(,crlf//msg(1:mlen - 2), text(2:17), 1 %val(brk$c_device),,,,,,,) return end subroutine ustat include 'CBcommon.for' include '($brkdef)' character*4096 full_msg character*16 his_term character*16 his_handle character*12 his_username character*1 his_st character*80 msg character*3 scram(4)/'Uns','Scr','Smc','Xcl'/ crlf = char(10)//char(13) full_msg = 'Terminal Channel Username Scr Handle'//crlf// 1 '----------- ------- ------------ --- ------'//crlf mlen = 93 record=1 0010 read(2,rec=record)his_term,his_chan,his_handle,his_username, 1 his_st if(his_chan.eq.0) then record=(((record)/100)+1)*100+1 if(record.gt.numnodes*100) go to 20 go to 10 end if if(his_chan.eq.99) then record=record+1 go to 10 end if sta = str$trim (his_handle,his_handle,hlen) sta = str$trim (his_term,his_term,tlen) call lib$sys_fao('!13AS !3UL !12AS !3AS !AS',len,msg, 1 his_term(3:tlen),%val(his_chan),his_username, 2 scram(ichar(his_st)+1),his_handle(1:hlen)) full_msg(mlen:) = msg full_msg(mlen + len:) = crlf mlen = mlen + len + 2 record=record+1 go to 10 0020 istat=sys$brkthru(,crlf//full_msg(1:mlen-2)//crlf, text(2:17), 1 %val(brk$c_device),,,,,,,) return end subroutine chg_handle include 'CBcommon.for' include '($brkdef)' crlf = char(10)//char(13) our_index = get_index(text(2:17)) do i = 1, numactive if ((handle(i).eq.text(21:36)).and.(i.ne.our_index)) then call sys$brkthru(,'Someone else already has '// 1 'that handle!'//crlf,text(2:17), 2 %val(brk$c_device),,,,,,,) return end if end do handle(our_index) = text(21:36) write(2,rec=our_index+mynode*5)terminal(our_index), 1 channel(our_index,1),handle(our_index),username(our_index), 2 scramble_type(our_index) unlock(unit=2) return end integer*4 function get_index(his_term) include 'CBcommon.for' character*16 his_term get_index=0 if(text(37:42).ne.nodename) return 2440 do our_index = 1, numactive if (his_term .eq. terminal(our_index)) go to 2450 end do call new_person go to 2440 2450 continue get_index = our_index return end subroutine tune include 'CBcommon.for' external get_index our_index = get_index(text(2:17)) if(our_index.eq.0) return channel(our_index,1) = ichar(text(18:18)) channel(our_index,2) = ichar(text(19:19)) channel(our_index,3) = ichar(text(20:20)) write(2,rec=our_index+mynode*5)terminal(our_index), 1 channel(our_index,1),handle(our_index),username(our_index), 2 scramble_type(our_index) unlock(unit=2) return end subroutine send_to_other_nodes c this routine writes the incoming data to the common file for each c other vaxcluster node to read. c ***** nodes must be set up in cbcommon.for ***** include 'cbcommon.for' if(text(37:42).ne.nodename) return mg=ichar(text(1:1)) if(mg.ne.2) return mypointer=mypointer+1 if(mypointer.gt.20) mypointer=1 mylastmess=mylastmess+1 write(1,rec=mynode+mypointer)mylastmess,text unlock(unit=1) return end subroutine setup_other_nodes c This routine sets up the files for the cluster. include 'cbcommon.for' integer mnum external wait_for open(unit=1,status='old',recl=65,recordtype='fixed', 1 file=file_loc//'mess.dat', 2 access='direct',form='unformatted',shared, 3 organization='relative',useropen=wait_for) open(unit=2,status='old',recl=16,recordtype='fixed', 1 file=file_loc//'user.dat', 2 access='direct',form='unformatted',shared, 3 organization='relative',useropen=wait_for) do i=1,numnodes-1 lastmess(i)=0 do k=1,20 read(1,rec=othern(i)+k)mnum,text if(mnum.gt.lastmess(i)) then lastmess(i)=mnum pointer(i)=k endif end do pointer(i)=pointer(i)+1 if(pointer(i).gt.20) pointer(i)=1 end do do k=1,20 read(1,rec=mynode+k)mnum,text if(mnum.gt.mylastmess) then mylastmess=mnum mypointer=k endif end do do k=1,100 write(2,rec=mynode*5+k)0 end do unlock(unit=2) nextnode = 1 return end integer function get_other_node() c This routine will read the data file written by all cluster nodes c to see if anyone has any outstanding data. The logic will rotate c between nodes regardless of how many messages may be waiting at c any 1 node. include 'cbcommon.for' integer mnum,i do j=1,numnodes-1 i = nextnode nextnode=nextnode+1 if (nextnode.ge.numnodes) nextnode=1 read(1,rec=othern(i)+pointer(i))mnum,text if(mnum.gt.lastmess(i)) then pointer(i)=pointer(i)+1 if(pointer(i).gt.20) pointer(i)=1 lastmess(i)=mnum get_other_node=1 return endif end do get_other_node=0 return end integer function wait_for(fab,rab,lun) implicit none include '($rabdef)' include '($fabdef)' record /rabdef/ rab record /fabdef/ fab integer sys$open,sys$connect integer lun,status c modify the rab to simplify things rab.rab$l_rop = ibset(rab.rab$l_rop, rab$v_nlk) rab.rab$l_rop = ibset(rab.rab$l_rop, rab$v_wat) c actually open the file status=sys$open(fab) if(status) status=sys$connect(rab) c return the status wait_for=status return end subroutine setup_scramble include 'CBcommon.for' external get_index our_index = get_index(text(2:17)) if(our_index.eq.0) return scramble_type(our_index)=text(51:51) scramble_key(our_index)=text(43:50) write(2,rec=our_index+mynode*5)terminal(our_index), 1 channel(our_index,1),handle(our_index),username(our_index), 2 scramble_type(our_index) unlock(unit=2) return end subroutine squelch_it include 'CBcommon.for' external get_index our_index = get_index(text(2:17)) if(our_index.eq.0) return squelch(our_index)=text(52:67) return end subroutine summon include 'CBcommon.for' external get_index include '($brkdef)' character*12 my_username, his_username character*16 my_handle character*23 time character*80 msg space = ' ' our_index = get_index(text(2:17)) his_username = text(52:) my_username = username(our_index) my_handle = handle(our_index) call str$upcase(his_username, his_username) call sys$asctim(, time, , ) istat=str$trim(my_username,my_username,ulen) istat=str$trim(my_handle,my_handle,hlen) msg = char(7)//my_handle(:hlen)//'('//my_username(:ulen)// 1 ') requests your presence on CB. ('//time(13:20)//')' istat = str$trim(msg,msg,mlen) istat=sys$brkthru(, msg(:mlen), his_username, 1 %val(brk$c_username), , ,%val(brk$m_cluster), , , ,) return end