#++ # # >>>>> CB/Vax Version 2.3 <<<<< # # The Citizens' Band radio simulator for VAX/VMS. (This is such # an incredible simulation, you'll think it's the real thing!) # # Written by: Chris Thomas # Engineering & Geoscience Computing Services # Placid Oil Company # 3900 Thanksgiving Tower # Dallas, TX 75201 # # While all of the coding is certainly original, the idea isn't.... # This looks very, very much like the CB simulator program that runs # on the CompuServe Information Service. # # # **** Important Notes **** # # Starting with V2.0, CB/Vax is distributed in two parts: # 1) CBMGR.RAT is the CB Manager. It runs detached and performs # all of CB/Vax's really important functions. # 2) CB.RAT, this program, is the user interface to CB/Vax. # You need -both- of these to run CB/Vax!!! # # I need to be INSTALLed with the following privileges: # DETACH, WORLD, OPER, SYSPRV, SETPRV, ALTPRI. # # # Modification History: # # 27-Apr-83/JCT V2.3 o Trap ^Z's and, if just waiting for a # message, behave like /EXIT. # o Check for /NOBROADCAST at startup and, if # so, tell the user that this won't work. # o Display the current time on a summons. # o Check the MAXPEOPLE limit in the manager. # o Check against batch access, since that's # real nasty. # o In Manager, before every send we check to # make sure the destination terminal is # still owned by the original PID. This is # to handle line drops and operator STOPs. # Otherwise, messages would continue to be # sent to these terminals. # # 16-Apr-83/JCT V2.2 o The terminal name is now obtained by # looking at SYS$COMMAND instead of SYS$INPUT. # When we were run from a command procedure, # this caused many problems. # o Commands need only be typed to uniqueness # now, also they may be fully typed out, # instead of the old 3-character limit. # o The /SUMMON command has been added. # o Users can't have null handles anymore. # # 27-Mar-83/JCT V2.1 Substantial enhancements from V2.0: # o 40-channel capability # o /STA, /UST, /HAN, /TUN, /HEL commands # o The symbol CB_HANDLE is checked for a # predefined handle. # o Commands can be in mixed case, and only # the first three letters matter. # o Duplicate handles are prohibited. # o The CB Manager is automatically created # if it's not present at startup. # o The CB Manager is automatically deleted # if there's nobody running CB. # # 25-Mar-83/JCT V2.0 Almost total rewrite of V1.0: # o Introduced the "CB Manager" concept. # o Changed default channel to 1. # #-- implicit integer*4(a-z) define(DVI$_DEVDEPEND,'0A'x) # Because FORSYSDEF.TLB doesn't have this. define(PCB$V_BATCH,'0E'x) # Or this one either. `include '($JPIDEF)'` `include '($PRVDEF)'` `include '($TTDEF)'` `include '($LIBCLIDEF)'` #****************************************************************************** # * # **** CB/Vax Site-Specific Things **** * # (Change at your own discretion - and risk) * # * #****************************************************************************** character*(*) CBMGR_LOCATION, CB_MAILBOX_NAME, CB_HANDLE, _ CBMGR_PROCNAME parameter ( _ CBMGR_LOCATION = "UTIL$EXE:CBMGR.EXE", _ CB_MAILBOX_NAME = "CB_MBX", _ CB_HANDLE = "CB_HANDLE", _ CBMGR_PROCNAME = "CB_Manager", _ CBMGR_GRP = 1, _ CBMGR_MEM = 4, _ CBMGR_PRIORITY = 5 ) # **** END of site-specific things **** character*16 tran,our_term character*12 my_username character*132 text character*32 handle, mbname, arg character*255 msg, ucased character*4 command character*1 null, space integer*4 privs(2), items(13), dvi_items(4) logical*1 wait, bad_handle external find_len # Message code definitions for the CB Manager. The first byte of every # message sent to him contains the action to be taken, as defined here: parameter ( NEW_PERSON=1, _ MESSAGE=2, _ LEAVING=3, _ USTAT=4, _ STATUS=5, _ TUNE=6, _ CHG_HANDLE=7 ) 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, , , ) # Check our status bits to make sure we're interactive. Batch access # to CB/Vax is not the least bit friendly! if ( ( proc_status & ( 2 ** PCB$V_BATCH ) ) ~= 0 ) { write ( 6, ( " %You can't run CB/Vax from batch." ) ) call exit } # Check to make sure our terminal is /BROADCAST. If it's not, then # nothing else here will work. dvi_items(1) = ( 65536 * DVI$_DEVDEPEND ) + 4 dvi_items(2) = %loc(devdepend) dvi_items(3) = 0 dvi_items(4) = 0 call sys$getdvi ( , , "SYS$COMMAND", dvi_items, , , , ) if ( ( devdepend & TT$M_NOBRDCST ) ~= 0 ) { write ( 6, ( " %Your terminal is set /NOBROADCAST." ) ) write ( 6, ( " %CB/Vax will not work with your terminal set this way." ) ) call exit } write(6,(" Welcome to CB/Vax V2.3")) # Decide if we need to start up the CB Manager. Attempt to translate # the mailbox's logical name. If we fail, then we assume the manager # doesn't exist, so we start him up with appropriate privileges. sta = sys$trnlog ( CB_MAILBOX_NAME, , mbname, , , ) if ( sta ~= 1 ) { privs(1) = ( 2 ** PRV$V_OPER ) + ( 2 ** PRV$V_PRMMBX ) _ + ( 2 ** PRV$V_SETPRI ) + ( 2 ** PRV$V_SYSNAM ) privs(2) = 0 sta2 = sys$creprc ( , CBMGR_LOCATION, _ , , , %ref(PRIVS(1)), , _ CBMGR_PROCNAME, %val(CBMGR_PRIORITY), _ %val((65536*CBMGR_GRP)+CBMGR_MEM), , ) wait = .true. if ( sta2 ~= 1 ) { write(6,(" ??Can't start CB Manager.")) write(6,(" Please contact the system manager.")) call exit } } # Try to read the global symbol CB_HANDLE from our process tables. # If it's there, then we'll use that as our initial handle. (You # see, having simple entry into CB is important to get people to # use it a lot.) space = " " null = char(0) repeat { 400 bad_handle = .false. sta = lib$get_symbol ( CB_HANDLE, handle ) if ( ~(sta & 1) ) { write ( 6, ( "$What's your handle? " ) ) read ( 5, ( A ), end=400, err=400 ) handle call lib$set_symbol ( CB_HANDLE, handle ) } do i = 32, 1, -1 if ( ( handle(i:i) ~= space ) & _ ( handle(i:i) ~= null ) ) break if ( i == 0 ) { write ( 6, (" You can't have a null handle!" ) ) bad_handle = .true. call lib$delete_symbol ( CB_HANDLE ) } } until ( ~bad_handle ) call sys$trnlog ( "SYS$COMMAND", length, tran, , , ) our_term = tran # Disable control-Y's while we run. If we don't, the CB Manager # won't know when we're done, and he'll continue to send messages, # making the user somewhat unhappy. call lib$disable_ctrl ( LIB$M_CLI_CTRLY ) # Build a "new user" string to send to the manager, and send it through # the mailbox. msg(1:1) = char(NEW_PERSON) msg(2:17) = our_term # Bytes 18 and 19 contain our group and member numbers for the /USTAT. msg(18:18) = char(grp) msg(19:19) = char(mem) msg(20:) = handle # Open up the mailbox. This is trickier than it appears... If we've # just created the Manager, the mailbox logical may not be defined by # the time we reach here, especially if we're on a fast system. The # logical variable WAIT is set up above if we've started the Manager. # Then, if we have trouble opening the mailbox, and WAIT is true, then # we keep trying every two seconds until it's open. repeat { open ( unit=9, file=CB_MAILBOX_NAME, status="NEW", _ recl=255, err=900 ) break 900 if ( wait ) { call bas$sleep ( %val(2) ) next } } write ( 9, (A) ) msg # Long loop. Repeat until we get an /EXIT command or ^Z from the user. # If it's a command, go execute it. Otherwise, we build a message # and send it off to the Manager. repeat { 300 read(5,(A),end=200,err=200) text call parse_cmd ( text, command_index, arg ) alen = find_len ( arg, 32, space ) msg(2:17) = our_term switch ( command_index ) { case -1 : next case 1 : { 200 msg(1:1) = char(LEAVING) write(9,(A)) msg call lib$enable_ctrl ( lib$m_cli_ctrly ) call exit } case 4 : { msg(1:1) = char(STATUS) write(9,(A)) msg next } case 7 : { msg(1:1) = char(USTAT) write(9,(A)) msg next } case 2 : { write(6,("$What's your handle? ")) read(5,(a),end=300,err=300) handle msg(1:1) = char(CHG_HANDLE) msg(18:) = handle write(9,(A)) msg next } case 6 : { call ots$cvt_ti_l ( arg(:alen), new_chan ) if ( ( new_chan < 1 ) | ( new_chan > 40 ) ) { write(6,(" That channel doesn't exist!")) next } msg(1:1) = char(TUNE) msg(18:18) = char(new_chan ) write(9,(A)) msg next } case 5 : { call summon ( arg(:alen), my_username, handle ) next } case 3 : { write(6,(" Quick summary of CB/Vax commands:")) write(6,(" /EXIT or ^Z exits from CB/Vax")) write(6,(" /HANDLE changes your handle")) write(6,(" /HELP print this help text")) write(6,(" /STATUS report number of people on each channel")) write(6,(" /SUMMON user summon username 'user' to CB/Vax.")) write(6,(" /TUNE n switch to channel 'n'. Channels 1-40 available.")) write(6,(" /USTAT detailed list of current CB/Vax users")) write(6,(" Commands may be in upper or lower case.")) next } case 0 : { msg(1:1) = char(MESSAGE) msg(18:) = text(1:132) write(9,(A)) msg } } } end subroutine summon ( his_username, my_username, my_handle ) implicit integer*4(a-z) `include '($JPIDEF)'` `include '($SSDEF)'` character*12 username, my_username, his_username character*32 my_handle character*23 time character*80 msg character*9 terminal character*1 null, space integer*4 items(7) external find_len null = char(0) space = " " call str$upcase ( his_username, his_username ) summon_count = 0 pid = -1 items(1) = ( 65536 * JPI$_USERNAME ) + 12 items(2) = %loc(username) items(3) = 0 items(4) = ( 65536 * JPI$_TERMINAL ) + 9 items(5) = %loc(terminal) items(6) = 0 items(7) = 0 call sys$asctim ( , time, , ) ulen = find_len ( my_username, 12, space ) hlen = find_len ( my_handle, 32, space ) msg = char(7) // my_handle(:hlen) // "(" // my_username(:ulen) // _ ") requests your presence on CB. (" // time(13:20) // ")" mlen = find_len ( msg, 80, space ) repeat { sta = sys$getjpi ( %val(1), pid, , items, , , ) call sys$waitfr ( %val(1) ) if ( sta == ss$_nomoreproc ) break if ( ~ ( sta & 1 ) ) next tlen = find_len ( terminal, 9, null ) if ( ( username == his_username ) & ( tlen > 1 ) ) { call sys$brdcst ( msg(:mlen), terminal ) summon_count = summon_count + 1 } } call lib$sys_fao ( " !UL user!%S summoned.", mlen, msg, _ %val(summon_count) ) write ( 6, ( A ) ) msg(:mlen) return end integer*4 function find_len ( str, maxlen, match_char ) character*(*) str character*1 match_char do i = maxlen, 1, -1 if ( str(i:i) ~= match_char ) break find_len = i return end subroutine parse_cmd ( cmdline, command_index, arg ) implicit integer*4(a-z) parameter ( MAXCMD=7 ) character*(*) cmdline character*32 arg character*16 cmdlist(MAXCMD), command character*1 space external find_len data cmdlist / "EXIT", "HANDLE", "HELP", "STATUS", "SUMMON", _ "TUNE", "USTAT" / # Quick case. If no slash in column 1, this is nothing. if ( cmdline(1:1) ~= "/" ) { command_index = 0 return } space = " " cmdline = cmdline(2:) len = find_len ( cmdline, 80, space ) do i = 1, len if ( cmdline(i:i) == space ) break clen = i - 1 command = cmdline(1:clen) if ( i < len ) arg = cmdline(i+1:) else arg = space call str$upcase ( command, command ) do i = 1, MAXCMD if ( command(:clen) == cmdlist(i)(:clen) ) break if ( i > MAXCMD ) { write ( 6, ( " %Invalid CB command; type /HELP for help." ) ) command_index = -1 } else command_index = i return end