🚀 go-pugleaf

Submitted-by: munroe@dmc.com (Dick Munroe)
Posting-number: Volume 3, Issue 110
Archive-name: ubbs/part02
-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X 3010`09zlast_name=qmail_to(ii:30)
X`09zur.user_key=zlast_name//zfirst_name
X`09read(1,key=zur.user_key,iostat=ios)zur
X`09unlock(unit=1)
X`09if(ios.ne.0) mh.mail_person=.false.`09`09!Error on read
X 3030`09write(6,1001)crlf(:cl)//'      Subject: '
X`09dummy=20
X`09call get_uplow_string(mh.mail_subject,dummy)
X`09if(dummy.eq.0) then
X`09    write(6,1001)crlf(:cl)//'Message send aborted'//bell
X`09    go to 200
X`09    end if
X`09if(.not.mh.mail_person) then
X 3031`09    istat=sys$gettim(rdummy)
X`09    if(arklug) then
X`09`09call addquad(rdummy,day_14,right_now)
X`09    else
X`09`09call addquad(rdummy,day_1,right_now)
X`09    end if
X`09    istat=sys$asctim(,dummy_20,right_now,)
X`09    mh.mail_private=.false.
X`09    write(6,1001)crlf(:cl)//
X`091`09'What is the expiration date for this message? `5B'//
X`092`09dummy_20(:11)//'`5D'
X`09    dummy=11
X`09    call get_uplow_string(line,dummy)
X`09    istat=str$upcase(line,line)
X`09    if(dummy.eq.0) then
X`09`09mh.mail_expire=right_now
X`09    else
X`09`09istat=sys$bintim(line(:11)//' 00:00:00',mh.mail_expire)
X`09    end if
X`09    dummy=compquad(mh.mail_expire,right_now)
X`09    if(dummy.eq.-1) then
X`09`09write(6,1001)crlf(:cl)//
X`091`09    'That is not a valid date.  Dates must be of the'//
X`092`09    crlf(:cl)//'form dd-mmm-yyyy (e.g. 01-Jan-1986)'
X`09`09go to 3031
X`09    end if
X`09    call addquad(right_now,day_31,rdummy)
X`09    dummy=compquad(rdummy,mh.mail_expire)
X`09    if(dummy.eq.-1) then
X`09`09write(6,1001)crlf(:cl)//
X`091`09    'Your expiration date may be no more than 1 month in'//
X`092`09    crlf(:cl)//'the future.  Please try again'
X`09`09go to 3031
X`09    end if
X`09    istat=sys$asctim(,line,mh.mail_expire,)
X`09else
X`09    mh.mail_private=.false.
X`09    write(6,1001)crlf(:cl)//'Is this a private message? `5Bno`5D'
X`09    dummy=3
X`09    call get_upcase_string(yesno,dummy)
X`09    if(yesno(1:1).eq.'Y') mh.mail_private=.true.
X`09end if
X`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   'Your message is to: '//zmail_to(1:namln)
X`09write(6,1001)crlf(:cl)//'The subject is:     '//mh.mail_subject
X`09if(mh.mail_private) then
X`09    write(6,1001)crlf(:cl)//'** Private message **'
X`09else if(mh.mail_person) then
X`09    write(6,1001)crlf(:cl)//'Non-private message'
X`09else
X`09    write(6,1001)crlf(:cl)//'Expiration: '//line(:11)
X`09end if
X`09write(6,1001)crlf(:cl)//'Is this correct? `5BYes`5D'
X`09dummy=3
X`09call get_upcase_string(yesno,dummy)
X`09if(dummy.gt.0.and.yesno(1:1).ne.'Y') go to 3000
X`09ii=20
X`09call enter_message(ii,*0200,0)
X
X 3080`09write(6,1001)crlf(:cl)//'Section number? `5Blist`5D'
X`09dummy=1
X`09dummyl=.false.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) then
X`09    do kk=0,7
X`09`09call ctrl_o_check(*3080,*3080)
X`09`09write(6,1020)crlf(:cl),kk,secnam(kk+1)
X`09`09end do
X`09    go to 3080
X`09    end if
X`09read(string,1011)sect
X`09if(sect.gt.7) then
X`09    write(6,1001)crlf(:cl)//'Invalid section number'
X`09    go to 3080
X`09    end if
X`09mh.mail_section=sect
X`09mh.mail_to=zmail_to
X`09call modify_mail_info(mh,*0200)
X
X3090`09read(2,rec=1,iostat=ios,err=90600)last_header,last_data,
X`091   first_mnum,last_mnum,busy
X`09if(busy) then
X`09    unlock(unit=2)
X`09    dummy=lib$wait(1.0)
X`09    go to 3090
X`09    end if
X`09last_header=last_header+1
X`09last_mnum=last_mnum+1
X`09write(2,rec=1,iostat=ios,err=90600)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,iostat=ios,err=90600) mh
X
X`09do jj=1,ii
X`09    write(3,rec=last_data+jj)message(jj)
X`09    end do
X`09call comint(last_mnum,lms)
X`09if(sect.ge.0) write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   ' Message number '//lms//' sent.'//bell//bell
X
X`09if(.not.mh.mail_person) go to 200`09`09!cannot flag mailbox
X`09read(1,key=zur.user_key,iostat=ios,err=90500)zur
X`09zur.num_unread=zur.num_unread+1
X`09rewrite(1,iostat=ios,err=90500)zur
X`09unlock(unit=1)
X`09unlock(unit=2)
X`09unlock(unit=3)
X`09go to 200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X 4000`09continue`09`09!File transfer
X`09area='file transfer'
X`09call add_elapsed_time(*91000)
X`09read(1,key=ur.user_key,iostat=ios,err=90500)ur
X`09ur.seconds_today = current_units
X`09rewrite(1,iostat=ios,err=90500)ur
X`20
X`09if(arklug) then
X`09    call arklug_files_section
X`09else
X`09    call ubbs_files_section
X`09end if
X
Xc`09Turn the timer back on.
X
X 4900`09continue
X`09call init_timer(user_timer)
X`09initial_units=ur.seconds_today
X`09go to 0200
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X 5000`09continue`09`09!Goodbye
X`09area='goodbye'
X`09read(1,key=ur.user_key,iostat=ios,err=90500)ur
X`09ur.seconds_today = current_units
X`09rewrite(1,iostat=ios,err=90500)ur
X`09call type_file('ubbs_data:signoff.txt')
X`09go to 99990
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X 6000`09continue`09`09!Help
X`09area='help'
X`09controlc_typed = .false.
X`09istat=lbr$output_help(bbs_put_output,,'bbs_help'
X`091   ,'ubbs_data:helplib',,bbs_get_input)
X`09go to 0200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X 8000`09continue`09`09!Modify user info
X`09area='modify'
X`09read(1,key=ur.user_key,iostat=ios,err=90500)ur
X`09unlock(unit=1)
X`09istat=str$trim(ur.city,ur.city,dummy1)
X`09istat=str$trim(ur.computer,ur.computer,dummy2)
X`09call out(ffeed(:fl)//'You are calling from '//ur.city(1:dummy1)
X`091    //', '//ur.state,*8050)
X`09call out('And you use a '//ur.computer(1:dummy2),*8050)
X`09call out(crlf(:cl)//'You are currently set to read sections:',*8050)
X`09kk=0
X`09do ii=0,7
X`09    dummyb=0
X`09    dummyb=dummyb.or.(2**ii)
X`09    if((dummyb.and.ur.auth_sections).ne.0) then
X`09`09kk=kk+1
X`09`09idummy(kk)=ii
X`09`09end if
X`09    end do
X`09if (kk.eq.0) then
X`09    call out('None!!',*8050)
X`09else
X`09    write(6,1021)crlf(:cl),(idummy(ll),ll=1,kk)
X`09    call ctrl_o_check(*8050,*8050)
X`09end if
X`09dummy1=cl
X`09call make_readable(ur.user_crlf,dummy1,dummy_20)
X`09call out('Your end-of-line sequence is:'//dummy_20(1:dummy1),*8050)
X`09dummy1=fl
X`09call make_readable(ur.user_ff,dummy1,dummy_20)
X`09call out('Your clear-screen sequence is:'//dummy_20(1:dummy1),*8050)
X`09istat=sys$asctim(,dummy_20,%ref(ur.last_pass_chg),)`09
X`09call out('Your password was last changed on '//
X`091   dummy_20(1:11)//' at '//dummy_20(13:20),*8050)
X`09if ((ur.editor.and.1).eq.1) then
X`09    call out('Your default editor is EDT.',*8050)
X`09else
X`09    call out('Your default is line editing.',*8050)
X`09endif
X`09if((ur.editor.and.7).eq.7) then
X`09    call out('You are set up as a VT100 terminal')
X`09else if((ur.editor.and.7).eq.3) then
X`09    call out('You are set up as a VT52 terminal')
X`09end if
X
X8050`09continue`09!modification menu
X`09call out(crlf(:cl),*8051)
X`09call out('You may change any of the following information',*8051)
X`09call out('(C)ity, state and computer type',*8051)
X`09call out('(E)xit (no more changes)',*8051)
X`09call out('(H)elp',*8051)
X`09call out('(M)essage sections',*8051)
X`09call out('(P)assword',*8051)
X`09call out('(T)erminal and editing characteristics',*8051)
X 8051`09call out(crlf(:cl)//'Item `5BE`5D?',*8051)
X`09dummy=1
X`09call get_upcase_string(cdummy,dummy)
X`09if(dummy.eq.0.or.cdummy.eq.'E') go to 8900
X`09if(cdummy.eq.'C') go to 8100
X`09if(cdummy.eq.'H') go to 8200
X`09if(cdummy.eq.'M') go to 8300
X`09if(cdummy.eq.'P') go to 8400
X`09if(cdummy.eq.'T') go to 8500
X`09write(6,1001)crlf(:cl)//'That is not a valid command'
X`09write(6,1001)crlf(:cl)//'Please try again.'//bell
X`09go to 8050
X
X 8100`09write(6,1001)crlf(:cl)//' The city you are calling from is? `5B'//
X`091    ur.city(1:dummy1)//'`5D '
X`09ctlen=20
X`09call get_uplow_string(zur.city,ctlen)
X`09if(ctlen.eq.0) go to 8110
X`09if(zur.city.eq.' ') go to 8100
X`09ur.city=zur.city
X 8110`09write(6,1001)crlf(:cl)//'The state you are calling from is? `5B'//
X`091   ur.state//'`5D '
X`09dummy=2
X`09call get_upcase_string(zur.state,dummy)
X`09if(dummy.eq.0) go to 8120
X`09if(zur.state.eq.' ') go to 8110
X`09ur.state=zur.state
X 8120`09write(6,1001)crlf(:cl)//'What type of computer do you use? `5B'//
X`091    ur.computer(1:dummy2)//'`5D '
X`09dummy=20
X`09call get_uplow_string(zur.computer,dummy)
X`09if(dummy.eq.0) go to 8130
X`09if(zur.computer.eq.' ') go to 8120
X`09ur.computer=zur.computer
X 8130`09continue
X`09istat=str$trim(ur.city,ur.city,dummy1)
X`09istat=str$trim(ur.computer,ur.computer,dummy2)
X`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   'You are calling from ',ur.city(1:dummy1)//', '//ur.state
X`09write(6,1001)crlf(:cl)//'And you use a '//ur.computer(1:dummy2)
X`09write(6,1001)crlf(:cl)//'Is this correct? `5BYes`5D'
X`09dummy=3
X`09call get_upcase_string(yesno,dummy)
X`09if(yesno(1:1).eq.'N') go to 8100
X`09go to 8050
X
X 8200`09continue`09! Help with options
X`09controlc_typed = .false.
X`09istat=lbr$output_help(bbs_put_output,,
X`091   'bbs_help modify','ubbs_data:helplib',,bbs_get_input)
X`09go to 8050
X
X 8300`09continue`09! choose message sections
X`09write(6,1001)crlf(:cl)//'The message sections available are:'
X`09do ii=0,7
X`09    write(6,1020)crlf(:cl),ii,secnam(ii+1)
X`09    end do
X`09write(6,1001)crlf(:cl)//crlf(:cl)
X 8350`09write(6,1001)crlf(:cl)//'Enter the sections you wish to read as a'
X`09write(6,1001)crlf(:cl)//'comma-seperated list, ALL for all sections'
X`09write(6,1001)crlf(:cl)//'or a carriage return for no change.'
X`09write(6,1001)crlf(:cl)//'?'
X`09slen=20
X`09call get_uplow_string(string,slen)
X`09istat=str$upcase(string,string)
X`09if(slen.eq.0) then
X`09    write(6,1001)crlf(:cl)//'No section change made.'
X`09    go to 8050
X`09    end if
X`09if(string.eq.'ALL') then
X`09    ur.auth_sections=255
X`09    write(6,1001)crlf(:cl)//'Set to read all sections.'
X`09    go to 8050
X`09    end if
X`09do ii=1,slen
X`09    i=ichar(string(ii:ii))
X`09    if((i.lt.48.or.i.gt.55).and.i.ne.44) then
X`09`09write(6,1001)crlf(:cl)//'Invalid list, try again.'
X`09`09go to 8350
X`09`09end if
X`09    end do
X`09ur.auth_sections=0
X`09do while(string.ne.' ')
X`09    dummy=index(string,',')-1
X`09    if(dummy.le.0) dummy=slen
X`09    read(string,1011)ii
X`09    dummyb=2**ii
X`09    ur.auth_sections=ur.auth_sections.or.dummyb
X`09    string(1:dummy+1)=' '
X`09    end do
X`09go to 8050
X
X 8400`09continue`09!Change password
X`09write(6,1001)crlf(:cl)//'Enter your old password..'
X`09dummy=10
X`09call get_password(inp_password,dummy)
X`09if(inp_password.ne.ur.password) then
X`09    write(6,1001)crlf(:cl)//'No match.  Password not changed.'
X`09else
X 8401`09    write(6,1001)crlf(:cl)//'Enter your new password..'
X`09    dummy=10
X`09    call get_password(inp_password,dummy)
X`09    if(dummy.lt.4) then
X`09`09write(6,1001)crlf(:cl)//
X`091`09    'That is too short.  Your password must be'//
X`092`09    crlf(:cl)//'at least 4 characters.'
X`09`09go to 8401
X`09    end if
X`09    write(6,1001)crlf(:cl)//'Enter it again...........'
X`09    dummy=10
X`09    call get_password(zur.password,dummy)
X`09    if(zur.password.ne.inp_password) then
X`09`09write(6,1001)crlf(:cl)//'No match.  Password not changed.'
X`09    else if(zur.password.eq.ur.password) then
X`09`09write(6,1001)crlf(:cl)//'Password not changed.'
X`09    else
X`09`09ur.password=inp_password
X`09`09istat=sys$gettim(%ref(ur.last_pass_chg))
X`09    end if
X`09end if
X`09go to 8050
X`09
X 8500`09continue`09!Terminal options
X`09dummy1=cl
X`09call make_readable(ur.user_crlf,dummy1,dummy_20)
X`09write(6,1001)crlf(:cl)//
X`091   ' Your end-of-line sequence is:'//dummy_20(1:dummy1)
X`09dummy1=fl
X`09call make_readable(ur.user_ff,dummy1,dummy_20)
X`09write(6,1001)crlf(:cl)//
X`091   'Your clear-screen sequence is:'//dummy_20(1:dummy1)
X`09write(6,1001)crlf(:cl)//
X`091   'Do you wish to change your end-of-line sequence? `5BNo`5D'
X`09dummy=3
X`09call get_upcase_string(yesno,dummy)
X`09if(yesno(1:1).ne.'Y') go to 8550
X`09write(6,1001)crlf(:cl)//'Available end of line sequences are:'
X`09write(6,1001)crlf(:cl)//crlf(:cl)//'(0)  No change'
X`09write(6,1001)crlf(:cl)//'(1)  Carriage return / line feed'
X`09write(6,1001)crlf(:cl)//'(2)  Carriage return only'
X`09write(6,1001)crlf(:cl)//'(3)  Line feed only'
X`09write(6,1001)crlf(:cl)//crlf(:cl)//
X`091   'Please choose one of the above.  If you need'
X`09call out('a different sequence, please contact the operator.',*8050)
X`09write(6,1001)crlf(:cl)//'Your choice? `5B0`5D'
X`09dummy=1
X`09dummyl=.false.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) go to 8500
X`09read(string,1011)number
X`09if(number.eq.0) then
X`09    go to 8550
X`09else if(number.eq.1) then
X`09    ur.user_crlf=char(13)//char(10)//char(255)
X`09    cl=2
X`09else if(number.eq.2) then
X`09    ur.user_crlf=char(13)//char(255)
X`09    cl=1
X`09else if(number.eq.3) then
X`09    ur.user_crlf=char(10)//char(255)
X`09    cl=1
X`09else
X`09    write(6,1001)crlf(:cl)//bell//
X`091`09'Invalid choice.  Please try again'
X`09    go to 8500
X`09end if
X`09crlf=ur.user_crlf
X
X 8550`09write(6,1001)crlf(:cl)//
X`091   'Do you wish to change your clear-screen sequence? `5BNo`5D'
X`09dummy=3
X`09call get_upcase_string(yesno,dummy)
X`09if(yesno(1:1).ne.'Y') go to 8580
X`09write(6,1001)crlf(:cl)//'Your clear-screen sequence may be 1 to 4'
X`09write(6,1001)crlf(:cl)//'characters.  You will be prompted to enter'
X`09write(6,1001)crlf(:cl)//'each character in decimal.  When you have'
X`09write(6,1001)crlf(:cl)//'entered all characters, just enter <return>.'
X`09dummy1=0
X`09do i=1,4
X 8560`09    write(6,1013)crlf(:cl)//'Character',i
X`09    dummy=3
X`09    dummyl=.false.
X`09    call get_number(string,dummy,dummyl)
X`09    if(dummy.eq.0) then
X`09`09go to 8570
X`09`09end if
X`09    read(string,1011)number
X`09    if(number.le.127) then
X`09`09dummy_20(i:i)=char(number)
X`09`09dummy1=dummy1+1
X`09    else
X`09`09write(6,1001)crlf(:cl)//
X`091`09    'Characters must be less than 128 decimal'
X`09`09go to 8560
X`09    end if
X`09    end do
X 8570`09if(dummy1.eq.0) then
X`09    write(6,1001)crlf(:cl)//'Clear-screen not changed'
X`09else
X`09    ur.user_ff=dummy_20(1:dummy1)//char(255)
X`09    ffeed=ur.user_ff
X`09    fl=dummy1
X`09end if
X`09go to 8050
X
X 8580`09continue`09`09! Change terminal and editor
X`09write(6,1001)crlf(:cl)//
X`091   'Do you wish to change your default editor? `5BNo`5D'
X`09dummy=3
X`09call get_upcase_string(yesno,dummy)
X`09if(yesno(1:1).ne.'Y') go to 8050
X`09write(6,1001)crlf(:cl)//
X`091   'Please enter "E" for EDT or "L" for line mode editing'
X`09dummy=1
X`09call get_upcase_string(cdummy,dummy)
X`09if(cdummy.eq.'E') then
X`09    ur.editor=(ur.editor.and.6)+1
X`09    go to 8585
X`09else if(cdummy.eq.'L') then
X`09    ur.editor=0
X`09    go to 8050
X`09else
X`09    write(6,1001)crlf(:cl)//'Invalid response.'//
X`091`09'  Please choose E or L.'
X`09    go to 8580
X`09end if
X 8585`09write(6,1001)crlf(:cl)//
X`091   'To be able to use the screen editing features of EDT,'//
X`092   ' you must be able'
X`09write(6,1001)crlf(:cl)//
X`091   'to emulate a VT52 or VT100 terminal.  Please enter "1" for'
X`09write(6,1001)crlf(:cl)//
X`091   'VT52, "2" for VT100, or "0" for no terminal emulation'
X`09dummy=1
X`09dummyl=.false.
X`09call get_number(cdummy,dummy,dummyl)
X`09if(cdummy.eq.'0') then
X`09    ur.editor=(ur.editor.and.1)
X`09    go to 8050
X`09else if(cdummy.eq.'1') then
X`09    ur.editor=(ur.editor.or.2)
X`09    go to 8050
X`09else if(cdummy.eq.'2') then
X`09    ur.editor=(ur.editor.or.6)
X`09else
X`09    write(6,1001)crlf(:cl)//'Invalid response.'//
X`091`09'  Please choose 0, 1, or 2.'
X`09    go to 8585
X`09end if
X
X 8900`09continue`09!Re-write his userlog record
X`09write(6,1001)crlf(:cl)//'Changes are now complete.'
X`09read(1,key=ur.user_key,iostat=ios,err=90500)zur
X`09rewrite(1,iostat=ios,err=90500)ur
X`09go to 0200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X9000`09continue`09`09!Private message to operator
X`09area='private'
X`09do ii=1,20`09`09! Blank out the message so the send will work
X`09    message(ii)=' '
X`09    end do
X`09ii=20
X`09call enter_message(ii,*0200,0)
X`09ii=ii+1
X`09message(ii) = ' ('//ur.phone_number(1:3)//
X`091   ') '//ur.phone_number(4:6)//'-'//ur.phone_number(7:10)//
X`092   ' '//ur.city//','//ur.state
X`09
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xc`09The following code will work on a DECNET site, but NOT on non-networked
Xc`09systems.  It is slightly more efficient that the lib$spawn
X
X`09istat=netmail(nodename,
X`091   'bbs%"'//mail_name//'"',
X`092   'SYSOP',
X`093   'BBS Sysop',
X`094   'Comment',
X`095   message)
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
Xc`09The following code will work on any VAX, but is not as nice as the
Xc`09DECNET code, and does not allow fudging the return address.
Xc
Xc`09Format a message and send to the operator.
Xc`09open(unit=4,file='mail.tmp',status='new',
Xc`091    carriagecontrol='list')
Xc`09write(4,1001)'From:'//mail_name//' ('//ur.phone_number(1:3)//
Xc`091   ') '//ur.phone_number(4:6)//'-'//ur.phone_number(7:10)//
Xc`092   ' '//ur.city//','//ur.state
Xc`09write(4,1001)' '
Xc`09do jj=1,ii
Xc`09    write(4,1001)message(jj)
Xc`09    end do
Xc `09close(unit=4)
Xc
Xc`09istat = lib$spawn('mail/subject="Comment" mail.tmp ubbs_sysop_mail')
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vcccc
X
Xc`09Also put it in mail section for ease of reply
X`09zmail_to='Sysop'
X`09mh.mail_subject='Comment'
X`09mh.mail_private=.true.
X`09mh.mail_section=0
X`09mh.mail_person=.false.
X`09istat=sys$bintim('31-DEC-2001 00:00:00',mh.mail_expire)
X`09sect=-1
X`09write(6,1001)crlf(:cl)//'Message sent.  Thank you.'
X`09go to 3090
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X10000`09continue`09`09!Retrieve message
X`09area='retrieve'
X`09if (.not.approved_mail_read) then
X`09    write(6,1001)crlf(:cl)//bell//
X`091`09'You are not yet approved to read messages.'
X`09    write(6,1001)crlf(:cl)//'Sorry.'
X`09    go to 0200
X`09    end if
X
X`09call time(ctime)
X`09call add_elapsed_time(*91000)
X`09write(cminutes,1002)current_units/60
X`09read(2,rec=1,iostat=ios,err=90600)last_header, last_data,
X`091   first_mnum,last_mnum
X`09unlock (unit=2)
X`09call comint(first_mnum,clms)
X`09call comint(last_mnum,lms)
X10001`09write(6,1001)crlf(:cl)//'The message file contains messages'//
X`091   clms//' through'//lms
X`09if((.not.ur.xpert).or.reprint) then
X`09    reprint=.false.
X`09    call out(crlf(:cl)//'    Retrieve Menu',*10010)
X`09    call out('(F)lagged        (I)ndividual',*10010)
X`09    call out('(M)arked         (N)ew',*10010)
X`09    call out('(R)ange          (T)hread',*10010)
X`09    call out('(E)xit to main menu',*10010)
X10010`09    write(6,1001)crlf(:cl)//ctime//'-'//cminutes//' Command? '
X`09else
X`09    write(6,1001)crlf(:cl)//ctime//'-'//
X`091`09cminutes//' Command (E,F,I,M,N,R,T,?)? '
X`09end if
X`09dummy=1
X`09call get_uplow_string(cdummy,dummy)
X`09istat=str$upcase(cdummy,cdummy)
X`09if(cdummy.eq.'E') then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if(cdummy.eq.'F') go to 10100
X`09if(cdummy.eq.'I') go to 10200
X`09if(cdummy.eq.'M') go to 10300
X`09if(cdummy.eq.'N') go to 10400
X`09if(cdummy.eq.'R') go to 10500
X`09if(cdummy.eq.'T') go to 10600
X`09if(cdummy.eq.'?') then
X`09    reprint=.true.
X`09    go to 10001
X`09    end if
X
X`09write(6,1001)crlf(:cl)//bell//
X`091   'That is not a valid retrieve command.'
X`09go to 10001
X
X10100`09continue`09`09!Read flagged
X`09area='flagged'
X`09if(num_flags.eq.0) then
X`09    write(6,1001)crlf(:cl)//'No messages flagged.'
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09nostop=.false.
X`09irec=1
X`09do ii=1,num_flags
X`09    call read_mail(flags(ii),irec,status,nostop,next_mess)
X`09    if(status.eq.1) go to 90500
X`09    if(status.eq.2) go to 90600
X`09    if(status.eq.3) go to 10000
X`09    end do
X`09go to 10000
X
X10200`09continue`09`09!Read individual
X`09area='individual'
X`09nostop=.false.
X`09write(6,1001)crlf(:cl)//'Message number? `5Bexit`5D'
X`09dummy=7
X`09dummyl=.false.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) go to 10000
X`09read(string,1011)mess
X`09if(mess.lt.first_mnum.or.mess.gt.last_mnum) then
X`09    write(6,1001)crlf(:cl)//'Message number out of range.'
X`09    go to 10200
X`09    end if
X`09irec=1
X`09call read_mail(mess,irec,status,nostop,next_mess)
X`09if(status.eq.1) go to 90500
X`09if(status.eq.2) go to 90600
X`09go to 10200
X
X`09   `20
X10300`09continue`09`09!Read marked
X`09area='marked'
X`09nostop=.false.
X`09do krec=2,last_header
X10310`09read(2,rec=krec,iostat=ios,err=90600) mh
X`09    unlock(unit=2)
X`09    if (.not.mh.mail_read.and..not.mh.mail_deleted
X`091`09.and.mh.mail_person) then
X`09`09istat=str$upcase(qmail_to,mh.mail_to)
X`09`09if(mail_name.eq.qmail_to) then
X`09`09    irec=krec-1
X`09`09    call read_mail(mh.mail_messnum,irec,status,
X`091`09`09nostop,next_mess)
X`09`09    if(status.eq.1) go to 90500
X`09`09    if(status.eq.2) go to 90600
X`09`09    if(status.eq.3) go to 10000`09!User flagged exit
X`09`09    end if
X`09`09end if
X`09    end do
X`09go to 10000
X
X10400`09continue`09`09!Read new
X`09area='new'
X`09nostop=.false.
X`09fmess=ur.last_message+1`09`09!the next message
X`09lmess=last_mnum
X`09go to 10505
X
X
X10500`09continue`09`09!Read range
X`09area='range'
X`09nostop=.false.
X`09write(6,1001)crlf(:cl)//'Starting message number? `5Bexit`5D'
X`09dummy=7
X`09dummyl=.true.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if(string.eq.'*') then
X`09    fmess=ur.last_message+1
X`09else
X`09    read(string,1011)fmess
X`09end if
X`09write(6,1001)crlf(:cl)//'Ending message number? `5Bexit`5D'
X`09dummy=7
X`09dummyl=.true.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if(string.eq.'*') then
X`09    lmess=last_mnum
X`09else
X`09    read(string,1011)lmess
X`09end if
X10505`09if(fmess.lt.first_mnum) fmess=first_mnum
X`09if(lmess.gt.last_mnum) lmess=last_mnum
X`09irec=1
X`09mess=fmess
X`09do while(mess.le.lmess)
X`09    call read_mail(mess,irec,status,nostop,next_mess)
X`09    if(status.eq.1) go to 90500
X`09    if(status.eq.2) go to 90600
X`09    if(status.eq.3) go to 10000
X`09    if((status.eq.0).and.(next_mess.ne.0)) then
X`09`09mess=next_mess
X`09    else
X`09`09mess=mess+1
X`09    end if
X`09    end do
X`09go to 10000
X
X
X10600`09continue`09`09!Read thread
X`09area='thread'
X`09write(6,1001)crlf(:cl)//'Starting message number? `5Bexit`5D'
X`09dummy=7
X`09dummyl=.true.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0) then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if(string.eq.'*') then
X`09    fmess=ur.last_message+1
X`09else
X`09    read(string,1011)fmess
X`09end if
X`09found=.false.
Xc`09get within 20 of the first message
X`09i=2
X`09do while (.not.found)
X10610`09read(2,rec=i,iostat=ios,err=90600) mh
X`09    unlock(unit=2)
X`09    if(mh.mail_messnum.ge.fmess) found=.true.
X`09    i=i+20
X`09    end do
X`09i=i-40
X`09if(i.lt.2) i=2
X
X`09stack_ptr=0
X`09do l=i,last_header
X`09    have_read(l)=.false.
X`09    end do
X
X`09do l=i,last_header
X`09read(2,rec=l,iostat=ios,err=90600) mh
X`09    unlock(unit=2)
X
X`09    if(mh.mail_messnum.lt.fmess) go to 10680
X`09    if(have_read(l)) go to 10680
X
X`09    mnum=mh.mail_messnum
X`09    if(mh.mail_messnum.gt.last_mnum) go to 10000
X10650`09    irec=l
X`09    call read_mail(mnum,irec,status,nostop,next_mess)
X`09    if(status.eq.1) go to 90500
X`09    if(status.eq.2) go to 90600
X`09    if(status.eq.3) go to 10000
X
X`09    if(status.eq.0) go to 10680
X`09read(2,rec=irec,iostat=ios,err=90600) mh
X`09    unlock(unit=2)
X
X`09    have_read(irec)=.true.
X`09    do ll=10,1,-1
X`09`09if(mh.mail_replys(ll).ne.0) then
X`09`09    if(stack_ptr.ge.200) go to 10680
X`09`09    stack_ptr=stack_ptr+1
X`09`09    stack(stack_ptr)=mh.mail_replys(ll)
X`09`09    end if
X`09`09end do
X10680`09    if(stack_ptr.gt.0) then
X`09`09mnum=stack(stack_ptr)
X`09`09stack_ptr=stack_ptr-1
X`09`09go to 10650
X`09`09end if
X`09    end do
X`09go to 10000
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X11000`09continue`09`09!Scan messages
X`09area='scan'
X`09if (.not.approved_mail_read) then
X`09    write(6,1001)crlf(:cl)//bell//
X`091`09'You are not yet approved to read messages.'
X`09    write(6,1001)crlf(:cl)//'Sorry.'
X`09    go to 0200
X`09    end if
X
X`09read_deleted = .false.
X`09if(sysop) then
X`09    write(6,1001)crlf(:cl)//'Process deleted messages? `5BNo`5D'
X`09    dummy=1
X`09    call get_upcase_string(cdummy,dummy)
X`09    if(cdummy.eq.'Y') then
X`09`09read_deleted = .true.
X`09`09end if
X`09    end if
X`09
X`09num_flags=0
X`09read(2,rec=1,iostat=ios,err=90600)last_header, last_data,
X`091   first_mnum,last_mnum
X`09unlock (unit=2)
X`09call comint(first_mnum,clms)
X`09call comint(last_mnum,lms)
X`09write(6,1001)crlf(:cl)//'The message file contains messages'//
X`091   clms//' through'//lms
X`09fmess=first_mnum
X`09lmess=last_mnum
X`09call out(crlf(:cl)//'        Scan menu',*11010)
X`09call out(crlf(:cl)//'(L)ist range of messages',*11010)
X`09call out('(F) search on From: field',*11010)
X`09call out('(T) search on To: field',*11010)
X`09call out('(S) search on Subject: field',*11010)
X
X11010`09write(6,1001)crlf(:cl)//'Command `5Bexit`5D?'
X`09dummy=1
X`09call get_upcase_string(cdummy,dummy)
X`09if(dummy.eq.0)  then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if (cdummy.eq.'L') go to 11100
X`09if (cdummy.eq.'F') go to 11200
X`09if (cdummy.eq.'T') go to 11300
X`09if (cdummy.eq.'S') go to 11400
X`09write(6,1001)crlf(:cl)//bell//'That was not a valid scan command'
X`09go to 11000
X
X11100`09continue`09`09!List messages
X`09write(6,1001)crlf(:cl)//'Starting message number? `5Bexit`5D'
X`09dummy=7
X`09dummyl=.true.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0)  then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if(string.eq.'*') then
X`09    fmess=ur.last_message+1
X`09else
X`09    read(string,1011)fmess
X`09end if
X`09write(6,1001)crlf(:cl)//'Ending message number? `5Bexit`5D'
X`09dummy=7
X`09dummyl=.true.
X`09call get_number(string,dummy,dummyl)
X`09if(dummy.eq.0)  then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09if(string.eq.'*') then
X`09    lmess=last_mnum
X`09else
X`09    read(string,1011)lmess
X`09end if
X`09if(fmess.lt.first_mnum) fmess=first_mnum
X`09if(lmess.gt.last_mnum) lmess=last_mnum
X`09irec=1
X`09do krec=2,last_header
X`09    read(2,rec=krec,iostat=ios,err=90600) mh
X`09    unlock(unit=2)
X`09    if(mh.mail_messnum.lt.fmess) goto 11190
X`09    if(mh.mail_messnum.gt.lmess) goto 11900
X`09    if(mh.mail_deleted.and..not.read_deleted) goto 11190
X`09    istat=str$upcase(zmail_to,mh.mail_to)
X`09    if(mh.mail_private.and..not.((zmail_to.eq.mail_name).or.
X`091`09(mh.mail_from.eq.mail_name).or.sysop)) go to 11190
X`09    if(mh.mail_read) then
X`09`09istat=str$trim(mh.mail_to,mh.mail_to,length)
X`09`09mh.mail_to=mh.mail_to(1:length)//' (X)'
X`09`09end if
X`09    write(6,1022)crlf(:cl),mh.mail_section,mh.mail_messnum,
X`091`09mh.mail_from,mh.mail_to,mh.mail_subject
X11120`09    write(6,1001)crlf(:cl)//'Command? (C,E,F,K,?) `5BC`5D'
X`09    dummy=1
X`09    call get_uplow_string(cdummy,dummy)
X`09    istat=str$upcase(cdummy,cdummy)
X`09    if(dummy.eq.0.or.cdummy.eq.'C') go to 11190
X`09    if(cdummy.eq.'?') then
X`09`09write(6,1001)crlf(:cl)//'(C)ontinue'
X`09`09write(6,1001)crlf(:cl)//'(E)xit'
X`09`09write(6,1001)crlf(:cl)//'(F)lag'
X`09`09write(6,1001)crlf(:cl)//'(K)ill'
X`09`09go to 11120
X`09`09end if
X`09    if(cdummy.eq.'F') then
X`09`09num_flags=num_flags+1
X`09`09flags(num_flags)=mh.mail_messnum
X`09`09if(num_flags.eq.100) then
X`09`09    write(6,1001)crlf(:cl)//'You have set 100 flags.'
X`09`09    write(6,1001)crlf(:cl)//'You must read these before'
X`09`09    write(6,1001)crlf(:cl)//'flagging any more.'
X`09`09    unlock(unit=2)
X`09`09    unlock(unit=3)
X`09`09    go to 0200
X`09`09    end if
X`09`09go to 11190
X`09`09end if
X`09    if(cdummy.eq.'E') go to 11900
X`09    if(cdummy.eq.'K') then
X`09`09call kill_mess(krec,status)
X`09`09if(status.eq.1) go to 90500
X`09`09if(status.eq.2) go to 90600
X`09`09go to 11190
X`09`09end if
X`09    write(6,1001)crlf(:cl)//'That was not a valid command.'
X`09    go to 11120
X
X11190`09    end do
X`09go to 11900
X
X
X11200`09continue`09`09!Scan on from field
X`09field=1
X`09go to 11500
X
X11300`09continue`09`09!Scan on to field
X`09field=2
X`09go to 11500
X
X11400`09continue`09`09!Scan on subject field
X`09field=3
X`09go to 11500
X
X11500`09continue
X`09dummy=-30
X`09write(6,1001)crlf(:cl)//'Search string? `5Bexit`5D'
X`09call get_uplow_string(string,dummy)
X`09istat=str$upcase(string,string)
X`09if(dummy.eq.0)  then
X`09    unlock(unit=2)
X`09    unlock(unit=3)
X`09    go to 0200
X`09    end if
X`09istat=str$trim(string,string,length)
X`09irec=1
X`09do krec=2,last_header
X`09    read(2,rec=krec,iostat=ios,err=90600) mh
X`09    unlock(unit=2)
X`09    if(mh.mail_messnum.gt.last_mnum) go to 11900
X`09    if(mh.mail_deleted) goto 11590
X`09    istat=str$upcase(zmail_to,mh.mail_to)
X`09    if(mh.mail_private.and..not.((zmail_to.eq.mail_name).or.
X`091`09(mh.mail_from.eq.mail_name).or.sysop)) go to 11590
X`09    if(field.eq.1) then
X`09`09count=str$position(mh.mail_from,string(1:length))
X`09    else if(field.eq.2) then
X`09`09count=str$position(zmail_to,string(1:length))
X`09    else if(field.eq.3) then
X`09`09istat=str$upcase(zmail_subject,mh.mail_subject)
X`09`09count=str$position(zmail_subject,string(1:length))
X`09    end if
X`09    if (count.eq.0) go to 11590
X
X`09    if(mh.mail_read) then
X`09`09istat=str$trim(mh.mail_to,mh.mail_to,dummy)
X`09`09mh.mail_to=mh.mail_to(1:dummy)//' (X)'
X`09`09end if
X`09    write(6,1022)crlf(:cl),mh.mail_section,mh.mail_messnum,
X`091`09mh.mail_from,mh.mail_to,mh.mail_subject
X11520`09    write(6,1001)crlf(:cl)//'Command? (C,E,F,K,?) `5BC`5D'
X`09    dummy=1
X`09    call get_uplow_string(cdummy,dummy)
X`09    istat=str$upcase(cdummy,cdummy)
X`09    if(dummy.eq.0.or.cdummy.eq.'C') go to 11590
X`09    if(cdummy.eq.'?') then
X`09`09write(6,1001)crlf(:cl)//'(C)ontinue'
X`09`09write(6,1001)crlf(:cl)//'(E)xit'
X`09`09write(6,1001)crlf(:cl)//'(F)lag'
X`09`09write(6,1001)crlf(:cl)//'(K)ill'
X`09`09go to 11520
X`09`09end if
X`09    if(cdummy.eq.'F') then
X`09`09num_flags=num_flags+1
X`09`09flags(num_flags)=mh.mail_messnum
X`09`09if(num_flags.eq.100) then
X`09`09    write(6,1001)crlf(:cl)//'You have set 100 flags.'
X`09`09    write(6,1001)crlf(:cl)//'You must read these before'
X`09`09    write(6,1001)crlf(:cl)//'flagging any more.'
X`09`09    unlock(unit=2)
X`09`09    unlock(unit=3)
X`09`09    go to 0200
X`09`09    end if
X`09`09go to 11590
X`09`09end if
X`09    if(cdummy.eq.'E') go to 11900
X`09    if(cdummy.eq.'K') then
X`09`09call kill_mess(krec,status)
X`09`09if(status.eq.1) go to 90500
X`09`09if(status.eq.2) go to 90600
X`09`09go to 11590
X`09`09end if
X`09    write(6,1001)crlf(:cl)//'That was not a valid command.'
X`09    go to 11520
X
X11590`09    end do
X
X11900`09if(num_flags.eq.0) then
X`09    write(6,1001)crlf(:cl)//'No messages flagged.'
X`09else
X`09    write(6,1023)crlf(:cl),num_flags
X`09end if
X`09unlock(unit=2)
X`09unlock(unit=3)
X`09go to 0200
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X12000`09continue`09`09!User log
X`09area='user log'
X`09write(6,1001)crlf(:cl)//'Please enter starting surname'
X`09write(6,1001)crlf(:cl)//'or <cr> to start at beginning.'
X`09write(6,1001)crlf(:cl)//'?'
X`09dummy=20
X`09call get_uplow_string(zur.user_key,dummy)
X`09call str$upcase(zur.user_key,zur.user_key)
X`09if(dummy.eq.0) zur.user_key=zeros
X`09write(6,1001)crlf(:cl)//'Enter cutoff date for login (users'//
X`091   ' before this date will not be'//crlf(:cl)//
X`092   'displayed.)  The date must be dd-mmm-yyyy (e.g. 19-APR-1986)'//
X`093   crlf(:cl)//'Or enter <cr> for a complete list.'//
X`094   crlf(:cl)//'?'
X`09dummy=11
X`09call get_uplow_string(line,dummy)
X`09if(dummy.eq.0) line='01-JUL-1985'
X`09istat=str$upcase(line,line)
X`09istat = sys$bintim(line(:11)//' 00:00:00',long_ago)
X`09istat = sys$asctim(,line,long_ago,)
X`09dummy=0
X
X`09call out(crlf(:cl)//'Ctrl-s to pause/Ctrl-q to resume,'//
X`091   ' Ctrl-o to skip',*12100)
X`09call out('Users logged on since: '//line(:11)//crlf(:cl),*12100)
X`09call out('User name                    Last logon'//
X`091    '         # Times  Calling from',*12100)
X`09call out('---------------------------------------'//
X`091    '------------------------------',*12100)
X12050`09read(1,keygt=zur.user_key,iostat=ios,err=12150)zur
X`09call ctrl_o_check(*12100,*12100)
X`09if(.not.zur.approved) go to 12050
X`09istat = sys$bintim(zur.last_log_date(1:7)//'19'//
X`091   zur.last_log_date(8:9)//' '//zur.last_log_time,his_login)
X`09if(hl(2).lt.la(2)) go to 12050
X`09istat=str$trim(zlast_name,zur.user_key(1:20),dummy1)
X`09istat=str$trim(zfirst_name,zur.user_key(21:40),dummy2)
X`09istat=str$trim(zur.city,zur.city,dummy4)
X`09dummy3=27-dummy1-dummy2
X`09if(dummy3.lt.1) dummy3=1
X`09write(6,1008)crlf(:cl),zfirst_name(1:dummy2)//' '//
X`091    zlast_name(1:dummy1)//space(1:dummy3),
X`092    zur.last_log_date,zur.last_log_time,zur.num_logon,
X`093    zur.city(1:dummy4)//','//zur.state
X`09dummy=dummy+1
X`09go to 12050
X
X12100`09write(6,1001)crlf(:cl)//crlf(:cl)//'Aborted'
X`09go to 12151
X
X12150`09write(6,1001)crlf(:cl)//crlf(:cl)//'End of user log'
X12151`09write(6,1005)crlf(:cl),dummy
X`09unlock(unit=1)
X`09go to 0200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X13000`09continue`09`09!Welcome message
X`09area='welcome reprint'
X`09call type_file('ubbs_data:welcome.txt')
X`09go to 0200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X14000`09continue`09`09!Xpert user mode
X`09area='expert'
X`09read(1,key=ur.user_key,iostat=ios,err=90500)ur
X`09ur.xpert = .not. ur.xpert
X`09rewrite(1,err=90500)ur
X`09go to 0200
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X15000`09continue`09`09!CB simulator
X`09if(arklug) then
X`09    call arklug_cb(*90500)
X`09else
X`09    call ubbs_cb(*90500)
X`09end if
X`09go to 0200
X
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
Xc
Xc`09exception conditions are handled after 90000
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X90000`09call type_file('ubbs_data:badpass.txt')
X`09go to 99990
Xc
X90500`09continue
X`09write(6,1001)crlf(:cl)//'Internal error -- unable to update userlog.'
X`09write(6,1001)crlf(:cl)//'The sysop will be notified.'
X`09error='unable to update user log'
X`09go to 90900
Xc
X90600`09write(6,1001)crlf(:cl)//'Internal error -- unable'//
X`091   ' to access message file.'
X`09write(6,1001)crlf(:cl)//'The sysop will be notified.'
X`09error='unable to access message.hed file'
X`09go to 90900
Xc
X90700`09write(6,1001)crlf(:cl)//'Internal error -- unable'//
X`091   ' to access message file.'
X`09write(6,1001)crlf(:cl)//'The sysop will be notified.'
X`09error='unable to access message.dat file'
X`09go to 90900
Xc
X90900`09continue
Xc
Xc`09error message to sysop here
Xc
X`09close(unit=1)
X`09close(unit=2)
X`09close(unit=3)
X`09open(unit=4,file='mail.tmp',status='new',
X`091    carriagecontrol='list')
X`09write(4,1001)'The BBS has a fatal error'
X`09write(4,1001)'The user is '//mail_name
X`09write(4,1001)'The area is '//area
X`09write(4,1001)'The error is '//error
X`09write(4,1007)'The iostatus is ',ios
X`09close(unit=4)
X`09istat=lib$spawn('mail/subject="abort" mail.tmp sysop')
X`09go to 99990
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
Xc
Xc`09User has exceeded his allowable time
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X
X91000`09write(6,1001)crlf(:cl)//
X`091   'You have been logged on for 1 hour today.'
X`09write(6,1001)crlf(:cl)//'You must wait until tomorrow.'
X`09read(1,key=ur.user_key,iostat=ios,err=90500)ur
X`09ur.seconds_today = current_units
X`09rewrite(1,iostat=ios,err=90500)ur
X`09go to 99990
X
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
Xc
Xc`09exit from the BBS the right way
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Vccc
X99990`09continue
X`09close(unit=1)
X`09close(unit=2)
X`09close(unit=3)
X`09interactive=.false.`09`09!reset before exiting
X`09call setup_local(interactive)
X`09write(6,1001)crlf(:cl)
X`09call exit
X`09end
$ CALL UNPACK BBS.FOR;165 1934534152
$ create 'f'
X`09subroutine arklug_cb(*)
X`09include 'bbs_inc.for'
X`09call out('The CB is not currently implemented on the BBS.',*0200)
X`09call out('If the CB becomes available a bulletin will be,',*0200)
X`09call out('placed on the BBS.',*0200)
X`09call out('                    Thank You',*0200)
X`09call out('                    Sysop',*0200)
X 0200`09return
X`09end
X`0C
X`09subroutine ubbs_cb(*)
Xc`09This is a version of cb for the bulletin board
Xc++
Xc
Xc`09>>>>>  CB/Vax Version 3.1  <<<<<
Xc
Xc`09The Citizens' Band radio simulator for VAX/VMS.  (This is such
Xc`09an incredible simulation, you'll think it's the real thing!)
Xc
Xc`09Written by:`09Dale Miller
Xc`09`09`09University of Arkansas at Little Rock
Xc`09`09`092801 S. University
Xc`09`09`09Little Rock, AR  72204
Xc`09`09`09(501) 569-3220
Xc
Xc`09Based on RATFIV coding by Chris Thomas - whereabouts currently unknown.
Xc`09Version 3.0 is a complete re-write of the RATFIV code distributed on
Xc`09the DECUS symposia tapes.
X`09
Xc
Xc`09While all of the coding is certainly original, the idea isn't....
Xc`09This looks very, very much like the CB simulator program that runs
Xc`09on the CompuServe Information Service.
Xc
Xc
Xc`09`09`09****  Important Notes  ****
Xc
Xc`09Starting with V2.0, CB/Vax is distributed in two parts:
Xc`091)  CBMGR.FOR is the CB Manager.  It runs detached and performs
Xc`09    all of CB/Vax's really important functions.
Xc`092)  CB.FOR, this program, is the user interface to CB/Vax.
Xc`09You need -both- of these to run CB/Vax!!!
Xc
Xc`09CB.EXE needs to be INSTALLed with the following privileges:
Xc`09`09DETACH, WORLD, OPER, SYSNAM, PRMMBX, ALTPRI.
Xc
Xc
Xc`09Modification History:
Xc
Xc`0924-Apr-1986`09V3.1`09o  Attempt is now made to start cb_manager
Xc`09`09`09`09   without any logical name checking.
Xc
Xc`0925-Jan-86/DOM`09V3.0`09o  Complete re-write in Fortran-77
Xc`09`09`09`09   Addition of scrambling, /time, /squelch.
Xc`09`09`09`09   Provisions for running on a VAXcluster.
Xc
Xc`0927-Apr-83/JCT`09V2.3`09o  Trap `5EZ's and, if just waiting for a
Xc`09`09`09`09   message, behave like /EXIT.
Xc`09`09`09`09o  Check for /NOBROADCAST at startup and, if
Xc`09`09`09`09   so, tell the user that this won't work.
Xc`09`09`09`09o  Display the current time on a summons.
Xc`09`09`09`09o  Check the MAXPEOPLE limit in the manager.
Xc`09`09`09`09o  Check against batch access, since that's
Xc`09`09`09`09   real nasty.
Xc`09`09`09`09o  In Manager, before every send we check to
Xc`09`09`09`09   make sure the destination terminal is
Xc`09`09`09`09   still owned by the original PID.  This is
Xc`09`09`09`09   to handle line drops and operator STOPs.
Xc`09`09`09`09   Otherwise, messages would continue to be
Xc`09`09`09`09   sent to these terminals.
Xc
Xc`0916-Apr-83/JCT`09V2.2`09o  The terminal name is now obtained by
Xc`09`09`09`09   looking at SYS$COMMAND instead of SYS$INPUT.
Xc`09`09`09`09   When we were run from a command procedure,
Xc`09`09`09`09   this caused many problems.
Xc`09`09`09`09o  Commands need only be typed to uniqueness
Xc`09`09`09`09   now, also they may be fully typed out,
Xc`09`09`09`09   instead of the old 3-character limit.
Xc`09`09`09`09o  The /SUMMON command has been added.
Xc`09`09`09`09o  Users can't have null handles anymore.
Xc
Xc`0927-Mar-83/JCT`09V2.1`09Substantial enhancements from V2.0:
Xc`09`09`09`09o  40-channel capability
Xc`09`09`09`09o  /STA, /UST, /HAN, /TUN, /HEL commands
Xc`09`09`09`09o  The symbol CB_HANDLE is checked for a
Xc`09`09`09`09   predefined handle.
Xc`09`09`09`09o  Commands can be in mixed case, and only
Xc`09`09`09`09   the first three letters matter.
Xc`09`09`09`09o  Duplicate handles are prohibited.
Xc`09`09`09`09o  The CB Manager is automatically created
Xc`09`09`09`09   if it's not present at startup.
Xc`09`09`09`09o  The CB Manager is automatically deleted
Xc`09`09`09`09   if there's nobody running CB.
Xc
Xc`0925-Mar-83/JCT`09V2.0`09Almost total rewrite of V1.0:
Xc`09`09`09`09o  Introduced the "CB Manager" concept.
Xc`09`09`09`09o  Changed default channel to 1.
Xc
Xc--
X`09implicit integer*4 (a-z)
X`09parameter PCB$V_BATCH = '0E'x`09 ! either of these.
X`09include '($jpidef)'
X`09include '($prvdef)'
X`09include '($ttdef)'
X`09include '($libclidef)'
X`09include '($dvidef)'
X`09include 'bbs_inc.for'
Xc***************************************************************************
V***
Xc                                                                        `20
V    *
Xc`09****  CB/Vax Site-Specific Things  ****                               *
Xc`09(Change at your own discretion - and risk)                            *
Xc                                                                        `20
V    *
Xc***************************************************************************
V***
X`09character*(*)cbmgr_location, cb_mailbox_name, cb_handle,
X`091   cbmgr_procname
X`09parameter(cbmgr_location = 'sys$common:`5Bsysmgr.ualr.cb`5Dcbmgr.exe',
X`091   cb_mailbox_name = 'CB_MBX', cb_handle = 'CB_HANDLE',
X`092   cbmgr_procname = 'CB_Manager', cbmgr_grp = 1, cbmgr_mem = 4,
X`093   cbmgr_priority = 5)
Xc`09****  end OF SITE-SPECIFIC THINGS  ****
X
X`09character*20 tran, our_term, pterminal, nodename
X`09character*12 my_username
X`09character*132 text,otext
X`09character*16 handle
X`09character*32 mbname, arg
X`09character*255 msg, ucased
X`09character*4 command
X`09character*1 space
X`09character currtim*8,ctime*8,cdate*9
X`09character*9 dow(7)/'Monday','Tuesday','Wednesday','Thursday',
X`091   'Friday','Saturday','Sunday'/
X`09integer*4 privs(2), items(13), dvi_items(4)
X`09logical*1 wait, bad_handle,bbs
X`09integer*4 write_code,ctrl_mask
X`09structure /status_block/
X`09    integer*2 iostat,
X`091`09      msg_len
X`09    integer*4 reader_pid
X`09    end structure
X`09record /status_block/ iostatus
X`09integer sys$crembx,sys$ascefc,sys$waitfr,sys$qio
X
X
Xc`09Message code definitions for the CB Manager.  The first byte of every
Xc`09message sent to him contains the action to be taken, as defined here:
X
X`09parameter(new_person = 1, chatter = 2, leaving = 3, ustat = 4,
X`091   status = 5, tune = 6, chg_handle = 7, scramble = 8,`20
X`092   squelch = 9, summon = 10)
X
X2000`09format(a)
X2001`09format(' You are monitoring channels ',i2,' and ',i2)
X
X`09if (.not.approved_cb) then
X`09    write(6,2000)crlf(:cl)//'You are not yet approved to'//
X`091`09' use CB.'//bell
X`09    write(6,2000)crlf(:cl)//'Sorry.'
X`09    return
X`09    end if
X`09write(6,2000)crlf(:cl)//'Starting CB simulator.'
X`09write(6,2000)crlf(:cl)//'For help, type /HELP'
X`09write(6,2000)crlf(:cl)//'to exit, type /EXIT'
X
X
X`09write_code=io$_writevblk .or. io$m_now
X`09len = 255
X`09command_index = 0
X
X`09items(1) = (65536*jpi$_grp) + 4
X`09items(2) = %loc(grp)
X`09items(3) = 0
X`09items(4) = (65536*jpi$_mem) + 4
X`09items(5) = %loc(mem)
X`09items(6) = 0
X`09items(7) = (65536*jpi$_username) + 12
X`09items(8) = %loc(my_username)
X`09items(9) = 0
X`09items(10) = (65536*jpi$_sts) + 4
X`09items(11) = %loc(proc_status)
X`09items(12) = 0
X`09items(13) = 0
X`09call sys$getjpi(, , , items, , , )
X
X`09sta = sys$setrwm(%val(1))
X
Xc`09Disable control-Y's while we run.  If we don't, the CB Manager
Xc`09won't know when we're done, and he'll continue to send messages,
Xc`09making the user somewhat unhappy.
X
X`09call lib$disable_ctrl(lib$m_cli_ctrly,ctrl_mask)
X
Xc`09Check our status bits to make sure we're interactive.  Batch access
Xc`09to CB/Vax is not the least bit friendly!
X
X`09if ((proc_status .and. (2**'0e'x)) .ne. 0) then
X`09    write(6,2000)crlf(:cl)//'%You can''t run CB/Vax from batch.'
X`09    go to 99000
X`09    end if
X
Xc`09Check to make sure our terminal is /BROADCAST.  If it's not, then
Xc`09nothing else here will work.
X
X`09dvi_items(1) = (65536*'0a'x) + 4
X`09dvi_items(2) = %loc(devdepend)
X`09dvi_items(3) = 0
X`09dvi_items(4) = 0
X`09call sys$getdvi(, , 'SYS$COMMAND', dvi_items, , , , )
X`09if ((devdepend .and. tt$m_nobrdcst) .ne. 0) then
X`09    write(6,2000)crlf(:cl)//
X`091`09'%Your terminal is set /NOBROADCAST.'
X`09    write(6,2000)crlf(:cl)//
X`091`09'%CB/Vax will not work with your terminal '//
X`091`09'set this way.'
X`09    go to 99000
X`09    end if
X
X
X`09write(6,2000)crlf(:cl)//'Welcome to CB/Vax V3.1'
X`09if(my_username.eq.'BBS') then
X`09    bbs=.true.
X`09else
X`09    bbs=.false.
X`09endif
X
Xc`09Decide if we need to start up the CB Manager.  Attempt to translate
Xc`09the mailbox's logical name.  If we fail, then we assume the manager
Xc`09doesn't exist, so we start him up with appropriate privileges.
X
X`09sta = sys$trnlog(cb_mailbox_name,,mbname,,,)
X
Xc`09if (sta .ne. 1) then
X`09    privs(1) = prv$m_oper + prv$m_prmmbx + prv$m_setpri +`20
X`091`09prv$m_sysnam + prv$m_world
X`09    privs(2) = 0
X`09    sta2 = sys$creprc(,cbmgr_location,,,,%ref(privs(1)),,
X`091`09cbmgr_procname,%val(cbmgr_priority),%val((65536*cbmgr_grp)
X`092`09+ cbmgr_mem),,)
X`09    if (sta2 .ne. ss$_normal .and. sta2 .ne. ss$_duplnam) then
X`09`09write(6,2000)crlf(:cl)//
X`091`09    '??Can''t start CB Manager.'
X`09`09write(6,2000)crlf(:cl)//
X`091`09    'Please contact the system manager.'
X`09`09go to 99000
X`09`09end if
Xc`09     end if
Xc`09Turn off privs for this process.
X
X`09privs(1) = privs(1) + prv$m_detach
Xc`09sta = sys$setprv(%val(0),%ref(privs(1)),%val(0),)
X
X
Xc`09Try to read the global symbol CB_HANDLE from our process tables.
Xc`09If it's there, then we'll use that as our initial handle.  (You
Xc`09see, having simple entry into CB is important to get people to
Xc`09use it a lot.)
X
X`09space = ' '
X2060`09continue
X`09bad_handle = .false.
X`09sta = lib$get_symbol(cb_handle, handle)
X`09if (.not.(sta .and. 1)) then
X`09    write(6,2000)crlf(:cl)//'What''s your handle? '
X`09    read(5,2000, end=2060, err=2060) handle
X`09    call lib$set_symbol(cb_handle, handle)
X`09    end if
X`09    ista=str$trim(handle,handle,i)
X`09if (i .eq. 0) then
X`09    write(6,2000)crlf(:cl)//'You can''t have a null handle!'
X`09    bad_handle = .true.
X`09    call lib$delete_symbol(cb_handle)
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-