home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / vmsnet / sources / 303 < prev    next >
Encoding:
Internet Message Format  |  1992-08-21  |  47.5 KB

  1. Path: sparky!uunet!paladin.american.edu!darwin.sura.net!mips!swrinde!network.ucsd.edu!mvb.saic.com!vmsnet-sources
  2. From: munroe@dmc.com (Dick Munroe)
  3. Newsgroups: vmsnet.sources
  4. Subject: UBBS, part 01/12
  5. Message-ID: <7868437@MVB.SAIC.COM>
  6. Date: 21 Aug 92 20:18:44 GMT
  7. Organization: Doyle, Munroe Consultants, Inc., Hudson, MA
  8. Lines: 1250
  9. Approved: Mark.Berryman@Mvb.Saic.Com
  10.  
  11. Submitted-by: munroe@dmc.com (Dick Munroe)
  12. Posting-number: Volume 3, Issue 109
  13. Archive-name: ubbs/part01
  14.  
  15.          [ UBBS - The UALR Bulletin Board System ]
  16.  
  17. $! ------------------ CUT HERE -----------------------
  18. $ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
  19. $!
  20. $! This archive created by VMS_SHARE Version 7.2-010  25-Jun-1992
  21. $!   On 21-AUG-1992 13:04:03.97   By user BERRYMAN 
  22. $!
  23. $! This VMS_SHARE Written by:
  24. $!    Andy Harper, Kings College London UK
  25. $!
  26. $! Acknowledgements to:
  27. $!    James Gray       - Original VMS_SHARE
  28. $!    Michael Bednarek - Original Concept and implementation
  29. $!
  30. $!+ THIS PACKAGE DISTRIBUTED IN 12 PARTS, TO KEEP EACH PART
  31. $!  BELOW 100 BLOCKS
  32. $!
  33. $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
  34. $! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
  35. $!
  36. $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
  37. $!       1. AAAREADME.TXT;4
  38. $!       2. ABBREV.STD;3
  39. $!       3. ARKLUG.COM;4
  40. $!       4. BBS.COM;12
  41. $!       5. BBS.FOR;165
  42. $!       6. BBSCB.FOR;20
  43. $!       7. BBSDOWN.COM;3
  44. $!       8. BBS_INC.FOR;28
  45. $!       9. BUILD.COM;13
  46. $!      10. CHECK_MODEMS.FOR;11
  47. $!      11. COMINT.MAR;4
  48. $!      12. DISTLOGIN.COM;5
  49. $!      13. HEADER.FOR;1
  50. $!      14. KERMIT_INC.FOR;2
  51. $!      15. LOGIN.COM;23
  52. $!      16. QUADMATH.MAR;2
  53. $!      17. SYSOP.FOR;168
  54. $!      18. UBBS_SUBS.FOR;170
  55. $!      19. [.DATA]BADPASS.TXT;1
  56. $!      20. [.DATA]BULLETIN.001;1
  57. $!      21. [.DATA]BULLETIN.002;6
  58. $!      22. [.DATA]BULLETIN.003;1
  59. $!      23. [.DATA]BULLETIN.004;1
  60. $!      24. [.DATA]BULLETIN.005;1
  61. $!      25. [.DATA]BULLETIN.006;1
  62. $!      26. [.DATA]BULLETIN.007;1
  63. $!      27. [.DATA]BULLETIN.008;1
  64. $!      28. [.DATA]BULLETIN.009;1
  65. $!      29. [.DATA]BULLETIN.010;1
  66. $!      30. [.DATA]BULLETIN.MNU;1
  67. $!      31. [.DATA]HELPLIB.HLP;1
  68. $!      32. [.DATA]MESSAGE.SECTIONS;1
  69. $!      33. [.DATA]SIGNOFF.TXT;1
  70. $!      34. [.DATA]WELCOME.TXT;1
  71. $!      35. [.DATA]WORDWRAP.EDT;1
  72. $!      36. [.MAIL_PROTOCOL]BBS_INC.FOR;28
  73. $!      37. [.MAIL_PROTOCOL]BUILD.COM;2
  74. $!      38. [.MAIL_PROTOCOL]INSTALL.COM;2
  75. $!      39. [.MAIL_PROTOCOL]L.COM;9
  76. $!      40. [.MAIL_PROTOCOL]MAILSHR.MAR;3
  77. $!      41. [.MAIL_PROTOCOL]MAILSHR.OPT;2
  78. $!      42. [.MAIL_PROTOCOL]PROT_INC.FOR;7
  79. $!      43. [.MAIL_PROTOCOL]UBBS_MAILSHR.FOR;6
  80. $!      44. [.MAIL_PROTOCOL]UBBS_MAIL_ERR.MSG;7
  81. $!      45. [.UPGRADE]CONVERT_FILES.FOR;2
  82. $!      46. [.UPGRADE]CRLF.FOR;1
  83. $!      47. [.UPGRADE]CVTV6.FOR;1
  84. $!      48. [.UPGRADE]FIXMESS.FOR;1
  85. $!      49. [.UPGRADE]REFORMAT_UPLOADS.FOR;2
  86. $!      50. [.UTILITY]ADD_FILES.FOR;2
  87. $!      51. [.UTILITY]ASSIGN.COM;2
  88. $!      52. [.UTILITY]COMPILE.COM;11
  89. $!      53. [.UTILITY]DAILY_RESTORE.COM;2
  90. $!      54. [.UTILITY]INIT_IDX.FOR;2
  91. $!      55. [.UTILITY]INIT_MESS.FOR;2
  92. $!      56. [.UTILITY]INIT_USERLOG.FOR;2
  93. $!      57. [.UTILITY]INSTBBS.COM;2
  94. $!      58. [.UTILITY]L.COM;2
  95. $!      59. [.UTILITY]LT.COM;2
  96. $!      60. [.UTILITY]MAIL.DELIVERY;3
  97. $!      61. [.UTILITY]MESSAGE.FOR;1
  98. $!      62. [.UTILITY]SYSOP.HOWTO;2
  99. $!      63. [.UTILITY]VMSARC.FOR;2
  100. $!
  101. $set="set"
  102. $set symbol/scope=(nolocal,noglobal)
  103. $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
  104. $e="write sys$error  ""%UNPACK"", "
  105. $w="write sys$output ""%UNPACK"", "
  106. $ if f$trnlnm("SHARE_LOG") then $ w = "!"
  107. $ ve=f$getsyi("version")
  108. $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
  109. $ e "-E-OLDVER, Must run at least VMS 4.4"
  110. $ v=f$verify(v)
  111. $ exit 44
  112. $UNPACK: SUBROUTINE ! P1=filename, P2=checksum
  113. $ x = P1 - f$parse(P1,,,"version")
  114. $ y = f$search(x)
  115. $ if y .eqs. "" then $ goto file_absent
  116. $ x = f$integer(f$parse(P1,,,"version")-";")
  117. $ y = f$integer(f$parse(y,,,"version")-";")
  118. $ if x .gt. y then $ goto file_absent
  119. $ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive
  120. $ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped."
  121. $ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped."
  122. $file_delete:
  123. $ delete 'f'*
  124. $ exit
  125. $file_interactive:
  126. $ if x .eq. y then e "-W-EXISTS, File ''P1' exists."
  127. $ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists."
  128. $ read/error=file_delete/end=file_delete-
  129.   /prompt="Create new version [y/n]: " -
  130.   sys$command x
  131. $ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped."
  132. $ if .not. x then $ goto file_delete
  133. $ P1 = P1 - f$parse(P1,,,"version")
  134. $file_absent:
  135. $ if f$parse(P1) .nes. "" then $ goto dirok
  136. $ dn=f$parse(P1,,,"DIRECTORY")
  137. $ w "-I-CREDIR, Creating directory ''dn'."
  138. $ create/dir 'dn'
  139. $ if $status then $ goto dirok
  140. $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
  141. $ delete 'f'*
  142. $ exit
  143. $dirok:
  144. $ w "-I-PROCESS, Processing file ''P1'."
  145. $ if .not. f$verify() then $ define/user sys$output nl:
  146. $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
  147. PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
  148. SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
  149. CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
  150. LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
  151. BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
  152. IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
  153. MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
  154. ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
  155. 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
  156. POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
  157. ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
  158. COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
  159. "output_file"));ENDPROCEDURE;Unpacker;QUIT;
  160. $ delete/nolog 'f'*
  161. $ CHECKSUM 'P1'
  162. $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
  163. $ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
  164. $ ENDSUBROUTINE
  165. $START:
  166. $ create 'f'
  167. X               UBBS - The UALR Bulletin Board System             06-Nov-1988
  168. X
  169. X           Dale Miller - University of Arkansas at Little Rock
  170. X
  171. X                    DOMILLER@UALR.BITNET
  172. X
  173. X    This directory contains all of the files necessary to implement UBBS, a
  174. Xfull-featured public computerized bulletin board system.  UBBS has message
  175. Xfiles, uploads, downloads, private messages, help files, bulletins,
  176. Xconferencing, and most importantly, multiple concurrent access.
  177. X    UBBS is written in FORTRAN and all source code is included.  The files
  178. Xsupplied to run UBBS are:
  179. X
  180. XAAAREADME.TXT        - This file
  181. XABBREV.STD           - Miscellaneous message tidbits
  182. XARKLUG.COM           - Login file for second bulletin board
  183. XBBS.COM              - A command file to execute UBBS
  184. XBBS.FOR              - The main source program for UBBS
  185. XBBSCB.FOR            - UBBS-specific version of CB.  Requires CB manager.
  186. XBBSDOWN.COM          - Set the logical to disallow UBBS logins
  187. XBBS_INC.FOR          - An include file for the source
  188. XBUILD.COM            - ** Command file to build UBBS **
  189. XCHECK_MODEMS.FOR     - Routine to limit UBBS usage to certain ports
  190. XCOMINT.MAR           - Macro routine to do a COBOL-type numeric-edited move.
  191. XDISTLOGIN.COM        - Another sample LOGIN.COM (somewhat more generic)
  192. XKERMIT_INC.FOR       - Include file for Kermit modules
  193. XLOGIN.COM            - Sample LOGIN.COM for captive account
  194. XQUADMATH.MAR         - Macro subroutines used in UBBS.
  195. XSYSOP.FOR            - Performs system operator duties
  196. XUBBS_SUBS.FOR        - Subroutines for UBBS
  197. X
  198. X
  199. X    Data files included with UBBS are in the directory `5B.data`5D, and incl
  200. Vude:
  201. X
  202. XBADPASS.TXT          - Message to display for failed password
  203. XBULLETIN.nnn         - Sample bulletins
  204. XBULLETIN.MNU         - Bulletin menu
  205. XHELPLIB.HLP          - Help library
  206. XMESSAGE.SECTIONS     - List of message sections
  207. XSIGNOFF.TXT          - Message to display at logoff
  208. XWELCOME.TXT          - Sample welcome file
  209. XWORDWRAP.EDT         - EDT init file to turn on word wrap.
  210. X
  211. X    Files to upgrade earlier versions of UBBS to the current format are
  212. Xalso included.  These are:
  213. X
  214. XCONVERT_FILES.FOR    - Convert the FILES.DAT to FILES.IDX.
  215. XCRLF.FOR             - Add end of line and clear screen sequences to userlog
  216. V.
  217. XCVTV6.FOR            - Convert files to version 6.
  218. XFIXMESS.FOR          - Add expiration dates to messages.
  219. XREFORMAT_UPLOADS.FOR - Changes format of uploads for UBBS Rev. 4.7 or later.
  220. X
  221. XIf you are currently running UBBS, check these to see if you need to run the
  222. Vm.
  223. X
  224. X    There is also a directory of UBBS-related utilities which contains:
  225. X
  226. XADD_FILES.FOR        - Rather esoteric utility to modify large number of fil
  227. Ve
  228. X                       descriptions.
  229. XASSIGN.COM           - Make assignments necessary to run UBBS
  230. XCOMPILE.COM          - Procedure to compile all modules of UBBS
  231. XINIT_IDX.FOR         - Sets up the file sections.
  232. XINIT_MESS.FOR        - Program to initialize message data base
  233. XINIT_USERLOG.FOR     - Program to initialize the userlog
  234. XDAILY_RESTORE.COM    - Command procedure to restore requested files.
  235. XINSTBBS.COM          - Procedure to install UBBS with necessary privs.
  236. XL.COM                - Procedure to link UBBS and SYSOP
  237. XLT.COM               - Procedure to link UBBS and SYSOP with /TRACE
  238. XSYSOP.HOWTO          - Documentation for file SYSOPs
  239. XVMSARC.FOR           - A VMS program to de-ARC files from PCs.
  240. X
  241. X
  242. X    BUILD.COM will create all files necessary to create and run UBBS.
  243. XThere are, however several things a budding SYSOP must know.
  244. X   `20
  245. X    UBBS is set up to require user verification.  This verification is
  246. Xapplicable to all functions not authorized by the logical name UBBS_FLAGS.
  247. XThis logical is bit mapped with the following values:
  248. X
  249. X        approved_mail_read = 01   - Allow users to read mail
  250. X        approved_mail_send = 02   - Allow users to send mail
  251. X        approved_cb        = 04   - Allow use of CB simulator
  252. X        approved_file_down = 08   - Allow file downlaoding
  253. X        approved_file_up   = 16   - Allow file uploading
  254. X
  255. X   For instance, the defination "$ define ubbs_flags 25"
  256. Xwould allow unapproved users all fucntions except leaving messages and using
  257. Xthe CB simulator.  A verified user may execute all functions.
  258. XVerification is taken care of via the UPUSER function of SYSOP
  259. X(described below).  Users are requested to use the (P)rivate message to
  260. Xoperator function to request access.  This function
  261. Xsends VAXmail to the user defined by the logical UBBS_SYSOP_MAIL
  262. Xe.g. "$ DEFINE UBBS_SYSOP_MAIL DOMILLER"
  263. X
  264. XAll UBBS file accesses are referenced by means of 2 logical names:
  265. X    UBBS_DATA  - Location of all data files needed to run UBBS
  266. X    UBBS_FILES - Location of upload and download file sections
  267. X
  268. X    All utilities necessary for day to day operation are included in
  269. XSYSOP.FOR.  They are accessed by answering the "Choice" question with a 1 or
  270. X2 character key for the following programs:
  271. X
  272. X        A  - Aging
  273. X        AF - Archive files
  274. X        C  - Compress message file
  275. X        CA - Compress m.f. eliminating ALL read messages
  276. X        CF - Check files
  277. X        CI - Check indices
  278. X        F  - Fixcounts
  279. X        UB - Update bulletin number & date
  280. X        UF - Update files
  281. X        UL - User list
  282. X        US - Update sysops on file sections
  283. X        UU - Update userlog
  284. X
  285. XThe individual programs are described below.
  286. X
  287. XAGING         -`09This is a program to allow you to delete users that have
  288. X`09`09not logged on for a specified period of time.  You will
  289. X`09`09be prompted for a date.  This is in standard VMS format.
  290. X`09`09You will then be asked whether to delete approved and/or
  291. X`09`09un-approved users before this date.  If a "NO" response
  292. X`09`09is entered, the users will be listed, but not deleted.
  293. X
  294. XARCHIVE_FILES - Delete and set the ARCHIVED bit on files which have not been
  295. X                downloaded since a user-supplied date.
  296. X
  297. XCHECK_FILES   - This program runs through all files in the download areas
  298. X                and makes sure they appear in the index.  If they are not
  299. X                in the index, they are deleted.
  300. X
  301. XCHECK_INDEX   - Reverse of CHECK_FILES.  Allows files to be deleted or
  302. X                added to the index.
  303. X
  304. XCOMPRESS_MESS - This is a program that compresses the message data base.
  305. X                as messages are logically deleted, they are merely marked
  306. X                for deletion.  This program actually recovers the space.
  307. X                statistics are given on space gained.  It is a good idea to
  308. X`09`09have this set up in a batch job to run semi-occasionally.
  309. X`09`09I have found 03:00 each morning to be a good time.
  310. X
  311. XCOMPRESS_ALL  - This is similar to COMPRESS but eliminates ALL read messages
  312. X                whether private or public.
  313. X
  314. XFIXCOUNTS     - This program is written to fix the count of unread messages
  315. X`09`09announced at logon.  This can under certain conditions become
  316. X`09`09corrupted (like VMS mail) and so this program will fix the
  317. X`09`09counts like they should be.
  318. X
  319. X
  320. XUSER LIST     - This will give a formatted list of the user names, addresses
  321. V,
  322. X                authorization level, and phone number.
  323. X
  324. XUPDATE BULL.  - This will update the last bulletin counter.  You are prompte
  325. Vd
  326. X                for the last bulletin you have entered and the last date.
  327. X
  328. XUPDATE FILES  - This is a program to interactively update the FILES.IDX file
  329. Vs
  330. X                for downloading.  Instructions follow.
  331. X
  332. XUPDATE SYSOPS - Allows naming of up to 3 persons per section as "file sysops
  333. V"
  334. X                who then have all privileges for that file section.
  335. X
  336. XUPDATE USERL. - This program updates the user log.  You may delete or modify
  337. X                user info.
  338. X
  339. X
  340. X
  341. XThe following programs are included for setting up a new installation of
  342. XUBBS.
  343. X
  344. XINIT_MESS     - This program initializes the message file.  It should only
  345. X                be run if you want to clear the message file and start over.
  346. X
  347. XINIT_USERLOG  - This program initialized the user log.  It should only be
  348. X                used to remove all users from the user log.
  349. X
  350. XINIT_IDX      - This program creates an empty index of downloads available.
  351. X****************************************************************************
  352. V***
  353. X
  354. X                   Details of UBBS
  355. X
  356. X    The messages are stored in two files.  MESSAGE.HED is a file of message
  357. Xheaders, 1 per message + 1.  INIT_MESS.FOR is set up for 1000 headers`20
  358. X(999 messages).  This will expand as needed.  The MESSAGE.DAT file is the
  359. Xactual message content.  There is 1 record per message line.  INIT_MESS will
  360. Xset this file up for 5000 records.  This file will also expand as needed.
  361. XIf the message files get full, space will be added.  Whenever an
  362. Xerror is detected on the message files, a message is sent via VAXmail to the
  363. Xusername defined by the logical UBBS_MAIL_SYSOP.
  364. XThe COMPRESS_MESS program will delete all messages that are logically
  365. Xdeleted, expired messages, and private mail which has already been read. Thi
  366. Vs
  367. Xwill have to be run periodically depending on your usage.  At UALR, we have
  368. Xit set up to run each night.
  369. X
  370. X    The user log is an indexed file USERLOG.DAT containing a header record a
  371. Vnd
  372. X1 record for each user.  User names are upper case only for ease of comparis
  373. Von.
  374. XThe ULIST program will give a brief listing of the userlog information.  The
  375. XUPUSER will give a list of user information and allow you to change it.  To
  376. Xuse this program, answer UU to SYSOP.  You will be asked whether to check ci
  377. Vty
  378. Xnames, or process all users.  Using the "City" response will allow you to fi
  379. Vnd
  380. Xall users whose home city is not in CITIES.DAT (initially empty).  Selecting
  381. Xall users is exactly that.  you will then be asked for a key to start.
  382. XPressing return at this point allows starting at the beginning.  For each us
  383. Ver
  384. Xname, UPUSER will pause
  385. Xand allow you to enter a 1 or 2 character code.  These are:
  386. X      A - Approves the user. (see U)
  387. X      B - Starts over at the beginning of the userlog
  388. X      C - Allows you to change the City field
  389. X      CN- Allows you to change the Company name field
  390. X      CO- Allows you to change the type of computer
  391. X      D - Deletes the record
  392. X      DN- Allows you to change the DECUS number field
  393. X      E - Exits the program
  394. X      P - Allows you to change the password
  395. X      PN- Allows you to change the phone number field
  396. X      S - Allows you to change the state field
  397. X      U - Unapproves the user (see A)
  398. X      W - Writes the modified record
  399. X      Z - Zeros the time-used-today field.
  400. X          anything else proceeds to the next record.
  401. X
  402. X    The bulletin system is rather simplistic.  You just create a file, using
  403. Xyour favorite editor, called BULLETIN.MNU.  A sample file is included.  This
  404. Xis the file displayed when The bulletin option is selected.  Individual
  405. Xbulletins are numbered, beginning with 1 and named BULLETIN.nnn where nnn is
  406. Xthe 3-digit bulletin number.  BULLETIN.001 is supplied as a sample.  When
  407. Xadding a new bulletin, the UPBULL program will change the displays for highe
  408. Vst
  409. Xbulletin number and latest bulletin date.  It's not fancy, but it works.
  410. X
  411. X    There is one main menu option which does not appear on the menu.  The Q
  412. Xoption sets a special flag.  If an authorized user enters Q, it will allow t
  413. Vhem
  414. Xto read and/or delete all messages.  This includes private and logically
  415. Xdeleted messages.  This feature could be considered an invasion of privacy.
  416. XTo allow a person to use this feature, the person's name must be defined by
  417. Xa logical name UBBS_SYSOP_n where n is 1 to 9.  The logicals must begin with
  418. X1 and be in sequence.  e.g. $ define ubbs_sysop_1 "DALE MILLER"
  419. X                            $ define ubbs_sysop_2 "MICHAEL SMITH"
  420. X
  421. X    Uploaded files do not appear in the download directory automatically,
  422. Xwhen a file is uploaded, its name is placed into FILES.IDX.  The SYSOP
  423. Xroutine "update files" allows you to make this known to the world.  This
  424. Xprogram runs through the message sections allowing you to delete approve or
  425. Xmodify an entry.  Instructions are included in the program.  This program ma
  426. Vy
  427. Xalso be invoked inside UBBS by trusted users.  To do so, enter the download`
  428. V20
  429. Xarea of your choice and enter "abc.xyz" as the file name.  This is only
  430. Xavailable to persons with sysop privilege and those you have specifically
  431. Xapproved using "update sysop".
  432. X
  433. X    File up/downloading is controlled by the presence of the files
  434. X"ALLOW.UP" and "ALLOW.DOWN" in the file section directories.  These files ha
  435. Vve
  436. Xno content.  The files UBBS_FILES:DOWNLOAD.AREAS and UBBS_FILES:UPLOAD.AREAS
  437. Xare text files printed whenever the user requests a list of up/download area
  438. Vs.
  439. XNote that these two control areas allow you to create upload only areas,
  440. Xdownload only areas, or areas which do not appear in the listings but are
  441. Xaccessible to those "in the know".
  442. X
  443. X    The "update sysop" selection allows you to designate up to 3 people as
  444. Xfile sysops for each download section.  When this selection is invoked, you
  445. Xare given each of the 3 names for each file section.  If you wish to chenge
  446. V it,
  447. Xjust enter the new name.  The names appearing here must match EXACTLY the
  448. Xuser's mail name on UBBS.
  449. X
  450. X    The CB selection requires the CB/Vax simulator also distributed by UALR.
  451. XThe CB selection will not work unless UBBS is installed privileged, and the
  452. XCB system is operational at your site.
  453. X
  454. X    If you wish to set up UBBS as a public bulletin board, define an account
  455. Xin SYSUAF.DAT similar to the following:
  456. X
  457. X     Username: BBS                              Owner:  BULLETIN BOARD SYSTE
  458. VM
  459. X     Account:  BULLETIN                         UIC:    `5B177,1`5D (`5BBULL
  460. VETIN,BBS`5D)
  461. X     CLI:      DCL                              Tables:`20
  462. X     Default:  DISK$USER:`5BBBS`5D
  463. X     LGICMD:   DISK$USER:`5BBBS`5DLOGIN.COM
  464. X     Login Flags:  Disctly Lockpwd Captive Diswelcome Disnewmail Dismail Dis
  465. Vreport`0D
  466. X                   Disreconnect
  467. X     Primary days:   Mon Tue Wed Thu Fri       `20
  468. X     Secondary days:                     Sat Sun
  469. X     No access restrictions
  470. X     Expiration:            (none)    Pwdminimum:  5   Login Fails:     0
  471. X     Pwdlifetime:           (none)    Pwdchange:             (none)`20
  472. X     Last Login: 23-NOV-1985 22:33 (interactive),            (none) (non-int
  473. Veractive)
  474. X     Maxjobs:         0  Fillm:        20  Bytlm:         8192
  475. X     Maxacctjobs:     0  Shrfillm:      0  Pbytlm:           0
  476. X     Maxdetach:       0  BIOlm:        18  JTquota:       1024
  477. X     Prclm:           1  DIOlm:        18  WSdef:          150
  478. X     Prio:            4  ASTlm:        24  WSquo:          200
  479. X     Queprio:         0  TQElm:        10  WSextent:       500
  480. X     CPU:        (none)  Enqlm:        30  Pgflquo:      10000
  481. X     Authorized Privileges:`20
  482. X       TMPMBX NETMBX
  483. X     Default Privileges:`20
  484. X       TMPMBX NETMBX
  485. X
  486. X    This account should have no password.  To allow a specific line to
  487. Xautomatically connect to the BBS, use the SYS$MANAGER:SYSALF.COM to specify
  488. Xautomatic connection to the username you have defined.  If you wish to limit
  489. Xthe ability for other access, the LOGIN.COM file has the code in it to restr
  490. Vict
  491. XUBBS to certain dial-in lines.  It is currently not being used on my board,
  492. Xbut was left in in order to customize it for your site.
  493. X
  494. X    To the best of my knowledge, there is no limit (other than your VAX) as
  495. Xto how many concurrent users you may have.  All file updating is handled
  496. Xvia standard FORTRAN i/o and RMS record locking.
  497. X
  498. X    While this documentation does not cover all aspects of UBBS, it should
  499. Xallow you to set the board up and get your feet wet.  A good working knowled
  500. Vge
  501. Xof FORTRAN is recommended to fully utilize UBBS.
  502. X
  503. X    I/O routines used in UBBS have been lifted from the VAXNET submission,
  504. Xand are used by permission.
  505. X
  506. X    The current implementation of UBBS is actually used to run 2 different
  507. Xbulletin boards at UALR.  This just requires changing the pointers to
  508. XBBS$ and BBS$FILES.  In our case, there are also some programming changes.
  509. XTo handle that without separate copies of the program, the user logical`20
  510. X"ARKLUG" is set to "TRUE" to invoke the changes.
  511. X
  512. X    I realize that UBBS will have to be customized for each individual site
  513. Xthat runs it.  I would appreciate hearing from anyone who implements it as a
  514. Xpublic system.  I would also like to get copies of any enhancements, fixes,
  515. Xor improvements anyone makes to UBBS.  If you have any questions, comments,
  516. Xpraises, or curses, feel free to send them on.  New versions of UBBS are
  517. Xavailable from UALR at very infrequent intervals.
  518. X
  519. X              Dale Miller
  520. X              Computing Center - NS204
  521. X              University of Arkansas at Little Rock
  522. X              2801 S. University
  523. X              Little Rock, AR   72204-1099
  524. X
  525. X              DOMILLER@UALR.BITNET
  526. X
  527. X              (501) 569-8714 (voice - 8:00-17:00 Central)
  528. X              (501) 568-9464 (UBBS)
  529. X
  530. XUBBS is copyrighted  (c) 1986 by Dale O. Miller, and is released for`20
  531. Xprivate and commercial use.  It may not be sold, either alone or as part`20
  532. Xof a package.  The author excludes any and all implied warranties including
  533. Xwarranties of fitness for a particular purpose and will not be liable for
  534. Xincidental or consequential damages as a result of using this product.
  535. X
  536. X****** Warning ***** UBBS may be addictive both to you and your users.
  537. $ CALL UNPACK AAAREADME.TXT;4 1967712251
  538. $ create 'f'
  539. XIn the July issue of the "Q-link Update", I came accross the following listi
  540. Vng
  541. Xof abbreviations and 'faces' used on that network. I'm sure many of you are
  542. Xfamiliar with some of them.  I was just thinking how nice it would be if the
  543. Vy
  544. Xcould become standardized on UBBS and the cb.  They are, to wit:
  545. X
  546. X:)     smile            :>     mischievious smile
  547. X`5B`5D     hug              :P     sticking out tongue
  548. X;)     wink             :X     not saying a word
  549. X:'(    crying           LOL    laughing out loud
  550. X:*     kiss             OTF    on the floor, laughing!
  551. X:c     pout             afk    away from keys
  552. X:(     frown            BRB    be right back
  553. X:D     big smile        bak    back
  554. $ CALL UNPACK ABBREV.STD;3 1882022662
  555. $ create 'f'
  556. X$ set term/nodisc
  557. X$ on error then goto send_mail
  558. X$ tries=0
  559. X$ restart:
  560. X$ tries=tries+1
  561. X$ if tries .ge. 5 then goto itsdown
  562. X$ on error then goto send_mail
  563. X$ on warning then goto send_mail
  564. X$ status=f$logical("ubbs_status")
  565. X$ if status.nes."DOWN" then goto itsup
  566. X$ itsdown:
  567. X$ write sys$output "UBBS-ARKLUG is temporarily out of service."
  568. X$ write sys$output "Please try again later."
  569. X$ logoutnow
  570. X$ itsup:
  571. X$ kermit `09:== $sys$system:kermit
  572. X$ who `09`09:== $sys$common:`5Bsysmgr.ualr.users`5Ddispuser
  573. X$ home `09`09:== set def dua10:`5Bdecus`5D
  574. X$ dn `09`09:== @sys$system:dn
  575. X$ up `09`09:== @sys$system:up
  576. X$ x*modem`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dxmodem
  577. X$ toxmod`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dtoxmod
  578. X$ fromxmod`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dfromxmod
  579. X$ xsend`09`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dxmodem st
  580. X$ xrec`09`09:== $sys$common:`5Bsysmgr.ualr.xmodem`5Dxmodem rct
  581. X$ define/user ubbs_data disk$user:`5Barklug_bbs`5D
  582. X$ define/user ubbs_files dua10:`5Barklug_files.`5D
  583. X$ define/user arklug "TRUE"
  584. X$ define/user ubbs_sysop_1 "DALE MILLER"
  585. X$ define/user ubbs_sysop_2 "MICHAEL SMITH"
  586. X$ define/user ubbs_flags 25
  587. X$ define/user ubbs_sysop_mail "MLSMITH"
  588. X$! approved_mail_read = 01
  589. X$! approved_mail_send = 02
  590. X$! approved_cb        = 04
  591. X$! approved_file_down = 08
  592. X$! approved_file_up   = 16
  593. X$ define/user ubbs_flags 1
  594. X$ run sys$system:ubbs
  595. X$ goto finish
  596. X$ !
  597. X$ ! we had an error
  598. X$ !
  599. X$ send_mail:
  600. X$ write sys$output "A fatal error has occurred.  UBBS is restarting."
  601. X$ goto restart
  602. X$ !
  603. X$ ! normal way out
  604. X$ !
  605. X$ finish:
  606. X$ logoutnow
  607. $ CALL UNPACK ARKLUG.COM;4 543643885
  608. $ create 'f'
  609. X$ restart:
  610. X$ define ubbs_data disk$user:`5Bualr_bbs.data`5D
  611. X$ define ubbs_files dua10:`5Bbbs_files.`5D
  612. X$ define ubbs_sysop_1 "DALE MILLER"
  613. X$ define ubbs_sysop_2 "MICHAEL SMITH"
  614. X$ define ubbs_sysop_mail "DOMILLER"
  615. X$! approved_mail_read = 01
  616. X$! approved_mail_send = 02
  617. X$! approved_cb        = 04
  618. X$! approved_file_down = 08
  619. X$! approved_file_up   = 16
  620. X$ define ubbs_flags 25
  621. X$! set proc/prior=2
  622. X$ on error then goto send_mail
  623. X$ on warning then goto send_mail
  624. X$ set message/nofacility/noident/noseverity/notext
  625. X$ assign sys$command sys$input
  626. X$ termin == f$getsyi("nodename") + "_" + f$getjpi("","terminal")
  627. X$ termin == f$extract(0,(f$locate(":",termin)),termin)
  628. X$ assign failure.'termin' sys$error
  629. X$ assign sys$error sys$output
  630. X$ sho symbol termin
  631. X$ deassign sys$output
  632. X$ assign sys$error for007
  633. X$ set message/facility/ident/severity/text
  634. X$ run bbs
  635. X$ goto finish
  636. X$ !
  637. X$ ! we had an error
  638. X$ !
  639. X$ send_mail:
  640. X$ deassign for007
  641. X$ deassign sys$error
  642. X$ mail/subject="bbs aborted" failure.'termin' domiller
  643. X$ set message/nofacility/noident/noseverity/notext
  644. X$ delete failure.'termin';*
  645. X$ write sys$output "A fatal error has occurred.  UBBS is restarting."
  646. X$ goto restart
  647. X$ !
  648. X$ ! normal way out
  649. X$ !
  650. X$ finish:
  651. X$ deassign for007
  652. X$ deassign sys$error
  653. X$ set message/nofacility/noident/noseverity/notext
  654. X$ delete failure.'termin';*
  655. X$ set message/fac/ident/sever/text
  656. X$ set proc/prio=4
  657. X$! logoutnow
  658. $ CALL UNPACK BBS.COM;12 1128403077
  659. $ create 'f'
  660. X`09program bbs_main
  661. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  662. Vcccc
  663. Xc
  664. Xc`09This is the driver for a VAX CBBS system
  665. Xc
  666. Xc`09Begun: 19-Jul-1985
  667. Xc`09Dale Miller - University of Arkansas at Little Rock
  668. Xc`09Rev. 1.0  29-Jul-1985
  669. Xc`09Rev. 1.1  01-Aug-1985
  670. Xc`09Rev. 1.2  05-Aug-1985
  671. Xc`09Rev. 1.3  06-Aug-1985
  672. Xc`09Rev. 1.4  08-Aug-1985
  673. Xc`09Rev. 1.5  14-Aug-1985
  674. Xc`09Rev. 1.6  18-Aug-1985
  675. Xc`09Rev. 1.7  24-Aug-1985
  676. Xc`09Rev. 1.8  27-Aug-1985
  677. Xc`09Rev. 1.9  08-Sep-1985
  678. Xc`09Rev. 1.10 13-Sep-1985
  679. Xc`09Rev. 1.11 14-Sep-1985
  680. Xc       Rev. 1.12 17-Sep-1985
  681. Xc`09Rev. 1.13 28-Sep-1985
  682. Xc`09Rev. 1.14 29-Sep-1985
  683. Xc`09Rev. 1.15 15-Oct-1985
  684. Xc`09Rev. 2.0  14-Nov-1985
  685. Xc`09Rev. 2.1  07-Jan-1986
  686. Xc`09Rev. 2.2  18-Jan-1986
  687. Xc`09Rev. 2.3  03-Feb-1986
  688. Xc`09Rev. 3.0  18-Feb-1986
  689. Xc`09Rev. 3.1  24-Feb-1986
  690. Xc`09Rev. 3.2  02-Mar-1986
  691. Xc`09Rev. 3.3  04-Mar-1986
  692. Xc`09Rev. 3.4  19-Apr-1986
  693. Xc`09Rev. 3.5  19-Jun-1986
  694. Xc`09Rev. 3.6  25-Jun-1986
  695. Xc`09Rev. 4.0  27-Jun-1986
  696. Xc`09Rev. 4.1  07-Jul-1986
  697. Xc`09Rev. 4.2  23-Jul-1986
  698. Xc`09Rev. 4.3  26-Jul-1986
  699. Xc`09Rev. 4.4  15-Aug-1986
  700. Xc`09Rev. 4.5  24-Sep-1986
  701. Xc       Rev. 4.6  09-Nov-1986
  702. Xc`09Rev. 4.7  29-Nov-1986
  703. Xc`09Rev. 4.8  03-Feb-1987
  704. Xc`09Rev. 4.9  10-Feb-1987
  705. Xc`09Rev. 4.10 11-Feb-1987
  706. Xc`09Rev. 4.11 27-Feb-1987
  707. Xc`09Rev. 4.12 11-Jun-1987
  708. Xc`09Rev. 4.13 04-Jul-1987
  709. Xc`09Rev. 5.0  12-Sep-1987
  710. Xc`09Rev. 5.1  28-Sep-1987
  711. Xc`09Rev. 5.2  17-Oct-1987
  712. Xc`09Rev. 5.3  02-Dec-1987
  713. Xc`09Rev. 5.4  21-Dec-1987
  714. Xc`09Rev. 5.5  19-Jan-1988
  715. Xc`09Rev. 5.6  07-Mar-1988
  716. Xc`09Rev. 6.0  06-Jun-1988
  717. Xc`09Rev. 6.1  08-Jun-1988
  718. Xc`09Rev. 6.2  21-Jul-1988
  719. Xc`09Rev. 7.0  23-Aug-1988
  720. Xc`09Rev. 7.1  24-Sep-1988
  721. Xc`09Rev. 7.2  02-Jan-1989
  722. Xc`09Rev. 7.3  20-Jan-1989
  723. Xc`09Rev. 7.4  24-Jul-1989
  724. Xc
  725. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  726. Vcccc
  727. X`09implicit none
  728. X`09include 'bbs_inc.for/nolist'
  729. X`09include 'sys$library:foriosdef/nolist'
  730. X`09include '($syidef)'
  731. X`09include '($jpidef)'
  732. X`09include '($rmsdef)'
  733. X`09character logon_date*9,logon_time*8,inp_password*10
  734. X`09character cdate*9,ctime*8,lms*9,clms*9,uns*9
  735. X`09character yesno*3,three*3,bull_date*11
  736. X`09character space*30/'                    '/
  737. X`09character zeros*40/'0000000000000000000000000000000000000000'/
  738. X`09character dummy_20*20,dummy_40*40,line*200
  739. X`09character error*60/' '/
  740. X`09character pm*14/' ** private **'/
  741. X`09character last_name*20,first_name*20
  742. X`09character zmail_from*30,xxx*4
  743. X`09character nodename*6,terminal*6
  744. X`09character prcname*15,cminutes*2
  745. X`09character zfirst_name*20,zlast_name*20,zmail_to*30,qmail_to*30
  746. X`09character string*80,cdummy*1,darea*3,zmail_subject*30
  747. X`09byte dummyb
  748. X`09integer istat,pid,realpid,high_bull,ubbs_flags
  749. X`09integer try,length,fnlen,lnlen,ctlen,pwlen,namln,flen
  750. X`09integer spc,sect,i,j,k,l,ii,jj,kk,ll
  751. X`09integer dummy,dummy1,dummy2,dummy3,dummy4
  752. X`09integer kmess,irec,krec,slen,num_flags
  753. X`09integer status,next_mess,fmess,lmess,mess,mnum
  754. X`09integer stack_ptr,field,count,number
  755. X`09integer idummy(8),flags(100),stack(200)
  756. X`09integer compquad,netmail
  757. X`09logical*1 interactive,reprint,found,nostop,dummyl
  758. X`09logical*1 have_read(1000),busy,arklug,read_deleted
  759. X`09real*8 long_ago,his_login,day_1,day_14,day_31,rdummy,right_now
  760. X`09integer*4 la(2),hl(2)
  761. X
  762. Xc`09System routines used
  763. X`09integer str$upcase,str$trim,str$position
  764. X`09integer sys$gettim,sys$setprn,sys$asctim,sys$bintim
  765. X`09integer lib$getsyi,lib$getjpi,lib$set_symbol,lib$wait
  766. X`09integer lib$spawn,lib$delete_file
  767. X`09integer lbr$output_help,lib$sys_trnlog
  768. X
  769. X`09equivalence(long_ago,la), (his_login,hl)
  770. X`09equivalence(stack,rbuffer),(have_read,xbuffer)
  771. X`09external uopen,getsize,bbs_put_output,bbs_get_input
  772. X
  773. X`09record /userlog_structure/ zur
  774. X
  775. X`09record /mail_header_structure/ mh
  776. X
  777. Xc
  778. X
  779. X 1001`09format(a)
  780. X 1002`09format(i2.2)
  781. X 1003`09format(q,a)
  782. X 1004`09format('$!',a3,'=',a18,i3,1x,a)
  783. X 1005`09format(a,i4,' users listed.')
  784. X 1006`09format(a,'Last logon on ',a,' at ',a,
  785. X`091    'You have signed on',i6,' times.',a,
  786. X`092    'The last message you read was',a9,a,
  787. X`093    '      Current last message is',a9,a,
  788. X`094    '          You are user number',a9,a,
  789. X`095    'You have uploaded',i5,' files and downloaded',i5,' files.',
  790. X`096    a,'There are',i4,' bulletins today.  Last bulletin was ',a)
  791. X
  792. X 1007`09format(1x,a,z8,' Hex')
  793. X 1008`09format(a,a28,1x,a9,1x,a8,i6,4x,a)
  794. X 1009`09format(a,'You have',i3,' marked messages waiting.',a)
  795. X 1010`09format(a,'There are',i4,' bulletins today.  Last bulletin was ',a)
  796. X 1011`09format(i<dummy>)
  797. X 1012`09format(i3.3)
  798. X 1013`09format(a,i2,'>')
  799. X 1015`09format(a,i2,1x,a)
  800. X 1018`09format(a,'Sysop mode is ',l1,a,'Last header=',i6,
  801. X`091   a,'Last data=  ',i6)
  802. X 1019`09format(a1,'file_',i6.6,'.dat')
  803. X 1020`09format(a,i1,' - ',a)
  804. X 1021`09format(a,8i2)
  805. X 1022`09format(a,'S#',i1,' #',i7,' From:'a18,' To:',a18,' Sub:',a18)
  806. X 1023`09format(a,'You have flagged',i4,' messages.  They may be read',
  807. X`091  a,'with the (F)lagged option of the (R)etrieve command')
  808. X 1024   format(i5.5)
  809. X 1025`09format(a,1x,i6.6)
  810. X 1026`09format(i6)
  811. X 1027`09format(i<i>)
  812. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  813. Vcccc
  814. Xc
  815. Xc`09logon message and user log update
  816. Xc
  817. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  818. Vcccc
  819. X`09open(unit=6,recl=1024,status='unknown',carriagecontrol='none')
  820. X`09area = 'logon'
  821. X`09sysop = .false.
  822. X`09tnext=1
  823. X`09allowable_units=3600`09`09`09!How many seconds per day
  824. X`09crlf=char(10)//char(13)
  825. X`09ffeed=char(10)//char(13)
  826. X`09cl=2
  827. X`09fl=2
  828. X`09line='FALSE'
  829. X
  830. X`09istat=lib$sys_trnlog('ARKLUG',,line,,,0)
  831. X
  832. X`09if(line(1:4).eq.'TRUE') then
  833. X`09    arklug=.true.
  834. X`09else
  835. X`09    arklug=.false.
  836. X`09endif
  837. X
  838. X`09istat=sys$bintim('18-NOV-1858 00:00:00',day_1)
  839. X`09istat=sys$bintim('01-DEC-1858 00:00:00',day_14)
  840. X`09istat=sys$bintim('18-DEC-1858 00:00:00',day_31)
  841. X`09call fake_vaxnet`09`09!set up the symbols, etc.
  842. X`09interactive=.true.`09`09!clear the control-s and disallow
  843. X`09call setup_local(interactive)`09!interruptions
  844. X`09call date(logon_date)
  845. X`09call time(logon_time)
  846. Xc`09Get the message section names
  847. X`09open(unit=file_unit,file='ubbs_data:message.sections',readonly,
  848. X`091   shared,iostat=ios,status='old')
  849. X`09do i=1,8
  850. X`09    read(unit=file_unit,fmt=1001,iostat=ios)secnam(i)
  851. X`09    end do
  852. X`09close(unit=file_unit)
  853. X
  854. X`09istat = lib$getsyi(syi$_nodename,,nodename,,,)
  855. X`09pid=0
  856. Xc`09istat = lib$getjpi(jpi$_pid,pid,,realpid,,)
  857. Xc`09istat = lib$getjpi(jpi$_terminal,realpid,,,terminal,)
  858. Xc`09istat = str$trim(terminal,terminal,length)
  859. Xc`09term = nodename(1:1)//terminal(1:2)//terminal(length-1:length)
  860. X
  861. X`09istat=lib$sys_trnlog('UBBS_FLAGS',i,line,,,0)
  862. X`09if(istat.eq.ss$_normal) then
  863. X`09    read(line(1:i),1027)ubbs_flags
  864. X`09else
  865. X`09    ubbs_flags = 0
  866. X`09end if
  867. X
  868. X
  869. Xc`09open the userlog and message files
  870. X`09open(unit=1,file='ubbs_data:userlog.dat',status='old',`09
  871. X`091   organization='indexed',access='keyed',err=90500,
  872. X`092   recordtype='fixed',recl=50,shared,useropen=uopen,
  873. X`093   iostat=ios)
  874. X`09open(unit=2,file='ubbs_data:message.hed',status='old',`09
  875. X`091   organization='relative',access='direct',err=90600,
  876. X`092   recordtype='fixed',recl=48,shared,useropen=uopen,
  877. X`093   iostat=ios)
  878. X`09open(unit=3,file='ubbs_data:message.dat',status='old',`09
  879. X`091   organization='relative',access='direct',err=90700,
  880. X`092   recordtype='fixed',recl=20,shared,useropen=uopen,
  881. X`093   iostat=ios)
  882. X
  883. Xc
  884. X`09read(1,key=zeros,iostat=ios,err=90500)ur.user_key,
  885. X`091   user_number,high_bull,bull_date
  886. X`09user_number=user_number+1
  887. X`09rewrite(1,err=90500)zeros,user_number,high_bull,bull_date
  888. X
  889. X`09read(2,rec=1,iostat=ios,err=90600)last_header,last_data,
  890. X`091   first_mnum,last_mnum
  891. X`09unlock(unit=2)
  892. Xc
  893. Xc
  894. Xc
  895. X`09call out('     Welcome to UBBS - The UALR Bulletin Board System',*95)
  896. X`09call out('               Rev. 7.4  --  24-Jul-1989'//crlf(:cl),*95)
  897. X`09call type_file('ubbs_data:welcome.txt')
  898. X
  899. X 0095`09yesno='N'
  900. X`09do while(yesno(1:1).eq.'N')
  901. X 0100`09    write(6,1001)crlf(:cl)//'Please enter your first name..'
  902. X`09    fnlen=20
  903. X`09    call get_upcase_string(first_name,fnlen)
  904. X`09    if(fnlen.eq.0) go to 100`09!force an answer
  905. X 0110`09    write(6,1001)crlf(:cl)//'          and your last name..'
  906. X`09    lnlen=20
  907. X`09    call get_upcase_string(last_name,lnlen)
  908. X`09    if(lnlen.eq.0) go to 110`09!force an answer
  909. X`09    mail_name=first_name(1:fnlen)//' '//last_name(1:lnlen)
  910. X`09    prcname=last_name(1:lnlen)//','//first_name(1:fnlen)
  911. X`09    write(6,1001)crlf(:cl)//crlf(:cl)//' Your name is '//mail_name
  912. X`09    write(6,1001)crlf(:cl)//'is this correct? `5BYes`5D'
  913. X`09    dummy=3
  914. X`09    call get_upcase_string(yesno,dummy)
  915. X`09    end do
  916. X`09istat = lib$set_symbol('cb_handle',mail_name)
  917. X
  918. X`09sysop2=.false.
  919. X`09i=1
  920. X`09istat=lib$sys_trnlog('UBBS_SYSOP_'//CHAR(I+48),,line,,,0)
  921. X`09do while(line(1:4).ne.'UBBS')
  922. X`09    if(mail_name.eq.line) then
  923. X`09        sysop2 = .true.
  924. X`09`09end if
  925. X`09    i = i + 1
  926. X`09    istat=lib$sys_trnlog('UBBS_SYSOP_'//CHAR(I+48),,line,,,0)
  927. X`09    end do
  928. X
  929. Xc
  930. Xc`09Check for existence of user and update user file.
  931. Xc
  932. X`09ur.user_key=last_name//first_name
  933. X
  934. X`09read(1,key=ur.user_key,iostat=ios)ur
  935. X`09if(ios.ne.0) go to 150`09`09`09`09!Record does not exist
  936. X
  937. Xc`09get his password
  938. X`09try=1`09`09`09`09!set up for his first chance
  939. X 0130`09write(6,1001)crlf(:cl)//'Please enter your password..'
  940. X`09call get_password(inp_password,pwlen)
  941. X`09if(ur.password.eq.inp_password) go to 140
  942. X`09if(try.gt.2) go to 90000
  943. X`09try=try+1
  944. X`09write(6,1001)crlf(:cl)//'Not right, try again'
  945. X`09go to 130
  946. X
  947. X 0140`09continue
  948. Xc`09now, set up to re-write
  949. X`09ur.num_logon=ur.num_logon+1
  950. X`09if(ur.current_day.ne.logon_date) then
  951. X`09    ur.current_day = logon_date
  952. X`09    ur.seconds_today = 0
  953. X`09    end if
  954. X`09zur=ur
  955. X`09zur.last_log_date=logon_date
  956. X`09zur.last_log_time=logon_time
  957. X`09rewrite(1,iostat=ios,err=90500)zur
  958. X`09go to 190
  959. X
  960. X 0150`09continue`09!come here if no record in userlog
  961. X`09write(6,1001)crlf(:cl)//crlf(:cl)
  962. X`09write(6,1001)crlf(:cl)//
  963. X`091   'There is no information for you in the user log'
  964. X`09write(6,1001)crlf(:cl)//
  965. X`091   'Please enter some information about yourself.'
  966. X`09write(6,1001)crlf(:cl)//
  967. X`091   '(<cr> returns you to the "First name" prompt).'
  968. X
  969. X 0151`09continue
  970. X`09if(.not.arklug) go to 153
  971. X`09write(6,1001)crlf(:cl)//crlf(:cl)//
  972. X`091   ' What is you DECUS number?'
  973. X`09dummy=6
  974. X`09dummyl=.false.
  975. X`09call get_number(string,dummy,dummyl)
  976. X`09if (dummy.eq.0) go to 95
  977. X`09if (dummy.lt.6)go to 151
  978. X`09read(string,1026)ur.decus_number
  979. X`09if(ur.decus_number.eq.0) go to 151
  980. X
  981. X 0152`09continue
  982. X`09write(6,1001)crlf(:cl)//crlf(:cl)//
  983. X`091   ' What is your company name?'
  984. X`09dummy=20
  985. X`09call get_uplow_string(ur.company_name,dummy)
  986. X`09if (dummy.eq.0) go to 95
  987. X`09if(ur.city.eq.' ') go to 152
  988. X
  989. X 0153`09continue
  990. X`09write(6,1001)crlf(:cl)//crlf(:cl)//
  991. X`091   ' The city you are calling from is?'
  992. X`09ctlen=20
  993. X`09call get_uplow_string(ur.city,ctlen)
  994. X`09if (ctlen.eq.0) go to 95
  995. X`09if(ctlen.eq.0.or.ur.city.eq.' ') go to 153
  996. X
  997. X 0154`09continue
  998. X`09write(6,1001)crlf(:cl)//'The state you are calling from is?'
  999. X`09dummy=2
  1000. X`09call get_upcase_string(ur.state,dummy)
  1001. X`09if (dummy.eq.0) go to 95
  1002. X`09if(dummy.lt.2.or.ur.state.eq.' ') go to 154
  1003. X
  1004. X 0155`09continue
  1005. X`09write(6,1001)crlf(:cl)//'What type of computer do you use?'
  1006. X`09dummy=20
  1007. X`09call get_uplow_string(ur.computer,dummy)
  1008. X`09if (dummy.eq.0) go to 95
  1009. X`09if(ur.computer.eq.' ') go to 155
  1010. X
  1011. X`09write(6,1001)crlf(:cl)
  1012. X`09if(arklug) then
  1013. X`09    write(6,1025)crlf(:cl)//'Your DECUS number is ',ur.decus_number
  1014. X`09    write(6,1001)crlf(:cl)//'Your company name is '//ur.company_name
  1015. X`09    end if
  1016. X`09write(6,1001)crlf(:cl)//'You are calling from '//
  1017. X`091   ur.city(1:ctlen)//','//ur.state
  1018. X`09write(6,1001)crlf(:cl)//'And you use a '//ur.computer
  1019. X`09write(6,1001)crlf(:cl)//'Is this correct? `5BYes`5D'
  1020. X`09dummy=3
  1021. X`09call get_upcase_string(yesno,dummy)
  1022. X`09if(yesno(1:1).eq.'N') go to 151
  1023. X
  1024. X 0156`09write(6,1001)crlf(:cl)//crlf(:cl)//
  1025. X`091   'To allow you to send messages, you must supply your'
  1026. X`09write(6,1001)crlf(:cl)//
  1027. X`091   'phone number.  This will not appear to anyone other than'
  1028. X`09write(6,1001)crlf(:cl)//
  1029. X`091   'the system operator.'
  1030. X`09write(6,1001)crlf(:cl)//crlf(:cl)//'Number (with area code):'
  1031. X`09dummy=10
  1032. X`09dummyl=.false.
  1033. X`09call get_number(ur.phone_number,dummy,dummyl)
  1034. X`09if(dummy.lt.10) then
  1035. X`09    write(6,1001)crlf(:cl)//bell//
  1036. X`091`09'That is not a valid phone number.'
  1037. X`09    go to 156
  1038. X`09    end if
  1039. X
  1040. X 0157`09write(6,1001)crlf(:cl)//crlf(:cl)//
  1041. X`091   'Passwords are required on this system.'
  1042. X`09write(6,1001)crlf(:cl)//'Please enter a 4 to 10 character password'
  1043. X`09write(6,1001)crlf(:cl)//'to be used to help prevent unauthorized'
  1044. X`09write(6,1001)crlf(:cl)//'usage.  No control characters are allowed,'
  1045. X`09write(6,1001)crlf(:cl)//'and case is unimportant..'
  1046. X`09call get_password(ur.password,dummy)
  1047. X`09if(dummy.lt.4) go to 157
  1048. X`09write(6,1001)crlf(:cl)//'Enter it again please....'
  1049. X`09call get_password(inp_password,dummy)
  1050. X`09if(inp_password.ne.ur.password) then
  1051. X`09    write(6,1001)crlf(:cl)//crlf(:cl)//bell//
  1052. X`091`09'Those did not match, please try again.'
  1053. X`09    go to 157
  1054. X`09    end if
  1055. X`09ur.num_logon=1
  1056. X`09ur.last_log_date=logon_date
  1057. X`09ur.last_log_time=logon_time
  1058. X`09ur.last_message=0
  1059. X`09ur.num_unread=0
  1060. X`09ur.auth_sections=255
  1061. X`09ur.approved=.false.
  1062. X`09ur.user_crlf=char(13)//char(10)//char(255)
  1063. X`09ur.user_ff=char(13)//char(10)//char(255)
  1064. X`09istat=sys$gettim(ur.last_pass_chg)
  1065. X`09ur.current_day = logon_date
  1066. X`09ur.seconds_today = 0
  1067. X`09ur.up_files=0
  1068. X`09ur.down_files=0
  1069. X`09zur=ur
  1070. X`09write(1,iostat=ios,err=90500)zur
  1071. X`09call out(crlf(:cl)//'You are now entered into the user log.',*190)
  1072. X`09if(ubbs_flags.ne.31) then
  1073. X`09    call out('The following UBBS functions are not available to',*190)
  1074. X`09    call out('you as a new user.  Please read the bulletins for',*190)
  1075. X`09    call out('further information.',*190)
  1076. X`09    if(ur.approved .or. ((ubbs_flags.and.01).ne.01))
  1077. X`091`09call out('Reading messages',*190)
  1078. X`09    if(ur.approved .or. ((ubbs_flags.and.02).ne.02))
  1079. X`091`09call out('Sending messages',*190)
  1080. X`09    if(ur.approved .or. ((ubbs_flags.and.04).ne.04))
  1081. X`091`09call out('CB simulator',*190)
  1082. X`09    if(ur.approved .or. ((ubbs_flags.and.08).ne.08))
  1083. X`091`09call out('File downloading',*190)
  1084. X`09    if(ur.approved .or. ((ubbs_flags.and.16).ne.16))
  1085. X`091`09call out('File uploading',*190)
  1086. X`09    end if
  1087. X
  1088. Xc`09Check his logon time so far today, and set up user-specific items
  1089. X 0190`09istat=sys$setprn(prcname)
  1090. X`09initial_units = ur.seconds_today
  1091. X`09current_units = ur.seconds_today
  1092. X`09if(ur.seconds_today.gt.allowable_units) go to 91000
  1093. X`09call init_timer(user_timer)
  1094. X`09crlf=ur.user_crlf
  1095. X`09ffeed=ur.user_ff
  1096. X`09cl=index(crlf,char(255))-1
  1097. X`09fl=index(ffeed,char(255))-1
  1098. X`09if(cl.le.0) cl=4
  1099. X`09if(fl.le.0) fl=4
  1100. X
  1101. X`09approved_mail_read = (ur.approved .or. ((ubbs_flags.and.01).eq.01))
  1102. X`09approved_mail_send = (ur.approved .or. ((ubbs_flags.and.02).eq.02))
  1103. X`09approved_cb        = (ur.approved .or. ((ubbs_flags.and.04).eq.04))
  1104. X`09approved_file_down = (ur.approved .or. ((ubbs_flags.and.08).eq.08))
  1105. X`09approved_file_up   = (ur.approved .or. ((ubbs_flags.and.16).eq.16))
  1106. X
  1107. Xc`09print information message
  1108. X`09call comint(ur.last_message,lms)
  1109. X`09call comint(last_mnum,clms)
  1110. X`09call comint(user_number,uns)
  1111. X`09write(6,1006)crlf(:cl)//crlf(:cl),ur.last_log_date,
  1112. X`091   ur.last_log_time//crlf(:cl),ur.num_logon,crlf(:cl),
  1113. X`092   lms,crlf(:cl),clms,crlf(:cl),
  1114. X`093   uns,crlf(:cl)//crlf(:cl),ur.up_files,ur.down_files,
  1115. X`094   crlf(:cl)//crlf(:cl),high_bull,bull_date
  1116. X`09zur=ur
  1117. X`09istat=sys$gettim(right_now)
  1118. X`09call subquad(right_now,day_31,rdummy)
  1119. X`09istat=compquad(rdummy,ur.last_pass_chg)
  1120. X`09if(istat.eq.1) then
  1121. X`09    write(6,1001)crlf(:cl)//bell//bell//
  1122. X`091`09'*********************************************************'
  1123. X`09    write(6,1001)crlf(:cl)//
  1124. X`091`09'*                                                       *'
  1125. X`09    write(6,1001)crlf(:cl)//
  1126. X`091`09'* It has been more than 1 month since you changed your  *'
  1127. X`09    write(6,1001)crlf(:cl)//
  1128. X`091`09'* password.  For your own security, you need to change  *'
  1129. X`09    write(6,1001)crlf(:cl)//
  1130. X`091`09'* your password.  (use the (M) option of the main menu) *'
  1131. X`09    write(6,1001)crlf(:cl)//
  1132. X`091`09'*                                                       *'
  1133. X`09    write(6,1001)crlf(:cl)//bell//bell//
  1134. X`091`09'*********************************************************'
  1135. X`09    end if
  1136. X
  1137. X`09if(ur.num_unread.eq.1) then
  1138. X`09    write(6,1001)crlf(:cl)//bell//bell//
  1139. X`091`09'You have a marked message waiting.'
  1140. X`09else if(ur.num_unread.gt.1) then
  1141. X`09    write(6,1009)crlf(:cl),ur.num_unread,bell//bell
  1142. X`09end if
  1143. X
  1144. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  1145. Vcccc
  1146. Xc
  1147. Xc`09the main menu is at 200
  1148. Xc
  1149. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  1150. Vcccc
  1151. X 0200`09continue
  1152. X`09call time(ctime)
  1153. X`09call add_elapsed_time(*91000)
  1154. X`09write(cminutes,1002)current_units/60
  1155. X`09area='menu'
  1156. X`09if((.not.ur.xpert).or.reprint) then
  1157. X`09    reprint=.false.
  1158. X`09    call out(ffeed(:fl)//
  1159. X`091`09     '            UBBS Main Menu',*201)
  1160. X`09    call out(crlf(:cl)//
  1161. X`091`09     '(B)ulletins         (P)rivate message to operator',*201)
  1162. X`09    call out('(C).B. simulator    (R)etrieve messages',*201)
  1163. X`09    call out('(E)nter message     (S)can messages',*201)
  1164. X`09    call out('(F)ile transfer     (U)ser log',*201)
  1165. X`09    call out('(G)oodbye           (W)elcome reprint',*201)
  1166. X`09    call out('(H)elp              (X)pert user toggle',*201)
  1167. X`09    call out('(M)odify user info',*201)
  1168. X 0201`09    continue
  1169. X`09    write(6,1001)crlf(:cl)//crlf(:cl)//ctime//'-'//
  1170. X`091`09cminutes//' Command ? '
  1171. X`09else
  1172. X`09    write(6,1001)crlf(:cl)//ctime//'-'//cminutes//
  1173. X`091`09' Command (B,C,E,F,G,H,M,P,R,S,U,W,X,?)?'
  1174. X`09end if
  1175. X`09length=80
  1176. X`09call get_uplow_string(string,length)
  1177. X`09istat=str$upcase(cdummy,string)
  1178. X`09if(cdummy.eq.'B') go to 2000`09`09!Bulletins
  1179. X`09if(cdummy.eq.'C') go to 15000`09`09!CB simulator
  1180. X`09if(cdummy.eq.'E') go to 3000`09`09!Enter message
  1181. X`09if(cdummy.eq.'F') go to 4000`09`09!File transfer
  1182. X`09if(cdummy.eq.'G') go to 5000`09`09!Goodbye
  1183. X`09if(cdummy.eq.'H') go to 6000`09`09!Help
  1184. X`09if(cdummy.eq.'M') go to 8000`09`09!Modify user info
  1185. X`09if(cdummy.eq.'P') go to 9000`09`09!Private message
  1186. X`09if(cdummy.eq.'Q'.and.sysop2) then
  1187. X`09    sysop = .not.sysop
  1188. X`09    write(6,1018)crlf(:cl),sysop,crlf(:cl),
  1189. X`091`09last_header,crlf(:cl),last_data
  1190. X`09    go to 0200
  1191. X`09    end if
  1192. X`09if(cdummy.eq.'R') go to 10000`09`09!Retrieve message
  1193. X`09if(cdummy.eq.'S') go to 11000`09`09!Scan message
  1194. X`09if(cdummy.eq.'U') go to 12000`09`09!User log
  1195. X`09if(cdummy.eq.'W') go to 13000`09`09!Welcome reprint
  1196. X`09if(cdummy.eq.'X') go to 14000`09`09!Xpert user mode
  1197. X`09if(cdummy.eq.'?') then`09`09`09!reprint menu
  1198. X`09    reprint=.true.
  1199. X`09    go to 0200
  1200. X`09end if
  1201. X
  1202. X`09write(6,1001)crlf(:cl)//'That was not a valid command.  '//
  1203. X`091   'Try again, please'
  1204. X`09go to 0200
  1205. X
  1206. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  1207. Vccc
  1208. X 2000`09continue`09`09!Bulletins
  1209. X`09area='bulletin'
  1210. X`09write(6,1010)ffeed(:fl),high_bull,bull_date
  1211. X`09call type_file('ubbs_data:bulletin.mnu')
  1212. X 2010`09write(6,1001)crlf(:cl)//crlf(:cl)//'Bulletin number? `5Bquit`5D '
  1213. X`09dummy=7
  1214. X`09dummyl=.false.
  1215. X`09call get_number(string,dummy,dummyl)
  1216. X`09if(dummy.eq.0) go to 200`09!end of bulletins
  1217. X`09read(string,1011)number`09`09!get number into an integer
  1218. X`09if(number.lt.1) go to 2050
  1219. X`09if(number.gt.high_bull) go to 2050
  1220. X`09write(three,1012)number`09`09!put it into the string
  1221. X`09write(6,1001)ffeed(:fl)
  1222. X`09call type_file('ubbs_data:bulletin.'//three)
  1223. X`09write(6,1001)crlf(:cl)//crlf(:cl)//'Press <cr> to continue'
  1224. X`09dummy=1
  1225. X`09call get_uplow_string(cdummy,dummy)
  1226. X`09go to 2000
  1227. X
  1228. X 2050`09write(6,1001)crlf(:cl)//'That bulletin does not exist.  '//
  1229. X`091   'Please try again.'
  1230. X`09go to 2010
  1231. X
  1232. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  1233. Vccc
  1234. X 3000`09continue`09`09!Enter message
  1235. X`09area='enter message'
  1236. X`09if (.not.approved_mail_send) then
  1237. X`09    write(6,1001)crlf(:cl)//bell//
  1238. X`091`09'You are not yet approved to send messages.'
  1239. X`09    write(6,1001)crlf(:cl)//'Sorry.'
  1240. X`09    go to 0200
  1241. X`09    end if
  1242. X`09write(6,1001)crlf(:cl)//crlf(:cl)//'Message is to: '
  1243. X`09namln=30
  1244. X`09mh.mail_person=.true.
  1245. X`09call get_uplow_string(zmail_to,namln)
  1246. X`09if(namln.eq.0) then
  1247. X`09    write(6,1001)crlf(:cl)//'Message send aborted'//bell
  1248. X`09    go to 200
  1249. X`09    end if
  1250. X`09istat=str$upcase(qmail_to,zmail_to)
  1251. X`09spc=index(qmail_to,' ')
  1252. X`09zfirst_name=qmail_to(1:spc-1)`09
  1253. X`09do ii=spc+1,30
  1254. X`09    if(zmail_to(ii:ii).ne.' ') go to 3010
  1255. X`09    end do
  1256. Xc`09No last name found.  This must be a public message
  1257. X`09mh.mail_person=.false.
  1258. X`09go to 3030`09!no need to check further
  1259. X
  1260. +-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
  1261.