NetNews Usenet Archive 1992 #18

home *** CD-ROM | disk | FTP | other *** search

/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / vmsnet / sources / 305 < prev next >

Wrap

Internet Message Format | 1992-08-21 | 47.1 KB

Path: sparky!uunet!elroy.jpl.nasa.gov!ames!network.ucsd.edu!mvb.saic.com!vmsnet-sources From: munroe@dmc.com (Dick Munroe) Newsgroups: vmsnet.sources Subject: UBBS, part 03/12 Message-ID: <7868452@MVB.SAIC.COM> Date: Fri, 21 Aug 1992 20:19:19 GMT Organization: Doyle, Munroe Consultants, Inc., Hudson, MA Lines: 1438 Approved: Mark.Berryman@Mvb.Saic.Com Submitted-by: munroe@dmc.com (Dick Munroe) Posting-number: Volume 3, Issue 111 Archive-name: ubbs/part03 -+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X`09 end if X`09do k=1,i X`09 if(ichar(handle(k:k)).lt.32.or.ichar(handle(k:k)).gt.126) then X`09`09write(6,2000)crlf(:cl)//'Invalid character in handle' X`09`09bad_handle=.true. X`09`09call lib$delete_symbol(cb_handle) X`09`09endif X`09 enddo X`09if (bad_handle) goto 2060 X`09length=11 X`09tran='SYS$COMMAND' X`09sta = sys$trnlog(tran(1:length),length,tran,,,) X`09our_term = tran(5:20) X`09sta = str$trim(our_term, our_term, length) X`09if (our_term(length:length) .ne. ':') then X`09 our_term(length + 1:length + 1) = ':' X`09 end if X`09is = index(our_term, '$') X`09nodename = our_term(1:is) X`09our_term = our_term(is + 1:20) X`09istat = lib$getdvi(dvi$_tt_phydevnam, , our_term, , pterminal, ) X`09our_term = nodename(1:is)//pterminal(2:20) X`09nodename=nodename(3:is-1) X`09new_chan = 1 X X XC`09Build a "new user" string to send to the manager, and send it through XC`09the mailbox. X`09msg(1:1) = char(new_person) X`09msg(2:17) = our_term X`09msg(18:18) = char(new_chan) X`09msg(19:19) = null X`09msg(20:20) = null X`09msg(21:36) = handle X`09msg(37:42) = nodename X`09msg(43:50) = ' '`09`09!Scramble key X`09msg(51:51) = null`09`09!Scramble type X`09msg(52:) = my_username X XC`09Open up the mailbox. This is trickier than it appears... If we've XC`09just created the Manager, the mailbox logical may not be defined by XC`09the time we reach here, especially if we're on a fast system. XC`09If we have trouble opening the mailbox, then we keep trying every`20 XC`09two seconds until it's open (max 20 seconds). X`09trys=0 X X`09sta = .false. X`09do while(.not.sta) X`09 sta = sys$assign(cb_mailbox_name,mbx_chan,,,) X`09 if (.not. sta) then X`09`09trys=trys+1 X`09`09if(trys.gt.10) then X`09`09 write(6,2000)crlf(:cl)// X`091`09`09'CB internal error. exiting CB-Vax.' X`09`09 go to 99000 X`09`09else X`09`09 call bas$sleep(%val(2)) X`09`09end if X`09 endif X`09 end do X`09go to 30000`09`09!Start the whole thing off X X XC`09Long loop. Repeat until we get an /EXIT command or `5EZ from the user. XC`09If it's a command, go execute it. Otherwise, we build a message XC`09and send it off to the Manager. X X2180`09continue X`09if (command_index.eq.1) then X`09 go to 99000 X`09 end if Xc*************************************************************************** V** Xc`09the following is necessary for the user timer Xc*************************************************************************** V** X`09call add_elapsed_time(*4000) Xc`09****** end of timer ***** Xc`09read(5, 2000, end=4000, err=4000) text X`09write(6,2000)crlf(:cl) X`09txtlen=-132`09`09`09!allow for ctrl-z X`09call get_uplow_string(text,txtlen) X`09if(txtlen.lt.0) go to 4000 X`09call parse_cmd(text, command_index, arg) X`09istat = str$trim(arg,arg,alen) X`09goto (3000,4000,5000,6000,7000,8000,9000,10000,11000, X`091 12000,13000,14000,15000,16000,17000,18000), command_index + 1 X`09goto 2180 X X3000 continue`09!message (what it's all about) X`09if((text.eq.' ').or.(text.eq.otext)) go to 2180 X`09msg(1:1) = char(chatter) X`09msg(52:) = text X`09otext=text X`09go to 30000 X X4000 continue`09!user leaving X`09msg(1:1) = char(leaving) X`09command_index=1 X`09go to 30000 X X5000 continue`09!change handle X`09if(bbs) go to 2180 X`09bad_handle = .false. X`09if(arg(:alen).eq.' ') then X`09 write(6,2000)crlf(:cl)//'What''s your handle? ' X`09 read(5,2000, end=2060, err=2060) handle X`09else X`09 handle=arg(:alen) X`09endif X`09ista=str$trim(handle,handle,i) X`09if (i .eq. 0) then X`09 write(6,2000)crlf(:cl)//'Your handle was not changed.' X`09 go to 2180 X`09 end if X`09do k=1,i X`09 if(ichar(handle(k:k)).lt.32.or.ichar(handle(k:k)).gt.126) then X`09`09write(6,2000)crlf(:cl)//'Invalid character in handle' X`09`09bad_handle=.true. X`09`09call lib$delete_symbol(cb_handle) X`09`09endif X`09 enddo X`09if (bad_handle) goto 5000 X`09call lib$set_symbol(cb_handle, handle) X`09msg(1:1) = char(chg_handle) X`09msg(21:36) = handle X`09go to 30000 X X6000 continue`09!help X`09write(6,2000)crlf(:cl)// X`091 'Quick summary of CB/Vax commands:' X`09write(6,2000)crlf(:cl)// X`091 '/EXIT or `5EZ Exits from CB/Vax' X`09if(.not.bbs)write(6,2000)crlf(:cl)// X`091 '/HANDLE Changes your handle' X`09write(6,2000)crlf(:cl)// X`091 '/HELP Print this help text' X`09write(6,2000)crlf(:cl)// X`091 '/MONITOR n Monitor a channel (Max of 2)' X`09if(.not.bbs)write(6,2000)crlf(:cl)// X`091 '/SCRAMBLE xyz Scramble on key "xyz" (xmit & recieve)' X`09if(.not.bbs)write(6,2000)crlf(:cl)// X`091 '/SMC xyz Scramble xmit/recieve scrambled & clear' X`09write(6,2000)crlf(:cl)// X`091 '/SQUELCH abc Squelch handle "abc"' X`09write(6,2000)crlf(:cl)// X`091 '/STATUS Report number of people on each channel' X`09if(.not.bbs)write(6,2000)crlf(:cl)// X`091 '/SUMMON user Summon'// X`091 ' username ''user'' to CB/Vax.' X`09write(6,2000)crlf(:cl)// X`091 '/TIME Report time, day, and date' X`09write(6,2000)crlf(:cl)// X`091 '/TUNE n Switch to channel ''n''. '// X`091 'Channels 1-5 available.' X`09write(6,2000)crlf(:cl)// X`091 '/UNMONITOR n Stop monitoring a channel' X`09if(.not.bbs)write(6,2000)crlf(:cl)// X`091 '/UNSCRAMBLE Do not xmit or recieve scrambled.' X`09write(6,2000)crlf(:cl)// X`091 '/USTAT Detailed list of current CB/Vax users' X`09if(.not.bbs)write(6,2000)crlf(:cl)// X`091 '/XCL xyz Xmit clear/ recieve scrambled & clear' X`09write(6,2000)crlf(:cl)//' ' X`09write(6,2000)crlf(:cl)//'Commands may be in upper or lower case' X`09write(6,2000)crlf(:cl)//'and may be abbreviated to 3 characters.' X`09goto 2180 X X7000`09continue`09!Monitor X`09call ots$cvt_ti_l(arg(:alen), mon_chan) X`09if ((mon_chan .lt. 1) .or. (mon_chan .gt. 5)) then X`09 write(6, 2000)crlf(:cl)//'That channel doesn''t exist!' X`09 goto 2180 X`09 end if Xc`09if we are monitoring it already, ignore this request X`09if( (mon_chan.eq.ichar(msg(19:19))).or. X`091 (mon_chan.eq.ichar(msg(20:20)))) go to 2180 X X`09msg(1:1) = char(tune) X`09if(msg(19:19).eq.null) then X`09 msg(19:19) = char(mon_chan) X`09else if(msg(20:20).eq.null) then X`09 msg(20:20) = char(mon_chan) X`09else X`09 write(6,2000)crlf(:cl)// X`091`09'You can only monitor 2 channels at a time' X`09 write(6,2001)crlf(:cl),ichar(msg(19:19)),ichar(msg(20:20)) X`09 go to 2180 X`09endif X`09go to 30000 X X8000`09continue`09!Scramble X`09if(bbs) go to 2180 X`09if(alen.eq.0) then X`09 write(6,2000)crlf(:cl)//'You must provide a scramble key' X`09 go to 2180 X`09 endif X`09ist=str$upcase(arg(:alen),arg(:alen)) X`09msg(1:1) = char(scramble) X`09msg(43:50) = arg(:alen) X`09msg(51:51) = char(1) X`09go to 30000 X X9000`09continue`09!Scramble and monitor clear X`09if(bbs) go to 2180 X`09if(alen.eq.0) then X`09 write(6,2000)crlf(:cl)//'You must provide a scramble key' X`09 go to 2180 X`09 endif X`09ist=str$upcase(arg(:alen),arg(:alen)) X`09msg(1:1) = char(scramble) X`09msg(43:50) = arg(:alen) X`09msg(51:51) = char(2) X`09go to 30000 X X10000`09continue`09!Squelch X`09msg(1:1) = char(squelch) X`09msg(52:) = arg(:alen) X`09go to 30000 X X11000`09continue`09!status X`09msg(1:1) = char(status) X`09go to 30000 X X12000`09continue`09!summon X`09if(bbs) go to 2180 X`09msg(1:1) = char(summon) X`09msg(52:) = arg(:alen) X`09write(6,2000)crlf(:cl)//'Summon complete.' X`09go to 30000 X X13000`09continue`09!Time X`09call date(cdate) X`09call time(ctime) X`09is=lib$day_of_week(,daynum) X`09is=str$trim(dow(daynum),dow(daynum),daylen) X`09write(6,2000)crlf(:cl)// X`091 'It is '//dow(daynum)(1:daylen)//', '//cdate// X`092 ' and it is now '//ctime X`09go to 2180 X X14000`09continue`09!tune X`09call ots$cvt_ti_l(arg(:alen), new_chan) X`09if(new_chan.eq.99.and.my_username.eq.'DOMILLER') then X`09 msg(1:1) = char(tune) X`09 msg(18:18)=char(new_chan) X`09 go to 30000 X`09 endif X`09if ((new_chan .lt. 1) .or. (new_chan .gt. 5)) then X`09 write(6, 2000)crlf(:cl)//'That channel doesn''t exist!' X`09 goto 2180 X`09 end if X`09msg(1:1) = char(tune) X`09msg(18:18) = char(new_chan) X`09go to 30000 X X15000`09continue`09!Unmonitor X`09call ots$cvt_ti_l(arg(:alen), mon_chan) X`09if ((mon_chan .lt. 1) .or. (mon_chan .gt. 40)) then X`09 write(6, 2000)crlf(:cl)//'That channel doesn''t exist!' X`09 goto 2180 X`09 end if X X`09msg(1:1) = char(tune) X`09if(msg(19:19).eq.char(mon_chan)) then X`09 msg(19:19) = null X`09else if(msg(20:20).eq.char(mon_chan)) then X`09 msg(20:20) = null X`09else X`09 write(6,2000)crlf(:cl)//'You are not monitoring that channel' X`09 go to 2180 X`09endif X`09go to 30000 X X16000`09continue`09!Unscramble X`09if(bbs) go to 2180 X`09msg(1:1) = char(scramble) X`09msg(43:50) = ' ' X`09msg(51:51) = char(0) X`09go to 30000 X X17000`09continue`09!ustat X`09msg(1:1) = char(ustat) X`09go to 30000 X X18000`09continue`09!Xmit clear, unscramble recieve. X`09if(bbs) go to 2180 X`09if(alen.eq.0) then X`09 write(6,2000)crlf(:cl)//'You must provide a scramble key' X`09 go to 2180 X`09 endif X`09ist=str$upcase(arg(:alen),arg(:alen)) X`09msg(1:1) = char(scramble) X`09msg(43:50) = arg(:alen) X`09msg(51:51) = char(3) X`09go to 30000 X X30000`09continue`09`09!send a message to the CB manager X`09sta = sys$qio(,%val(mbx_chan),%val(write_code),iostatus,,, X`091 %ref(msg),%val(len),,,,) X`09if(sta.eq.2264) then X`09 wait=wait+1 X`09 if(wait.gt.10) go to 90000 X`09 stat=lib$wait(2.0) X`09 go to 30000 X`09else X`09 wait=0 X`09endif X`09if (.not. sta) call lib$signal (%val(sta)) X`09if (.not. iostatus.iostat) call lib$signal(%val(iostatus.iostat)) X`09go to 2180 Xc X90000`09continue`09`09!unable to fit a message into the mailbox X`09write(6,2000)crlf(:cl)//'CB internal error. exiting CB-Vax.' X`09privs(1) = (2**prv$v_oper) + (2**prv$v_prmmbx) + X`091 (2**prv$v_setpri) + (2**prv$v_sysnam) X`09privs(2) = 0 X`09sta2 = sys$creprc(,cbmgr_location,,,,%ref(privs(1)),, X`091 cbmgr_procname,%val(cbmgr_priority),%val((65536*cbmgr_grp) X`092 + cbmgr_mem),,) X`09if (sta2 .ne. 1) then X`09 write(6,2000)crlf(:cl)//'??Can''t start CB Manager.' X`09 write(6,2000)crlf(:cl)//'Please contact the system manager.' X`09 end if X99000`09call lib$enable_ctrl(ctrl_mask) X`09sta = sys$setrwm(%val(0)) Xc`09call exit X`09return X90500`09return 1 X`09end X`0C X`09subroutine parse_cmd(cmdline, command_index, arg) X`09implicit integer*4(a - z) X`09include 'bbs_inc.for' X`09parameter(maxcmd = 15) X`09character*(*)cmdline X`09character*32 arg X`09character*16 cmdlist(maxcmd), command X`09integer*2 cmdlen(maxcmd) X`09character*1 space X`09data cmdlist/'EXIT', 'HANDLE', 'HELP', 'MONITOR', 'SCRAMBLE', X`091 'SMC', 'SQUELCH', 'STATUS', 'SUMMON', 'TIME', 'TUNE', X`091 'UNMONITOR', 'UNSCRAMBLE', 'USTAT', 'XCL'/ X`09data cmdlen/1,2,2,1,2,2,2,2,2,2,2,3,3,2,1/ X XC`09Quick case. If no slash in column 1, this is nothing. X`09if (cmdline(1:1) .ne. '/') then X`09 command_index = 0 X`09 return X`09 end if X X`09cmdline = cmdline(2:) X`09istat = str$trim(cmdline,cmdline,len) X`09clen = str$position(cmdline,' ') X`09clen=clen-1 X`09command = cmdline(1:clen) X`09call str$upcase(command, command) X`09arg = cmdline(clen+2:) X`09do i = 1, maxcmd X`09 if (command(:clen) .eq. cmdlist(i)(:clen)) go to 2600 X`09 end do X2600`09continue X`09if (i .gt. maxcmd) then X`09 write(6,2000)crlf(:cl)// X`091`09'%CB-W Invalid CB command; type /HELP for help.' X`09else if (cmdlen(i).gt.clen) then X`09 write(6,2000)crlf(:cl)// X`091`09'%CB-W Ambiguous CB command; supply more characters.' X`09 i = maxcmd + 1 X`09end if X`09command_index = i X`09return X 2000`09format(a) X`09end $ CALL UNPACK BBSCB.FOR;20 2119707942 $ create 'f' X$ DEFINE/SYSTEM UBBS_STATUS "DOWN" $ CALL UNPACK BBSDOWN.COM;3 370442197 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09Include file for use with UBBS program. Xc Xc`09Rev. 3.5 19-Jun-1986 Xc`09Rev. 3.6 25-Jun-1986 Xc`09Rev. 4.8 05-Feb-1987 Xc`09Rev. 4.9 10-Feb-1987 Xc`09Rev. 4.14 12-Sep-1987 Xc`09Rev. 5.5 04-Jan-1988 Xc`09Rev. 5.6 03-Mar-1988 Xc`09Rev. 6.0 06-Jun-1988 Xc`09Rev. 7.0 29-Aug-1988 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X`09include '($ssdef)' X`09include '($iodef)' X`09include '($dscdef)' XC XC`09Define I/O status blocks and some descriptors. XC X`09integer*2 liosb(4), xiosb(4), ltypeahead_count(4) X X`09integer*4 local_status, local_char(3), noterm(2) X`09integer*4 tptr(2), ttbl(8) X X`09data noterm /0,0/`09`09! Don't terminate on anything. X`09data ttbl /0,0,0,0,0,0,0,0/`09! Long terminator table X X`09record/dscdef1/ ldesc,rdesc,xdesc X X`09common /status/ local_status, liosb, xiosb, local_char, X`091`09noterm, ttbl, tptr, ldesc, rdesc, xdesc XC XC`09Define counters, etc. XC X`09integer*4 byte_count, record_count, rbyte_count, X`091`09timeouts, parity_errors, naks_received, naks_xmitted, X`091`09enqs_received, enqs_xmitted, timeout_count, X`091`09flow, mode, dump_timeout, overrun_errors, X`091`09error_count, error_record, retry_count, X`091`09display_record, file_count, block_count, retry_limit, X`091`09block_received, block_xmitted X X`09common /counts/ byte_count, record_count, rbyte_count, X`091`09timeouts, parity_errors, naks_received, naks_xmitted, X`091`09enqs_received, enqs_xmitted, timeout_count, X`091`09ltypeahead_count, local_asts, lmax_typeahead, X`091`09dump_timeout, overrun_errors, error_count, X`091`09error_record, retry_count, display_record, file_count, X`091`09block_count, retry_limit, block_received, block_xmitted Xc Xc`09Define storage for channels and event flags. Xc X`09integer*4 lchan_in, lchan_out, X`091`09local_asts, lefn_in, lefn_out X X`09common /channels/ lchan_in, lchan_out, X`091`09lefn_in, lefn_out Xc Xc`09Define integers to contains character sizes. Xc X`09integer*4 lmax_typeahead, vsize, protocol, bitmask, file_type X X`09common /sizes/ vsize, protocol, bitmask, file_type Xc Xc`09Parameters. Xc X`09character*(*) null, bell, ss X`09parameter (ss = char(13)//char(10))`09! Single space. X`09parameter (bell = char(7))`09! Bell X`09parameter (null = char(0))`09! Null X`09parameter soh = 1`09`09! Start of header`09`09CTRL/A X`09parameter stx = 2`09`09! Start of text`09`09`09CTRL/B X`09parameter etx = 3`09`09! End of text`09`09`09CTRL/C X`09parameter eot = 4`09`09! End of transmission`09`09CTRL/D X`09parameter enq = 5`09`09! Enquire`09`09`09CTRL/E X`09parameter ack = 6`09`09! Acknowlegment`09`09`09CTRL/F X`09parameter bel = 7`09`09! Bell`09`09`09`09CTRL/G X`09parameter bs = 8`09`09! Backspace`09`09`09CTRL/H X`09parameter ht = 9`09`09! Horizontal tab`09`09CTRL/I X`09parameter lf = 10`09`09! Line feed`09`09`09CTRL/J X`09parameter vt = 11`09`09! Vertical tab`09`09`09CTRL/K X`09parameter ff = 12`09`09! Form feed`09`09`09CTRL/L X`09parameter cr = 13`09`09! Carriage return`09`09CTRL/M X`09parameter so = 14`09`09! Shift out`09`09`09CTRL/N X`09parameter si = 15`09`09! Shift in`09`09`09CTRL/O X`09parameter dle = 16`09`09! Data link escape`09`09CTRL/P X`09parameter dc1 = 17`09`09! Resume output to terminal`09CTRL/Q X`09parameter dc2 = 18`09`09! Device control 2`09`09CTRL/R X`09parameter dc3 = 19`09`09! Stop output to the terminal`09CTRL/S X`09parameter dc4 = 20`09`09! Device control 4`09`09CTRL/T X`09parameter nak = 21`09`09! Negative Acknowlegment`09CTRL/U X`09parameter syn = 22`09`09! Synchronize byte`09`09CTRL/V X`09parameter etb = 23`09`09! End of transmission block`09CTRL/W X`09parameter can = 24`09`09! Cancel transmission`09`09CTRL/X X`09parameter em = 25`09`09! End of medium`09`09`09CTRL/Y X`09parameter sub = 26`09`09! End of file`09`09`09CTRL/Z X`09parameter esc = 27`09`09! Escape`09`09`09CTRL/`5B X`09parameter fs = 28`09`09! File separator`09`09CTRL/\ X`09parameter gs = 29`09`09! Group separator`09`09CTRL/`5D X`09parameter rs = 30`09`09! Record Separator`09`09CTRL/`5E X`09parameter us = 31`09`09! Unit separator`09`09CTRL/_ X`09parameter sp = 32`09`09! Space X`09parameter rub = 127`09`09! Rubout X`09parameter file_unit = 10`09! Unit # for VAX file. X`09parameter out_size = 512`09! Size of SYS$OUTPUT records. X`09parameter buffer_size = 1040`09! Buffer size. X`09parameter timer_efn = 10`09! Event flag used with set timer. X`09parameter sevenbit_mask = "177`09! Seven bit mask. X`09parameter eightbit_mask = "377`09! Eight bit mask. XC XC`09Flags for LIB$SPAWN: XC X`09parameter nowait = 1`09`09!(0) If set, don't wait for command. X`09parameter noclisym = 2`09`09!(1) If set, don't copy CLI symbols. X`09parameter nolognam = 4`09`09!(2) If set, don't copy logical names. XC XC`09Buffer allocation: XC X`09logical*1 rbuffer(buffer_size)`09! Receive buffer. X`09logical*1 xbuffer(buffer_size)`09! Transmit buffer. X`09logical*1 lbuffer(buffer_size)`09! Local buffer. X`09character lbufferc*(buffer_size) ! Local buffer as a character string X`09character rbufferc*(buffer_size) ! Receive buffer as a character string X`09equivalence (lbuffer, lbufferc) X`09equivalence (rbuffer, rbufferc) X XC XC`09Flags. XC X`09logical`09controlc_typed X X`09common /flags/ controlc_typed Xc Xc`09Character strings for filenames, system type, baud rate, etc. Xc X`09character*80 local_device X`09character*128 vax_file X`09character*256 scratch X`09character*256 remote_file X X`09common /buffers/ rbuffer, xbuffer, lbuffer, vax_file, X`091 `09local_device, mode, flow, scratch, remote_file XC XC`09Direction for GET/SEND. XC X`09parameter to_vax = 1`09`09! Get a file from the remote. X`09parameter to_remote = 2`09`09! Send a file to the remote. XC XC`09Type of protocol: XC X`09parameter unknown = 0`09`09! Unknown protocol. X`09parameter xmodem = 1`09`09! CPM XMODEM protocol`20 X`09parameter kermit = 2`09`09! Kermit protocol. X`09parameter asciid = 3`09`09! Ascii dump protocol X`09parameter ymodem = 4`09`09! Ymodem variation`20 Xc Xc`09Type of file being transfered. Xc X`09parameter ascii = 0`09`09! Type of file is ASCII. X`09parameter binary = 1`09`09! Type of file is BINARY. X`09parameter block = 2`09`09! Use 512 byte blocks. X X`09structure /userlog_structure/ X`09 character*40 user_key`09!positions 1: 40 key 0 X`09 character*10 password`09!positions 41: 50 X`09 character*20 city`09`09!positions 51: 70 X`09 character*2 state`09`09!positions 71: 72 X`09 character*20 computer`09!positions 73: 92 X`09 character*9 last_log_date !positions 93:101 X`09 character*8 last_log_time`09!positions 102:109 X`09 logical*1 xpert !positions 110:110 X`09 integer*4 num_logon !positions 111:114 X`09 integer*4 last_message !positions 115:118 X`09 integer*4 num_unread !positions 119:122 X`09 byte auth_sections !positions 123:123 X`09 logical*1 approved`09!positions 124:124 X`09 character*10 phone_number`09!positions 125:134 X`09 character*4 user_crlf`09!positions 135:138 X`09 character*4 user_ff`09!positions 139:142 X`09 real*8 last_pass_chg`09!positions 143:150 X`09 character*9 current_day`09!positions 151:159 X`09 integer*2 seconds_today`09!positions 160:163 X`09 integer*4 decus_number`09!positions 164:167 X`09 character*20 company_name`09!positions 168:187 X`09 byte term_line_len !positions 188:188 X`09 byte editor`09`09!positions 189:189 X`09 integer*2 up_files !positions 190:191 X`09 integer*2 down_files !positions 192:193 X`09 end structure X X`09structure/mail_header_structure/ X`09 character*30 mail_to`09!positions 1:30 X`09 character*30 mail_from`09!positions 31:60 X`09 character*30 mail_subject`09!positions 61:80 X`09 character*9 mail_date`09!positions 81:89 X`09 character*8 mail_time`09!positions 90:97 X`09 byte mail_section`09!positions 98:98 X`09 integer*4 mail_first`09!positions 99:102 X`09 integer*4 mail_last`09!positions 103:106 X`09 integer*4 mail_messnum`09!positions 107:110 X`09 logical*1 mail_private`09!positions 111:111 X`09 logical*1 mail_read`09!positions 112:112 X`09 logical*1 mail_deleted`09!positions 113:113 X`09 logical*1 mail_person`09!positions 114:114 X`09 integer*4 mail_reply_to`09!postiions 115:118 X`09 integer*4 mail_replys(10)!positions 119:158 X`09 real*8 mail_expire`09!positions 159:166 X`09 end structure X X`09structure/file_description/ X`09 character*18 file_name`09!Positions 1:18 Primary key X`09 integer*2 file_size`09!Positions 19:20 X`09 real*8 upload_date`09!Positions 21:28 X`09 integer*4 times_down`09!Positions 29:32 X`09 character*1 file_type`09!Positions 33:33 X`09 character*30 upload_name`09!Positions 34:63 X`09 character*400 upload_text`09!Positions 64:463 X`09 character*79 keywords`09!Positions 464:542 X`09 real*8 download_date !Positions 543:550 X`09 logical*1 archived !Positions 551:551 X`09 end structure X X`09character*20 secnam(8) X`09character mail_name*30,area*60 X`09character*80 message(20) X`09logical*1 sysop,sysop2 X`09integer last_header,last_data,first_mnum,last_mnum X`09integer user_number,ios X X`09logical*1 approved_mail_read,approved_mail_send,approved_cb X`09logical*1 approved_file_down,approved_file_up X X`09record /userlog_structure/ ur X X`09common/for_mail/ur, last_header, last_data, X`091 first_mnum, last_mnum, mail_name, sysop, sysop2, X`092 area, user_number, secnam, ios, message, X`093 approved_mail_read,approved_mail_send,approved_cb, X`094 approved_file_down,approved_file_up X Xc Xc`09Local typeahead implementation Xc X`09logical*1 tbuffer(buffer_size)`09! Local typeahead buffer X`09character cbuffer*(buffer_size)`09! Also local typeahead buffer X`09integer tnext X`09equivalence(tbuffer,cbuffer) X X`09common/typeah/tbuffer,tnext Xc Xc`09screen formatting characters Xc X`09character*4 crlf,ffeed X`09integer cl,fl X X`09common/screen_controls/crlf,ffeed,cl,fl X Xc`09Timer pointers X X`09integer*4 file_timer,user_timer,initial_units,current_units, X`091 allowable_units X X`09common/timers/file_timer,user_timer,initial_units,current_units, X`091 allowable_units X Xc`09EDT definitions (since they aren't in the library) X XC`09Integer*4 EDT$M_RECOVER,EDT$M_COMMAND,EDT$M_NOJOURNAL XC`09Integer*4 EDT$M_NOOUTPUT,EDT$M_NOCOMMAND,EDT$M_NOCREATE X`09Parameter`09EDT$M_RECOVER = `091`09! recover this edit X`09Parameter`09EDT$M_COMMAND =`09`092`09! read command file X`09Parameter`09EDT$M_NOJOURNAL =`094`09! do not open journal X`09Parameter`09EDT$M_NOOUTPUT = `098`09! do not write output X`09Parameter`09EDT$M_NOCOMMAND = `0916`09! do not read cmd file X`09Parameter`09EDT$M_NOCREATE =`0932`09! do not create X XC`09Integer*4`09EDT$_INPFILNEX,EDT$_NONSTDFIL X`09Parameter`09EDT$_INPFILNEX =`098749384`09! input file non-exis X`09Parameter`09EDT$_NONSTDFIL = `098749395`09! non standard file X XC`09Integer*4 EDT$K_OPEN_INPUT, EDT$K_OPEN_OUTPUT_SEQ XC`09Integer*4 EDT$K_OPEN_OUTPUT_NOSEQ,EDT$K_OPEN_IN_OUT,EDT$K_GET XC`09Integer*4 EDT$K_PUT,EDT$K_CLOSE_DEL,EDT$K_CLOSE X`09Parameter`09EDT$K_OPEN_INPUT = `091`09! open file for read X`09Parameter`09EDT$K_OPEN_OUTPUT_SEQ =`092`09! open sequenced/write X`09Parameter`09EDT$K_OPEN_OUTPUT_NOSEQ = 3`09! open nosequenc/write X`09Parameter`09EDT$K_OPEN_IN_OUT =`094`09! open for read/write X`09Parameter`09EDT$K_GET =`09`095`09! read a record X`09Parameter`09EDT$K_PUT = `09`096`09! write a record X`09Parameter`09EDT$K_CLOSE_DEL =`097`09! close and delete X`09Parameter`09EDT$K_CLOSE =`09`098`09! close X XC`09Integer*4 EDT$K_COMMAND_FILE,EDT$K_INPUT_FILE,EDT$K_INCLUDE_FILE XC`09Integer*4 EDT$K_JOURNAL_FILE,EDT$K_OUTPUT_FILE,EDT$K_WRITE_FILE X`09Parameter`09EDT$K_COMMAND_FILE =`091`09! stream /command X`09Parameter`09EDT$K_INPUT_FILE =`092`09! stream for read X`09Parameter`09EDT$K_INCLUDE_FILE =`093`09! stream on "include" X`09Parameter`09EDT$K_JOURNAL_FILE =`094`09! stream of journal X`09Parameter`09EDT$K_OUTPUT_FILE =`095`09! stream of output X`09Parameter`09EDT$K_WRITE_FILE =`096`09! stream on "write" Xc Xc`09End of BBS_INC.FOR. Xc $ CALL UNPACK BBS_INC.FOR;28 894427919 $ create 'f' X$ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! X$ !!`09 PACKAGE: UBBS Build command`09`09`09!!! X$ !!`09 PROGRAM NAME: BUILD.COM`09`09`09`09!!! X$ !!`09 AUTHOR: Dale Miller`09`09`09`09!!! X$ !!`09 OPERATING SYSTEM: VAX/VMS version 4.3`09`09`09!!! X$ !!`09 LANGUAGE: Digital Command Language`09`09!!! X$ !!`09 DATE: April, 1986`09`09`09`09!!! X$ !!`09`09`09`09`09`09`09`09`09!!! X$ !!`09This program will build UBBS from the source files.`09`09!!! X$ !!`09`09`09`09`09`09`09`09`09!!! X$ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! X$ ! First, compile and link all the utilities X$ inquire/nopunct choice "Are you ready to build UBBS? `5BYes`5D" X$ if f$extract(1,1,choice) .eqs. "N" then exit X$ write sys$output "Compiling and linking utilities." X$ fortran `5B.utility`5DINIT_IDX X$ fortran `5B.utility`5DINIT_MESS X$ fortran `5B.utility`5DINIT_USERLOG X$ link INIT_IDX X$ link INIT_MESS X$ link INIT_USERLOG X$ delete *.obj;* X$ rename init*.exe `5B.utility`5D X$ write sys$output "Setting up the help library" X$ library/help/create `5B.DATA`5Dhelplib `5B.DATA`5Dhelplib X$ ! X$ ! Now, do the actual compiles for UBBS X$ ! X$ write sys$output "Now compiling UBBS. This may take a little while." X$ fortran/check=nooverflow BBS X$ fortran/check=nooverflow BBSCB X$ fortran/check=nooverflow UBBS_SUBS X$ fortran/check=nooverflow SYSOP X$ macro COMINT X$ macro QUADMATH X$ library/object/create ubbs *.obj X$ link/notrace/EXEC=BBS UBBS/INCLUDE=(BBS_MAIN)/LIBRARY X$ link/exec=sysop ubbs/include=(sysop)/library X$ copy bbs.exe ubbs.exe X$ SET DEFAULT `5B.DATA`5D X$ run `5B-.utility`5Dinit_mess X$ run `5B-.utility`5Dinit_userlog X$ create cities.dat X$ SET DEFAULT `5B-`5D X$ run sysop Xub X7 X13-Sep-1986 X$ inquire/nopunctuation choice "Do you want to build the directories for dow Vnloads?" X$ if f$extract(1,1,choice) .eqs. "N" then goto nocreate X$ create/dir `5B.files`5D X$ create/dir `5B.files.100`5D X$ create/dir `5B.files.128`5D X$ create/dir `5B.files.ami`5D X$ create/dir `5B.files.app`5D X$ create/dir `5B.files.ast`5D X$ create/dir `5B.files.ata`5D X$ create/dir `5B.files.com`5D X$ create/dir `5B.files.cpm`5D X$ create/dir `5B.files.ibm`5D X$ create/dir `5B.files.mac`5D X$ create/dir `5B.files.mis`5D X$ create/dir `5B.files.pcs`5D X$ create/dir `5B.files.trs`5D X$ create/dir `5B.files.100.asc`5D X$ create/dir `5B.files.128.asc`5D X$ create/dir `5B.files.ami.asc`5D X$ create/dir `5B.files.app.asc`5D X$ create/dir `5B.files.ast.asc`5D X$ create/dir `5B.files.ata.asc`5D X$ create/dir `5B.files.com.asc`5D X$ create/dir `5B.files.cpm.asc`5D X$ create/dir `5B.files.ibm.asc`5D X$ create/dir `5B.files.mac.asc`5D X$ create/dir `5B.files.mis.asc`5D X$ create/dir `5B.files.pcs.asc`5D X$ create/dir `5B.files.trs.asc`5D X$ create/dir `5B.files.100.bin`5D X$ create/dir `5B.files.128.bin`5D X$ create/dir `5B.files.ami.bin`5D X$ create/dir `5B.files.app.bin`5D X$ create/dir `5B.files.ast.bin`5D X$ create/dir `5B.files.ata.bin`5D X$ create/dir `5B.files.com.bin`5D X$ create/dir `5B.files.cpm.bin`5D X$ create/dir `5B.files.ibm.bin`5D X$ create/dir `5B.files.mac.bin`5D X$ create/dir `5B.files.mis.bin`5D X$ create/dir `5B.files.pcs.bin`5D X$ create/dir `5B.files.trs.bin`5D X$ set def `5B.files`5D X$ create download.areas XThe following download areas are available: X X 100 - Radio shack MOD100 & MOD200 X 128 - Commodore 128 X AMI - Amiga X APP - Apple X AST - Atari ST X ATA - Atari X COM - Commodore 64 X CPM - CP/M & CP/M 86 X IBM - IBM-PC & MS/DOS X MAC - Apple Macintosh X MIS - Miscellaneous files X PCS - PC/SIG Diskette library X TRS - Radio Shack Model II,III,4,COCO,Etc. X$ copy download.areas upload.areas X$ set def `5B-`5D X$ set def `5B.files.100`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.128`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.ami`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.app`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.ast`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.ata`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.com`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.cpm`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.ibm`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.mac`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.mis`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.pcs`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--.files.trs`5D X$ create allow.up X$ create allow.down X$ run `5B--`5Dinit_idx X$ set def `5B--`5D X$ nocreate: X$ write sys$output "UBBS has been built. To try it out, use @DISTLOGIN" X$ exit $ CALL UNPACK BUILD.COM;13 1817593606 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - CHECK_MODEMS.FOR Xc`09This program checks an incoming user to determine what line he/she Xc`09is on, and whether to allow access based on current modem line usage. Xc Xc`09Dale Miller - UALR Xc`0923-Apr-1987 Xc Xc`09Rev. 1.0 23-Apr-1987 Xc`09Rev. 1.1 05-Jan-1988 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include '($dvidef)' X`09include '($syidef)' X`09include '($lnmdef)' X X`09character*6 nodename X`09character*32 terminal_name,pterminal X`09integer istat,count,status X`09integer lib$getdvi,lib$getsyi,sys$trnlnm,lib$set_symbol X`09integer d1,d2,d3,str$trim X`09 X`09! Define item list structure X`09structure`09/itmlst/ X`09 union X`09`09map X`09`09 integer*2`09buflen, itmcod X`09`09 integer*4 bufadr, retadr X`09`09 end map X`09`09map X`09`09 integer*4`09end_list X`09`09 end map X`09`09end union X`09 end structure X X`09record /itmlst/`09trnlnm_list(2) X Xc`09First, determine if he is even a candidate for checking X`09istat=lib$getsyi(syi$_nodename,,nodename,,,) X X`09trnlnm_list(1).itmcod = lnm$_string X`09trnlnm_list(1).bufadr = %loc(terminal_name) X`09trnlnm_list(1).buflen = 32 X`09trnlnm_list(1).retadr = 0 X`09trnlnm_list(2).end_list = 0 X X`09istat = lib$set_symbol('MODEM_STATUS','OKAY') X X`09istat = sys$trnlnm(,'LNM$PROCESS_TABLE','TT',,trnlnm_list) X`09istat = lib$getdvi(dvi$_tt_phydevnam,,terminal_name,,pterminal,) X`09istat = str$trim(nodename,nodename,d1) X`09istat = str$trim(pterminal,pterminal,d3) X`09if(index(pterminal,'_').ne.0) d2=index(pterminal,'_')+1 X`09if(index(pterminal,':').ne.0) d3=index(pterminal,':')-1 X`09print*,'Port='//nodename(:d1)//'::'//pterminal(d2:d3) X`09print*,' ' X`09print*,' ' X`09if(nodename.eq.'GAMMA') call exit X`09if(terminal_name(1:3).ne.'VTA') call exit Xc`09if(nodename.eq.'ALPHA'.and.(pterminal(2:5).eq.'TXJ6'.or. Xc`091 pterminal(2:5).eq.'TXJ7')) then Xc`09 call exit Xc`09 end if X X`09count=0 X`09istat = lib$getdvi(dvi$_refcnt,,'txj0:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj1:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj2:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj3:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj4:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj5:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj6:',status,,) X`09if(status.ne.0) count=count+1 X`09istat = lib$getdvi(dvi$_refcnt,,'txj7:',status,,) X`09if(status.ne.0) count=count+1 X`09if(count.ge.5) then X`09 istat = lib$set_symbol('MODEM_STATUS','FULL') X`09else X`09 istat = lib$set_symbol('MODEM_STATUS','OKAY') X`09end if X`09if(nodename.eq.'ALPHA'.and.count.ge.3) then X`09 istat = lib$set_symbol('MODEM_STATUS','FULL') X`09 end if X`09call exit X`09end $ CALL UNPACK CHECK_MODEMS.FOR;11 1328507111 $ create 'f' X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; X;`09`09`09`09`09`09`09`09`09; X;`09UBBS subroutines`09`09`09`09`09`09; X;`09This routine will convert a binary integer to an edited`09`09; X;`09Z,ZZZ,ZZ9 string.`09`09`09`09`09`09; X;`09`09`09`09`09`09`09`09`09; X;`09Dale Miller - UALR`09`09`09`09`09`09; X;`09Rev. 4.3 26-Jul-1986`09`09`09`09`09`09; X;`09`09`09`09`09`09`09`09`09; X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; X`09.PSECT`09STRING,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG X;`09A character string descriptor to keep FORTRAN happy XSTRING:`09.LONG`09`5EX010E0009 X`09.LONG`09`5EX00000000 X; X`09.PSECT`09$CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG X`09.ENTRY`09COMINT,`5EM<R2,R3,R4,R5> X`09MOVQ`09@B`5E08(AP), R0 X`09MOVL`09R1, STRING+4 X`09CLRQ`09-(SP) X`09SUBL2`09#`5EX04, SP X`09CVTLP`09@4(AP), #`5EX07, (SP) X`09EDITPC`09#`5EX07, (R3), EOPAT, @STRING+4 X`09MOVL`09#`5EX01, R0 X`09RET X; XEOPAT:`09.BYTE`09`5EX47`09`09;EO$ADJUST_INPUT X`09.BYTE`09`5EX07`09`09`09;LENGTH X`09.BYTE`09`5EX02`09`09;EO$CLEAR_SIGNIF X`09.BYTE`09`5EX91`09`09;EO$MOVE (1 DIGIT) X`09.BYTE`09`5EX44`09`09;EO$INSERT X`09.BYTE`09`5EX2C`09`09`09; ',' X`09.BYTE`09`5EX93`09`09;EO$MOVE (3 DIGITS) X`09.BYTE`09`5EX44`09`09;EO$INSERT X`09.BYTE`09`5EX2C`09`09`09; ',' X`09.BYTE`09`5EX92`09`09;EO$MOVE (2 DIGITS) X`09.BYTE`09`5EX03`09`09;EO$SET$SIGNIF X`09.BYTE`09`5EX91`09`09;EO$MOVE (1 DIGIT) X`09.BYTE`09`5EX00`09`09;EO$END X`09.END $ CALL UNPACK COMINT.MAR;4 1946442527 $ create 'f' X$ here = f$logical("SYS$DISK") + f$directory() X$ data = here - "`5D" + ".data`5D" X$ fileplace = here - "`5D" + ".files.`5D" X$ define ubbs_data 'data'`09`09!these symbols will need to be changed X$ define ubbs_files 'fileplace'`09`09!if you use UBBS from another directory X$ define ubbs_sysop_1 "DALE MILLER"`09! Change these symbols as appropriate X$ define ubbs_sysop_2 "MICHAEL SMITH" X$ define ubbs_sysop_mail "DOMILLER" X$! approved_mail_read = 01`09`09!UBBS_FLAGS is a bit mask to allow X$! approved_mail_send = 02`09`09!unapproved users access to certain X$! approved_cb = 04`09`09!UBBS features. Set the bits to 1 to X$! approved_file_down = 08`09`09!allow access. X$! approved_file_up = 16 X$ define ubbs_flags 25`09`09`09!Everything but MAIL_SEND & CB X$ restart: X$ on error then goto send_mail X$ on warning then goto send_mail X$ set message/nofacility/noident/noseverity/notext X$ assign sys$command sys$input X$ node = f$getsyi("nodename") X$ term = f$getdvi(f$getjpi("","terminal"),"tt_phydevnam") - ":" - "_" X$ termin == node + "_" + term - " " X$ assign failure.'termin' sys$error X$ assign failure.'termin' sys$output X$ sho symbol termin X$ deassign sys$output X$ set message/facility/ident/severity/text X$ run ubbs X$ goto finish X$ ! X$ ! we had an error X$ ! X$ send_mail: X$ deassign sys$error X$ mail/subject="bbs aborted" failure.'termin' UBBS_SYSOP_MAIL X$ set message/nofacility/noident/noseverity/notext X$ delete failure.'termin';* X$ write sys$output "A fatal error has occurred. UBBS is restarting." X$ goto restart X$ ! X$ ! normal way out X$ ! X$ finish: X$ deassign sys$error X$ delete failure.'termin';* X$ logoutnow $ CALL UNPACK DISTLOGIN.COM;5 105178331 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Compress.for Xc`09This program compresses the message data base eliminating deleted and Xc`09expired messages as well as private messages which have already been Xc`09read. Xc`09Dale Miller - UALR Xc`0914-Nov-1985 Xc Xc`09Rev. 3.5 24-Jun-1986 Xc`09Rev. 4.3 26-Jul-1986 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc $ CALL UNPACK HEADER.FOR;1 1075586781 $ create 'f' XC XC`09Include file for KERMIT. XC X`09PARAMETER POVER =`093`09! Packet overhead count: X`09`09`09`09`09! LEN, SEQ, & TYPE. X`09PARAMETER TOVER =`096`09! Total packet overhead: X`09`09`09`09`09! MARK, LEN, SEQ, TYPE, CHECK, EOL. X`09PARAMETER MAXDATASIZ =`0991`09! Maximum data size field. X`09PARAMETER MAXPACKSIZ =`0994`09! Maximum packet size (-MARK & CHECK) X`09PARAMETER PACKBUFSIZ =`0998`09! The packet buffer size: X`09`09`09`09`09! MARK, CHECK1, `5BCHECK2,`5D & EOL. X`09PARAMETER TO_CHECK =`092`09! This size + PLEN = check field. X`09PARAMETER PACKET_LENGTH = 80 XC XC`09Define my init characteristics. XC X`09PARAMETER DEFMAXL =`0980`09! Maximum packet length. X`09PARAMETER DEFTIME =`0910`09! Timeout value to use. X`09PARAMETER DEFNPAD =`090`09! Number of padding characters. X`09PARAMETER DEFPADC =`090`09! Padding character to send. X`09PARAMETER DEFEOLC =`0913`09! End-Of-Line character. X`09PARAMETER DEFQCTL =`09'#'`09! Control quote character. X`09PARAMETER DEFQBIN = 'N'`09! No eight bit quoting. X`09PARAMETER DEFCHKT = '1'`09! Check type (1=checksum). X`09PARAMETER DEFREPT =`09' '`09! No repeat char processing. X`09PARAMETER DEFCAPAS =`090`09! No extended capabilities. XC XC`09Define my init characteristics. XC X`09PARAMETER MYMAXL =`0980`09! Maximum packet length. X`09PARAMETER MYTIME =`0910`09! Timeout value to use. X`09PARAMETER MYNPAD =`090`09! Number of padding characters. X`09PARAMETER MYPADC =`090`09! Padding character to send. X`09PARAMETER MYEOLC =`0913`09! End-Of-Line character. X`09PARAMETER MYQCTL =`09'#'`09! Control quote character. X`09PARAMETER MYQBIN = 'N'`09! No eight bit quoting. X`09PARAMETER MYCHKT = '1'`09! Check type (1=checksum). X`09PARAMETER MYREPT =`09' '`09! No repeat char processing. X`09PARAMETER MYCAPAS =`090`09! No extended capabilities. XC XC`09Define the packet offsets: XC XC`09I'd like to define a structure here, but since the packets can XC`09vary in size I'm unable to use a structure declaration. XC X`09PARAMETER PMARK`09= 1`09`09! Start of packet character. X`09PARAMETER PLEN`09= 2`09`09! The packet length field. X`09PARAMETER PSEQ`09= 3`09`09! The packet sequence field. X`09PARAMETER PTYPE`09= 4`09`09! The packet type field. X`09PARAMETER PDATA`09= 5`09`09! The packet data field. XC XC`09Define init packet offsets: XC X`09PARAMETER IMAXL`09= 1`09`09! Maximum packet length. X`09PARAMETER ITIME`09= 2`09`09! Timeout limit to use. X`09PARAMETER INPAD`09= 3`09`09! Number of pad characters. X`09PARAMETER IPAD`09= 4`09`09! Pad character to use. X`09PARAMETER IEOLC`09= 5`09`09! End of line character. X`09PARAMETER IQCTL`09= 6`09`09! Control quote character. XC XC`09The next init packet fields are optional. XC X`09PARAMETER IQBIN`09= 7`09`09! 8-bit quote character. X`09PARAMETER ICHKT`09= 8`09`09! Check type to use. X`09PARAMETER IREPT`09= 9`09`09! Repeat character to use. X`09PARAMETER ICAPAS = 10`09`09! Capabilities mask. X X`09PARAMETER ISIZE = ICAPAS`09! Set the init packet size. XC XC`09Define Variables: XC X`09INTEGER`09`09cpsiz,`09`09! The current packet size. X`091`09`09rbytes,`09`09! The record byte count. X`092`09`09rpsiz,`09`09! Maximum receive packet size. X`093`09`09spsiz,`09`09! Maximum send packet size. X`094`09`09pad,`09`09! How much padding to send. X`095`09`09paknum,`09`09! The packet number. X`096`09`09prepak,`09`09! The previous packet number. X`097`09`09maxtry,`09`09! The maximum retry count. X`098`09`09numtry,`09`09! Times this packet retried. X`099`09`09oldtry,`09`09! Times previous packet retried. X`091`09`09timout,`09`09! Timeout for foreign host on sends. X`092`09`09packet_count, X`093`09`09total_packets, X`094`09`09total_bytes, X`095`09`09total_records X X`09LOGICAL`09`09image,`09`09! 8-bit mode for file data. X`091`09`09filnamcnv,`09! Do file name case conversions. X`092`09`09qbin,`09`09! Do 8-bit character quoting. X`093`09`09repeat,`09`09! Do repeat character compression. X`094`09`09turn,`09`09! Look for turnaround char (XON). X`095`09`09end_of_file X X`09BYTE`09`09state,`09`09! Present state of the automaton. X`091`09`09cchksum,`09! Our (computed) checksum. X`092`09`09padc,`09`09! Padding character to send. X`093`09`09eolc,`09`09! End-Of-Line character to send. X`094`09`09qctlc,`09`09! Control quote character. X`095`09`09qbinc,`09`09! Binary quote character. X`095`09`09markc,`09`09! Character to use for MARK. X`096`09`09bquote,`09`09! The binary quote character. X`097`09`09chktyp,`09`09! The check type to use. X`098`09`09reptc,`09`09! Character to use for repeats. X`099`09`09capas`09`09! The capabilities bit mask. X X`09BYTE`09packet(PACKBUFSIZ)`09! Allocate packet for send/receive. X X`09COMMON /KERCOM/`09cpsiz, rpsiz, spsiz, pad, timout, paknum, prepak, X`091`09`09maxtry, numtry, oldtry, image, turn, filnamcnv, X`092`09`09state, cchksum, padc, eolc, qctlc, markc, packet, X`093`09`09qbin, qbinc, chktyp, repeat, reptc, capas, rbytes, X`094`09`09packet_count,total_packets,end_of_file, X`095`09`09total_bytes,total_records X XC XC`09End of KERMIT include file. XC $ CALL UNPACK KERMIT_INC.FOR;2 1933455111 $ create 'f' X$IF F$MODE() .EQS. "BATCH" THEN GOTO BATCH X$ SET TERM/NODISC X$ ON ERROR THEN GOTO SEND_MAIL X$ RESTART: X$ ON ERROR THEN GOTO SEND_MAIL X$ ON WARNING THEN GOTO SEND_MAIL X$ STATUS=F$LOGICAL("UBBS_STATUS") X$ IF STATUS.NES."DOWN" THEN GOTO ITSUP X$ WRITE SYS$OUTPUT "UBBS is temporarily out of service." X$ WRITE SYS$OUTPUT "Please try again later." X$ LOGOUTNOW X$ ITSUP: X$ DEFINE/USER UBBS_EXE DISK$USER:`5BUALR_BBS`5D X$ RUN UBBS_EXE:CHECK_MODEMS X$ IF MODEM_STATUS.EQS."OKAY" THEN GOTO LINEOK X$ WRITE SYS$OUTPUT "UBBS may not be accessed on this line at this" X$ WRITE SYS$OUTPUT "time. Please try (501) 568-9464." X$ LOGOUTNOW X$ LINEOK: X$ SET MESSAGE/NOFACILITY/NOIDENT/NOSEVERITY/NOTEXT X$ ASSIGN SYS$COMMAND SYS$INPUT X$ ! X$ NODE = F$GETSYI("NODENAME") X$ TERM = F$GETDVI(F$GETJPI("","TERMINAL"),"TT_PHYDEVNAM") - ":" - "_" X$ TERMIN == NODE + "_" + TERM - " " X$ ASSIGN FAILURE.'TERMIN' SYS$ERROR X$ ASSIGN FAILURE.'TERMIN' SYS$OUTPUT X$ SHO SYMBOL TERMIN X$ DEASSIGN SYS$OUTPUT X$ SET MESSAGE/FACILITY/IDENT/SEVERITY/TEXT X$ DEFINE/USER UBBS_SYSOP_1 "DALE MILLER" X$ DEFINE/USER UBBS_SYSOP_2 "MICHAEL SMITH" X$ DEFINE/USER UBBS_SYSOP_MAIL "DOMILLER" X$ DEFINE/USER UBBS_FLAGS 25 X$ DEFINE/USER UBBS_DATA DISK$USER:`5BUALR_BBS.DATA`5D X$ DEFINE/USER UBBS_FILES DUA10:`5BBBS_FILES.`5D X$ RUN SYS$SYSTEM:UBBS X$ GOTO FINISH X$ ! X$ ! WE HAD AN ERROR X$ ! X$ SEND_MAIL: X$ ON ERROR THEN GOTO OFFNOW X$ DEASSIGN SYS$ERROR X$ MAIL/SUBJECT="BBS ABORTED" FAILURE.'TERMIN' SYSOP X$ SET MESSAGE/NOFACILITY/NOIDENT/NOSEVERITY/NOTEXT X$ DELETE FAILURE.'TERMIN';* X$ WRITE SYS$OUTPUT "A fatal error has occurred. UBBS is restarting." X$ GOTO RESTART X$ ! X$ ! NORMAL WAY OUT X$ ! X$ FINISH: X$ ON ERROR THEN GOTO OFFNOW X$ DEASSIGN SYS$ERROR X$ DELETE FAILURE.'TERMIN';* X$ OFFNOW: X$ LOGOUTNOW X$! X$BATCH: X$DEFINE UBBS_SYSOP_1 "DALE MILLER" X$DEFINE UBBS_SYSOP_2 "MICHAEL SMITH" X$DEFINE UBBS_FLAGS 25 X$DEFINE UBBS_DATA DISK$USER:`5BUALR_BBS.DATA`5D X$DEFINE UBBS_FILES DUA10:`5BBBS_FILES.`5D $ CALL UNPACK LOGIN.COM;23 2104324526 $ create 'f' X`09.TITLE`09ICR_QUAD_MATH X; X;`09CALL SUBQUAD(A,B,C) X; X;`09RETURNS: A - B -> C X; X`09.psect`09code,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec,long X`09.ENTRY`09SUBQUAD`09`5EM<R2> X; X; XA=4 XB=8 XC=12 X`09MOVQ`09@A(AP),R0 X`09MOVAQ`09@B(AP),R2 X`09SUBL`09(R2)+,R0 X`09SBWC`09(R2),R1 X`09MOVQ`09R0,@C(AP) X`09RET X; X; X; X`09.psect`09code,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec,long X`09.ENTRY`09COMPQUAD`09`5EM<R2> X; X;`09ival = COMPQUAD(a,b) X; X;`09if a > b`09 1 --> ival X;`09 a = b`09 0 --> ival X;`09 a < b`09-1 --> ival X; X; X`09MOVQ`09@A(AP),R0 X`09MOVAQ`09@B(AP),R2 X`09SUBL`09(R2)+,R0 X`09SBWC`09(R2),R1 X`09MOVQ`09R0,R0`09`09`09;"TEST" QUADWORD X`09BEQL`0910$ X`09BGTR`0920$ X`09MOVL`09#-1,R0 X`09BRB`0930$ X10$: X`09CLRL`09R0 X`09BRB`0930$ X20$: X`09MOVL`09#1,R0 X30$: X`09RET X; X; X; X`09.psect`09code,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec,long X`09.ENTRY`09EDIV`09`5EM<R2> X; X;`09CALL EDIV (A,B,C) X;`09RETURNS A/B->C X; X`09MOVQ`09@A(AP),R0 X`09MOVAL`09@B(AP),R2 X`09EDIV`09(R2),R0,R0,R1 X`09MOVL`09R0,@C(AP) X`09RET X; X; X; X`09.psect`09code,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec,long X`09.ENTRY`09EMUL`09`5EM<R2> X; X;`09CALL EMUL (A,B,C) X;`09RETURNS A*B->C X; X`09MOVAL`09@A(AP),R1 X`09MOVAL`09@B(AP),R2 X`09EMUL`09(R1),(R2),#0,R0 X`09MOVQ`09R0,@C(AP) X`09RET X; X; X;`09CALL ADDQUAD(A,B,C) X; X;`09RETURNS: A + B -> C X; X`09.psect`09code,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec,long X`09.ENTRY`09ADDQUAD`09`5EM<R2> X; X; XA=4 XB=8 XC=12 X`09MOVQ`09@A(AP),R0 X`09MOVAQ`09@B(AP),R2 X`09ADDL`09(R2)+,R0 X`09ADWC`09(R2),R1 X`09MOVQ`09R0,@C(AP) X`09RET X; X; X;`09RESULT = QUAD_TO_D,F(A) X; X;`09RETURNS: A -> CONVERT TO DOUBLE,FLOATING -> RESULT X; X`09.psect`09code,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec,long XQUAD_TO_F:: X`09.ENTRY`09QUAD_TO_D `5EM<R2,R3> X; X; XA=4 X`09MOVQ`09@A(AP),R0 X`09CVTLD`09R1,R2 X`09TSTL`09R2 X`09BEQL`095$ X`09EXTV`09#7,#8,R2,R1 X`09ADDL`09#32,R1 X`09INSV`09R1,#7,#8,R2 X5$: X`09BBCC`09#31,R0,10$ X`09ADDD`09#`5EF2147483648,R2 X10$: X`09CVTLD`09R0,R0 X`09ADDD`09R2,R0 X`09RET X`09.END $ CALL UNPACK QUADMATH.MAR;2 859685145 $ create 'f' X`09program sysop Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Sysop.for Xc`09This program combines all of the UBBS utility functions. Xc`09Dale Miller - UALR Xc`0907-Jul-1986 Xc Xc`09Rev. 4.10 11-Feb-1987 Xc`09Rev. 7.1 19-Sep-1988 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X`09implicit none X`09character choice*2 X`09integer str$upcase,istat X X 0010`09write(6,*)'Choice?' X`09read(5,1001,end=900)choice X 1001`09format(a) X`09istat=str$upcase(choice,choice) X`09if(choice.eq.' '.or.choice.eq.'E') then X`09 call exit X`09else if(choice.eq.'A') then X`09 call aging X`09else if(choice.eq.'AF') then X`09 call archive_files X`09else if (choice.eq.'C') then X`09 call compress(.false.) X`09else if (choice.eq.'CA') then X`09 call compress(.true.) X`09else if (choice.eq.'F') then X`09 call fixcounts X`09else if (choice.eq.'UL') then X`09 call ulist X`09else if (choice.eq.'UB') then X`09 call upbull X`09else if (choice.eq.'UF') then X`09 call update_files X`09else if (choice.eq.'US') then X`09 call update_sysops X`09else if (choice.eq.'UU') then X`09 call upuser X`09else if (choice.eq.'CF') then X`09 call check_files X`09else if (choice.eq.'CI') then X`09 call check_indices X`09else X`09 write(6,*)'Programs available' X`09 write(6,*)'A - Aging' X`09 write(6,*)'AF - Archive files' X`09 write(6,*)'C - Compress message file' X`09 write(6,*)'CA - Compress m.f. eliminating ALL read messages' X`09 write(6,*)'CF - Check files' X`09 write(6,*)'CI - Check indices' X`09 write(6,*)'F - Fixcounts' X`09 write(6,*)'UB - Update bulletin number & date' X`09 write(6,*)'UF - Update files' X`09 write(6,*)'UL - User list' X`09 write(6,*)'US - Update sysops on file sections' X`09 write(6,*)'UU - Update userlog' +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-