🚀 go-pugleaf

Submitted-by: munroe@dmc.com (Dick Munroe)
Posting-number: Volume 3, Issue 109
Archive-name: ubbs/part01

         [ UBBS - The UALR Bulletin Board System ]

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-010  25-Jun-1992
$!   On 21-AUG-1992 13:04:03.97   By user BERRYMAN 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 12 PARTS, TO KEEP EACH PART
$!  BELOW 100 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME.TXT;4
$!       2. ABBREV.STD;3
$!       3. ARKLUG.COM;4
$!       4. BBS.COM;12
$!       5. BBS.FOR;165
$!       6. BBSCB.FOR;20
$!       7. BBSDOWN.COM;3
$!       8. BBS_INC.FOR;28
$!       9. BUILD.COM;13
$!      10. CHECK_MODEMS.FOR;11
$!      11. COMINT.MAR;4
$!      12. DISTLOGIN.COM;5
$!      13. HEADER.FOR;1
$!      14. KERMIT_INC.FOR;2
$!      15. LOGIN.COM;23
$!      16. QUADMATH.MAR;2
$!      17. SYSOP.FOR;168
$!      18. UBBS_SUBS.FOR;170
$!      19. [.DATA]BADPASS.TXT;1
$!      20. [.DATA]BULLETIN.001;1
$!      21. [.DATA]BULLETIN.002;6
$!      22. [.DATA]BULLETIN.003;1
$!      23. [.DATA]BULLETIN.004;1
$!      24. [.DATA]BULLETIN.005;1
$!      25. [.DATA]BULLETIN.006;1
$!      26. [.DATA]BULLETIN.007;1
$!      27. [.DATA]BULLETIN.008;1
$!      28. [.DATA]BULLETIN.009;1
$!      29. [.DATA]BULLETIN.010;1
$!      30. [.DATA]BULLETIN.MNU;1
$!      31. [.DATA]HELPLIB.HLP;1
$!      32. [.DATA]MESSAGE.SECTIONS;1
$!      33. [.DATA]SIGNOFF.TXT;1
$!      34. [.DATA]WELCOME.TXT;1
$!      35. [.DATA]WORDWRAP.EDT;1
$!      36. [.MAIL_PROTOCOL]BBS_INC.FOR;28
$!      37. [.MAIL_PROTOCOL]BUILD.COM;2
$!      38. [.MAIL_PROTOCOL]INSTALL.COM;2
$!      39. [.MAIL_PROTOCOL]L.COM;9
$!      40. [.MAIL_PROTOCOL]MAILSHR.MAR;3
$!      41. [.MAIL_PROTOCOL]MAILSHR.OPT;2
$!      42. [.MAIL_PROTOCOL]PROT_INC.FOR;7
$!      43. [.MAIL_PROTOCOL]UBBS_MAILSHR.FOR;6
$!      44. [.MAIL_PROTOCOL]UBBS_MAIL_ERR.MSG;7
$!      45. [.UPGRADE]CONVERT_FILES.FOR;2
$!      46. [.UPGRADE]CRLF.FOR;1
$!      47. [.UPGRADE]CVTV6.FOR;1
$!      48. [.UPGRADE]FIXMESS.FOR;1
$!      49. [.UPGRADE]REFORMAT_UPLOADS.FOR;2
$!      50. [.UTILITY]ADD_FILES.FOR;2
$!      51. [.UTILITY]ASSIGN.COM;2
$!      52. [.UTILITY]COMPILE.COM;11
$!      53. [.UTILITY]DAILY_RESTORE.COM;2
$!      54. [.UTILITY]INIT_IDX.FOR;2
$!      55. [.UTILITY]INIT_MESS.FOR;2
$!      56. [.UTILITY]INIT_USERLOG.FOR;2
$!      57. [.UTILITY]INSTBBS.COM;2
$!      58. [.UTILITY]L.COM;2
$!      59. [.UTILITY]LT.COM;2
$!      60. [.UTILITY]MAIL.DELIVERY;3
$!      61. [.UTILITY]MESSAGE.FOR;1
$!      62. [.UTILITY]SYSOP.HOWTO;2
$!      63. [.UTILITY]VMSARC.FOR;2
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ x = P1 - f$parse(P1,,,"version")
$ y = f$search(x)
$ if y .eqs. "" then $ goto file_absent
$ x = f$integer(f$parse(P1,,,"version")-";")
$ y = f$integer(f$parse(y,,,"version")-";")
$ if x .gt. y then $ goto file_absent
$ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped."
$file_delete:
$ delete 'f'*
$ exit
$file_interactive:
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists."
$ read/error=file_delete/end=file_delete-
  /prompt="Create new version [y/n]: " -
  sys$command x
$ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped."
$ if .not. x then $ goto file_delete
$ P1 = P1 - f$parse(P1,,,"version")
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X               UBBS - The UALR Bulletin Board System             06-Nov-1988
X
X           Dale Miller - University of Arkansas at Little Rock
X
X                    DOMILLER@UALR.BITNET
X
X    This directory contains all of the files necessary to implement UBBS, a
Xfull-featured public computerized bulletin board system.  UBBS has message
Xfiles, uploads, downloads, private messages, help files, bulletins,
Xconferencing, and most importantly, multiple concurrent access.
X    UBBS is written in FORTRAN and all source code is included.  The files
Xsupplied to run UBBS are:
X
XAAAREADME.TXT        - This file
XABBREV.STD           - Miscellaneous message tidbits
XARKLUG.COM           - Login file for second bulletin board
XBBS.COM              - A command file to execute UBBS
XBBS.FOR              - The main source program for UBBS
XBBSCB.FOR            - UBBS-specific version of CB.  Requires CB manager.
XBBSDOWN.COM          - Set the logical to disallow UBBS logins
XBBS_INC.FOR          - An include file for the source
XBUILD.COM            - ** Command file to build UBBS **
XCHECK_MODEMS.FOR     - Routine to limit UBBS usage to certain ports
XCOMINT.MAR           - Macro routine to do a COBOL-type numeric-edited move.
XDISTLOGIN.COM        - Another sample LOGIN.COM (somewhat more generic)
XKERMIT_INC.FOR       - Include file for Kermit modules
XLOGIN.COM            - Sample LOGIN.COM for captive account
XQUADMATH.MAR         - Macro subroutines used in UBBS.
XSYSOP.FOR            - Performs system operator duties
XUBBS_SUBS.FOR        - Subroutines for UBBS
X
X
X    Data files included with UBBS are in the directory `5B.data`5D, and incl
Vude:
X
XBADPASS.TXT          - Message to display for failed password
XBULLETIN.nnn         - Sample bulletins
XBULLETIN.MNU         - Bulletin menu
XHELPLIB.HLP          - Help library
XMESSAGE.SECTIONS     - List of message sections
XSIGNOFF.TXT          - Message to display at logoff
XWELCOME.TXT          - Sample welcome file
XWORDWRAP.EDT         - EDT init file to turn on word wrap.
X
X    Files to upgrade earlier versions of UBBS to the current format are
Xalso included.  These are:
X
XCONVERT_FILES.FOR    - Convert the FILES.DAT to FILES.IDX.
XCRLF.FOR             - Add end of line and clear screen sequences to userlog
V.
XCVTV6.FOR            - Convert files to version 6.
XFIXMESS.FOR          - Add expiration dates to messages.
XREFORMAT_UPLOADS.FOR - Changes format of uploads for UBBS Rev. 4.7 or later.
X
XIf you are currently running UBBS, check these to see if you need to run the
Vm.
X
X    There is also a directory of UBBS-related utilities which contains:
X
XADD_FILES.FOR        - Rather esoteric utility to modify large number of fil
Ve
X                       descriptions.
XASSIGN.COM           - Make assignments necessary to run UBBS
XCOMPILE.COM          - Procedure to compile all modules of UBBS
XINIT_IDX.FOR         - Sets up the file sections.
XINIT_MESS.FOR        - Program to initialize message data base
XINIT_USERLOG.FOR     - Program to initialize the userlog
XDAILY_RESTORE.COM    - Command procedure to restore requested files.
XINSTBBS.COM          - Procedure to install UBBS with necessary privs.
XL.COM                - Procedure to link UBBS and SYSOP
XLT.COM               - Procedure to link UBBS and SYSOP with /TRACE
XSYSOP.HOWTO          - Documentation for file SYSOPs
XVMSARC.FOR           - A VMS program to de-ARC files from PCs.
X
X
X    BUILD.COM will create all files necessary to create and run UBBS.
XThere are, however several things a budding SYSOP must know.
X   `20
X    UBBS is set up to require user verification.  This verification is
Xapplicable to all functions not authorized by the logical name UBBS_FLAGS.
XThis logical is bit mapped with the following values:
X
X        approved_mail_read = 01   - Allow users to read mail
X        approved_mail_send = 02   - Allow users to send mail
X        approved_cb        = 04   - Allow use of CB simulator
X        approved_file_down = 08   - Allow file downlaoding
X        approved_file_up   = 16   - Allow file uploading
X
X   For instance, the defination "$ define ubbs_flags 25"
Xwould allow unapproved users all fucntions except leaving messages and using
Xthe CB simulator.  A verified user may execute all functions.
XVerification is taken care of via the UPUSER function of SYSOP
X(described below).  Users are requested to use the (P)rivate message to
Xoperator function to request access.  This function
Xsends VAXmail to the user defined by the logical UBBS_SYSOP_MAIL
Xe.g. "$ DEFINE UBBS_SYSOP_MAIL DOMILLER"
X
XAll UBBS file accesses are referenced by means of 2 logical names:
X    UBBS_DATA  - Location of all data files needed to run UBBS
X    UBBS_FILES - Location of upload and download file sections
X
X    All utilities necessary for day to day operation are included in
XSYSOP.FOR.  They are accessed by answering the "Choice" question with a 1 or
X2 character key for the following programs:
X
X        A  - Aging
X        AF - Archive files
X        C  - Compress message file
X        CA - Compress m.f. eliminating ALL read messages
X        CF - Check files
X        CI - Check indices
X        F  - Fixcounts
X        UB - Update bulletin number & date
X        UF - Update files
X        UL - User list
X        US - Update sysops on file sections
X        UU - Update userlog
X
XThe individual programs are described below.
X
XAGING         -`09This is a program to allow you to delete users that have
X`09`09not logged on for a specified period of time.  You will
X`09`09be prompted for a date.  This is in standard VMS format.
X`09`09You will then be asked whether to delete approved and/or
X`09`09un-approved users before this date.  If a "NO" response
X`09`09is entered, the users will be listed, but not deleted.
X
XARCHIVE_FILES - Delete and set the ARCHIVED bit on files which have not been
X                downloaded since a user-supplied date.
X
XCHECK_FILES   - This program runs through all files in the download areas
X                and makes sure they appear in the index.  If they are not
X                in the index, they are deleted.
X
XCHECK_INDEX   - Reverse of CHECK_FILES.  Allows files to be deleted or
X                added to the index.
X
XCOMPRESS_MESS - This is a program that compresses the message data base.
X                as messages are logically deleted, they are merely marked
X                for deletion.  This program actually recovers the space.
X                statistics are given on space gained.  It is a good idea to
X`09`09have this set up in a batch job to run semi-occasionally.
X`09`09I have found 03:00 each morning to be a good time.
X
XCOMPRESS_ALL  - This is similar to COMPRESS but eliminates ALL read messages
X                whether private or public.
X
XFIXCOUNTS     - This program is written to fix the count of unread messages
X`09`09announced at logon.  This can under certain conditions become
X`09`09corrupted (like VMS mail) and so this program will fix the
X`09`09counts like they should be.
X
X
XUSER LIST     - This will give a formatted list of the user names, addresses
V,
X                authorization level, and phone number.
X
XUPDATE BULL.  - This will update the last bulletin counter.  You are prompte
Vd
X                for the last bulletin you have entered and the last date.
X
XUPDATE FILES  - This is a program to interactively update the FILES.IDX file
Vs
X                for downloading.  Instructions follow.
X
XUPDATE SYSOPS - Allows naming of up to 3 persons per section as "file sysops
V"
X                who then have all privileges for that file section.
X
XUPDATE USERL. - This program updates the user log.  You may delete or modify
X                user info.
X
X
X
XThe following programs are included for setting up a new installation of
XUBBS.
X
XINIT_MESS     - This program initializes the message file.  It should only
X                be run if you want to clear the message file and start over.
X
XINIT_USERLOG  - This program initialized the user log.  It should only be
X                used to remove all users from the user log.
X
XINIT_IDX      - This program creates an empty index of downloads available.
X****************************************************************************
V***
X
X                   Details of UBBS
X
X    The messages are stored in two files.  MESSAGE.HED is a file of message
Xheaders, 1 per message + 1.  INIT_MESS.FOR is set up for 1000 headers`20
X(999 messages).  This will expand as needed.  The MESSAGE.DAT file is the
Xactual message content.  There is 1 record per message line.  INIT_MESS will
Xset this file up for 5000 records.  This file will also expand as needed.
XIf the message files get full, space will be added.  Whenever an
Xerror is detected on the message files, a message is sent via VAXmail to the
Xusername defined by the logical UBBS_MAIL_SYSOP.
XThe COMPRESS_MESS program will delete all messages that are logically
Xdeleted, expired messages, and private mail which has already been read. Thi
Vs
Xwill have to be run periodically depending on your usage.  At UALR, we have
Xit set up to run each night.
X
X    The user log is an indexed file USERLOG.DAT containing a header record a
Vnd
X1 record for each user.  User names are upper case only for ease of comparis
Von.
XThe ULIST program will give a brief listing of the userlog information.  The
XUPUSER will give a list of user information and allow you to change it.  To
Xuse this program, answer UU to SYSOP.  You will be asked whether to check ci
Vty
Xnames, or process all users.  Using the "City" response will allow you to fi
Vnd
Xall users whose home city is not in CITIES.DAT (initially empty).  Selecting
Xall users is exactly that.  you will then be asked for a key to start.
XPressing return at this point allows starting at the beginning.  For each us
Ver
Xname, UPUSER will pause
Xand allow you to enter a 1 or 2 character code.  These are:
X      A - Approves the user. (see U)
X      B - Starts over at the beginning of the userlog
X      C - Allows you to change the City field
X      CN- Allows you to change the Company name field
X      CO- Allows you to change the type of computer
X      D - Deletes the record
X      DN- Allows you to change the DECUS number field
X      E - Exits the program
X      P - Allows you to change the password
X      PN- Allows you to change the phone number field
X      S - Allows you to change the state field
X      U - Unapproves the user (see A)
X      W - Writes the modified record
X      Z - Zeros the time-used-today field.
X          anything else proceeds to the next record.
X
X    The bulletin system is rather simplistic.  You just create a file, using
Xyour favorite editor, called BULLETIN.MNU.  A sample file is included.  This
Xis the file displayed when The bulletin option is selected.  Individual
Xbulletins are numbered, beginning with 1 and named BULLETIN.nnn where nnn is
Xthe 3-digit bulletin number.  BULLETIN.001 is supplied as a sample.  When
Xadding a new bulletin, the UPBULL program will change the displays for highe
Vst
Xbulletin number and latest bulletin date.  It's not fancy, but it works.
X
X    There is one main menu option which does not appear on the menu.  The Q
Xoption sets a special flag.  If an authorized user enters Q, it will allow t
Vhem
Xto read and/or delete all messages.  This includes private and logically
Xdeleted messages.  This feature could be considered an invasion of privacy.
XTo allow a person to use this feature, the person's name must be defined by
Xa logical name UBBS_SYSOP_n where n is 1 to 9.  The logicals must begin with
X1 and be in sequence.  e.g. $ define ubbs_sysop_1 "DALE MILLER"
X                            $ define ubbs_sysop_2 "MICHAEL SMITH"
X
X    Uploaded files do not appear in the download directory automatically,
Xwhen a file is uploaded, its name is placed into FILES.IDX.  The SYSOP
Xroutine "update files" allows you to make this known to the world.  This
Xprogram runs through the message sections allowing you to delete approve or
Xmodify an entry.  Instructions are included in the program.  This program ma
Vy
Xalso be invoked inside UBBS by trusted users.  To do so, enter the download`
V20
Xarea of your choice and enter "abc.xyz" as the file name.  This is only
Xavailable to persons with sysop privilege and those you have specifically
Xapproved using "update sysop".
X
X    File up/downloading is controlled by the presence of the files
X"ALLOW.UP" and "ALLOW.DOWN" in the file section directories.  These files ha
Vve
Xno content.  The files UBBS_FILES:DOWNLOAD.AREAS and UBBS_FILES:UPLOAD.AREAS
Xare text files printed whenever the user requests a list of up/download area
Vs.
XNote that these two control areas allow you to create upload only areas,
Xdownload only areas, or areas which do not appear in the listings but are
Xaccessible to those "in the know".
X
X    The "update sysop" selection allows you to designate up to 3 people as
Xfile sysops for each download section.  When this selection is invoked, you
Xare given each of the 3 names for each file section.  If you wish to chenge
V it,
Xjust enter the new name.  The names appearing here must match EXACTLY the
Xuser's mail name on UBBS.
X
X    The CB selection requires the CB/Vax simulator also distributed by UALR.
XThe CB selection will not work unless UBBS is installed privileged, and the
XCB system is operational at your site.
X
X    If you wish to set up UBBS as a public bulletin board, define an account
Xin SYSUAF.DAT similar to the following:
X
X     Username: BBS                              Owner:  BULLETIN BOARD SYSTE
VM
X     Account:  BULLETIN                         UIC:    `5B177,1`5D (`5BBULL
VETIN,BBS`5D)
X     CLI:      DCL                              Tables:`20
X     Default:  DISK$USER:`5BBBS`5D
X     LGICMD:   DISK$USER:`5BBBS`5DLOGIN.COM
X     Login Flags:  Disctly Lockpwd Captive Diswelcome Disnewmail Dismail Dis
Vreport`0D
X                   Disreconnect
X     Primary days:   Mon Tue Wed Thu Fri       `20
X     Secondary days:                     Sat Sun
X     No access restrictions
X     Expiration:            (none)    Pwdminimum:  5   Login Fails:     0
X     Pwdlifetime:           (none)    Pwdchange:             (none)`20
X     Last Login: 23-NOV-1985 22:33 (interactive),            (none) (non-int
Veractive)
X     Maxjobs:         0  Fillm:        20  Bytlm:         8192
X     Maxacctjobs:     0  Shrfillm:      0  Pbytlm:           0
X     Maxdetach:       0  BIOlm:        18  JTquota:       1024
X     Prclm:           1  DIOlm:        18  WSdef:          150
X     Prio:            4  ASTlm:        24  WSquo:          200
X     Queprio:         0  TQElm:        10  WSextent:       500
X     CPU:        (none)  Enqlm:        30  Pgflquo:      10000
X     Authorized Privileges:`20
X       TMPMBX NETMBX
X     Default Privileges:`20
X       TMPMBX NETMBX
X
X    This account should have no password.  To allow a specific line to
Xautomatically connect to the BBS, use the SYS$MANAGER:SYSALF.COM to specify
Xautomatic connection to the username you have defined.  If you wish to limit
Xthe ability for other access, the LOGIN.COM file has the code in it to restr
Vict
XUBBS to certain dial-in lines.  It is currently not being used on my board,
Xbut was left in in order to customize it for your site.
X
X    To the best of my knowledge, there is no limit (other than your VAX) as
Xto how many concurrent users you may have.  All file updating is handled
Xvia standard FORTRAN i/o and RMS record locking.
X
X    While this documentation does not cover all aspects of UBBS, it should
Xallow you to set the board up and get your feet wet.  A good working knowled
Vge
Xof FORTRAN is recommended to fully utilize UBBS.
X
X    I/O routines used in UBBS have been lifted from the VAXNET submission,
Xand are used by permission.
X
X    The current implementation of UBBS is actually used to run 2 different
Xbulletin boards at UALR.  This just requires changing the pointers to
XBBS$ and BBS$FILES.  In our case, there are also some programming changes.
XTo handle that without separate copies of the program, the user logical`20
X"ARKLUG" is set to "TRUE" to invoke the changes.
X
X    I realize that UBBS will have to be customized for each individual site
Xthat runs it.  I would appreciate hearing from anyone who implements it as a
Xpublic system.  I would also like to get copies of any enhancements, fixes,
Xor improvements anyone makes to UBBS.  If you have any questions, comments,
Xpraises, or curses, feel free to send them on.  New versions of UBBS are
Xavailable from UALR at very infrequent intervals.
X
X              Dale Miller
X              Computing Center - NS204
X              University of Arkansas at Little Rock
X              2801 S. University
X              Little Rock, AR   72204-1099
X
X              DOMILLER@UALR.BITNET
X
X              (501) 569-8714 (voice - 8:00-17:00 Central)
X              (501) 568-9464 (UBBS)
X
XUBBS is copyrighted  (c) 1986 by Dale O. Miller, and is released for`20
Xprivate and commercial use.  It may not be sold, either alone or as part`20
Xof a package.  The author excludes any and all implied warranties including
Xwarranties of fitness for a particular purpose and will not be liable for
Xincidental or consequential damages as a result of using this product.
X
X****** Warning ***** UBBS may be addictive both to you and your users.
$ CALL UNPACK AAAREADME.TXT;4 1967712251
$ create 'f'
XIn the July issue of the "Q-link Update", I came accross the following listi
Vng
Xof abbreviations and 'faces' used on that network. I'm sure many of you are
Xfamiliar with some of them.  I was just thinking how nice it would be if the
Vy
Xcould become standardized on UBBS and the cb.  They are, to wit:
X
X:)     smile            :>     mischievious smile
X`5B`5D     hug              :P     sticking out tongue
X;)     wink             :X     not saying a word
X:'(    crying           LOL    laughing out loud
X:*     kiss             OTF    on the floor, laughing!
X:c     pout             afk    away from keys
X:(     frown            BRB    be right back
X:D     big smile        bak    back
$ CALL UNPACK ABBREV.STD;3 1882022662
$ create 'f'
X$ set term/nodisc
X$ on error then goto send_mail
X$ tries=0
X$ restart:
X$ tries=tries+1
X$ if tries .ge. 5 then goto itsdown
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$ itsdown:
X$ write sys$output "UBBS-ARKLUG is temporarily out of service."
X$ write sys$output "Please try again later."
X$ logoutnow
X$ itsup:
X$ kermit `09:== $sys$system:kermit
X$ who `09`09:== $sys$common:`5Bsysmgr.ualr.users`5Ddispuser
X$ home `09`09:== set def dua10:`5Bdecus`5D
X$ dn `09`09:== @sys$system:dn
X$ up `09`09:== @sys$system:up
X$ x*modem`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dxmodem
X$ toxmod`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dtoxmod
X$ fromxmod`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dfromxmod
X$ xsend`09`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dxmodem st
X$ xrec`09`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dxmodem rct
X$ define/user ubbs_data disk$user:`5Barklug_bbs`5D
X$ define/user ubbs_files dua10:`5Barklug_files.`5D
X$ define/user arklug "TRUE"
X$ define/user ubbs_sysop_1 "DALE MILLER"
X$ define/user ubbs_sysop_2 "MICHAEL SMITH"
X$ define/user ubbs_flags 25
X$ define/user ubbs_sysop_mail "MLSMITH"
X$! approved_mail_read = 01
X$! approved_mail_send = 02
X$! approved_cb        = 04
X$! approved_file_down = 08
X$! approved_file_up   = 16
X$ define/user ubbs_flags 1
X$ run sys$system:ubbs
X$ goto finish
X$ !
X$ ! we had an error
X$ !
X$ send_mail:
X$ write sys$output "A fatal error has occurred.  UBBS is restarting."
X$ goto restart
X$ !
X$ ! normal way out
X$ !
X$ finish:
X$ logoutnow
$ CALL UNPACK ARKLUG.COM;4 543643885
$ create 'f'
X$ restart:
X$ define ubbs_data disk$user:`5Bualr_bbs.data`5D
X$ define ubbs_files dua10:`5Bbbs_files.`5D
X$ define ubbs_sysop_1 "DALE MILLER"
X$ define ubbs_sysop_2 "MICHAEL SMITH"
X$ define ubbs_sysop_mail "DOMILLER"
X$! approved_mail_read = 01
X$! approved_mail_send = 02
X$! approved_cb        = 04
X$! approved_file_down = 08
X$! approved_file_up   = 16
X$ define ubbs_flags 25
X$! set proc/prior=2
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$ termin == f$getsyi("nodename") + "_" + f$getjpi("","terminal")
X$ termin == f$extract(0,(f$locate(":",termin)),termin)
X$ assign failure.'termin' sys$error
X$ assign sys$error sys$output
X$ sho symbol termin
X$ deassign sys$output
X$ assign sys$error for007
X$ set message/facility/ident/severity/text
X$ run bbs
X$ goto finish
X$ !
X$ ! we had an error
X$ !
X$ send_mail:
X$ deassign for007
X$ deassign sys$error
X$ mail/subject="bbs aborted" failure.'termin' domiller
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 for007
X$ deassign sys$error
X$ set message/nofacility/noident/noseverity/notext
X$ delete failure.'termin';*
X$ set message/fac/ident/sever/text
X$ set proc/prio=4
X$! logoutnow
$ CALL UNPACK BBS.COM;12 1128403077
$ create 'f'
X`09program bbs_main
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xc
Xc`09This is the driver for a VAX CBBS system
Xc
Xc`09Begun: 19-Jul-1985
Xc`09Dale Miller - University of Arkansas at Little Rock
Xc`09Rev. 1.0  29-Jul-1985
Xc`09Rev. 1.1  01-Aug-1985
Xc`09Rev. 1.2  05-Aug-1985
Xc`09Rev. 1.3  06-Aug-1985
Xc`09Rev. 1.4  08-Aug-1985
Xc`09Rev. 1.5  14-Aug-1985
Xc`09Rev. 1.6  18-Aug-1985
Xc`09Rev. 1.7  24-Aug-1985
Xc`09Rev. 1.8  27-Aug-1985
Xc`09Rev. 1.9  08-Sep-1985
Xc`09Rev. 1.10 13-Sep-1985
Xc`09Rev. 1.11 14-Sep-1985
Xc       Rev. 1.12 17-Sep-1985
Xc`09Rev. 1.13 28-Sep-1985
Xc`09Rev. 1.14 29-Sep-1985
Xc`09Rev. 1.15 15-Oct-1985
Xc`09Rev. 2.0  14-Nov-1985
Xc`09Rev. 2.1  07-Jan-1986
Xc`09Rev. 2.2  18-Jan-1986
Xc`09Rev. 2.3  03-Feb-1986
Xc`09Rev. 3.0  18-Feb-1986
Xc`09Rev. 3.1  24-Feb-1986
Xc`09Rev. 3.2  02-Mar-1986
Xc`09Rev. 3.3  04-Mar-1986
Xc`09Rev. 3.4  19-Apr-1986
Xc`09Rev. 3.5  19-Jun-1986
Xc`09Rev. 3.6  25-Jun-1986
Xc`09Rev. 4.0  27-Jun-1986
Xc`09Rev. 4.1  07-Jul-1986
Xc`09Rev. 4.2  23-Jul-1986
Xc`09Rev. 4.3  26-Jul-1986
Xc`09Rev. 4.4  15-Aug-1986
Xc`09Rev. 4.5  24-Sep-1986
Xc       Rev. 4.6  09-Nov-1986
Xc`09Rev. 4.7  29-Nov-1986
Xc`09Rev. 4.8  03-Feb-1987
Xc`09Rev. 4.9  10-Feb-1987
Xc`09Rev. 4.10 11-Feb-1987
Xc`09Rev. 4.11 27-Feb-1987
Xc`09Rev. 4.12 11-Jun-1987
Xc`09Rev. 4.13 04-Jul-1987
Xc`09Rev. 5.0  12-Sep-1987
Xc`09Rev. 5.1  28-Sep-1987
Xc`09Rev. 5.2  17-Oct-1987
Xc`09Rev. 5.3  02-Dec-1987
Xc`09Rev. 5.4  21-Dec-1987
Xc`09Rev. 5.5  19-Jan-1988
Xc`09Rev. 5.6  07-Mar-1988
Xc`09Rev. 6.0  06-Jun-1988
Xc`09Rev. 6.1  08-Jun-1988
Xc`09Rev. 6.2  21-Jul-1988
Xc`09Rev. 7.0  23-Aug-1988
Xc`09Rev. 7.1  24-Sep-1988
Xc`09Rev. 7.2  02-Jan-1989
Xc`09Rev. 7.3  20-Jan-1989
Xc`09Rev. 7.4  24-Jul-1989
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X`09implicit none
X`09include 'bbs_inc.for/nolist'
X`09include 'sys$library:foriosdef/nolist'
X`09include '($syidef)'
X`09include '($jpidef)'
X`09include '($rmsdef)'
X`09character logon_date*9,logon_time*8,inp_password*10
X`09character cdate*9,ctime*8,lms*9,clms*9,uns*9
X`09character yesno*3,three*3,bull_date*11
X`09character space*30/'                    '/
X`09character zeros*40/'0000000000000000000000000000000000000000'/
X`09character dummy_20*20,dummy_40*40,line*200
X`09character error*60/' '/
X`09character pm*14/' ** private **'/
X`09character last_name*20,first_name*20
X`09character zmail_from*30,xxx*4
X`09character nodename*6,terminal*6
X`09character prcname*15,cminutes*2
X`09character zfirst_name*20,zlast_name*20,zmail_to*30,qmail_to*30
X`09character string*80,cdummy*1,darea*3,zmail_subject*30
X`09byte dummyb
X`09integer istat,pid,realpid,high_bull,ubbs_flags
X`09integer try,length,fnlen,lnlen,ctlen,pwlen,namln,flen
X`09integer spc,sect,i,j,k,l,ii,jj,kk,ll
X`09integer dummy,dummy1,dummy2,dummy3,dummy4
X`09integer kmess,irec,krec,slen,num_flags
X`09integer status,next_mess,fmess,lmess,mess,mnum
X`09integer stack_ptr,field,count,number
X`09integer idummy(8),flags(100),stack(200)
X`09integer compquad,netmail
X`09logical*1 interactive,reprint,found,nostop,dummyl
X`09logical*1 have_read(1000),busy,arklug,read_deleted
X`09real*8 long_ago,his_login,day_1,day_14,day_31,rdummy,right_now
X`09integer*4 la(2),hl(2)
X
Xc`09System routines used
X`09integer str$upcase,str$trim,str$position
X`09integer sys$gettim,sys$setprn,sys$asctim,sys$bintim
X`09integer lib$getsyi,lib$getjpi,lib$set_symbol,lib$wait
X`09integer lib$spawn,lib$delete_file
X`09integer lbr$output_help,lib$sys_trnlog
X
X`09equivalence(long_ago,la), (his_login,hl)
X`09equivalence(stack,rbuffer),(have_read,xbuffer)
X`09external uopen,getsize,bbs_put_output,bbs_get_input
X
X`09record /userlog_structure/ zur
X
X`09record /mail_header_structure/ mh
X
Xc
X
X 1001`09format(a)
X 1002`09format(i2.2)
X 1003`09format(q,a)
X 1004`09format('$!',a3,'=',a18,i3,1x,a)
X 1005`09format(a,i4,' users listed.')
X 1006`09format(a,'Last logon on ',a,' at ',a,
X`091    'You have signed on',i6,' times.',a,
X`092    'The last message you read was',a9,a,
X`093    '      Current last message is',a9,a,
X`094    '          You are user number',a9,a,
X`095    'You have uploaded',i5,' files and downloaded',i5,' files.',
X`096    a,'There are',i4,' bulletins today.  Last bulletin was ',a)
X
X 1007`09format(1x,a,z8,' Hex')
X 1008`09format(a,a28,1x,a9,1x,a8,i6,4x,a)
X 1009`09format(a,'You have',i3,' marked messages waiting.',a)
X 1010`09format(a,'There are',i4,' bulletins today.  Last bulletin was ',a)
X 1011`09format(i<dummy>)
X 1012`09format(i3.3)
X 1013`09format(a,i2,'>')
X 1015`09format(a,i2,1x,a)
X 1018`09format(a,'Sysop mode is ',l1,a,'Last header=',i6,
X`091   a,'Last data=  ',i6)
X 1019`09format(a1,'file_',i6.6,'.dat')
X 1020`09format(a,i1,' - ',a)
X 1021`09format(a,8i2)
X 1022`09format(a,'S#',i1,' #',i7,' From:'a18,' To:',a18,' Sub:',a18)
X 1023`09format(a,'You have flagged',i4,' messages.  They may be read',
X`091  a,'with the (F)lagged option of the (R)etrieve command')
X 1024   format(i5.5)
X 1025`09format(a,1x,i6.6)
X 1026`09format(i6)
X 1027`09format(i<i>)
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xc
Xc`09logon message and user log update
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X`09open(unit=6,recl=1024,status='unknown',carriagecontrol='none')
X`09area = 'logon'
X`09sysop = .false.
X`09tnext=1
X`09allowable_units=3600`09`09`09!How many seconds per day
X`09crlf=char(10)//char(13)
X`09ffeed=char(10)//char(13)
X`09cl=2
X`09fl=2
X`09line='FALSE'
X
X`09istat=lib$sys_trnlog('ARKLUG',,line,,,0)
X
X`09if(line(1:4).eq.'TRUE') then
X`09    arklug=.true.
X`09else
X`09    arklug=.false.
X`09endif
X
X`09istat=sys$bintim('18-NOV-1858 00:00:00',day_1)
X`09istat=sys$bintim('01-DEC-1858 00:00:00',day_14)
X`09istat=sys$bintim('18-DEC-1858 00:00:00',day_31)
X`09call fake_vaxnet`09`09!set up the symbols, etc.
X`09interactive=.true.`09`09!clear the control-s and disallow
X`09call setup_local(interactive)`09!interruptions
X`09call date(logon_date)
X`09call time(logon_time)
Xc`09Get the message section names
X`09open(unit=file_unit,file='ubbs_data:message.sections',readonly,
X`091   shared,iostat=ios,status='old')
X`09do i=1,8
X`09    read(unit=file_unit,fmt=1001,iostat=ios)secnam(i)
X`09    end do
X`09close(unit=file_unit)
X
X`09istat = lib$getsyi(syi$_nodename,,nodename,,,)
X`09pid=0
Xc`09istat = lib$getjpi(jpi$_pid,pid,,realpid,,)
Xc`09istat = lib$getjpi(jpi$_terminal,realpid,,,terminal,)
Xc`09istat = str$trim(terminal,terminal,length)
Xc`09term = nodename(1:1)//terminal(1:2)//terminal(length-1:length)
X
X`09istat=lib$sys_trnlog('UBBS_FLAGS',i,line,,,0)
X`09if(istat.eq.ss$_normal) then
X`09    read(line(1:i),1027)ubbs_flags
X`09else
X`09    ubbs_flags = 0
X`09end if
X
X
Xc`09open the userlog and message files
X`09open(unit=1,file='ubbs_data:userlog.dat',status='old',`09
X`091   organization='indexed',access='keyed',err=90500,
X`092   recordtype='fixed',recl=50,shared,useropen=uopen,
X`093   iostat=ios)
X`09open(unit=2,file='ubbs_data:message.hed',status='old',`09
X`091   organization='relative',access='direct',err=90600,
X`092   recordtype='fixed',recl=48,shared,useropen=uopen,
X`093   iostat=ios)
X`09open(unit=3,file='ubbs_data:message.dat',status='old',`09
X`091   organization='relative',access='direct',err=90700,
X`092   recordtype='fixed',recl=20,shared,useropen=uopen,
X`093   iostat=ios)
X
Xc
X`09read(1,key=zeros,iostat=ios,err=90500)ur.user_key,
X`091   user_number,high_bull,bull_date
X`09user_number=user_number+1
X`09rewrite(1,err=90500)zeros,user_number,high_bull,bull_date
X
X`09read(2,rec=1,iostat=ios,err=90600)last_header,last_data,
X`091   first_mnum,last_mnum
X`09unlock(unit=2)
Xc
Xc
Xc
X`09call out('     Welcome to UBBS - The UALR Bulletin Board System',*95)
X`09call out('               Rev. 7.4  --  24-Jul-1989'//crlf(:cl),*95)
X`09call type_file('ubbs_data:welcome.txt')
X
X 0095`09yesno='N'
X`09do while(yesno(1:1).eq.'N')
X 0100`09    write(6,1001)crlf(:cl)//'Please enter your first name..'
X`09    fnlen=20
X`09    call get_upcase_string(first_name,fnlen)
X`09    if(fnlen.eq.0) go to 100`09!force an answer
X 0110`09    write(6,1001)crlf(:cl)//'          and your last name..'
X`09    lnlen=20
X`09    call get_upcase_string(last_name,lnlen)
X`09    if(lnlen.eq.0) go to 110`09!force an answer
X`09    mail_name=first_name(1:fnlen)//' '//last_name(1:lnlen)
X`09    prcname=last_name(1:lnlen)//','//first_name(1:fnlen)
X`09    write(6,1001)crlf(:cl)//crlf(:cl)//' Your name is '//mail_name
X`09    write(6,1001)crlf(:cl)//'is this correct? `5BYes`5D'
X`09    dummy=3
X`09    call get_upcase_string(yesno,dummy)
X`09    end do
X`09istat = lib$set_symbol('cb_handle',mail_name)
X
X`09sysop2=.false.
X`09i=1
X`09istat=lib$sys_trnlog('UBBS_SYSOP_'//CHAR(I+48),,line,,,0)
X`09do while(line(1:4).ne.'UBBS')
X`09    if(mail_name.eq.line) then
X`09        sysop2 = .true.
X`09`09end if
X`09    i = i + 1
X`09    istat=lib$sys_trnlog('UBBS_SYSOP_'//CHAR(I+48),,line,,,0)
X`09    end do
X
Xc
Xc`09Check for existence of user and update user file.
Xc
X`09ur.user_key=last_name//first_name
X
X`09read(1,key=ur.user_key,iostat=ios)ur
X`09if(ios.ne.0) go to 150`09`09`09`09!Record does not exist
X
Xc`09get his password
X`09try=1`09`09`09`09!set up for his first chance
X 0130`09write(6,1001)crlf(:cl)//'Please enter your password..'
X`09call get_password(inp_password,pwlen)
X`09if(ur.password.eq.inp_password) go to 140
X`09if(try.gt.2) go to 90000
X`09try=try+1
X`09write(6,1001)crlf(:cl)//'Not right, try again'
X`09go to 130
X
X 0140`09continue
Xc`09now, set up to re-write
X`09ur.num_logon=ur.num_logon+1
X`09if(ur.current_day.ne.logon_date) then
X`09    ur.current_day = logon_date
X`09    ur.seconds_today = 0
X`09    end if
X`09zur=ur
X`09zur.last_log_date=logon_date
X`09zur.last_log_time=logon_time
X`09rewrite(1,iostat=ios,err=90500)zur
X`09go to 190
X
X 0150`09continue`09!come here if no record in userlog
X`09write(6,1001)crlf(:cl)//crlf(:cl)
X`09write(6,1001)crlf(:cl)//
X`091   'There is no information for you in the user log'
X`09write(6,1001)crlf(:cl)//
X`091   'Please enter some information about yourself.'
X`09write(6,1001)crlf(:cl)//
X`091   '(<cr> returns you to the "First name" prompt).'
X
X 0151`09continue
X`09if(.not.arklug) go to 153
X`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   ' What is you DECUS number?'
X`09dummy=6
X`09dummyl=.false.
X`09call get_number(string,dummy,dummyl)
X`09if (dummy.eq.0) go to 95
X`09if (dummy.lt.6)go to 151
X`09read(string,1026)ur.decus_number
X`09if(ur.decus_number.eq.0) go to 151
X
X 0152`09continue
X`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   ' What is your company name?'
X`09dummy=20
X`09call get_uplow_string(ur.company_name,dummy)
X`09if (dummy.eq.0) go to 95
X`09if(ur.city.eq.' ') go to 152
X
X 0153`09continue
X`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   ' The city you are calling from is?'
X`09ctlen=20
X`09call get_uplow_string(ur.city,ctlen)
X`09if (ctlen.eq.0) go to 95
X`09if(ctlen.eq.0.or.ur.city.eq.' ') go to 153
X
X 0154`09continue
X`09write(6,1001)crlf(:cl)//'The state you are calling from is?'
X`09dummy=2
X`09call get_upcase_string(ur.state,dummy)
X`09if (dummy.eq.0) go to 95
X`09if(dummy.lt.2.or.ur.state.eq.' ') go to 154
X
X 0155`09continue
X`09write(6,1001)crlf(:cl)//'What type of computer do you use?'
X`09dummy=20
X`09call get_uplow_string(ur.computer,dummy)
X`09if (dummy.eq.0) go to 95
X`09if(ur.computer.eq.' ') go to 155
X
X`09write(6,1001)crlf(:cl)
X`09if(arklug) then
X`09    write(6,1025)crlf(:cl)//'Your DECUS number is ',ur.decus_number
X`09    write(6,1001)crlf(:cl)//'Your company name is '//ur.company_name
X`09    end if
X`09write(6,1001)crlf(:cl)//'You are calling from '//
X`091   ur.city(1:ctlen)//','//ur.state
X`09write(6,1001)crlf(:cl)//'And you use a '//ur.computer
X`09write(6,1001)crlf(:cl)//'Is this correct? `5BYes`5D'
X`09dummy=3
X`09call get_upcase_string(yesno,dummy)
X`09if(yesno(1:1).eq.'N') go to 151
X
X 0156`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   'To allow you to send messages, you must supply your'
X`09write(6,1001)crlf(:cl)//
X`091   'phone number.  This will not appear to anyone other than'
X`09write(6,1001)crlf(:cl)//
X`091   'the system operator.'
X`09write(6,1001)crlf(:cl)//crlf(:cl)//'Number (with area code):'
X`09dummy=10
X`09dummyl=.false.
X`09call get_number(ur.phone_number,dummy,dummyl)
X`09if(dummy.lt.10) then
X`09    write(6,1001)crlf(:cl)//bell//
X`091`09'That is not a valid phone number.'
X`09    go to 156
X`09    end if
X
X 0157`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   'Passwords are required on this system.'
X`09write(6,1001)crlf(:cl)//'Please enter a 4 to 10 character password'
X`09write(6,1001)crlf(:cl)//'to be used to help prevent unauthorized'
X`09write(6,1001)crlf(:cl)//'usage.  No control characters are allowed,'
X`09write(6,1001)crlf(:cl)//'and case is unimportant..'
X`09call get_password(ur.password,dummy)
X`09if(dummy.lt.4) go to 157
X`09write(6,1001)crlf(:cl)//'Enter it again please....'
X`09call get_password(inp_password,dummy)
X`09if(inp_password.ne.ur.password) then
X`09    write(6,1001)crlf(:cl)//crlf(:cl)//bell//
X`091`09'Those did not match, please try again.'
X`09    go to 157
X`09    end if
X`09ur.num_logon=1
X`09ur.last_log_date=logon_date
X`09ur.last_log_time=logon_time
X`09ur.last_message=0
X`09ur.num_unread=0
X`09ur.auth_sections=255
X`09ur.approved=.false.
X`09ur.user_crlf=char(13)//char(10)//char(255)
X`09ur.user_ff=char(13)//char(10)//char(255)
X`09istat=sys$gettim(ur.last_pass_chg)
X`09ur.current_day = logon_date
X`09ur.seconds_today = 0
X`09ur.up_files=0
X`09ur.down_files=0
X`09zur=ur
X`09write(1,iostat=ios,err=90500)zur
X`09call out(crlf(:cl)//'You are now entered into the user log.',*190)
X`09if(ubbs_flags.ne.31) then
X`09    call out('The following UBBS functions are not available to',*190)
X`09    call out('you as a new user.  Please read the bulletins for',*190)
X`09    call out('further information.',*190)
X`09    if(ur.approved .or. ((ubbs_flags.and.01).ne.01))
X`091`09call out('Reading messages',*190)
X`09    if(ur.approved .or. ((ubbs_flags.and.02).ne.02))
X`091`09call out('Sending messages',*190)
X`09    if(ur.approved .or. ((ubbs_flags.and.04).ne.04))
X`091`09call out('CB simulator',*190)
X`09    if(ur.approved .or. ((ubbs_flags.and.08).ne.08))
X`091`09call out('File downloading',*190)
X`09    if(ur.approved .or. ((ubbs_flags.and.16).ne.16))
X`091`09call out('File uploading',*190)
X`09    end if
X
Xc`09Check his logon time so far today, and set up user-specific items
X 0190`09istat=sys$setprn(prcname)
X`09initial_units = ur.seconds_today
X`09current_units = ur.seconds_today
X`09if(ur.seconds_today.gt.allowable_units) go to 91000
X`09call init_timer(user_timer)
X`09crlf=ur.user_crlf
X`09ffeed=ur.user_ff
X`09cl=index(crlf,char(255))-1
X`09fl=index(ffeed,char(255))-1
X`09if(cl.le.0) cl=4
X`09if(fl.le.0) fl=4
X
X`09approved_mail_read = (ur.approved .or. ((ubbs_flags.and.01).eq.01))
X`09approved_mail_send = (ur.approved .or. ((ubbs_flags.and.02).eq.02))
X`09approved_cb        = (ur.approved .or. ((ubbs_flags.and.04).eq.04))
X`09approved_file_down = (ur.approved .or. ((ubbs_flags.and.08).eq.08))
X`09approved_file_up   = (ur.approved .or. ((ubbs_flags.and.16).eq.16))
X
Xc`09print information message
X`09call comint(ur.last_message,lms)
X`09call comint(last_mnum,clms)
X`09call comint(user_number,uns)
X`09write(6,1006)crlf(:cl)//crlf(:cl),ur.last_log_date,
X`091   ur.last_log_time//crlf(:cl),ur.num_logon,crlf(:cl),
X`092   lms,crlf(:cl),clms,crlf(:cl),
X`093   uns,crlf(:cl)//crlf(:cl),ur.up_files,ur.down_files,
X`094   crlf(:cl)//crlf(:cl),high_bull,bull_date
X`09zur=ur
X`09istat=sys$gettim(right_now)
X`09call subquad(right_now,day_31,rdummy)
X`09istat=compquad(rdummy,ur.last_pass_chg)
X`09if(istat.eq.1) then
X`09    write(6,1001)crlf(:cl)//bell//bell//
X`091`09'*********************************************************'
X`09    write(6,1001)crlf(:cl)//
X`091`09'*                                                       *'
X`09    write(6,1001)crlf(:cl)//
X`091`09'* It has been more than 1 month since you changed your  *'
X`09    write(6,1001)crlf(:cl)//
X`091`09'* password.  For your own security, you need to change  *'
X`09    write(6,1001)crlf(:cl)//
X`091`09'* your password.  (use the (M) option of the main menu) *'
X`09    write(6,1001)crlf(:cl)//
X`091`09'*                                                       *'
X`09    write(6,1001)crlf(:cl)//bell//bell//
X`091`09'*********************************************************'
X`09    end if
X
X`09if(ur.num_unread.eq.1) then
X`09    write(6,1001)crlf(:cl)//bell//bell//
X`091`09'You have a marked message waiting.'
X`09else if(ur.num_unread.gt.1) then
X`09    write(6,1009)crlf(:cl),ur.num_unread,bell//bell
X`09end if
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xc
Xc`09the main menu is at 200
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X 0200`09continue
X`09call time(ctime)
X`09call add_elapsed_time(*91000)
X`09write(cminutes,1002)current_units/60
X`09area='menu'
X`09if((.not.ur.xpert).or.reprint) then
X`09    reprint=.false.
X`09    call out(ffeed(:fl)//
X`091`09     '            UBBS Main Menu',*201)
X`09    call out(crlf(:cl)//
X`091`09     '(B)ulletins         (P)rivate message to operator',*201)
X`09    call out('(C).B. simulator    (R)etrieve messages',*201)
X`09    call out('(E)nter message     (S)can messages',*201)
X`09    call out('(F)ile transfer     (U)ser log',*201)
X`09    call out('(G)oodbye           (W)elcome reprint',*201)
X`09    call out('(H)elp              (X)pert user toggle',*201)
X`09    call out('(M)odify user info',*201)
X 0201`09    continue
X`09    write(6,1001)crlf(:cl)//crlf(:cl)//ctime//'-'//
X`091`09cminutes//' Command ? '
X`09else
X`09    write(6,1001)crlf(:cl)//ctime//'-'//cminutes//
X`091`09' Command (B,C,E,F,G,H,M,P,R,S,U,W,X,?)?'
X`09end if
X`09length=80
X`09call get_uplow_string(string,length)
X`09istat=str$upcase(cdummy,string)
X`09if(cdummy.eq.'B') go to 2000`09`09!Bulletins
X`09if(cdummy.eq.'C') go to 15000`09`09!CB simulator
X`09if(cdummy.eq.'E') go to 3000`09`09!Enter message
X`09if(cdummy.eq.'F') go to 4000`09`09!File transfer
X`09if(cdummy.eq.'G') go to 5000`09`09!Goodbye
X`09if(cdummy.eq.'H') go to 6000`09`09!Help
X`09if(cdummy.eq.'M') go to 8000`09`09!Modify user info
X`09if(cdummy.eq.'P') go to 9000`09`09!Private message
X`09if(cdummy.eq.'Q'.and.sysop2) then
X`09    sysop = .not.sysop
X`09    write(6,1018)crlf(:cl),sysop,crlf(:cl),
X`091`09last_header,crlf(:cl),last_data
X`09    go to 0200
X`09    end if
X`09if(cdummy.eq.'R') go to 10000`09`09!Retrieve message
X`09if(cdummy.eq.'S') go to 11000`09`09!Scan message
X`09if(cdummy.eq.'U') go to 12000`09`09!User log
X`09if(cdummy.eq.'W') go to 13000`09`09!Welcome reprint
X`09if(cdummy.eq.'X') go to 14000`09`09!Xpert user mode
X`09if(cdummy.eq.'?') then`09`09`09!reprint menu
X`09    reprint=.true.
X`09    go to 0200
X`09end if
X
X`09write(6,1001)crlf(:cl)//'That was not a valid command.  '//
X`091   'Try again, please'
X`09go to 0200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X 2000`09continue`09`09!Bulletins
X`09area='bulletin'
X`09write(6,1010)ffeed(:fl),high_bull,bull_date
X`09call type_file('ubbs_data:bulletin.mnu')
X 2010`09write(6,1001)crlf(:cl)//crlf(:cl)//'Bulletin number? `5Bquit`5D '
X`09dummy=7
X`09dummyl=.false.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) go to 200`09!end of bulletins
X`09read(string,1011)number`09`09!get number into an integer
X`09if(number.lt.1) go to 2050
X`09if(number.gt.high_bull) go to 2050
X`09write(three,1012)number`09`09!put it into the string
X`09write(6,1001)ffeed(:fl)
X`09call type_file('ubbs_data:bulletin.'//three)
X`09write(6,1001)crlf(:cl)//crlf(:cl)//'Press <cr> to continue'
X`09dummy=1
X`09call get_uplow_string(cdummy,dummy)
X`09go to 2000
X
X 2050`09write(6,1001)crlf(:cl)//'That bulletin does not exist.  '//
X`091   'Please try again.'
X`09go to 2010
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X 3000`09continue`09`09!Enter message
X`09area='enter message'
X`09if (.not.approved_mail_send) then
X`09    write(6,1001)crlf(:cl)//bell//
X`091`09'You are not yet approved to send messages.'
X`09    write(6,1001)crlf(:cl)//'Sorry.'
X`09    go to 0200
X`09    end if
X`09write(6,1001)crlf(:cl)//crlf(:cl)//'Message is to: '
X`09namln=30
X`09mh.mail_person=.true.
X`09call get_uplow_string(zmail_to,namln)
X`09if(namln.eq.0) then
X`09    write(6,1001)crlf(:cl)//'Message send aborted'//bell
X`09    go to 200
X`09    end if
X`09istat=str$upcase(qmail_to,zmail_to)
X`09spc=index(qmail_to,' ')
X`09zfirst_name=qmail_to(1:spc-1)`09
X`09do ii=spc+1,30
X`09    if(zmail_to(ii:ii).ne.' ') go to 3010
X`09    end do
Xc`09No last name found.  This must be a public message
X`09mh.mail_person=.false.
X`09go to 3030`09!no need to check further
X
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-