C++
C
C	>>>>>  CB/Vax Manager Version 3.0 - non-cluster  <<<<<
C
C	The CB/Vax Manager program.  See CB.FOR for additional documentation
C	and modification history.
C
C	This version of CBMGR is for a non-clustered system.
C
C--
	program cbmgr
	include 'SNCBCOMMON.FOR/list'
	include 'sys$library:foriosdef.for'
	include '($syidef)'
	include '($jpidef)'
	include '($brkdef)'
	integer sys$crembx
	character null*1

	null = char(0)
	crlf = char(10)//char(13)
	numactive = 0

c	create our mailbox.

	sta = sys$crembx(%val(1),mb_chan,,,,,'CB_MBX')
	open(unit=30,file='CB_MBX',status='old',recl=255,
	1   carriagecontrol='none')

c	begin the read and process loop
2000	continue
	read(30,1001)text
1001	format(a)

	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
	    close(unit=30)
	    sta = sys$delmbx(%val(mb_chan))	! 99 - command to die
	    call exit
	end if
c	*************************	! any other message type is ignored.
	go to 2000
	end

	subroutine new_person
	include 'SNCBCOMMON.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)

	
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.

	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

	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 'SNCBCOMMON.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)
	    end if

	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
	    close(unit=30)
	    sta = sys$delmbx(%val(mb_chan))
	    sta = lib$wait(2.)
	    call exit
	    end if
	return
	end

	subroutine message
	include 'SNCBCOMMON.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<scr>,!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 'SNCBCOMMON.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

	do i = 1, numactive
	    if(channel(i,1).le.maxchannel) then
		on_chan(channel(i,1)) = on_chan(channel(i,1)) + 1
		end if
	    end do

 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 'SNCBCOMMON.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
	do 10 i = 1, numactive
	    his_term=terminal(i)
	    his_chan=channel(i,1)
	    his_handle=handle(i)
	    his_username=username(i)
	    his_st=scramble_type(i)
	    if(his_chan.eq.99) go to 10
	    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
 0010	    continue

	istat=sys$brkthru(,crlf//full_msg(1:mlen-2)//crlf, text(2:17),
	1   %val(brk$c_device),,,,,,,)
	return
	end

	subroutine chg_handle
	include 'SNCBCOMMON.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)
	return
	end

	integer*4 function get_index(his_term)
	include 'SNCBCOMMON.FOR'
	character*16 his_term
	get_index=0
 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 'SNCBCOMMON.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))
	return
	end

	subroutine setup_scramble
	include 'SNCBCOMMON.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)
	return
	end

	subroutine squelch_it
	include 'SNCBCOMMON.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 'SNCBCOMMON.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
