home *** CD-ROM | disk | FTP | other *** search
- Path: sparky!uunet!paladin.american.edu!darwin.sura.net!mips!swrinde!network.ucsd.edu!mvb.saic.com!vmsnet-sources
- From: munroe@dmc.com (Dick Munroe)
- Newsgroups: vmsnet.sources
- Subject: UBBS, part 01/12
- Message-ID: <7868437@MVB.SAIC.COM>
- Date: 21 Aug 92 20:18:44 GMT
- Organization: Doyle, Munroe Consultants, Inc., Hudson, MA
- Lines: 1250
- Approved: Mark.Berryman@Mvb.Saic.Com
-
- 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 +-+-+-+-+-+-+-+-
-