subroutine arklug_cb(*) include 'bbs_inc.for' call out('The CB is not currently implemented on the BBS.',*0200) call out('If the CB becomes available a bulletin will be,',*0200) call out('placed on the BBS.',*0200) call out(' Thank You',*0200) call out(' Sysop',*0200) 0200 return end subroutine ubbs_cb(*) c This is a version of cb for the bulletin board c++ c c >>>>> CB/Vax Version 3.1 <<<<< c c The Citizens' Band radio simulator for VAX/VMS. (This is such c an incredible simulation, you'll think it's the real thing!) c c Written by: Dale Miller c University of Arkansas at Little Rock c 2801 S. University c Little Rock, AR 72204 c (501) 569-3220 c c Based on RATFIV coding by Chris Thomas - whereabouts currently unknown. c Version 3.0 is a complete re-write of the RATFIV code distributed on c the DECUS symposia tapes. c c While all of the coding is certainly original, the idea isn't.... c This looks very, very much like the CB simulator program that runs c on the CompuServe Information Service. c c c **** Important Notes **** c c Starting with V2.0, CB/Vax is distributed in two parts: c 1) CBMGR.FOR is the CB Manager. It runs detached and performs c all of CB/Vax's really important functions. c 2) CB.FOR, this program, is the user interface to CB/Vax. c You need -both- of these to run CB/Vax!!! c c CB.EXE needs to be INSTALLed with the following privileges: c DETACH, WORLD, OPER, SYSNAM, PRMMBX, ALTPRI. c c c Modification History: c c 24-Apr-1986 V3.1 o Attempt is now made to start cb_manager c without any logical name checking. c c 25-Jan-86/DOM V3.0 o Complete re-write in Fortran-77 c Addition of scrambling, /time, /squelch. c Provisions for running on a VAXcluster. c c 27-Apr-83/JCT V2.3 o Trap ^Z's and, if just waiting for a c message, behave like /EXIT. c o Check for /NOBROADCAST at startup and, if c so, tell the user that this won't work. c o Display the current time on a summons. c o Check the MAXPEOPLE limit in the manager. c o Check against batch access, since that's c real nasty. c o In Manager, before every send we check to c make sure the destination terminal is c still owned by the original PID. This is c to handle line drops and operator STOPs. c Otherwise, messages would continue to be c sent to these terminals. c c 16-Apr-83/JCT V2.2 o The terminal name is now obtained by c looking at SYS$COMMAND instead of SYS$INPUT. c When we were run from a command procedure, c this caused many problems. c o Commands need only be typed to uniqueness c now, also they may be fully typed out, c instead of the old 3-character limit. c o The /SUMMON command has been added. c o Users can't have null handles anymore. c c 27-Mar-83/JCT V2.1 Substantial enhancements from V2.0: c o 40-channel capability c o /STA, /UST, /HAN, /TUN, /HEL commands c o The symbol CB_HANDLE is checked for a c predefined handle. c o Commands can be in mixed case, and only c the first three letters matter. c o Duplicate handles are prohibited. c o The CB Manager is automatically created c if it's not present at startup. c o The CB Manager is automatically deleted c if there's nobody running CB. c c 25-Mar-83/JCT V2.0 Almost total rewrite of V1.0: c o Introduced the "CB Manager" concept. c o Changed default channel to 1. c c-- implicit integer*4 (a-z) parameter PCB$V_BATCH = '0E'x ! either of these. include '($jpidef)' include '($prvdef)' include '($ttdef)' include '($libclidef)' include '($dvidef)' include 'bbs_inc.for' c****************************************************************************** c * c **** CB/Vax Site-Specific Things **** * c (Change at your own discretion - and risk) * c * c****************************************************************************** character*(*)cbmgr_location, cb_mailbox_name, cb_handle, 1 cbmgr_procname parameter(cbmgr_location = 'sys$common:[sysmgr.ualr.cb]cbmgr.exe', 1 cb_mailbox_name = 'CB_MBX', cb_handle = 'CB_HANDLE', 2 cbmgr_procname = 'CB_Manager', cbmgr_grp = 1, cbmgr_mem = 4, 3 cbmgr_priority = 5) c **** end OF SITE-SPECIFIC THINGS **** character*20 tran, our_term, pterminal, nodename character*12 my_username character*132 text,otext character*16 handle character*32 mbname, arg character*255 msg, ucased character*4 command character*1 space character currtim*8,ctime*8,cdate*9 character*9 dow(7)/'Monday','Tuesday','Wednesday','Thursday', 1 'Friday','Saturday','Sunday'/ integer*4 privs(2), items(13), dvi_items(4) logical*1 wait, bad_handle,bbs integer*4 write_code,ctrl_mask 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 c Message code definitions for the CB Manager. The first byte of every c message sent to him contains the action to be taken, as defined here: parameter(new_person = 1, chatter = 2, leaving = 3, ustat = 4, 1 status = 5, tune = 6, chg_handle = 7, scramble = 8, 2 squelch = 9, summon = 10) 2000 format(a) 2001 format(' You are monitoring channels ',i2,' and ',i2) if (.not.approved_cb) then write(6,2000)crlf(:cl)//'You are not yet approved to'// 1 ' use CB.'//bell write(6,2000)crlf(:cl)//'Sorry.' return end if write(6,2000)crlf(:cl)//'Starting CB simulator.' write(6,2000)crlf(:cl)//'For help, type /HELP' write(6,2000)crlf(:cl)//'to exit, type /EXIT' write_code=io$_writevblk .or. io$m_now len = 255 command_index = 0 items(1) = (65536*jpi$_grp) + 4 items(2) = %loc(grp) items(3) = 0 items(4) = (65536*jpi$_mem) + 4 items(5) = %loc(mem) items(6) = 0 items(7) = (65536*jpi$_username) + 12 items(8) = %loc(my_username) items(9) = 0 items(10) = (65536*jpi$_sts) + 4 items(11) = %loc(proc_status) items(12) = 0 items(13) = 0 call sys$getjpi(, , , items, , , ) sta = sys$setrwm(%val(1)) c Disable control-Y's while we run. If we don't, the CB Manager c won't know when we're done, and he'll continue to send messages, c making the user somewhat unhappy. call lib$disable_ctrl(lib$m_cli_ctrly,ctrl_mask) c Check our status bits to make sure we're interactive. Batch access c to CB/Vax is not the least bit friendly! if ((proc_status .and. (2**'0e'x)) .ne. 0) then write(6,2000)crlf(:cl)//'%You can''t run CB/Vax from batch.' go to 99000 end if c Check to make sure our terminal is /BROADCAST. If it's not, then c nothing else here will work. dvi_items(1) = (65536*'0a'x) + 4 dvi_items(2) = %loc(devdepend) dvi_items(3) = 0 dvi_items(4) = 0 call sys$getdvi(, , 'SYS$COMMAND', dvi_items, , , , ) if ((devdepend .and. tt$m_nobrdcst) .ne. 0) then write(6,2000)crlf(:cl)// 1 '%Your terminal is set /NOBROADCAST.' write(6,2000)crlf(:cl)// 1 '%CB/Vax will not work with your terminal '// 1 'set this way.' go to 99000 end if write(6,2000)crlf(:cl)//'Welcome to CB/Vax V3.1' if(my_username.eq.'BBS') then bbs=.true. else bbs=.false. endif c Decide if we need to start up the CB Manager. Attempt to translate c the mailbox's logical name. If we fail, then we assume the manager c doesn't exist, so we start him up with appropriate privileges. sta = sys$trnlog(cb_mailbox_name,,mbname,,,) c if (sta .ne. 1) then privs(1) = prv$m_oper + prv$m_prmmbx + prv$m_setpri + 1 prv$m_sysnam + prv$m_world privs(2) = 0 sta2 = sys$creprc(,cbmgr_location,,,,%ref(privs(1)),, 1 cbmgr_procname,%val(cbmgr_priority),%val((65536*cbmgr_grp) 2 + cbmgr_mem),,) if (sta2 .ne. ss$_normal .and. sta2 .ne. ss$_duplnam) then write(6,2000)crlf(:cl)// 1 '??Can''t start CB Manager.' write(6,2000)crlf(:cl)// 1 'Please contact the system manager.' go to 99000 end if c end if c Turn off privs for this process. privs(1) = privs(1) + prv$m_detach c sta = sys$setprv(%val(0),%ref(privs(1)),%val(0),) c Try to read the global symbol CB_HANDLE from our process tables. c If it's there, then we'll use that as our initial handle. (You c see, having simple entry into CB is important to get people to c use it a lot.) space = ' ' 2060 continue bad_handle = .false. sta = lib$get_symbol(cb_handle, handle) if (.not.(sta .and. 1)) then write(6,2000)crlf(:cl)//'What''s your handle? ' read(5,2000, end=2060, err=2060) handle call lib$set_symbol(cb_handle, handle) end if ista=str$trim(handle,handle,i) if (i .eq. 0) then write(6,2000)crlf(:cl)//'You can''t have a null handle!' bad_handle = .true. call lib$delete_symbol(cb_handle) end if do k=1,i if(ichar(handle(k:k)).lt.32.or.ichar(handle(k:k)).gt.126) then write(6,2000)crlf(:cl)//'Invalid character in handle' bad_handle=.true. call lib$delete_symbol(cb_handle) endif enddo if (bad_handle) goto 2060 length=11 tran='SYS$COMMAND' sta = sys$trnlog(tran(1:length),length,tran,,,) our_term = tran(5:20) sta = str$trim(our_term, our_term, length) if (our_term(length:length) .ne. ':') then our_term(length + 1:length + 1) = ':' end if is = index(our_term, '$') nodename = our_term(1:is) our_term = our_term(is + 1:20) istat = lib$getdvi(dvi$_tt_phydevnam, , our_term, , pterminal, ) our_term = nodename(1:is)//pterminal(2:20) nodename=nodename(3:is-1) new_chan = 1 C Build a "new user" string to send to the manager, and send it through C the mailbox. msg(1:1) = char(new_person) msg(2:17) = our_term msg(18:18) = char(new_chan) msg(19:19) = null msg(20:20) = null msg(21:36) = handle msg(37:42) = nodename msg(43:50) = ' ' !Scramble key msg(51:51) = null !Scramble type msg(52:) = my_username C Open up the mailbox. This is trickier than it appears... If we've C just created the Manager, the mailbox logical may not be defined by C the time we reach here, especially if we're on a fast system. C If we have trouble opening the mailbox, then we keep trying every C two seconds until it's open (max 20 seconds). trys=0 sta = .false. do while(.not.sta) sta = sys$assign(cb_mailbox_name,mbx_chan,,,) if (.not. sta) then trys=trys+1 if(trys.gt.10) then write(6,2000)crlf(:cl)// 1 'CB internal error. exiting CB-Vax.' go to 99000 else call bas$sleep(%val(2)) end if endif end do go to 30000 !Start the whole thing off C Long loop. Repeat until we get an /EXIT command or ^Z from the user. C If it's a command, go execute it. Otherwise, we build a message C and send it off to the Manager. 2180 continue if (command_index.eq.1) then go to 99000 end if c***************************************************************************** c the following is necessary for the user timer c***************************************************************************** call add_elapsed_time(*4000) c ****** end of timer ***** c read(5, 2000, end=4000, err=4000) text write(6,2000)crlf(:cl) txtlen=-132 !allow for ctrl-z call get_uplow_string(text,txtlen) if(txtlen.lt.0) go to 4000 call parse_cmd(text, command_index, arg) istat = str$trim(arg,arg,alen) goto (3000,4000,5000,6000,7000,8000,9000,10000,11000, 1 12000,13000,14000,15000,16000,17000,18000), command_index + 1 goto 2180 3000 continue !message (what it's all about) if((text.eq.' ').or.(text.eq.otext)) go to 2180 msg(1:1) = char(chatter) msg(52:) = text otext=text go to 30000 4000 continue !user leaving msg(1:1) = char(leaving) command_index=1 go to 30000 5000 continue !change handle if(bbs) go to 2180 bad_handle = .false. if(arg(:alen).eq.' ') then write(6,2000)crlf(:cl)//'What''s your handle? ' read(5,2000, end=2060, err=2060) handle else handle=arg(:alen) endif ista=str$trim(handle,handle,i) if (i .eq. 0) then write(6,2000)crlf(:cl)//'Your handle was not changed.' go to 2180 end if do k=1,i if(ichar(handle(k:k)).lt.32.or.ichar(handle(k:k)).gt.126) then write(6,2000)crlf(:cl)//'Invalid character in handle' bad_handle=.true. call lib$delete_symbol(cb_handle) endif enddo if (bad_handle) goto 5000 call lib$set_symbol(cb_handle, handle) msg(1:1) = char(chg_handle) msg(21:36) = handle go to 30000 6000 continue !help write(6,2000)crlf(:cl)// 1 'Quick summary of CB/Vax commands:' write(6,2000)crlf(:cl)// 1 '/EXIT or ^Z Exits from CB/Vax' if(.not.bbs)write(6,2000)crlf(:cl)// 1 '/HANDLE Changes your handle' write(6,2000)crlf(:cl)// 1 '/HELP Print this help text' write(6,2000)crlf(:cl)// 1 '/MONITOR n Monitor a channel (Max of 2)' if(.not.bbs)write(6,2000)crlf(:cl)// 1 '/SCRAMBLE xyz Scramble on key "xyz" (xmit & recieve)' if(.not.bbs)write(6,2000)crlf(:cl)// 1 '/SMC xyz Scramble xmit/recieve scrambled & clear' write(6,2000)crlf(:cl)// 1 '/SQUELCH abc Squelch handle "abc"' write(6,2000)crlf(:cl)// 1 '/STATUS Report number of people on each channel' if(.not.bbs)write(6,2000)crlf(:cl)// 1 '/SUMMON user Summon'// 1 ' username ''user'' to CB/Vax.' write(6,2000)crlf(:cl)// 1 '/TIME Report time, day, and date' write(6,2000)crlf(:cl)// 1 '/TUNE n Switch to channel ''n''. '// 1 'Channels 1-5 available.' write(6,2000)crlf(:cl)// 1 '/UNMONITOR n Stop monitoring a channel' if(.not.bbs)write(6,2000)crlf(:cl)// 1 '/UNSCRAMBLE Do not xmit or recieve scrambled.' write(6,2000)crlf(:cl)// 1 '/USTAT Detailed list of current CB/Vax users' if(.not.bbs)write(6,2000)crlf(:cl)// 1 '/XCL xyz Xmit clear/ recieve scrambled & clear' write(6,2000)crlf(:cl)//' ' write(6,2000)crlf(:cl)//'Commands may be in upper or lower case' write(6,2000)crlf(:cl)//'and may be abbreviated to 3 characters.' goto 2180 7000 continue !Monitor call ots$cvt_ti_l(arg(:alen), mon_chan) if ((mon_chan .lt. 1) .or. (mon_chan .gt. 5)) then write(6, 2000)crlf(:cl)//'That channel doesn''t exist!' goto 2180 end if c if we are monitoring it already, ignore this request if( (mon_chan.eq.ichar(msg(19:19))).or. 1 (mon_chan.eq.ichar(msg(20:20)))) go to 2180 msg(1:1) = char(tune) if(msg(19:19).eq.null) then msg(19:19) = char(mon_chan) else if(msg(20:20).eq.null) then msg(20:20) = char(mon_chan) else write(6,2000)crlf(:cl)// 1 'You can only monitor 2 channels at a time' write(6,2001)crlf(:cl),ichar(msg(19:19)),ichar(msg(20:20)) go to 2180 endif go to 30000 8000 continue !Scramble if(bbs) go to 2180 if(alen.eq.0) then write(6,2000)crlf(:cl)//'You must provide a scramble key' go to 2180 endif ist=str$upcase(arg(:alen),arg(:alen)) msg(1:1) = char(scramble) msg(43:50) = arg(:alen) msg(51:51) = char(1) go to 30000 9000 continue !Scramble and monitor clear if(bbs) go to 2180 if(alen.eq.0) then write(6,2000)crlf(:cl)//'You must provide a scramble key' go to 2180 endif ist=str$upcase(arg(:alen),arg(:alen)) msg(1:1) = char(scramble) msg(43:50) = arg(:alen) msg(51:51) = char(2) go to 30000 10000 continue !Squelch msg(1:1) = char(squelch) msg(52:) = arg(:alen) go to 30000 11000 continue !status msg(1:1) = char(status) go to 30000 12000 continue !summon if(bbs) go to 2180 msg(1:1) = char(summon) msg(52:) = arg(:alen) write(6,2000)crlf(:cl)//'Summon complete.' go to 30000 13000 continue !Time call date(cdate) call time(ctime) is=lib$day_of_week(,daynum) is=str$trim(dow(daynum),dow(daynum),daylen) write(6,2000)crlf(:cl)// 1 'It is '//dow(daynum)(1:daylen)//', '//cdate// 2 ' and it is now '//ctime go to 2180 14000 continue !tune call ots$cvt_ti_l(arg(:alen), new_chan) if(new_chan.eq.99.and.my_username.eq.'DOMILLER') then msg(1:1) = char(tune) msg(18:18)=char(new_chan) go to 30000 endif if ((new_chan .lt. 1) .or. (new_chan .gt. 5)) then write(6, 2000)crlf(:cl)//'That channel doesn''t exist!' goto 2180 end if msg(1:1) = char(tune) msg(18:18) = char(new_chan) go to 30000 15000 continue !Unmonitor call ots$cvt_ti_l(arg(:alen), mon_chan) if ((mon_chan .lt. 1) .or. (mon_chan .gt. 40)) then write(6, 2000)crlf(:cl)//'That channel doesn''t exist!' goto 2180 end if msg(1:1) = char(tune) if(msg(19:19).eq.char(mon_chan)) then msg(19:19) = null else if(msg(20:20).eq.char(mon_chan)) then msg(20:20) = null else write(6,2000)crlf(:cl)//'You are not monitoring that channel' go to 2180 endif go to 30000 16000 continue !Unscramble if(bbs) go to 2180 msg(1:1) = char(scramble) msg(43:50) = ' ' msg(51:51) = char(0) go to 30000 17000 continue !ustat msg(1:1) = char(ustat) go to 30000 18000 continue !Xmit clear, unscramble recieve. if(bbs) go to 2180 if(alen.eq.0) then write(6,2000)crlf(:cl)//'You must provide a scramble key' go to 2180 endif ist=str$upcase(arg(:alen),arg(:alen)) msg(1:1) = char(scramble) msg(43:50) = arg(:alen) msg(51:51) = char(3) go to 30000 30000 continue !send a message to the CB manager sta = sys$qio(,%val(mbx_chan),%val(write_code),iostatus,,, 1 %ref(msg),%val(len),,,,) if(sta.eq.2264) then wait=wait+1 if(wait.gt.10) go to 90000 stat=lib$wait(2.0) go to 30000 else wait=0 endif if (.not. sta) call lib$signal (%val(sta)) if (.not. iostatus.iostat) call lib$signal(%val(iostatus.iostat)) go to 2180 c 90000 continue !unable to fit a message into the mailbox write(6,2000)crlf(:cl)//'CB internal error. exiting CB-Vax.' privs(1) = (2**prv$v_oper) + (2**prv$v_prmmbx) + 1 (2**prv$v_setpri) + (2**prv$v_sysnam) privs(2) = 0 sta2 = sys$creprc(,cbmgr_location,,,,%ref(privs(1)),, 1 cbmgr_procname,%val(cbmgr_priority),%val((65536*cbmgr_grp) 2 + cbmgr_mem),,) if (sta2 .ne. 1) then write(6,2000)crlf(:cl)//'??Can''t start CB Manager.' write(6,2000)crlf(:cl)//'Please contact the system manager.' end if 99000 call lib$enable_ctrl(ctrl_mask) sta = sys$setrwm(%val(0)) c call exit return 90500 return 1 end subroutine parse_cmd(cmdline, command_index, arg) implicit integer*4(a - z) include 'bbs_inc.for' parameter(maxcmd = 15) character*(*)cmdline character*32 arg character*16 cmdlist(maxcmd), command integer*2 cmdlen(maxcmd) character*1 space data cmdlist/'EXIT', 'HANDLE', 'HELP', 'MONITOR', 'SCRAMBLE', 1 'SMC', 'SQUELCH', 'STATUS', 'SUMMON', 'TIME', 'TUNE', 1 'UNMONITOR', 'UNSCRAMBLE', 'USTAT', 'XCL'/ data cmdlen/1,2,2,1,2,2,2,2,2,2,2,3,3,2,1/ C Quick case. If no slash in column 1, this is nothing. if (cmdline(1:1) .ne. '/') then command_index = 0 return end if cmdline = cmdline(2:) istat = str$trim(cmdline,cmdline,len) clen = str$position(cmdline,' ') clen=clen-1 command = cmdline(1:clen) call str$upcase(command, command) arg = cmdline(clen+2:) do i = 1, maxcmd if (command(:clen) .eq. cmdlist(i)(:clen)) go to 2600 end do 2600 continue if (i .gt. maxcmd) then write(6,2000)crlf(:cl)// 1 '%CB-W Invalid CB command; type /HELP for help.' else if (cmdlen(i).gt.clen) then write(6,2000)crlf(:cl)// 1 '%CB-W Ambiguous CB command; supply more characters.' i = maxcmd + 1 end if command_index = i return 2000 format(a) end