NetNews Usenet Archive 1992 #18

home *** CD-ROM | disk | FTP | other *** search

/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / vmsnet / sources / 312 < prev next >

Wrap

Internet Message Format | 1992-08-21 | 46.8 KB

Path: sparky!uunet!usc!elroy.jpl.nasa.gov!ames!network.ucsd.edu!mvb.saic.com!vmsnet-sources From: munroe@dmc.com (Dick Munroe) Newsgroups: vmsnet.sources Subject: UBBS, part 10/12 Message-ID: <7868514@MVB.SAIC.COM> Date: Fri, 21 Aug 1992 20:22:38 GMT Organization: Doyle, Munroe Consultants, Inc., Hudson, MA Lines: 1597 Approved: Mark.Berryman@Mvb.Saic.Com Submitted-by: munroe@dmc.com (Dick Munroe) Posting-number: Volume 3, Issue 118 Archive-name: ubbs/part10 -+-+-+-+-+-+-+-+ START OF PART 10 -+-+-+-+-+-+-+-+ X; Modified by Ned Freed, 16-Nov-86, to use proper global symbols. X; X;--------------------------------------------------------------------------- X; This is invoked by MAIL when it encounters the foreign mail protocol. X; This module really has nothing protocol-specific to it and can be used X; to dispatch to any handler. The handler should supply the following X; action routines: X; X;`09status := MAIL_OUT_CONNECT (context : unsigned; X;`09`09`09`09 LNK_C_OUT_CONNECT : immediate; X;`09`09`09`09 protocol, node : string_descriptor; X;`09`09`09`09 MAIL$_LOGLINK : immediate; X;`09`09`09`09 file_RAT, file_RFM : immediate; X;`09`09`09`09 MAIL$GL_FLAGS : immediate; X;`09`09`09`09 attached_file : descriptor := immediate 0) X; X;`09status := MAIL_OUT_LINE (context : unsigned; X;`09`09`09`09 `5BLNK_C_OUT_SENDER `7C LNK_C_OUT_TO `7C X;`09`09`09`09 LNK_C_OUT_SUBJ`5D : immediate; X;`09`09`09`09 node, sender_name : string_descriptor) X; X;`09status := MAIL_OUT_CHECK (context : unsigned; X;`09`09`09`09 `5BLNK_C_OUT_CKUSER `7C X;`09`09`09`09 LNK_C_OUT_CKSEND`5D : immediate; X;`09`09`09`09 node, addressee : string_descriptor; X;`09`09`09`09 procedure MAIL$READ_ERROR_TEXT); X; X;`09status := MAIL_OUT_FILE (context : unsigned; X;`09`09`09`09 LNK_C_OUT_FILE : immediate; X;`09`09`09`09 node : string_descriptor; X;`09`09`09`09 rab : $RAB_TYPE; X;`09`09`09`09 procedure UTIL$REPORT_IO_ERROR); X; X;`09status := MAIL_OUT_DEACCESS (context : unsigned; X;`09`09`09`09 LNK_C_OUT_DEACCESS : immediate); X; X;`09status := MAIL_IN_CONNECT (context : unsigned; X;`09`09`09`09 LNK_C_IN_CONNECT : immediate; X;`09`09`09`09 input_tran : string_descriptor; X;`09`09`09`09 file_RAT, file_RFM : immediate; X;`09`09`09`09 MAIL$GL_FLAGS : immediate; X;`09`09`09`09 MAIL$Q_PROTOCOL : string_descriptor; X;`09`09`09`09 pflags : immediate); X; X;`09status := MAIL_IN_LINE (context : unsigned; X;`09`09`09`09 `5BLNK_C_IN_SENDER `7C LNK_C_IN_CKUSER `7C X;`09`09`09`09 LNK_C_IN_TO `7C LNK_C_IN_SUBJ`5D : immediate; X;`09`09`09`09 returned_line : string_descriptor); X; X;`09status := MAIL_IN_FILE (context : unsigned; X;`09`09`09`09 LNK_C_OUT_FILE : immediate; X;`09`09`09`09 0 : immediate; X;`09`09`09`09 rab : $RAB_TYPE; X;`09`09`09`09 procedure UTIL$REPORT_IO_ERROR); X; X;`09status := MAIL_IO_READ (context : unsigned; X;`09`09`09`09 LNK_C_IO_READ : immediate; X;`09`09`09`09 returned_text_line : string_descriptor); X; X;`09status := MAIL_IO_WRITE (context : unsigned; X;`09`09`09`09 LNK_C_IO_WRITE : immediate; X;`09`09`09`09 text_line : string_descriptor); X; X;--------------------------------------------------------------------------- X; X; Define major and minor protocol identifiers. MAIL requires that these X; be 1. The shareable image MUST be linked with the options file MAILSHR.OP VT X; that promotes these symbols to UNIVERSAL symbols so they will end up X; in the shareable image's symbol table. X; X`09`09MAIL$C_PROT_MAJOR == 1 X`09`09MAIL$C_PROT_MINOR == 1 X; X; Constants for dispatcher, taken from MAIL.SDL listing X; X`09LNK_C_FIRST = 0 X`09LNK_C_OUT_CONNECT == 0 X`09LNK_C_OUT_SENDER == 1 X`09LNK_C_OUT_CKUSER == 2 X`09LNK_C_OUT_TO`09 == 3 X`09LNK_C_OUT_SUBJ`09 == 4 X`09LNK_C_OUT_FILE`09 == 5 X`09LNK_C_OUT_CKSEND == 6 X`09LNK_C_OUT_DEACCESS == 7 X X`09LNK_C_IN_CONNECT == 8 X`09LNK_C_IN_SENDER == 9 X`09LNK_C_IN_CKUSER == 10 X`09LNK_C_IN_TO`09 == 11 X`09LNK_C_IN_SUBJ`09 == 12 X`09LNK_C_IN_FILE`09 == 13 X X`09LNK_C_IO_READ`09 == 14 X`09LNK_C_IO_WRITE`09 == 15 X`09LNK_C_LAST = 15 X; X; Here's the main routine that is called by MAIL. Note that we don't really X; do any work here, just dispatch the call to the appropriate handler. The X; reason I do it this way is that I am not interested in writing the handler Vs X; in MACRO, and I cannot easily deal with different numbers of arguments in X; the same procedure in other languages. X; X X; X; General argument offset to the function code: X; X`09LNK_FUNCTION = 8 X; X; Shareable image transfer vectors X; X`09.Transfer`09MAIL$PROTOCOL X`09.Mask`09`09MAIL$PROTOCOL X`09jmp`09L`5EMAIL$PROTOCOL + 2 X X`09.Entry`09MAIL$PROTOCOL, `5EM<r2,r3> X X`09caseb`09LNK_FUNCTION(ap), #LNK_C_FIRST, -`09; Dispatch to handler X`09`09#<LNK_C_LAST - LNK_C_FIRST> X X10$:`09 .word`09Dispatch_out_connect - 10$`09`09; LNK_C_OUT_CONNECT X`09 .word`09Dispatch_out_line - 10$`09`09`09; LNK_C_OUT_SENDER X`09 .word`09Dispatch_out_check - 10$`09`09; LNK_C_OUT_CKUSER X`09 .word`09Dispatch_out_line - 10$`09`09`09; LNK_C_OUT_TO X`09 .word`09Dispatch_out_line - 10$`09`09`09; LNK_C_OUT_SUBJ X`09 .word`09Dispatch_out_file - 10$`09`09`09; LNK_C_OUT_FILE X`09 .word`09Dispatch_out_check - 10$`09`09; LNK_C_OUT_CKSEND X`09 .word`09Dispatch_out_deaccess - 10$`09`09; LNK_C_OUT_DEACCESS X X`09 .word`09Dispatch_in_connect - 10$`09`09; LNK_C_IN_CONNECT X`09 .word`09Dispatch_in_line - 10$`09`09`09; LNK_C_IN_SENDER X`09 .word`09Dispatch_in_line - 10$`09`09`09; LNK_C_IN_CKUSER X`09 .word`09Dispatch_in_line - 10$`09`09`09; LNK_C_IN_TO X`09 .word`09Dispatch_in_line - 10$`09`09`09; LNK_C_IN_SUBJ X`09 .word`09Dispatch_in_file - 10$`09`09`09; LNK_C_IN_FILE X X`09 .word`09Dispatch_IO_read - 10$`09`09`09; LNK_C_IO_READ X`09 .word`09Dispatch_IO_write - 10$`09`09`09; LNK_C_IO_WRITE X Xunknown: X`09pushl`09LNK_FUNCTION(ap)`09; FAO parameter in the function code X`09pushl`09#1 X`09pushl`09#ubbsml__UNKFUNC`09; Signal unknown function code X`09calls`09#3, G`5ELIB$SIGNAL`09; if we fall through dispatcher. X`09movl`09#ubbsml__UNKFUNC, r0 X`09ret X; X; The dispatchers X; XDispatch_out_connect: X`09callg`09(ap), MAIL_OUT_CONNECT X`09ret X XDispatch_out_line: X`09callg`09(ap), MAIL_OUT_LINE X`09ret X XDispatch_out_check: X`09callg`09(ap), MAIL_OUT_CHECK X`09ret X XDispatch_out_file: X`09callg`09(ap), MAIL_OUT_FILE X`09ret X XDispatch_out_deaccess: X`09callg`09(ap), MAIL_OUT_DEACCESS X`09ret X XDispatch_in_connect: X`09callg`09(ap), MAIL_IN_CONNECT X`09ret X XDispatch_in_line: X`09callg`09(ap), MAIL_IN_LINE X`09ret X XDispatch_in_file: X`09callg`09(ap), MAIL_IN_FILE X`09ret X XDispatch_IO_read: X`09callg`09(ap), MAIL_IO_READ X`09ret X XDispatch_IO_write: X`09callg`09(ap), MAIL_IO_WRITE X`09ret X X`09.end $ CALL UNPACK [.MAIL_PROTOCOL]MAILSHR.MAR;3 1813544556 $ create 'f' Xuniversal=MAIL$C_PROT_MAJOR, MAIL$C_PROT_MINOR $ CALL UNPACK [.MAIL_PROTOCOL]MAILSHR.OPT;2 993680312 $ create 'f' X`09parameter LNK_C_OUT_CONNECT = 0 !(* MAIL protocol link actions. V *) X`09parameter LNK_C_OUT_SENDER = 1 !(* These are defined in MAILSHR.MAR V *) X`09parameter LNK_C_OUT_CKUSER = 2 !(* but because we cannot have external V *) X`09parameter LNK_C_OUT_TO = 3 !(* constants in Pascal, they are V *) X`09parameter LNK_C_OUT_SUBJECT = 4 !(* redefined here. V *) X`09parameter LNK_C_OUT_FILE = 5 X`09parameter LNK_C_OUT_CKSEND = 6 X`09parameter LNK_C_OUT_DEACCESS = 7 X`09parameter LNK_C_IN_CONNECT = 8 X`09parameter LNK_C_IN_SENDER = 9 X`09parameter LNK_C_IN_CKUSER = 10 X`09parameter LNK_C_IN_TO = 11 X`09parameter LNK_C_IN_SUBJ = 12 X`09parameter LNK_C_IN_FILE = 13 X`09parameter LNK_C_IO_READ = 14 X`09parameter LNK_C_IO_WRITE = 15 X X`09character*80 from_string,to_string,subject_string,address(40) X`09common /mailchars/ from_string,to_string,subject_string,address X`09integer*4 num_addresses X`09common/mailints/ num_addresses $ CALL UNPACK [.MAIL_PROTOCOL]PROT_INC.FOR;7 320155909 $ create 'f' X`09integer function mail_out_connect (context, function, protocol, X`091 node, mail$_loglink, file_rat, file_rfm, mail$gl_flags, X`092 attached_file) X Xc`09MAIL_OUT_CONNECT is called by VMS MAIL to initiate a send operation. X X`09implicit none X`09include '($ssdef)' X`09include 'prot_inc.for' X X`09integer*4 context,function,mail$_loglink,file_rat X`09integer*4 file_rfm,mail$gl_flags X`09integer*4 attached_file X`09character*(*) protocol X`09character*(*) node Xc`09character*(*) attached_file X`09character*12 filename X`09external uopen X`09external ubbsml__filopnerr X X X`09from_string = ' ' X`09to_string = ' ' X`09subject_string = ' ' X`09num_addresses = 0 X Xc`09open the userlog and message files X`09filename = 'USERLOG.DAT' X`09open(unit=1,file='ubbs_data:userlog.dat',status='old',`09 X`091 organization='indexed',access='keyed',err=1000, X`092 recordtype='fixed',recl=50,shared,useropen=uopen) X`09filename = 'MESSAGE.HED' X`09open(unit=2,file='ubbs_data:message.hed',status='old',`09 X`091 organization='relative',access='direct',err=1000, X`092 recordtype='fixed',recl=48,shared,useropen=uopen) X`09filename = 'MESSAGE.DAT' X`09open(unit=3,file='ubbs_data:message.dat',status='old',`09 X`091 organization='relative',access='direct',err=1000, X`092 recordtype='fixed',recl=20,shared,useropen=uopen) X X`09mail_out_connect = ss$_normal X`09return X X 1000`09call lib$signal(ubbsml__filopnerr, X`091 %val(1), filename) X Xc`09Don't set return code to normal on error X`09return X`09end X`0C X`09integer function mail_out_line(context,function,node,line) X Xc`09MAIL_OUT_LINE is called by VMS MAIL whenever a single line of stuff Xc`09must be delivered to the UBBS mail interface. Xc`09These currently are the To:, From:, and Subject: lines. X`09implicit none X`09include '($ssdef)' X`09include 'prot_inc.for' X`09integer*4 context,function,node,func2 X`09character*(*) line X Xc`09The following is because function is passed by value, and FORTRAN Xc`09thinks that it is an address. X X`09func2 = %loc(function) X X`09if(func2.eq.lnk_c_out_to) then X`09 to_string = line X`09else if (func2.eq.lnk_c_out_sender) then X`09 from_string = line X`09else if(func2.eq.lnk_c_out_subject) then X`09 subject_string = line X`09end if X X`09mail_out_line = ss$_normal X`09end X`0C X`09integer function MAIL_OUT_CHECK(context,function,node,addressee,error) Xc`09MAIL_OUT_CHECK is called once with each addressee for the current Xc`09message and once again after the message body has been sent. X X`09implicit none X`09include 'bbs_inc.for' X`09include 'prot_inc.for' X X`09integer context,function,func2,error,jj,istat X`09logical*1 valid X`09character*(*) node,addressee X`09character zmail_to*40,zfirst_name*20,zlast_name*20,yn*1 X`09external ubbsml__usernoexist X X 1001`09format(a) X X`09func2 = %loc(function) X X`09if(func2.eq.lnk_c_out_ckuser) then X`09 if(len(addressee).eq.1.and.ichar(addressee(1:1)).eq.0) then X`09`09mail_out_check = ss$_normal X`09`09return X`09`09end if X`09 jj=index(addressee,'/') X`09 if(jj.eq.0) jj = len(addressee) + 1 X`09 call str$upcase(zmail_to,addressee(1:jj-1)) X`09 jj = index(zmail_to,' ') X`09 zfirst_name=zmail_to(1:jj-1)`09 X`09 zlast_name=zmail_to(jj+1:30) X`09 ur.user_key=zlast_name//zfirst_name X`09 read(1,key=ur.user_key,iostat=istat)ur X`09 unlock(unit=1) X`09 if(istat.eq.0) then X`09`09num_addresses = num_addresses + 1 X`09`09address(num_addresses) = addressee X`09 else X`09`09call lib$signal(ubbsml__usernoexist,%val(1), addressee) X`09`09write(*,*) 'Do you wish to make this a general message? `5BN`5D' X`09`09read(*,1001)yn X`09`09call str$upcase(yn,yn) X`09`09if(yn.ne.'Y') then X`09`09 mail_out_check = %loc(ubbsml__usernoexist) X`09`09 return X`09`09 end if X`09 end if X`09else if(func2.eq.lnk_c_out_cksend) then X`09 continue X`09end if X`09mail_out_check = ss$_normal X`09return X`09end X`0C X`09integer function MAIL_OUT_FILE(context,function,node, X`091 message_rab,error) Xc`09MAIL_OUT_FILE is called when the body of the message is ready to be Xc`09sent. The message is available as a file and must be read from this Xc`09temporary file using RMS. MAIL_OUT_FILE is where most of the actual Xc`09work takes place. The following steps are taken: Xc Xc (1) The mode of the message file is set to record I/O (MAIL sometimes Xc leaves the file in block mode). Xc Xc (2) Put the message in the UBBS message files for each user. X X`09implicit none X`09include '($rabdef)' X`09include '($rmsdef)' X`09include 'prot_inc.for' X`09include 'bbs_inc.for' X`09integer context,function,error,length,num_lines,stat,ii,i,istat X`09integer jj,j X`09logical get_line,busy X`09character line*256,options*30,temp*30 X`09character zfirst_name*20,zlast_name*20,zmail_to*30 X`09character*(*) node X`09integer sys$get X`09external ubbsml__mesreaerr X`09external ubbsml__publmess X X`09record/rabdef/ message_rab X`09record/mail_header_structure/ mh X X Xc`09Do some fancy footwork with RMS to insure that the file is open Xc`09for sequential access and not block access. MAIL sometimes has Xc`09this file open in block mode. The only way to change modes is Xc`09to disconnect the RAB, diddle the mode bit and then reconnect it. X X`09call sys$disconnect (message_rab) X`09message_rab.rab$l_rop = message_rab.rab$l_rop .and. (.not.rab$m_bio) X`09call sys$connect (message_rab) X X`09call sys$rewind (message_rab) X`09 X`09get_line = .true. X`09num_lines = 0 X`09do while (get_line) X`09 message_rab.rab$l_ubf = %loc(line) X`09 message_rab.rab$w_usz = 256 X`09 stat = sys$get (message_rab) X`09 if(mod(stat,2).eq.1) then X`09`09length = message_rab.rab$w_rsz X`09`09num_lines = num_lines + 1 X`09 else if (stat .eq. rms$_eof) then X`09`09get_line = .false. X`09 else X`09`09call lib$signal (ubbsml__mesreaerr, 1, stat) X`09 end if X`09 end do X X`09i = index(from_string,'"') X`09if(i.ne.0) then X`09 from_string = from_string(i+1:) X`09 i=index(from_string,'"') X`09 if(i.ne.0) from_string = from_string(1:i-1) X`09 end if X X`09do ii = 1,num_addresses X X 3090`09read(2,rec=1)last_header,last_data, X`091 first_mnum,last_mnum,busy X`09if(busy) then X`09 unlock(unit=2) X`09 call lib$wait(1.0) X`09 go to 3090 X`09 end if X X`09last_header=last_header+1 X`09last_mnum=last_mnum+1 X`09write(2,rec=1)last_header,last_data+num_lines, X`091 first_mnum,last_mnum,busy X`09call date(mh.mail_date) X`09call time(mh.mail_time) X X`09mh.mail_read=.false. X`09mh.mail_deleted=.false. X`09mh.mail_subject=subject_string X`09i = index(address(ii),'/') X`09if (i.eq.0) then X`09 i=31 X`09 mh.mail_section = 0 X`09 mh.mail_private = .true. X`09else X`09 options = address(ii)(i+1:)//'///' Xc`09 extract first option (private `5BY/N`5D) X`09 j = index(options,'/') X`09 temp = options(1:j) X`09 options = options(j+1:) X`09 if(temp(1:1).eq.'N') then X`09`09mh.mail_private = .false. X`09 else X`09`09mh.mail_private = .true. X`09 end if X`09end if X`09mh.mail_to=address(ii)(1:i-1) X`09mh.mail_reply_to=0 X`09do i=1,10 X`09 mh.mail_replys(i)=0 X`09 end do X`09mh.mail_first=last_data+1 X`09mh.mail_last=last_data+num_lines X`09mh.mail_from=from_string X`09mh.mail_messnum=last_mnum X`09call str$upcase(zmail_to,mh.mail_to) X`09jj = index(zmail_to,' ') X`09zfirst_name=zmail_to(1:jj-1)`09 X`09zlast_name=zmail_to(jj+1:30) X`09ur.user_key=zlast_name//zfirst_name X`09read(1,key=ur.user_key,iostat=istat)ur X`09if(istat.eq.0) then X`09 mh.mail_person = .true. X`09else X`09 mh.mail_person = .false. X`09 mh.mail_private = .false. X`09 call lib$signal(ubbsml__publmess,%val(1),zmail_to) X X`09end if X`09write(2,rec=last_header) mh X`09call sys$rewind (message_rab) X`09get_line = .true. X`09num_lines = 0 X`09do while (get_line) X`09 line = ' ' X`09 message_rab.rab$l_ubf = %loc(line) X`09 message_rab.rab$w_usz = 256 X`09 stat = sys$get (message_rab) X`09 if(mod(stat,2).eq.1) then X`09`09length = message_rab.rab$w_rsz X`09`09num_lines = num_lines + 1 X`09`09write(3,rec=last_data+num_lines)line(1:80) X`09 else if (stat .eq. rms$_eof) then X`09`09get_line = .false. X`09 else X`09`09call lib$signal (ubbsml__mesreaerr, 1, stat) X`09 end if X`09 end do X`09 read(1,key=ur.user_key,iostat=istat)ur X`09 if(istat.eq.0) then X`09`09ur.num_unread = ur.num_unread + 1 X`09`09rewrite(1)ur X`09 else X`09`09print*,'error on user log - istat=',istat X`09 end if X`09 end do X`09mail_out_file = ss$_normal X`09return X`09end X`0C X`09integer function MAIL_OUT_DEACCESS(context,function) X`09include '($ssdef)' X`09close(unit=1) X`09close(unit=2) X`09close(unit=3) X`09mail_out_deaccess = ss$_normal X`09return X`09end X`0C X`09integer function MAIL_IN_CONNECT X`09include '($ssdef)' X`09mail_in_connect = ss$_normal X`09return X`09end X`09integer function MAIL_IN_LINE X`09include '($ssdef)' X`09mail_in_line = ss$_normal X`09return X`09end X`09integer function MAIL_IN_FILE X`09include '($ssdef)' X`09mail_in_file = ss$_normal X`09return X`09end X`09integer function MAIL_IO_READ X`09include '($ssdef)' X`09mail_io_read = ss$_normal X`09return X`09end X`09integer function MAIL_IO_WRITE X`09include '($ssdef)' X`09mail_io_write = ss$_normal X`09return X`09end X`0C X`09integer function uopen(fab,rab,lun) X`09implicit none X X`09include '($rabdef)' X`09include '($fabdef)' X X`09record /rabdef/ rab X`09record /fabdef/ fab X`09integer sys$open,sys$connect X X`09integer lun,status X`09 Xc`09modify the rab to simplify things X`09rab.rab$l_rop = ibset(rab.rab$l_rop, rab$v_wat) X Xc`09actually open the file X`09status=sys$open(fab) X`09if(status) status=sys$connect(rab) Xc`09return the status X`09uopen=status X`09return X`09end $ CALL UNPACK [.MAIL_PROTOCOL]UBBS_MAILSHR.FOR;6 1210369869 $ create 'f' X`09 .Title`09UBBSMAIL error messages X X! Written by Dale Miller 17-Jan-1989 X X`09 .Facility`09UBBSML,667/prefix=UBBSML__ X`09 .Ident`09'UBBS_MAIL Version 1.0' X X .Severity fatal X X`09INTSTKOVR <Internal error, stack overflow> X`09STKEMPTY <Internal error, stack empty> X`09BADSTKELE <Internal error, bad element found on stack> X X .Severity`09error X X`09FILOPNERR <Unable to open file "UBBS_DATA:!AS">/FAO=1 X`09NOSUCHUSER <No such user exists in USERLOG.DAT> X`09MESREAERR <Error reading intermediate message file, status = !UL>/FAO= V1 X UNKFUNC <Foreign MAIL protocol invoked with unknown function !U VL.>/FAO=1 X X .Severity`09warning X X USERNOEXIST <Specified user "!AS" does not exist>/FAO=1 X X .Severity`09information X X`09PUBLMESS <Public message delivered to "!AS">/FAO=1 X X .End $ CALL UNPACK [.MAIL_PROTOCOL]UBBS_MAIL_ERR.MSG;7 796878843 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Convert_files.for Xc`09This program converts the FILES.DAT files into FILES.IDX files for Xc`09UBBS Rev. 4.0 Xc`09Dale Miller - UALR Xc`0927-Jun-1986 Xc Xc`09Rev. 4.0 27-Jun-1986 Xc`09Rev. 6.0 06-Jun-1988 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for' X`09character cdate*9,cdate2*11 X`09integer str$upcase,istat,sys$bintim,txtlen X X`09record/file_description/ fd X X`09open(unit=1,file='files.dat',readonly,shared,status='old') X X`09open(unit=2,file='files.idx',status='new',organization='indexed', X`091 access='keyed',recl=192,form='unformatted', X`092 recordtype='variable',key=(1:18:character)) X X 1001`09format(a18,i3,1x,a1,6x,a9,1x,q,a) X 1002`09format(67x,a11) X X`09fd.file_name='$Header' X`09fd.upload_name='DALE MILLER' X`09fd.keywords=' ' X`09fd.times_down=0 X`09fd.upload_text=' ' X`09read(1,1002)cdate2 X`09istat = str$upcase(cdate2,cdate2) X`09istat = sys$bintim(cdate2//' 00:00:00.00',fd.upload_date) X`09write(2)fd X`09read(1,1001)fd.file_name X X`09fd.upload_name=' ' X`09fd.keywords=' ' X`09fd.times_down=0 X X 0010`09read(1,1001,end=99)fd.file_name,fd.file_size, X`091 fd.file_type,cdate,txtlen,fd.upload_text X`09fd.upload_text(txtlen+1:txtlen+1)=char(cr) X`09istat = str$upcase(cdate,cdate) X`09istat = sys$bintim(cdate(1:7)//'19'// X`091 cdate(8:9)//' 00:00:00.00',fd.upload_date) X`09print*,'file='//fd.file_name//' type='//fd.file_type//' date='// X`091 cdate X`09print*,'file_size=',fd.file_size X`09write(2)fd X`09go to 10 X 0099`09print*,'finished' X`09end $ CALL UNPACK [.UPGRADE]CONVERT_FILES.FOR;2 571816888 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Crlf.for Xc`09Redo the userlog for UBBS V 3.0 Xc`09Dale Miller - UALR Xc`0910-Feb-1985 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for' X`09include 'sys$library:foriosdef' X`09integer istat,str$upcase,sys$gettim,sys$asctim X`09character null4*4,lfcr*4,dummy_20*20 X`09real*8 null8/'0000000000000000'x/ X X`09character zz*1,appstr*12 X`09character*40 zeros/'0000000000000000000000000000000000000000'/ X`09null4=char(0)//char(0)//char(0)//char(0) X`09lfcr=char(10)//char(13)//char(255)//' ' X X`09open(unit=1,file='userlog.dat',status='old',`09 X`091 organization='indexed',access='keyed', X`092 recordtype='fixed',recl=50,shared) X X`09ur.user_key=char(0) X`09 X 0010`09read(1,keygt=ur.user_key,iostat=ios)ur X`09if(ios.eq.for$ios_sperecloc) go to 10 X`09if(ios.ne.0) go to 5000 X`09if(ur.user_key.eq.zeros) go to 10 X 0011`09if(ur.approved) then X`09 appstr='* Approved *' X`09else X`09 appstr='Not Approved' X`09endif X Xc`09write(6,1000)ur.user_key,ur.city,ur.state,ur.phone_number(1:3), Xc`091 ur.phone_number(4:6),ur.phone_number(7:10),ur.computer, Xc`092 ur.last_log_date,ur.last_log_time,ur.num_logon,appstr X X 1000`09format(1x,a,1x,a,','a,1x,'(',a,')',a,'-',a,/, X`091 1x,a,1x,a,1x,a,i6,/,1x,a) X X`09if(ur.user_crlf.eq.null4) then X`09 ur.user_crlf=char(13)//char(10)//char(255) X`09 print*,'bad cr '//ur.user_key X`09 endif X`09if(ur.user_ff.eq.null4) then X`09 ur.user_ff=char(13)//char(10)//char(255) X`09 print*,'bad ff '//ur.user_key X`09 endif X`09if(ur.user_crlf.eq.lfcr) then X`09 ur.user_crlf=char(13)//char(10)//char(255) X`09 print*,'flip cr '//ur.user_key X`09 endif X`09if(ur.user_ff.eq.lfcr) then X`09 ur.user_ff=char(13)//char(10)//char(255) X`09 print*,'flip ff '//ur.user_key X`09 endif X`09if(ur.last_pass_chg.eq.null8) then X`09 istat=sys$gettim(%ref(ur.last_pass_chg)) X`09 istat=sys$asctim(,dummy_20,%ref(ur.last_pass_chg),) X`09 print*,'bad password change date '//ur.user_key,dummy_20 X`09 endif X X`09rewrite(1,err=90500,iostat=ios)ur X`09go to 10 X X 5000`09close(unit=1) X`09print*,'ios=',ios X`09print*,'finished' X`09stop X X90500`09print*,'an error has occurred' X`09print*,'ios=',ios X`09stop X`09end $ CALL UNPACK [.UPGRADE]CRLF.FOR;1 940207298 $ create 'f' X`09program cvtv6 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Cvtv6.for Xc`09This program removes converts the FILES.IDX files for UBBS V6.0 Xc Xc`09Dale Miller - UALR Xc Xc`09Rev. 6.0 06-Jun-1988 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for' X`09include '($rmsdef)' X`09include 'sys$library:foriosdef.for/nolist' X`09character filnam1*100,filnam2*100,darea*3,tempfile*50,dsp*1 X`09integer d1,d2,dummy,istat,fc1,fc2,du1,du2,i,length X`09integer lib$find_file X`09integer str$trim,str$upcase,sys$gettim X`09external uopen X`09record/file_description/ fd X`09real*8 tempdate X X`09call sys$gettim(tempdate) X`09filnam1='bbs$files:`5B-`5D*.dir;*' X`09dummy=20 X`09fc1=0 X`09tempfile=filnam1 X`09istat=rms$_nmf X`09istat=lib$find_file(tempfile,filnam1,fc1) X`09do while (istat.ne.rms$_nmf) X`09 d1=1 X`09 do while(d1.ne.0) X`09`09d1=index(filnam1,'`5D') X`09`09filnam1=filnam1(d1+1:) X`09`09end do X`09 d2=index(filnam1,'.')-1 X`09 darea=filnam1(:d2) X`09 write(6,1001)' Beginning '//darea Xc Xc Get the index file. Xc X`09open(unit=4,`09`09shared, X`091 file='bbs$files:`5B'//darea//'`5Dfiles.idx', X`092 status='old',`09organization='indexed', X`093 access='keyed',`09form='unformatted', X`094 recl=128,`09`09recordtype='fixed', X`095`09`09`09key=(1:18:character), X`096 useropen=uopen) X X`09open(unit=3,`09`09shared, X`091 file='bbs$files:`5B'//darea//'`5Dnew_files.idx', X`092 status='new',`09organization='indexed', X`093 access='keyed',`09form='unformatted', X`094 recl=192,`09`09recordtype='variable', X`095`09`09`09key=(1:18:character)) X X`09fd.file_name=char(0) X`09read(4,keygt=fd.file_name,iostat=ios)fd X`09do while(ios.ne.for$ios_attaccnon) X`09 fd.archived=.false. X`09 fd.download_date = tempdate X`09 fd.keywords(50:79) = ' ' X`09 write(3)fd X`09 read(4,keygt=fd.file_name,iostat=ios)fd X`09 end do X`09 close(unit=4) X Xc`09Now, go on to the next directory. X`09 istat=lib$find_file(tempfile,filnam1,fc1) X`09 end do X 1001`09format(a) X`09stop X`09end $ CALL UNPACK [.UPGRADE]CVTV6.FOR;1 1342395196 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Fixmess.for Xc`09This program add expiration dates to messages created by UBBS Xc`09previous to version 3.5. New users may ignore its existance. Xc`09Dale Miller - UALR Xc Xc`09Rev. 3.5 20-Jun-1986 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for' X`09character dummy_20*20 X`09include 'sys$library:foriosdef/nolist' X`09external uopen X`09integer k,istat X`09integer sys$bintim,compquad X`09real*8 my_time,one_month,time_zero X X`09record /mail_header_structure/ mh X X`09istat=sys$bintim('18-DEC-1858 00:00:00',one_month) X`09istat=sys$bintim('19-JUN-1986 00:00:00',time_zero) X X`09open(unit=2,file='message.hed',status='old', X`091 organization='relative',access='direct',shared, X`092 recordtype='fixed',recl=48,useropen=uopen) X X 2100`09read(unit=2,rec=1,iostat=ios)last_header, X`091 last_data,first_mnum,last_mnum X`09if(ios.ne.0) then X`09 print*,'Error on header record ios=',ios X`09 stop X`09 end if X`09print*,'Last header= ',last_header X`09print*,'Last data= ',last_data X`09print*,'First message=',first_mnum X`09print*,'Last message= ',last_mnum X X`09do k=2,last_header Xc Xc`09Loop through all message headers to see if they need fixing Xc X `09 read(2,rec=k)mh X X`09 if(mh.mail_person) go to 30 X X`09 dummy_20=mh.mail_date(1:7)//'19'//mh.mail_date(8:9)//' 00:00:00' X`09 istat=sys$bintim(dummy_20,my_time) X`09 istat=compquad(my_time,time_zero) X`09 if(istat.eq.1) go to 30 X`09 call addquad(my_time,one_month,mh.mail_expire) X`09 write(2,rec=k)mh X`09 print*,'Fixed ',mh.mail_messnum,' from:'//mh.mail_from// X`091`09' To:'//mh.mail_to X 0030`09 continue X`09 end do X X`09close(unit=2) X`09stop X 9060`09print*,'could not open file' X`09stop X90000`09continue X`09print*,'Error reading record, ios=',ios X`09close(unit=2) X`09close(unit=3) X`09close(unit=4) X`09stop X`09end X`0C X`09integer function uopen(fab,rab,lun) X`09implicit none X X`09include '($rabdef)' X`09include '($fabdef)' X X`09record /rabdef/ rab X`09record /fabdef/ fab X`09integer sys$open,sys$connect X X`09integer lun,status X`09 Xc`09modify the rab to simplify things X`09rab.rab$l_rop = ibset(rab.rab$l_rop, rab$v_wat) X Xc`09actually open the file X`09status=sys$open(fab) X`09if(status) status=sys$connect(rab) Xc`09return the status X`09uopen=status X`09return X`09end X`0C X`09integer function uopen2(fab,rab,lun) X`09implicit none X X`09include '($rabdef)' X`09include '($fabdef)' X X`09record /rabdef/ rab X`09record /fabdef/ fab X`09integer sys$open,sys$connect X X`09integer lun,status X`09 Xc`09modify the rab to simplify things X`09rab.rab$l_rop = ibset(rab.rab$l_rop, rab$v_ulk) X Xc`09actually open the file X`09status=sys$open(fab) X`09if(status) status=sys$connect(rab) Xc`09return the status X`09uopen2=status X`09return X`09end $ CALL UNPACK [.UPGRADE]FIXMESS.FOR;1 2015459162 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Reformat_uploads.for Xc`09This program reformats binary files uploaded previous to Rev 4.7 Xc`09to conform to the new standard. It must be invoked for each file Xc`09to be converted. Xc`09New users may ignore its existance. Xc Xc`09Dale Miller - UALR Xc Xc`09Rev. 4.7 09-Dec-1986 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X implicit integer (a-z) X character*1024 buff X character*70 filnam X X status=lib$get_foreign(filnam,'Enter file name: ',nodlen) X if(nodlen.eq.0) go to 100 X open (unit=1,name=filnam,carriagecontrol='none', X 1 type='old',err=9000) X open (unit=2,name=filnam,carriagecontrol='none', X 1 type='new',err=9000) X X`09length=0 X 0010`09if(length.lt.128) then X`09 read(1,12,end=500)len2,buff(length+1:) X`09 length=length+len2 X`09endif X`09write(2,13)buff(1:128) X`09buff=buff(129:) X`09length=length-128 X`09go to 10 X 0500`09if(length.gt.0) then X`09 buff(length+1:)=' ' X`09 write(2,13)buff(1:128) X endif X`09close(unit=1) X`09close(unit=2) X`09call exit X X 0012`09format(q,a) X 0013`09format(a) X X 9000`09write(6,*)'could not open file' X`09call exit X 0100`09print*,'No file name found' X`09end $ CALL UNPACK [.UPGRADE]REFORMAT_UPLOADS.FOR;2 809512967 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Add_files.for Xc`09This program reads a sequential file containing file descriptions and Xc`09updates FILES.IDX accordingly. Xc`09Dale Miller - UALR Xc`0906-Jun-1988 Xc Xc`09Rev. 6.0 06-Jun-1988 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for' X`09character cdate*9,cdate2*11,darea*3,infile*80,inline*80,tchar*1 X`09character type*5 X`09integer str$upcase,istat,sys$bintim,txtlen,fsize X`09external getsize X`09common/filesize/fsize X`09record/file_description/ fd X`09record/file_description/ fd2 X X`09print*,'Area to update?' X`09read(*,1003)darea X`09open(unit=2,file='bbs$files:`5B'//darea//'`5Dfiles.idx', X`091 status='old',organization='indexed',shared, X`091 access='keyed',recl=192,form='unformatted', X`092 recordtype='variable',key=(1:18:character)) X X`09print*,'Input file name?' X`09read(*,1003)infile X`09open(unit=1,file=infile,readonly,shared,status='old') X X 1001`09format(a1,a) X 1002`09format(67x,a11) X 1003`09format(a) X X`09fd.file_name=' ' X`09fd.times_down=0 X`09fd.upload_text=' ' X`09call sys$gettim(fd.upload_date) X`09fd.download_date = fd.upload_date X`09fd.archived = .false. X X`09read(1,1001,end=99)tchar,inline X X 0010`09fd.file_name = inline(1:18) X`09fd.file_type = inline(20:20) X`09if(fd.file_type.eq.'A') then X`09 type = '.asc`5D' X`09else X`09 type = '.bin`5D' X`09end if X`09fd.upload_name = inline(22:51) X`09call sys$gettim(fd.upload_date) X`09fd.download_date = fd.upload_date X`09fd.archived = .false. X`09fd.times_down=0 X X`09read(1,1001,end=99)tchar,fd.keywords X`09fd.upload_text = fd.keywords X`09txtlen = 0 X 0011`09read(1,1001,end=99)tchar,inline X`09if(tchar.eq.'`7E') then X`09 open(unit=4,file='bbs$files:`5B'//darea//type// X`091`09fd.file_name,status='old',readonly, X`092`09useropen=getsize,err=12,iostat=istat) X`09 close(unit=4) X`09 fd.file_size = fsize X`09 print*,'file='//fd.file_name//' type='//fd.file_type// X`091`09' size=',fd.file_size X`09 read(2,key=fd.file_name,err=13)fd2 X`09 delete(unit=2) X X`09 fd.download_date = fd2.download_date X`09 fd.upload_date = fd2.upload_date X`09 fd.archived = fd2.archived X`09 fd.times_down = fd2.times_down X 0013`09 write(2)fd X`09 go to 10 X 0012`09 print*,'Open failed, file='//fd.file_name//' - status=',istat X`09 go to 10 X`09 end if X X`09fd.upload_text(txtlen+1:) = inline X`09call str$trim(fd.upload_text,fd.upload_text,txtlen) X`09if(txtlen.ge.400) then X`09 print*,'********'//fd.file_name//' truncated description' X`09else X`09 fd.upload_text(txtlen+1:txtlen+1)=char(cr) X`09 txtlen = txtlen+1 X`09end if X`09go to 11 X X X 0099`09open(unit=4,file='bbs$files:`5B'//darea//type// X`091 fd.file_name,status='old',readonly, X`092 useropen=getsize,err=100,iostat=istat) X`09close(unit=4) X`09fd.file_size = fsize X`09 print*,'file='//fd.file_name//' type='//fd.file_type// X`091`09' size=',fd.file_size X`09read(2,key=fd.file_name,err=101)fd2 X`09delete(unit=2) X 0101`09write(2)fd X`09go to 102 X X 0100`09print*,'Open failed, file='//fd.file_name//' - status=',istat X 0102`09close(unit=1) X`09close(unit=2) X`09print*,'finished' X`09end X`0C X`09integer function getsize(fab,rab,lun) Xc`09This user open finds out the file size. X X`09implicit none X X`09include '($rabdef)' X`09include '($fabdef)/list' X X`09record /rabdef/ rab X`09record /fabdef/ fab X`09integer sys$open,sys$connect X`09 X`09integer lun,status,fsize X`09common/filesize/fsize X`09 Xc`09actually open the file X`09status=sys$open(fab) X`09if(status) status=sys$connect(rab) Xc`09return the status X`09getsize=status Xc`09store the size X`09fsize=fab.fab$l_alq X`09return X`09end $ CALL UNPACK [.UTILITY]ADD_FILES.FOR;2 2087216843 $ create 'f' X$ define ubbs_data disk$user:`5Bualr_bbs.data`5D X$ define ubbs_files psi$dua106:`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 $ CALL UNPACK [.UTILITY]ASSIGN.COM;2 1195448397 $ create 'f' X$ bbs X$ set verify X$ on error then continue X$fort/check=noover BBS X$ on error then continue X$fort/check=noover BBSCB X$ on error then continue X$fort/check=noover SYSOP X$ on error then continue X$fort/check=noover UBBS_SUBS X$ on error then continue X$macro quadmath X$ LIBRARY/OBJECT/CREATE UBBS *.OBJ X$ on error then continue X$ link/notrace/EXEC=BBS UBBS/INCLUDE=(BBS_MAIN)/LIBRARY $ CALL UNPACK [.UTILITY]COMPILE.COM;11 492907203 $ create 'f' X$SET NOVERIFY X$ DEFINE UBBS_DATA DISK$USER:`5BUALR_BBS.DATA`5D X$ DEFINE UBBS_FILES DUA10:`5BBBS_FILES.`5D X$ SET DEFAULT DISK$USER:`5BBBS`5D X$ IF F$SEARCH("UBBS_DATA:TO_RESTORE.DAT") .EQS. "" THEN EXIT X$ RENAME UBBS_DATA:TO_RESTORE.DAT `5B`5DTO_RESTORE.DAT X$ APPEND TO_RESTORE.DAT;0 RESTORED.DAT X$ SORT/NODUPLICATES TO_RESTORE.DAT TO_RESTORE.DAT X$ FILES == F$LOGICAL("UBBS_FILES") X$ FF = F$EXTRACT(F$LOCATE(":",FILES)+1,999,FILES) X$ SHO SYM FF X$ FF = F$EXTRACT(0,F$LENGTH(FF)-1,FF) X$ DISK = F$EXTRACT(0,F$LOCATE(":",FILES)+1,FILES) X$ OPEN/READ INFILE TO_RESTORE.DAT X$ OPEN/WRITE OUTFILE FILELIST.DAT X$ IBM = 0 X$ PCS = 0 X$ AOTHER = 0 X$ OTHER = 0 X$ LOOP: X$ READ/END=EOF_INPUT INFILE INREC X$ TYPE = F$EXTRACT(1,3,INREC) X$ IF TYPE .EQS. "IBM" THEN IBM=IBM+1 X$ IF TYPE .EQS. "PCS" THEN PCS=PCS+1 X$ IF F$EXTRACT(0,1,TYPE) .EQS. "A" THEN AOTHER = AOTHER + 1 X$ IF (TYPE .NES. "IBM") .AND. (TYPE .NES. "PCS") .AND. - X (F$EXTRACT(0,1,TYPE) .NES. "A") THEN OTHER = OTHER+1 X$ INREC = FF+F$EXTRACT(1,F$LOCATE(" ",INREC)-1,INREC) X$ WRITE OUTFILE INREC X$ GOTO LOOP X$ EOF_INPUT: X$ CLOSE INFILE X$ CLOSE OUTFILE X$! X$!`09PROCESS EACH OF THE 3 TAPES X$! X$ WRITE SYS$OUTPUT IBM," IBM FILES" X$ WRITE SYS$OUTPUT PCS," PCS FILES" X$ WRITE SYS$OUTPUT AOTHER," A-OTHER FILES" X$ WRITE SYS$OUTPUT OTHER," OTHER FILES" X$ SET VERIFY X$ALOCWAIT MF TAPE_DRIVE X$ IF IBM .EQ. 0 THEN GOTO NOIBM X$! X$FINDTAPE UBBS_IBM X$MOUNT/BLOCK=32766/COMMENT="READ ONLY" TAPE_DRIVE 'TAPE' X$RDBACK/LOG TAPE_DRIVE:IBM.BCK DISK$TEMP:`5BUALR_BBS`5DIBM.BCK FILELIST.DAT X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DIBM.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$DISMOUNT TAPE_DRIVE X$! X$NOIBM: X$! X$IF PCS .EQ. 0 THEN GOTO NOPCS X$FINDTAPE/gen=99 UBBS_PCS X$MOUNT/BLOCK=32766/COMMENT="READ ONLY" TAPE_DRIVE 'TAPE' X$RDBACK/LOG TAPE_DRIVE:PCS.BCK DISK$TEMP:`5BUALR_BBS`5DPCS.BCK FILELIST.DAT X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DPCS.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$DISMOUNT TAPE_DRIVE X$! X$NOPCS: X$IF AOTHER .EQ. 0 THEN GOTO NOAOTHER X$FINDTAPE/gen=99 UBBS_AFILES X$MOUNT/BLOCK=32766/COMMENT="READ ONLY" TAPE_DRIVE 'TAPE' X$! X$RDBACK/LOG TAPE_DRIVE:AMI.BCK DISK$TEMP:`5BUALR_BBS`5DAMI.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:APP.BCK DISK$TEMP:`5BUALR_BBS`5DAPP.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:AST.BCK DISK$TEMP:`5BUALR_BBS`5DAST.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:ATA.BCK DISK$TEMP:`5BUALR_BBS`5DATA.BCK FILELIST.DAT X$! X$DISMOUNT TAPE_DRIVE X$! X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DAMI.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DAPP.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DAST.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DATA.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$! X$NOAOTHER: X$IF OTHER .EQ. 0 THEN GOTO NOOTHER X$FINDTAPE UBBS_FILES X$MOUNT/BLOCK=32766/COMMENT="READ ONLY" TAPE_DRIVE 'TAPE' X$! X$RDBACK/LOG TAPE_DRIVE:100.BCK DISK$TEMP:`5BUALR_BBS`5D100.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:128.BCK DISK$TEMP:`5BUALR_BBS`5D128.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:COM.BCK DISK$TEMP:`5BUALR_BBS`5DCOM.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:CPM.BCK DISK$TEMP:`5BUALR_BBS`5DCPM.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:MAC.BCK DISK$TEMP:`5BUALR_BBS`5DMAC.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:MIS.BCK DISK$TEMP:`5BUALR_BBS`5DMIS.BCK FILELIST.DAT X$RDBACK/LOG TAPE_DRIVE:TRS.BCK DISK$TEMP:`5BUALR_BBS`5DTRS.BCK FILELIST.DAT X$! X$DISMOUNT TAPE_DRIVE X$! X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5D100.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5D128.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DCOM.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DCPM.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DMAC.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DMIS.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$ ON ERROR THEN CONTINUE X$BACKUP DISK$TEMP:`5BUALR_BBS`5DTRS.BCK/SAVE_SET 'DISK'`5B*...`5D*.*;*/OWNER V=ORIG X$! X$NOOTHER: X$DEALLOCATE TAPE_DRIVE X$EXIT $ CALL UNPACK [.UTILITY]DAILY_RESTORE.COM;2 1700535198 $ create 'f' X`09program INIT_IDX Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - INIT_IDX Xc`09This routine will initialize the FILES.IDX file for a download area. Xc`09Dale Miller - UALR Xc Xc Xc`09Rev. 4.3 01-Aug-1986 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for' X`09integer istat X`09integer sys$gettim X X`09record/file_description/ fd X Xc`09Open the new indexed file. X`09open(unit=4,`09`09shared, X`091 file='files.idx', X`092 status='new',`09organization='indexed', X`093 access='keyed',`09form='unformatted', X`094 recl=192,`09`09recordtype='variable', X`095`09`09`09key=(1:18:character)) X X X`09fd.file_name='$Header' X`09istat=sys$gettim(fd.upload_date) X`09fd.upload_name=' ' X`09fd.upload_text=' ' X`09fd.keywords=' ' X`09write(4)fd X`09close(4) X`09end $ CALL UNPACK [.UTILITY]INIT_IDX.FOR;2 457599999 $ create 'f' X`09Program init_mess Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS utilities - Init_mess.for Xc`09This program initializes the message file for creating UBBS. Xc`09Dale Miller - UALR Xc`0914-Nov-1985 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09character*80 spaces/' '/ X`09integer i X`09include 'bbs_inc.for' X`09 X`09record/mail_header_structure/ mh X X`09open(unit=2,file='message.hed',status='new', X`091 organization='relative',access='direct', X`092 recordtype='fixed',recl=48) X X`09open(unit=3,file='message.dat',status='new',`09 X`091 organization='relative',access='direct', X`092 recordtype='fixed',recl=20) X Xc`09write the first record in the message header file X`09last_header=1 X`09last_data=0 X`09first_mnum=0 X`09last_mnum=0 X`09write(2,rec=1)last_header,last_data,first_mnum,last_mnum X Xc`09write the rest of the records X`09mh.mail_to=' ' X`09mh.mail_from=' ' X`09mh.mail_subject=' ' X`09mh.mail_date=' ' X`09mh.mail_time=' ' X`09mh.mail_section=0 X`09mh.mail_first=0 X`09mh.mail_last=0 X`09mh.mail_messnum=99999999 X`09mh.mail_private=.false. X`09mh.mail_read=.false. X`09mh.mail_deleted=.true. X`09mh.mail_person=.false. X`09mh.mail_reply_to=0 X`09do i=1,10 X`09 mh.mail_replys(i)=0 X`09 end do X X`09do i=2,1000 X`09 write(2,rec=i)mh X`09 end do X X`09do i=1,5000 X`09 write(3,rec=i)spaces X`09 end do X X`09print*,'The message files have been initialized.' X`09stop X`09end $ CALL UNPACK [.UTILITY]INIT_MESS.FOR;2 241912306 $ create 'f' X`09Program init_userlog Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09This program initializes the userlog. Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X`09character*40 zeros/'0000000000000000000000000000000000000000'/ X`09character*9 bull_date/'01-Jan-00'/ X`09integer*4 high_bull/0/ X`09integer*4 user_number/0/ X X`09open(unit=1,file='userlog.dat',status='new', X`091 organization='indexed',access='keyed', X`092 recordtype='fixed',recl=50,shared, X`093 key=(1:40:character)) X`09 X`09write(1)zeros,user_number,high_bull, X`091 bull_date X`09close(unit=1) X`09print*,'The USERLOG.DAT file has been initialized.' X`09stop X`09end $ CALL UNPACK [.UTILITY]INIT_USERLOG.FOR;2 492970626 $ create 'f' X$ mcr install Xubbs/delete Xubbs/open/shared/header/priv=(detach,world,oper,sysnam,prmmbx,altpri) X/exit X$ deassign/system UBBS_STATUS $ CALL UNPACK [.UTILITY]INSTBBS.COM;2 778393947 $ create 'f' X$ link/notrace/EXEC=BBS UBBS/INCLUDE=(BBS_MAIN)/LIBRARY X$ link/exec=sysop ubbs/include=(sysop)/library $ CALL UNPACK [.UTILITY]L.COM;2 2136229065 $ create 'f' X$ link/EXEC=BBS UBBS/INCLUDE=(BBS_MAIN)/LIBRARY X$ link/exec=sysop ubbs/include=(sysop)/library $ CALL UNPACK [.UTILITY]LT.COM;2 1879659445 $ create 'f' X*DOMILLER* * * T E @`5BUALR_BBS`5DSYSOP_REPLY.COM X*DOMILLER* * * T Q X* * * A F DOMILLER X* * * A Q $ CALL UNPACK [.UTILITY]MAIL.DELIVERY;3 1211850481 $ create 'f' Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09This program allows adding a message to UBBS from a file. Xc Xc`09Begun: 19-Jul-1985 Xc`09Dale Miller - University of Arkansas at Little Rock Xc`09Rev. 1.0 01-Jan-1988 Xc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for/nolist' X`09character last_name*20,first_name*20 X`09character zmail_from*30 X`09character zfirst_name*20,zlast_name*20,zmail_to*30,qmail_to*30 X`09character zmail_subject*30 X`09integer i,j,k,l,ii,jj,kk,ll X`09integer kmess,irec,krec,slen,num_flags X`09integer status,next_mess,fmess,lmess,mess,mnum X`09logical*1 busy X X`09external uopen X X`09record /userlog_structure/ zur X`09record /mail_header_structure/ mh X Xc X X 1001`09format(a) X 1002`09format(i1) 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', X`092 recordtype='fixed',recl=50,shared,useropen=uopen) X`09open(unit=2,file='ubbs_data:message.hed',status='old',`09 X`091 organization='relative',access='direct', X`092 recordtype='fixed',recl=48,shared,useropen=uopen) X`09open(unit=3,file='ubbs_data:message.dat',status='old',`09 X`091 organization='relative',access='direct', X`092 recordtype='fixed',recl=20,shared,useropen=uopen) X X Xc`09Read a message from MAIL_FILE, and add it to the message section. Xc`09The first line is the FROM: name. Xc`09The second line is the TO: name Xc`09The third line is the section number Xc`09The fourth line is the SUBJECT: line Xc`09Remaining lines are the message X`09open(unit=4,file='mail_file',status='old',carriagecontrol='none') X X`09read(4,1001)mail_name X`09read(4,1001)zmail_to X`09read(4,1002)mh.mail_section X`09read(4,1001)mh.mail_subject X X`09mh.mail_private=.true. X`09mh.mail_person=.true. X X X`09do i=1,20 X`09 read(4,1001,end=3090)message(i) X`09 ii=i X`09 end do X X X3090`09read(2,rec=1)last_header,last_data, X`091 first_mnum,last_mnum,busy X`09if(busy) then X`09 unlock(unit=2) X`09 call lib$wait(1.0) X`09 go to 3090 X`09 end if X X`09last_header=last_header+1 X`09last_mnum=last_mnum+1 X`09write(2,rec=1)last_header,last_data+ii, X`091 first_mnum,last_mnum,busy X`09call date(mh.mail_date) X`09call time(mh.mail_time) X`09mh.mail_read=.false. X`09mh.mail_deleted=.false. X`09mh.mail_to=zmail_to X`09mh.mail_reply_to=0 X`09do i=1,10 X`09 mh.mail_replys(i)=0 X`09 end do X`09mh.mail_first=last_data+1 X`09mh.mail_last=last_data+ii X`09mh.mail_from=mail_name X`09mh.mail_messnum=last_mnum X`09write(2,rec=last_header) mh X X`09do jj=1,ii X`09 write(3,rec=last_data+jj)message(jj) X`09 end do X X`09call str$upcase(zmail_to,zmail_to) X`09jj = index(zmail_to,' ') X`09zfirst_name=zmail_to(1:jj-1)`09 X`09zlast_name=zmail_to(jj+1:30) X`09zur.user_key=zlast_name//zfirst_name X`09 X`09read(1,key=zur.user_key)zur X`09zur.num_unread=zur.num_unread+1 X`09rewrite(1)zur X X`09close(unit=1) X`09close(unit=2) X`09close(unit=3) X`09close(unit=4) X`09call exit X`09end X $ CALL UNPACK [.UTILITY]MESSAGE.FOR;1 841550426 $ create 'f' X`09`09`09UBBS file approval/editor.`09`0901-Jan-1988 X---------------------------------------------------------------------------- V---- XEnter ABC.XYZ in response to filename to download in order to access approva Vl Xsection. Functions supported in file approval: X X`5BA`5Dpprove `5BD`5Delete `5BE`5Ddit `5BM`5Dove `5BR`5Dename `5BW` V5Drite e`5BX`5Dit <CR> X X1. Hit return to see the next file without altering the current one. X2. Use `5BE`5Ddit for changing information in file description header. X After editing a description, it must be `5BW`5Dritten. X3. To download an unapproved file, just download as usual. The files are th Vere, X although, they just don't show up in the general user's file listing unti Vl X approved. X4. To add a file to the listing, approve it then `5BW`5Drite it. X5. `5BR`5Dename changes the name of the file, `5BM`5Dove will move it to ano Vther X section but retain the file name. X---------------------------------------------------------------------------- V---- X XExample session: X XLast logon on 24-JUL-86 at 11:11:08 XYou have signed on 737 times. XThe last message you read was 110415 X Current last message is 110427 X You are user number 94404 X XThere are 6 bulletins today. Last bulletin was 23-Jul-1986 X11:19:44-05 Command (B,C,E,F,G,H,K,M,P,R,S,U,W,X,?)?F`0D X(D)ownload, (U)pload, (H)elp or (E)xit? `5Bexit`5D D`0D XArea? AMI`0D +-+-+-+-+-+-+-+- END OF PART 10 +-+-+-+-+-+-+-+-