$! ------------------ 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) 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) 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 '( 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 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 +-+-+-+-+-+-+-+-