/* rexx */
/**********************************************************************/
/* qftp - quick interface to ftp to issue a single command            */
/*                                                                    */
/* PROPERTY OF IBM                                                    */
/* COPYRIGHT IBM CORP. 1996                                           */
/*                                                                    */
/* Bill Schoen (SCHOEN at KGNVMC or schoen@vnet.ibm.com)  5/26/96     */
/**********************************************************************/
parse arg debug cmd parms
if debug<>'-d' then
   do
   parse arg cmd parms
   debug=0
   end
 else
   debug=1
parse value '' with user psw envhost prefix envsite login loginpsw
do i=1 to __environment.0
   if substr(__environment.i,1,8)='FTPUSER=' then
      parse var __environment.i xx '=' user '/' psw
   if substr(__environment.i,1,8)='FTPHOST=' then
      parse var __environment.i xx '=' envhost
   if substr(__environment.i,1,8)='FTPSITE=' then
      parse var __environment.i xx '=' envsite
   if substr(__environment.i,1,9)='FTPLOGIN=' then
      parse var __environment.i xx '=' login '/' loginpsw
   if substr(__environment.i,1,9)='FTPDEBUG=' then
      parse var __environment.i xx '=' debug
   if substr(__environment.i,1,8)='TSOPREFIX=' then
      parse var __environment.i xx '=' prefix
end
cmd=translate(cmd)
ftp=0
rv=8
address syscall "getlogin luser"
select
   when cmd='CP' then
      do
      parse var parms fnm tnm opts
      bin=''
      if fnm='-b' then
         parse var parms bin fnm tnm opts
      if pos(':',fnm)>0 & pos(':',tnm)=0 then
         do
         fnm=sethost(fnm)
         call setuser
         call doftp "get" fnm "ftp.temp (replace","RETR"
         rsp=rsp+1
         if tnm='' then
            tnm=fnm
         if word(out.rsp,1)=226 then  /* transfer complete message */
            do
            "tso -t oput ftp.temp \'"tnm"\'"
            rv=rc
            call bpxwdyn "alloc fi(ftp) da("luser".ftp.temp) old delete"
            call bpxwdyn "free fi(ftp)"
            end
          else
            say 'Command terminated'
         end
      else
      if pos(':',fnm)=0 & pos(':',tnm)>0 then
         do
         tnm=sethost(tnm)
         call setuser
         call bpxwdyn "alloc fi(ftp) da("user".ftp.temp) old delete"
         call bpxwdyn "free fi(ftp)"
         "tso -t oget \'"fnm"\' ftp.temp>/dev/null"
         if rc<>0 then
            do
            "tso -t oget \'"fnm"\' ftp.temp"
            exit 8
            end
         if tnm='' then
            tnm=fnm
         call doftp "put ftp.temp" tnm,"STOR"
         rsp=rsp+1
         if word(out.rsp,1)=226 then   /* transfer complete message */
            rv=0
         call bpxwdyn "alloc fi(ftp) da("luser".ftp.temp) old delete"
         call bpxwdyn "free fi(ftp)"
         end
      else
         do
         say "host name must be specified"
         exit 0
         end
      end
   when cmd='CAT' then
      do
      parse var parms fnm opts
      fnm=sethost(fnm)
      call setuser
      call doftp "get" fnm "ftp.temp (replace","RETR",1
      rsp=rsp+1
      if word(out.rsp,1)=226 then  /* transfer complete message */
         do
         call bpxwdyn "alloc fi(ftp) da("luser".ftp.temp) old delete"
         data.0=0
         address mvs 'execio * diskr ftp (fini stem data.'
         do i=1 to data.0
            say strip(data.i,'t')
         end
         call bpxwdyn "free fi(ftp)"
         end
       else
         do i=1 to out.0
            if i=1 then
               say 'Command terminated, FTP output follows:'
            say strip(out.i,'t')
         end
      end
   when cmd='LS' | cmd='DIR' then
      do
      dir=sethost(parms)
      call setuser
      call doftp "dir" dir,"LIST"
      end
   when cmd='MKDIR' then
      do
      dir=sethost(parms)
      call setuser
      call doftp "mkdir" dir,"MKD"
      if pos('command successful',out.rsp)>0 then
         rv=0
      end
   when cmd='RMDIR' then
      do
      dir=sethost(parms)
      call setuser
      call doftp "rmdir" dir,"RMD"
      if pos('command successful',out.rsp)>0 then
         rv=0
      end
   when cmd='RM' then
      do
      fi=sethost(parms)
      call setuser
      call doftp "delete" fi,"DELE"
      if pos('command successful',out.rsp)>0 then
         rv=0
      end
   when cmd='MV' | abbrev("RENAME",cmd,3) then
      do
      parse var parms f1 f2 .
      f1=sethost(f1)
      call setuser
      call doftp "rename" f1 f2,"RNFR"
      do i=rsp to out.0
         if pos('command successful',out.i)>0 then
            do
            rv=0
            leave
            end
      end
      end
   otherwise
      say 'Syntax:'

      say ' qftp cp <pathname> <host file>     copy to host'
      say ' qftp cp <host file> <pathname>     copy from host'
      say ' qftp cat <host file>               list host file on stdout'
      say ' qftp ls {<host file>}              run ls -l on host'
      say ' qftp mkdir <host file>             create host directory'
      say ' qftp rmdir <host file>             remove host directory'
      say ' qftp rm    <host file>             remove host file'
      say ' qftp mv    <host file> <pathname>  rename host file'
      say '    <host file> ::= host_name:pathname'
end
return rv

doftp:
   parse arg ln,key,quiet
   if quiet<>1 then
      say ln
   if bin='-b' then
      do
      ftp=ftp+1
      ftp.ftp='BINARY'
      end
   ftp=ftp+1
   ftp.ftp=ln
   ftp=ftp+1
   ftp.ftp='quit'
   if debug<>0 then
      do
      say 'debug option is on'
      address mvs 'execio' ftp 'diskw 1 (stem ftp.'
      exit 4
      end
   call bpxwdyn "free fi(input)"
   call bpxwdyn "free fi(output)"
   call bpxwdyn "free fi(sysprint)"
   call bpxwdyn "alloc fi(input)",
      "lrecl(80) blksize(3280) space(1,1) recfm(f,b) tracks"
   call bpxwdyn "alloc fi(output)",
      "lrecl(160) space(1,1) recfm(f,b) tracks"
   call bpxwdyn "alloc fi(sysprint)",
      "lrecl(160) space(1,1) recfm(f,b) tracks"
   address mvs 'execio' ftp 'diskw input (fini stem ftp.'
   address linkmvs 'ftp host'
   address mvs 'execio * diskr output (fini stem out.'
   call bpxwdyn "free fi(input)"
   call bpxwdyn "free fi(output)"
   call bpxwdyn "free fi(sysprint)"
   key='>>>'key
   do rsp=1 to out.0
      if pos(key,out.rsp)>0 then
         leave
   end
   do i=rsp+1 to out.0
      if word(out.i,2)='Command:' then
         do
         rsp=rsp+1
         return rsp
         end
      if quiet<>1 then
         say strip(out.i,'t')
   end
   do i=1 to out.0
      say strip(out.i,'t')
   end
   exit 8

sethost:
   host=''
   if pos(':',arg(1))>0 then
      parse arg host ':' fn
    else
      parse arg fn .
   if host='' then host=envhost
   parse var host host '@' port
   if host='' then
      do
      say 'host name must be specified'
      exit 8
      end
   return fn

setuser:
   if user='' then
      do
      say 'enter userid'
      parse pull user psw .
      end
   if psw='' then
      do
      say 'enter password'
      parse pull psw .
      end
   ftp=ftp+1
   ftp.ftp=user psw
   if envsite='' then
      return
   ftp=ftp+1
   ftp.ftp='site' envsite
   if login='' then
      do
      say 'enter userid for site' envsite
      parse pull login loginpsw .
      end
   if loginpsw='' then
      do
      say 'enter password'
      parse pull loginpsw .
      end
   ftp=ftp+1
   ftp.ftp='login' login
   ftp=ftp+1
   ftp.ftp=loginpsw
   return