🚀 go-pugleaf

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 +-+-+-+-+-+-+-+-