/**************************************************************************
 *** CCManager V1.0 by ApOllO/DDs                                       ***
 **************************************************************************/

/**************************************************************************
 *** Misc. Init stuff.                                                  ***
 **************************************************************************/

signal on syntax
signal on error
signal on ioerr
options results
parse arg node
nodeid="AERexxControl"node
if show(Ports,nodeid) = 0 then call NoHost
address value nodeid
tr=transmit
CR='0a'x
if ~show('L','rexxsupport.library') then do
  if ~addlib('rexxsupport.library',0,-30,0) then do
    errtxt = 'Unable to load Rexxsupport.library.'
    call prgerror
  end
end
tr ''

/**************************************************************************
 *** Get some info bout the user                                        ***
 **************************************************************************/

getuser (100);name=result
getuser (105);access=result
getuser (122);linelength=result
putustr '200'
putuser (122)

/**************************************************************************
 *** For the filename of the account, strip all DOS chars from the name ***
 **************************************************************************/

nam=name
DOSCHAR='/'
call editname
DOSCHAR=':'
call editname
DOSCHAR='#'
call editname
DOSCHAR='?'
call editname
DOSCHAR='*'
call editname
acname = 'doors:CCM/accounts/'nam'.ACC'

/**************************************************************************
 *** Get the PW from the file                                           ***
 **************************************************************************/

if ~exists('doors:CCM/Password.cfg') then do
  errtxt = 'Configuration Error! (Config file missing!)'
  call prgerror
end

if open('cfg','doors:CCM/Password.cfg','R') = 0 then do
  errtxt = 'Configuration Error! (Couldn''t open config file!)'
  call prgerror
end

p=0
do until eof('cfg')
  p=p+1
  cfg.p=readln('cfg')
end
NOCFG=p

/**************************************************************************
 *** Ask the Main entry PW                                              ***
 **************************************************************************/

pw=''
len=0
sendmessage "Enter Access Password: "

call pwinput; pw=input

if upper(PW) ~= upper(cfg.1) then do
  errtxt = 'ACCESS DENIED.'
  call prgerror
end

tr ''
tr ''
tr 'ACCESS GRANTED.'
tr ''

/**************************************************************************
 *** Check for user account, if there, read and ask the PW              ***
 **************************************************************************/

tr 'Welcome to CCM V1.0 by ApOllO/rYl'
tr ''

sendmessage 'Checking your account '

call delay 20
sendmessage '.'
call delay 20
sendmessage '.'
call delay 20
sendmessage '.'
call delay 20
if ~exists('doors:CCM/accounts/'nam'.acc') then do
  tr ' No account present.'
  balance = 0
  call OpenAccount
end
else do
  if open('acc','doors:CCM/accounts/'nam'.acc','R') = 0 then do
    errtxt = 'Error reading your account.'
    call prgerror
  end
  p=0
  do until eof('acc')
    p=p+1
    acline.p=readln('acc')
  end
  if close('acc') = 0 then do
    errtxt= ' Error closing your account.'
    call prgerror
  end
  perspw=upper(acline.1)
  if perspw = '' then do
    tr ' Sysop Created Account Located.'
    premade=1;balance=acline.2
    call openaccount
  end
  else do
    tr ' Located.'
    tr ''
    sendmessage 'Enter your Personal Account Password: '
    call PWinput;perspwent=upper(input)
    if upper(perspwent) ~= upper(perspw) then do
      errtxt = 'ACCESS DENIED.'
      call prgerror
    end
    tr ''
    tr ''
    tr 'ACCESS GRANTED.'
    tr ''
    call delay 30
  balance=acline.2
  end
end

/**************************************************************************
 *** Locate and if there, load and analyse the cardslist                ***
 **************************************************************************/

if ~exists('doors:CCM/CCList.txt') then do
  errtxt = 'We are sorry, our stock is empty at the moment.'
  call prgerror
end

if open('list','doors:CCM/CCList.txt','R') = 0 then do
  errtxt = 'We are sorry, our stock is empty at the moment.'
  call prgerror
end

p=0
do until eof('list')
  p=p+1
  CC.p=readln('list')
end
NOCR=p-1

if close('list') = 0 then do
  errtxt = 'Error 1 occured.'
  call prgerror
end

if Nocr < 1 then do
  errtxt= 'We are sorry, our stock is empty at the moment.'
  call prgerror
end

sold=0
do p = 1 to nocr
  if substr(CC.p,16,5) = '(SOLD' then do
    sold=sold+1
  end
end

noc=nocr-sold

if Noc < 1 then do
  errtxt = 'We are sorry, our stock is empty at the moment.'
  call prgerror
end

/**************************************************************************
 *** Main program, show balance info and ask user to withdraw           ***
 **************************************************************************/

withdraw:

tr ''
tr ''
tr ''
if access = 255 then do
tr 'Sysop Extended Info'
tr ''
tr 'List Contains: 'nocr''
tr '         Sold: 'sold''
tr '     In Stock: 'noc''
tr ''
end
tr '         Name: 'name''
tr ' Your Balance: 'balance''
tr ''
tr ''
sendmessage 'Withdraw ? (y/N) '
getchar;inp=result
if upper(inp) ~= 'Y' then do
  tr ''
  errtxt = 'Okay .. Exiting..'
  call prgerror
end
tr ''
if balance = 0 then do
  tr ''
  tr 'Your balance is zero! Contact Sysop!'
  tr ''
  tr '[KEY]'
  getchar
  call withdraw
end

tr ''
sendmessage 'Withdraw how many: '
call input;req=input


if input < 1 | input > balance then do
  tr ''
  tr 'Invalid entry!'
  tr ''
  tr '[KEY]'
  getchar
  call withdraw
end


tr ''
sendmessage 'Do you really want to withdraw 'req' pieces ? (Y/n) '
getchar;inp=result
if upper(inp) = 'N' then do
  call withdraw
end
tr ''
tr ''
sendmessage 'Processing your request '
call delay 20
sendmessage '.'
call delay 20
sendmessage '.'
call delay 20
sendmessage '.'
call delay 20
sendmessage '.'
call delay 20
sendmessage '.'
call delay 20
tr ''

if req > noc then do
  tr ''
  tr 'We are running low on stock. Unable to transfer 'req' pieces.'
  tr 'Maximum at the moment is 'noc'.'
  tr ''
  tr '[KEY]'
  getchar
  call withdraw
end

/**************************************************************************
 *** Requested amount of cards is accepted, deduct amount of balance    ***
 **************************************************************************/

tr ''

oldbal=balance
if length(oldbal)=1 then oldbal='0'oldbal
balance=balance-req
newbal=balance
if length(newbal)=1 then newbal='0'newbal

date=date('E')
time=time('N')

if open('acc2','doors:CCM/accounts/'nam'.acc','W') = 0 then do
  errtxt = 'Error opening your account for writing.'
  call prgerror
end

dm = writeln('acc2',upper(perspw))
dm = writeln('acc2',balance)

if close('acc2') = 0 then do
  errtxt = 'Error closing your account.'
  call prgerror
end

/**************************************************************************
 *** Comment the cards being sold in the cardslist.                     ***
 **************************************************************************/

con=0;hold=0
do p = 1 to nocr until hold=1
  if substr(CC.p,16,5) ~= '(SOLD' then do
    con=con+1
    CCOUT.con=CC.p
    ch.con=p
    CC.p=CC.p' (SOLD to 'name' at 'date' - 'time')'
    if con=req then hold=1
  end
end

if open('list2','doors:CCM/CCList.txt','W') = 0 then do
  errtxt = 'Error 2 occured.'
  call prgerror
end

do p = 1 to nocr
  dm = writeln('list2',CC.p)
end

if close('list2') = 0 then do
  errtxt = 'Error 3 occured.'
  call prgerror
end

/**************************************************************************
 *** Create the file that will be transferred to the user and DL it     ***
 **************************************************************************/

if open('OUTLIST','T:Delivery.txt','W') = 0 then do
  errtxt = 'Error 4 occured.'
  call prgerror
end

if length(req)=1 then do
  req2 = '0'req
end
else do
  req2=req
end

dm = WRITELN('OUTLIST',"                        -  - ----------------- -  -")
dm = WRITELN('OUTLIST',"                              CARDS DELIVERY")
dm = WRITELN('OUTLIST',"                        -  - ----------------- -  -")
dm = WRITELN('OUTLIST'," ")
dm = WRITELN('OUTLIST',"                              Transferred "req2)
dm = WRITELN('OUTLIST'," ")
dm = WRITELN('OUTLIST',"                              Old Balance "oldbal)
dm = WRITELN('OUTLIST',"                              New Balance "newbal)
dm = WRITELN('OUTLIST'," ")
dm = WRITELN('OUTLIST',"                              Date: "date)
dm = WRITELN('OUTLIST',"                              Time: "time)
dm = WRITELN('OUTLIST'," ")
dm = WRITELN('OUTLIST',"                        -  - ----------------- -  -")
dm = WRITELN('OUTLIST'," ")
do p = 1 to req
dm =   WRITELN('OUTLIST',"                              "CCOUT.p)
end
dm = WRITELN('OUTLIST'," ")
dm = WRITELN('OUTLIST',"                        -  - ----------------- -  -")
dm = WRITELN('OUTLIST',"                              USE 'M WISELY!")
dm = WRITELN('OUTLIST',"                        -  - ----------------- -  -")
dm = WRITELN('OUTLIST',"                              PLEASANT CALLS")
dm = WRITELN('OUTLIST',"                        -  - ----------------- -  -")

if close('OUTLIST') = 0 then do
  errtxt = 'Error 5 occured.'
  call prgerror
end

tr ''
tr 'Order processed.'
tr ''
tr 'Press a key to download your withdrawal.'
getchar

form='T:Delivery.txt'

if ~exists(form) then do
  errtxt = 'Error 6 occured.'
  call prgerror
end

tr ''
tr 'Initiating Download.'
tr ''
putustr form
putuser (137)
out=result

if out ~= 1 then do
 if out = -2 then do
  errtxt = 'Lost carrier'
  call prgerror
 end
 if out = 0 then do
  tr ' '
  tr 'Download was unsuccessfull !'
  tr 'Report to Sysop for manual receiving !'
  tr ' '
  address command('copy T:delivery.txt Doors:CCM')
  address command('delete >nil: T:delivery.txt')
  errtxt = 'Error in Download.'
  call prgerror
 end
end

tr ''
tr ''
tr 'Transfer completed.'
tr ''

/**************************************************************************
 *** All done, some ending misc. stuff and exiting.                     ***
 **************************************************************************/

tr ''
tr 'Thank you for using our service. Meet you again !'
tr ''

address command('delete >nil: T:delivery.txt')
if linelength ~= '' then do
  putustr linelength
  putuser (122)
end
shutdown
exit







/**************************************************************************
 *** S U B R O U T I N E S                                              ***
 **************************************************************************/


/**************************************************************************
 *** Subrout 01: Open a account for a new user.                         ***
 **************************************************************************/

Openaccount:

tr ''
if premade = 1 then do
sendmessage 'Do you want to activate and use this pre-made account ? (Y/n) '
end
else do
sendmessage 'Do you want to open an account ? (Y/n) '
end
getchar
res=result
if upper(res) = 'N' then do
  errtxt = 'Okay.. Exiting..'
  call prgerror
end

/**************************************************************************
 *** Wicked PW routine ;) User can select his PW now. (min 5 chars)     ***
 **************************************************************************/

pass=0
do until pass=1
tr ''
tr ''
tr 'ACCOUNT SEQUENCE'
tr  ''
tr ''
tr 'Your name: 'name
tr ''
  sendmessage 'Choose your personal password for future entry: '
  call PWinput; perspw1=input
  if length(perspw1) < 5 then do
    tr ''
    tr ''
    tr 'At least 5 characters long. Try again.'
    tr ''
    tr '[KEY]'
    getchar
    pass=0
  end
  else do
    tr ''
    sendmessage 'Repeat this personal password for verification: '
    call PWinput; perspw2=input
    if upper(perspw1) ~= upper(perspw2) then do
      tr ''
      tr ''
      tr 'The passwords do not match. Try again.'
      tr ''
      tr '[KEY]'
      getchar
      pass=0
    end
    else do
      pass=1;leave
    end
    if pass=1 then leave
  end
  if pass=1 then leave
  tr ''
end

/**************************************************************************
 *** Create account on disk                                             ***
 **************************************************************************/

if open('acccr',acname,'W') = 0 then do
  errtxt = 'Unable to create your account.'
  call prgerror
end

tr ''

if premade=1 then do
  ccs=balance
end
else do
  ccs=0
end
dm = writeln('acccr',upper(perspw1))
dm = writeln('acccr',ccs)
tr ''
if premade=1 then do
  tr 'Account activated.'
end
else do
  tr 'Account created.'
end
if close('acccr') = 0 then do
  errtxt = 'Unable to close your created account.'
  call prgerror
end
tr ''
tr '[KEY]'
getchar
return

errtxt = 'error 7 occured.'
call prgerror

/**************************************************************************
 *** Subrout 02: Get input from user. Kinddalike prompt                 ***
 **************************************************************************/

Input:

input=''
len=0
do until hold=1
  getchar
  chr=result
  if chr = '
' then leave
  if c2x(chr) = '08' then do 
    if length(input) > 0 then do
      input=left(input,length(input)-1)
      sendmessage chr' 'chr
      len=len-1
    end
    else do
      input=''
      len=0
    end
  end
  else do
    input=input''chr
    len=len+1
    sendmessage chr
  end
end
len=len-1
tr ''
return

errtxt = 'error 8 occured.'
call prgerror

/**************************************************************************
 *** Subrout 03: Get input from user. What user types is being /\/\/'ed ***
 **************************************************************************/

PWinput:

input=''
len=0
hh=0
do until hold=1
  getchar
  chr=result
  if chr = '
' then leave
  if c2x(chr) = '08' then do 
    if length(input) > 0 then do
      input=left(input,length(input)-1)
      sendmessage chr' 'chr
      if hh = 1 then do
        hh = 0
      end
      else do
        hh = 1
      end
      len=len-1
    end
    else do
      input=''
      len=0
    end
  end
  else do
    input=input''chr
    len=len+1
    if hh=1 then do
      sendmessage '\'
      hh=0
    end
    else do
      sendmessage '/'
      hh=1
    end
  end
end
len=len-1
return

errtxt = 'error 9 occured.'
call prgerror

/**************************************************************************
 *** Subrout 04: Standard Error traps.                                  ***
 **************************************************************************/

error:
ioerr:
syntax:

if rc = 13 then do
 say " "
 say "This is a door for AmiExpress V3.x and higher."
 say " "
 rc=0
 shutdown
 exit 0
end
else do
 tr " "
 tr "Program Error no. "rc" - Program Halted"
 tr "         Serial Error #"sigl
 tr sourceline(sigl)
 tr " "
 tr "Please report error number and serial in message to sysop !"
 tr " "
end

if linelength ~= '' then do
  putustr linelength
  putuser (122)
end

errtxt = 'error 10 occured.'
call prgerror

/**************************************************************************
 *** Subrout 05: At startup the /X host wasn't there (started from CLI) ***
 **************************************************************************/

NoHost:
say " "
say "CCM V1.0"
say " "
say "This is a door for AmiExpress V3.x and higher."
say " "
rc=0
shutdown
exit


/**************************************************************************
 *** Subrout 06: The DosChar stripper, replace /: etc to _ for filename ***
 **************************************************************************/

EditName:

stop=0
do until stop=1
  if index(nam,DOSCHAR) ~= 0 then do
    nam=left(nam,index(nam,DOSCHAR)-1)'_'right(nam,length(nam)-index(nam,DOSCHAR))
  end
  else do
    stop=1
  end
end
return
errtxt = 'error 11 occured.'
call prgerror

prgerror:

tr ''
tr ''
tr ''errtxt
tr ''

if exists('T:delivery.txt') then do
  address command('delete >nil: T:delivery.txt')
end
if linelength ~= '' then do
  putustr linelength
  putuser (122)
end
shutdown
exit