OS/2 Professional/OS2PRO194.ISO/os2/com/bbs/maxiftp/maxiftp.cmd

OS/2 REXX Batch file | 1994-02-03 | 66KB | 2,069 lines

/*------------------------------------------------------------------
 * miniftp.cmd :
 *------------------------------------------------------------------
 * 03-16-93 originally by Patrick J. Mueller & Cliff Nadler
 *------------------------------------------------------------------
 * maxiftp.cmd:
 *------------------------------------------------------------------
 * 10-27-93  modified by Albert Crosby <[e-mail]>
 * v2 11-5-93
 *
 * Some changes and suggestions were added from Al Dhir's sFTP
 *
 *  Second release:
 *     Fixed a bug in handling filenames on FAT partitions
 *     Added some additional extensions to the BINARIES list
 *     Removed some debugging code
 *     Changed "colon mode" to MGET instead of GET
 *     Changed the prompt to display directory
 *     Added highlighting
 *     Added a new help screen for MAXIFTP ?
 *     Added the status command
 *     Changed default to NODISPLAY
 *     Added TOGGLE command and some settings
 *     Added command line options
 *     Added the nifty new TOUCH command!
 *     Get now accepts wildcards! (psuedo fn completion...)
 *     Added quoted strings
 *     Added a CREATE command
 *     Now uses the NETRC file
 *     Added a LCD command to change local directory.
 * Version 3
 *     Fixed TOUCH for VM and Windows_NT
 *     Added a SET command to change string variables
 *     Display pager in the SHOW command
 *     Allow user defined prompt
 *     Added more binary types
 *     Fixed getpasswd to allow spaces
 *     Now prompts before exiting if Ctrl-C is pressed
 *     Added MORE as an alias for the PAGE command
 *     Shell now uses COMSPEC rather than always CMD
 *     Initial comments in NETRC are treated as commands to MaxiFTP
 *     Comments after a machine command in NETRC are queued as commands
 *     Uses EA's to store history and longname
 *     Redial mode added
 *     BELL added to ring a bell at connect and after a file transfer completes
 *     VISUAL mode began.  Very primitive.
 *------------------------------------------------------------------ */

/*------------------------------------------------------------------
 * set up call
 *------------------------------------------------------------------*/
call on halt

parse arg xargs

/* Add anything in the environment variable MAXIFTP */
xargs=strip(value('MAXIFTP',,'OS2ENVIRONMENT')||" "||xargs)

/* Build a blank delimited list of command line options */

args=" "

if pos(left(xargs,1),"/-")<>0 then
   do
   rest=xargs
   do until pos(left(rest,1),"/-")=0
      parse var rest argument rest
      if pos('"',argument)<>0 then
         do
         parse var rest remainder'"' rest
         argument=argument||' '||remainder||'"'
         end
      args=args||" "||substr(argument,2)
      rest=strip(rest)
   end
   parse var rest host rest
   if pos('"',host)<>0 then
      do
      parse var rest rest'"' user pass .
      host=host||" "||rest||'"'
      end
   else parse var rest user pass .
   end
else
   do
   parse var xargs host rest
   if pos('"',host)<>0 then
      do
      parse var rest rest'"' user pass .
      host=host||" "||rest||'"'
      end
   else parse var rest user pass .
   end

call LoadFunctions

parse value SysTextScreenSize() with rows cols

debug=0

"@echo off"
"ansi on > nul"

trace off

version="MaxiFTP version 3 BETA revision 153"
credits.0=3
credits.1="by Albert Crosby, 02/03/94"
credits.2="(based on original code by Patrick J. Mueller & Cliff Nadler of IBM"
credits.3="    and additional suggestions from Al Dhir's sFTP)"
/* List of filetypes currently assumed to be binary for get and put */
binaries=value("BINARIES",,"OS2ENVIRONMENT")
if binaries="" then
   binaries="EXE COM ZIP SYS DLL DEV ARJ ARC Z TAR GZ BIN DSK LZH ARK LBR JPG JPEG GIF PCX "
asciis=value("ASCIIS",,"OS2ENVIRONMENT")
if asciis="" then
   asciis="TXT"

hostname=""
phost=""
origdir=directory()
mode="ASCII"
delay=20
clobber=0
hostlist.0=0
prompt=1
display=0
unique=0
quiet=0
touch=0
netrc=1
visual=0
macros=1
retries=1
longname=1
history=1
bell=1
dircmd="dir"
viscmd="get"
greenonblack=d2c(27)||"[1;32m"
normvideo=d2c(27)||"[0m"
inversevideo=d2c(27)||"[7m"
boldvideo=d2c(27)||"[1m"
promptstr='progname||" ["||boldvideo||phost||":"||dirname||normvideo"] "'

stem.0=1
stem.1="No directory has been transferred - issue a ls or dir command."

pager=value('pager',,'os2environment')
if pager="" then pager=more

parse source . . name
parse value filespec('name',name) with progname".".

call ProcessINI filespec('drive',name)||filespec('path',name)||progname||'.ini'

if translate(progname)=="VISFTP" then visual=1

if RxFuncQuery("SockLoadFuncs")=0 then /* RxSock is loaded... */
   do
      /* Get info about this machine - this is the only useage of rxSock... */
      addr = SockGetHostId()
      rc   = SockGetHostByAddr(addr,"host.!")
      hostname=host.!name
   end
if hostname="" | hostname="HOST.!NAME" then hostname=value("HOSTNAME",,"OS2ENVIRONMENT")

anonpass="os2user"||"@"||hostname

netrcfile=stream('netrc','c','query exists')
if netrcfile="" then
   netrcfile=value("ETC",,"OS2ENVIRONMENT")||"\NETRC"

if pos(" N-",args)=0 then Call ProcessNETRC

call ProcessArgs args

if \quiet then call Credits

if (host="?") then
   do
   call Usage "INTRO"
   exitcode=0
   signal done
   end

oq=quiet;
quiet=1
call Mode mode
quiet=oq

if pos("@",host)<>0 then
   do
   pass=user
   parse var host user"@"host
   end

request=""

if pos(":",host)<>0 then parse var host host":"request
if pos('"',request)<>0 then parse var request '"'request'"'

if visual & (request="") then
   do
   visual=visinit()
   if visual then signal visftp
   end

if host = "" then
   do
   say "Welcome to "version
   say
   say "Type HELP for more information and HELP NEWS for an overview"
   say
   call Usage "CONNECT"
   say
   end

if (host <> "") then
   call Connect

if request<>"" then
   do
   if host="" then exit -1;
   prompt=0
   clobber=1
   /* Reprocess args to handle different defaults for colon-mode */
   oquiet=quiet
   quiet=1
   call ProcessArgs args
   quiet=oquiet

   if display then call QueryStatus

   /* If request contains wildcards, do an mget */
   if verify(request,"*?","MATCH")<>0 then
      err=mget(request)
   else err=get(request)
   exitcode=err
   signal done
   end

do while (cmd <> "QUIT")


/* Modified so default directory is not queried if not connected to
   a host.  This seemed rather pointless to me... */


   if (host = "") then
      do
         status = "not connected to a host"
         dir = ""
         phost="not connected"
      end
   else status = "connected to" user"@"host

if display then Call DisplayStatus

/* Moved displaying the prompt until AFTER the status is displayed. */

   /*---------------------------------------------------------------
    * print prompt
    *---------------------------------------------------------------*/
   Call SysCurState("ON")
   if pos('"',dir)<>0 then parse var dir '"'dirname'"'.
   else dirname=dir

   if queued()=0 then interpret "Call Charout," promptstr

   /*---------------------------------------------------------------
    * get command
    *---------------------------------------------------------------*/
   parse pull cmd cmdargs

   err=ProcessCMD(cmd, cmdargs)

   if (cmd="CD") | (cmd="CDUP") then
      err = FtpPwd('dir')

   /*------------------------------------------------------------------
    * check error
    *------------------------------------------------------------------*/
   /* Appears to be an error in error handling....  err may be -1 with
      FTPERRNO of 0 */
   if (err <> 0) & (ftperrno <>0) then
      do
      say "Error from FTP:" english(FTPERRNO) "["err"]"
      if ftperrno="FTPCONNECT" then
         do
         say "Remote server closed connection."
         host=""
         phost=""
         dir=""
         end
      end

end

/*------------------------------------------------------------------
 * quit
 *------------------------------------------------------------------*/

exitcode=0

done:
rc = FtpSetUser("X","X","X")
rc = FtpLogoff()
call directory origdir
/* Empty the queue in case any macro commands are pending. */
do queued()
   parse pull .
end
exit exitcode

/*------------------------------------------------------------------
 * break condition
 *------------------------------------------------------------------*/
halt:
   say
   call Charout, "Do you really want to quit (yes|no)? "
   do until pos(translate(key),"YN")<>0
      key=SysGetKey("NoECHO")
   end
   say key
   if translate(key)="N" then return;
   say "Terminating ..."
   exitcode=-1
   signal done

getpasswd: procedure

key=SysGetKey("NoEcho")
word=""
do until key=d2c(13)
   if (key=d2c(8)) & (length(word)>0) then
      do
      word=substr(word,1,length(word)-1)
      call Charout, d2c(8)||" "||d2c(8)
      end
   else if (key<>d2c(8)) then do; call Charout, "*"; word=word||key; end
   key=SysGetKey("NoEcho")
end
say
return word

get: procedure expose debug binaries file2 clobber quiet touch dir longname history host user bell visual asciis

parse arg remotefile, localfile, mode

curdir=dir
globbed=0
pipe=0

if remotefile=localfile then localfile=""

if translate(localfile)="CON" | translate(localfile)="CON:" then
   localfile="-"

if verify(remotefile,"*?","MATCH")<>0 then /* It's a wildcard request */
   do
   err=FtpLS(remotefile,'files.')
   if files.0=0 then
      do
      if \quiet then say "No files matching "remotefile" can be found."
      return -2
      end
   remotefile=files.1
   end

if wordpos(extension(remotefile),binaries)\=0 then
   if mode="" then mode="BINARY"

if wordpos(extension(remotefile),asciis)\=0 then
   if mode="" then mode="ASCII"

if remotefile="." then
   do
   call charout, "Remote file: "
   parse pull remotefile
   if remotefile="" then return -1
   call charout, "Local file: "
   parse pull localfile
   end

if left(localfile,1)="|" then
   do
   pipe=1
   destination=substr(localfile,2)
   localfile=systempfilename("tmp?????")
   end

if left(localfile,1)=">" then
   do
   say "Redirection not supported.  Use GET remotefile localfile instead."
   return -2
   end

ndir = filespec('drive',remotefile)||filespec('path',remotefile)
if ndir<>"" then
   do
   err=FtpPWD('olddir')
   err=FtpChDir(ndir)
   err=FtpPWD('curdir')
   if pos('"',olddir)<>"" then parse var olddir '"'olddir'"'.
   if pos('"',curdir)<>"" then parse var curdir '"'curdir'"'.
   end
request=remotefile
remotefile=filespec('name',remotefile)

err=FtpDir(remotefile,'files.')
if files.0=0 then
   do
   if dir<>"" then junk=FtpChDir(olddir)
   say "Remote file "request" does not exist."
   return -2
   end

if localfile="" then localfile=remotefile

if \pipe then
do
"dir "localfile" 1>nul 2>nul"
if (rc=123) | (rc=206) then /* File name isn't valid... */
   do
   if left(localfile,1)="." then localfile="_"||substr(localfile,2)
   if pos('.',localfile)<>0 then
      localfile=translate(translate(strip(left(left(localfile,lastpos('.',localfile)-1),8)),'__','. ')||"."||strip(left(extension(localfile),3)))
   else localfile=translate(translate(strip(left(localfile,8)),'__','. '))
   if stream(localfile,'c','query exists')<>"" then
      do
      say "Unable to generate a unique local name for the transfer."
      say "Specify a local name on the get command and try again."
      return -1
      end
   globbed=1
   end

if \quiet & localfile\="-" then say "Transferring "request" as "localfile" ..."
else if \quiet then say "Contents of "request":"
end
else if \quiet then say "Piping "request" to "destination" ..."

file2=localfile

if (\clobber) & (stream(localfile,"C","QUERY EXISTS")<>"") then
   if \visual then
      do
      call Charout, localfile || " already exists.  Replace (yes|no)? "
      do until pos(translate(key),"YN")<>0
         key=SysGetKey("NoECHO")
      end
      say key
      if translate(key)="N" then return 1;
      end
   else if vmsg("File Exists",localfile || " already exists.  Replace?  ",6)=="NO" then return 1;

call time "r"

if mode\="" then
   err=FtpGet(localfile,remotefile,mode)
else err=FtpGet(localfile,remotefile)

elapsed = strip(format(time("e"),10,2))
bytes = stream(localfile,"C","QUERY SIZE")
if \quiet & (elapsed<>0) & (datatype(bytes)="NUM") then
   say "Recieved" bytes "bytes in" elapsed "seconds:" strip(format(bytes/elapsed,10,2))  "bytes/second."
if \quiet & bell then call beep 278,200

if ndir<>"" then junk=FtpChDir(olddir)

if \pipe then
do
if stream(localfile,"C","QUERY EXISTS")="" then return -2
if touch then
   call touch files.1, localfile

if globbed & longname then
    call PutLong localfile, remotefile

if history then
   call PutComment localfile, user, host, curdir, remotefile
end

if pipe then
   do
   call stream localfile,'C','CLOSE'
   destination||"<"||localfile
   call SysFileDelete localfile
   end

return err

put: procedure expose debug binaries unique quiet bell visual

parse arg localfile, remotefile, lunique

if remotefile="" then remotefile=localfile
if remotefile="" | remotefile="." then
   do
   say "You must specify a file name!"
   return
   end
remotefile=filespec('name',remotefile)
if \quiet then say "Transferring "localfile" as "remotefile" ..."

call time "r"

if (unique) | (lunique=1) then
   if wordpos(extension(localfile),binaries)=0 then
      err = FtpPutUnique(localfile,remotefile)
   else err=FtpPutUnique(localfile,remotefile,"BINARY")
else if wordpos(extension(localfile),binaries)=0 then
      err = FtpPut(localfile,remotefile)
   else err=FtpPut(localfile,remotefile,"BINARY")

elapsed = strip(format(time("e"),10,2))
bytes = stream(localfile,"C","QUERY SIZE")
if \quiet & (elapsed<>0) & (datatype(bytes)="NUM") then
   say "Transmitted" bytes "bytes in" elapsed "seconds:" strip(format(bytes/elapsed,10,2))  "bytes/second."

if \quiet & bell then call beep 278,200

return err

extension: procedure

arg filename
/* If no period or only period is first char, then return "" */
if lastpos(".",filename)<2 then return ""
return substr(right(filename,pos(".",reverse(filename))),2)

mget: procedure expose debug binaries file2 clobber quiet touch dir longname history host user prompt bell visual

parse arg spec

if \quiet then say "Transferring file list..."
if spec="" then spec="."
err=FtpLS(spec,'files.')
if \quiet then say files.0 "files requested."
all=\prompt
do i=1 to files.0
   if prompt & \all then
      do
      if \visual then
      do
         Call Charout, "Get "files.i" (yes|no|all|quit)? "
         do until pos(translate(key),"YNAQ")<>0
            key=SysGetKey("NoEcho")
         end
         say key
         key=translate(key)
         select
            when key="Y" | key="A" then
               do
               err=get(files.i)
               if key="A" then all=\all
               end
            when key="Q" then leave
            otherwise nop;
         end
      end
      else if vmsg("Multiple File Request","Get "||files.i||"? ",6)=="YES" then err=get(files.i)
      end
   else err=get(files.i)
end
if \quiet then say "Transfer complete."
return 0

mput: procedure expose debug prompt clobber unique quiet bell visual

parse arg spec

if \quiet then say "Obtaining file list..."
if spec="" then spec="."
if spec="." then spec="*"
rc=SysFileTree(spec, "files.", "FO")
if \quiet then say files.0 "files to be transferred."
all=\prompt
do i=1 to files.0
   if prompt & \all then
      do
      if \visual then
         do
         Call Charout, "Put "files.i" (yes|no|all|quit)? "
         do until pos(translate(key),"YNAQ")<>0
            key=SysGetKey("NoEcho")
         end
         say key
         key=translate(key)
         select
            when key="Y" | key="A" then
               do
               err=put(files.i)
               if key="A" then all=\all
               end
            when key="Q" then leave
            otherwise nop;
         end
         end
      else if vmsg("Multiple File Request","Put "||files.i||"? ",6)=="YES" then err=get(files.i)
      end
   else err=put(files.i)
end
if \quiet then say "Transfer complete."
return 0

english: procedure

arg code

select
   when code="FTPSERVICE"     then phrase="unknown service"
   when code="FTPHOST"        then phrase="unknown host"
   when code="FTPSOCKET"      then phrase="unable to obtain socket"
   when code="FTPCONNECT"     then phrase="unable to connect to server"
   when code="FTPLOGIN"       then phrase="login failed"
   when code="FTPABORT"       then phrase="transfer aborted"
   when code="FTPLOCALFILE"   then phrase="problem openning local file"
   when code="FTPDATACONN"    then phrase="problem initializing data connection"
   when code="FTPCOMMAND"     then phrase="command failed"
   when code="FTPPROXYTHIRD"  then phrase="proxy server does not support third party transfers"
   when code="FTPNOPRIMARY"   then phrase="no primary connection for proxy transfer"
   when code="0"              then phrase="no error (possibly unknown error)"
otherwise
   phrase="unknown error condition "||code||" - contact author"
end

return phrase

/*------------------------------------------------------------------
 * some help
 *------------------------------------------------------------------*/
Usage: procedure expose debug binaries version credits. pager

arg cmd .

select
   when cmd="!" then say "!     issue a command to OS/2"
   when cmd="CONNECT" | cmd="OPEN" then
      do
      say "connect host [user [password]]"
      say "connect user@host [password]"
      say "open host [user [password]]"
      say "open user@host [password]"
      say
      say "Connect to a remote host.  If user is not specified, anonymous"
      say "is selected as the default."
      end
   when cmd="CLOSE" then say "close     Close the remote session"
   when cmd="LCD"   then say "lcd       Change the local working directory"
   when cmd="SITE"  then say "site command      Issue a site specific command to the remote host"
   when cmd="VERSION"  then say "version      Display information about the version of MaxiFTP"
   when cmd="QUOTE"  then say "quote command      execute the command on the remote host"
   when cmd="REDIR" then say "redir     redisplay the last dir or ls results"
   when cmd="PREDIR" then say "predir     redisplay the last dir or ls results through the pager"
   when cmd="PAGER" then
      do
      say "By default, MaxiFTP uses MORE as the pager.  If you prefer a different pager, put it's"
      say "name (and path information) in the PAGER environment variable."
      end
   when cmd="VISUAL" then
      do
      say "VISUAL"
      say
      say "Enter MaxiFTP's VISUAL FTP mode."
      say
      say "In visual mode, MaxiFTP presents a scrollable list of files and directories from the"
      say "remote host in a PM dialog box.  You can choose a file to transfer or a directory to"
      say "enter by clicking with your mouse.  Choosing CANCEL will exit MaxiFTP.  You can also"
      say "issue any MaxiFTP command, and output will be displayed in the window where MaxiFTP"
      say "started."
      say
      say "VISUAL mode may be selected by typing the command VISUAL at the MaxiFTP prompt, or"
      say "starting MaxiFTP with the /V option.  If you rename MaxiFTP to VisFTP, VISUAL mode"
      say "will be the default."
      end
   when (cmd="DIR") | (cmd="LS")  | (cmd="PDIR") then
      do
      say "dir [pattern] [|command]"
      say "pdir [pattern]"
      say "ls [pattern] [|command]"
      say
      say "  Display a directory listing for the remote host"
      say "  The output can be piped into another program."
      say "  ls displays a short listing, dir displays a long format listing"
      say "  pdir displays a directory using the more command."
      say "Examples:"
      say "  dir"
      say "  ls *.exe"
      say '  dir "|head -20"'
      end
   when (cmd="TYPE") | (cmd="PAGE") | (cmd="MORE") then
      do
      say "type filename [|command]"
      say "page filename"
      say
      say "Display a remote file on the screen."
      say "The page command uses MORE as a pager.  The output from type can"
      say "optionally be piped to another program."
      end
  when (cmd="GET") | (cmd="PUT") then
      do
      say "get remotefile [localfile]"
      say "aget remotefile [localfile]"
      say "bget remotefile [localfile]"
      say "put localfile [remotefile]"
      say "uput localfile [remotefile]"
      say
      say "GET transfers a file from a remote host to the PC."
      say "AGET transfers a file from a remote host to the PC in ASCII mode."
      say "BGET transfers a file from a remote host to the PC in BINARY mode."
      say "PUT transfers a file from the PC to a remote host."
      say "UPUT transfers a file from the PC to a remote host, ensuring a unique name."
      say
      say "There are two transfer modes - ASCII and BINARY.  You can set the"
      say "default mode with the ASCII and BINARY commands.  This client will"
      say "assume binary mode for the following extensions: "binaries
      say
      say "GET also ensures that the file transferred has a valid local name.  It creates"
      say "a valid local name from the remote name if necessary."
      end
  when (cmd="RENAME") then  say "rename oldname newname       rename a remote file"
  when (cmd="DELETE") then  say "delete filename     delete a remote file"
  when (cmd="SYS") then  say "sys       Display information about remote host"
  when (cmd="QUIT") then say "quit      Leave MaxiFTP"
  when (cmd="ASCII") then say "ascii     set default transfer mode to 7-bit ASCII"
  when (cmd="BINARY") then say "binary    set default transfer mode to 8-bit BINARY"
  when (cmd="PWD") then say "pwd       display remote working directory"
  when (cmd="MD") then say "md       create a new directory on the remote host"
  when (cmd="CDUP") then say "cdup       change to a the parent of the current remote working directory"
  when (cmd="RD") then say "rd       remove an existing directory on the remote host"
  when (cmd="APPEND") then say "append      transfer an ASCII file and append to an existing local file"
  when (cmd="SHOW") then say "show       display information about the current connection"
  when (cmd="CREATE") then say "create      create an empty file on the remote host"
  when (cmd="CD") then
     do
     say "cd directory"
     say "directory"
     say
     say "Change to the specified directory on the remote host.  If you type a"
     say "directory name by itself that does not match a MaxiFtp command,"
     say "MaxiFtp assumes the CD command."
     end
  when (cmd="MGET")|(cmd="MPUT") then
     do
     say "mget filespec"
     say "mput filespec"
     say
     say "Transfer a group of files at once."
     say "If PROMPT is set (default), you will be asked to confirm each transfer."
     say "The values of CLOBBER and UNIQUE will affect local and remote filenames."
     end
  when (cmd="NETRC") then
     do
     say "MaxiFTP will use the TCP/IP NETRC file to obtain information about a host"
     say "and connections.  MaxiFTP uses the hostname, username, and password fields."
     say "At present, it ignores any other values."
     say
     say "By default, when you issue a connection command, MaxiFTP will look for an"
     say "entry in your NETRC file and use those values, unless you have specified"
     say "different values at the command line or MaxiFTP prompt."
     say
     say "MaxiFTP looks for a NETRC file first in your current directory and then"
     say "in the directory pointed to by the %etc% variable."
     say
     say "If you wish MaxiFTP to ignore the NETRC file, you can issue the"
     say "TOGGLE NETRC command or place the -n- option on the command line or in the"
     say "MAXIFTP environment variable."
     end
  when (cmd="TOGGLE") then
     do
     say "toggle [setting]"
     say
     say "where setting is one of the following:"
     say
     say "CLOBBER  controls whether or not MaxiFTP will automatically overwrite existing"
     say "         files."
     say "PROMPT   determines whether or not MaxiFTP will prompt during mget and mput."
     say "DISPLAY  toggles displaying a status bar at the top of the screen."
     say "UNIQUE   determines whether or not remote file targets during put will be"
     say "         forced to be unique."
     say "QUIET    determines whether messages will be displayed about command success"
     say "         and failure."
     say "TOUCH    make the timestamp on files transferred with get/mget match the remote"
     say "         filesystem."
     say "NETRC    use the NETRC file for information about a connection."
     say "LONGNAME store the real name in the .LONGNAME extended attribute on a FAT"
     say "         partition if the name is globbed."
     say "HISTORY  store information in the .HISTORY extended attribute."
     say "BELL     ring a bell after connecting and after a transfer."
     end
  when (cmd="COLON-MODE") then
     do
     say "MaxiFTP implements a simple, automated FTP transfer.  You can invoke MaxiFTP"
     say "with a colon in the host name, followed by the name of the file to transfer."
     say "MaxiFTP will attempt (one time) to connect to the remote host, transfer the "
     say "file, and close the connection."
     say "The filename can include a wildcard.  CLOBBER and NOPROMPT are assumed"
     say "for automated transfers."
     say "You can also specify a user name with or without a password to identify the"
     say "user account on the remote host."
     end
  when (cmd="TOUCH") then
     do
     say "MaxiFTP has a special option called TOUCH that is not included in most FTP"
     say "clients.  In TOUCH mode, MaxiFTP will attempt to make the timestamp on a"
     say "transferred file match the timestamp on the remote system."
     say
     say "This requires having a TOUCH program compatible with the Unix TOUCH command"
     say "installed on your system.  One source for such a program is the GNU File"
     say "Utilities for OS/2 available from ftp-os2.cdrom.com and other anonymous"
     say "FTP sites."
     say
     end
  when (cmd="NEWS") then
     do
     parse source . . name
     news=filespec('drive',name)||filespec('path',name)||"maxiftp.new"
     if stream(news,"C","QUERY EXISTS")<>"" then
        pager " <"news
     else say "No news available."
     end
  when (cmd="CREDITS") then
     do
     say version credits.1
     say
     say "MaxiFTP is based on the MiniFTP client included with the RxFTP package"
     say "from the IBM Employee Written Software Program (EWS)."
     say
     say "Special thanks to Al Dhir for suggesting several features."
     say
     say "My warmest thanks go to Micheal Gleason, author of the NcFTP program"
     say "for Unix.  His program is the inspiration for many of the features found"
     say "in MaxiFTP, and, with his permission, the manual for MaxiFTP is based upon"
     say "the NcFTP manual."
     say
     say "Other ideas for MaxiFTP features have came from the OS/2 internet community."
     say "If you have any suggestions, please mail them to me!"
     say
     say "Albert Crosby - [e-mail]"
     end
  when (cmd="PROMPT") then
     do
     say "The MaxiFTP prompt can be customized.  The command to use is:"
     say "    set prompt=promptstring"
     say
     say "Special information can be inserted in the prompt using the following"
     say "codes:"
     say "@D         Inserts the current remote directory."
     say "@L         Inserts the current local directory."
     say "@H         Inserts the name of the remote host."
     say "@0         Inserts the name of the calling program."
     say "@B         Turns on boldface mode."
     say "@Cfb       Set color to foreground f on background b"
     say "@I or @R   Turns on inverse (reverse) video mode."
     say "@N         Inserts a newline character."
     say "@P         Turns off any video modes you might have set with @B, @I, or @R"
     say "@T         Inserts the current time."
     say '@S         Inserts the current connection status.'
     say "@_         Inserts a blank."
     say "@@         Inserts an at sign."
     say "@E         Inserts the most recent FTP Error code."
     say
     say "The default prompt is  set prompt=@0@S[@B@H:@D@P]@S"
     say
     say "See MaxiFTP.MAN for more information."
     end
  when (cmd="COLORS") then
     do
     say "The @C code in the SET PROMPT command uses colors in the following"
     say "fashion:"
     say
     say " @Cfb Set color to foreground f on background b; where f and b"
     say "      are numbers between 0 and 7.  0 is black; 1 is red; 2 is green; 3"
     say "      is yellow; 4 is blue; 5 is magenta; 6 is cyan; 7 is white."
     end
  when (cmd="OPTIONS") then
     do
     say "MaxiFTP has several command line options which can be specified when starting"
     say "the program, preceeded by a dash ('-') or in the environment variable MAXIFTP."
     say "These are:"
     say
     say " option  type     desc"
     say " ------  -------  -----------------------------------------"
     say " b               default to binary file transfer mode"
     say " a       string  anonymous ftp password"
     say " h       string  display help on a topic"
     say " q       t/f     quiet mode"
     say " d       t/f     display the status banner"
     say " c       t/f     set CLOBBER mode"
     say " p       t/f     set PROMPT mode"
     say " u       t/f     set UNIQUE mode"
     say " t       t/f     set TOUCH mode"
     say " n       t/f     use/do not use NETRC for connection info"
     say " l       string  set the default local directory"
     say ' m       t/f     use "#macros" from netrc file'
     say ' x       t/f     use rxSock to determine hostname'
     say " r       n:s     Retry N times with S second pause between tries"
     say
     say "The t/f (true/false) options default to true.  If followed by a '-',"
     say "they set the value to false.  The string options must be followed"
     say "immeadiately by a string (with no blanks) that sets the value."
     end
otherwise
   say version credits.1
   say
   say "   Commands available are:"
   say "       !       cdup     dir   mget    put    redir   toggle   set"
   say "       ?       close    get   open    pwd    rename  type     echo"
   say "       append  connect  help  page    quit   show    uput     aget"
   say "       ascii   create   ls    pdir    quote  site    version  bget"
   say "       cd      delete   md    predir  rd     sys     lcd      addhost"
   say
   say "Additional topics:  colon-mode  intro  options  touch  netrc credits"
   say "                    prompt"
   say
   say "Enter HELP COMMAND for more information or HELP NEWS for news."
   say "Refer to MaxiFTP.MAN for additionl information on MaxiFTP."
   if cmd="INTRO" then
      do
      say
      say "MaxiFTP may be called with [user@]host:filename to transfer a file and exit."
      say
      say "See MaxiFTP.NEW for additional information or the online help."
      say
      say "Syntax: "
      say "   MaxiFTP [-options] [host[:filename] [user [password]]]"
      say "   MaxiFTP [-options] [user@host[:filename] [password]]"
      end
end

   return 0

displaystatus: procedure expose debug host dir rows cols mode clobber prompt status unique quiet touch bell

   /*---------------------------------------------------------------
    * print status
    *---------------------------------------------------------------*/
   say
   say
   say
   parse value SysCurPos(0,0) with row col

   do i = 1 to 5
      call SysCurPos i-1, 0
      say copies(" ",cols)
   end
   call SysCurPos 0,0


   say d2c(218) || copies(d2c(196),cols-3) || d2c(191)
   say d2c(179) || left(" MaxiFtp: "||time()||" "||status,cols-3) || d2c(179)
   say d2c(179) || left(" directory: "||dir,cols-3) || d2c(179)
   line=" " || left(mode,7)
   if clobber then line=line||"CLOBBER   "
   else line=line||"NOCLOBBER "
   if prompt then line=line||"PROMPT   "
   else line=line||"NOPROMPT "
   if quiet then line=line||"QUIET   "
   if touch then line=line||"TOUCH   "
   if unique then line=line||"UNIQUE"
   say d2c(179) || left(line,cols-3) || d2c(179)
   say d2c(192) || copies(d2c(196),cols-3) || d2c(217)

if row>6 then call SysCurPos row-2, col
else Call SysCurPos 5, col

return

querystatus:

say version credits.1
vsn="Junk"
junk=FtpVersion('vsn')
say "rxFTP version "vsn
if host<>"" then
   do
   say "Remote host: "host
   say "Remote directory: "dir
   say "Remote system type: "sys
   end
else say "Not connected to a remote host."
say "Default transfer mode: "mode
say "Local directory: "directory()
say "Anonymous password: "anonpass
say "Pager: "pager
say "Prompt: "promptstr
say "NETRC file: "netrcfile
if clobber then
   say "CLOBBER is ON (local files are overwritten)"
else say "CLOBBER is OFF (local files are not overwritten)"
if prompt then
   say "MPROMPT is ON (you will be prompted during mget and mput"
else say "MPROMPT is OFF (you will not be prompted during mget and mput"
if display then
   say "DISPLAY is ON (status bar is displayed)"
else say "DISPLAY is OFF (status bar is not displayed)"
if unique then
   say "UNIQUE is ON (remote files during put will be forced to unique names)"
else say "UNIQUE is OFF (remote files during put will not be forced to unique names)"
if quiet then
   say "QUIET is ON (messages will not be displayed)"
else say "QUIET is OFF (messages will be displayed)"
if touch then
   say "TOUCH is ON (files received will be stamped with the remote timestamp)"
else say "TOUCH is OFF (files received will not be stamped with the remote timestamp)"
if netrc then
   say "NETRC is ON (the NETRC file will be searched for connection info)"
else say "NETRC is OFF (the NETRC file will not be searched for connection info)"
if macros then
   say "MACROS is ON (NETRC macros will be processed for hosts in the NETRC)"
else say "MACROS is OFF (NETRC macros will not be processed for hosts in the NETRC)"
if visual then
   say "VISUAL mode is ON (VREXX will be used for directory lists & dialogs)"
else say "VISUAL mode is OFF (VREXX will not be used.)"
say "File types automatically transferred in binary mode:"
say "   "binaries
say "File types automatically transferred in ASCII mode:"
say "   "asciis

return

connect: procedure expose debug host user pass phost anonpass quiet netrc sys dir retries delay bell visual needdir netrcfile hostlist. hostnetrcline

if visual then needdir=1
if (host="") then
   if visual then
      do
      host=VListNETRC()
      if host="" then call GetHost
      end
   else
      do
      call Usage "CONNECT"
      return -1
      end
if netrc then Call LookUpNETRC hostnetrcline
do attempt=1 to retries
         if pos("@",host)<>0 then
            do
            pass=user
            parse var host user"@"host
            end
         if pos(":",host)<>0 then
            do
            end
         if netrc & (newhost<>"") then host=newhost
         if netrc & (user="") & (newuser<>"") then
            do
            user=newuser
            pass=newpass
            end
         if (user="") then user="anonymous"
         if (translate(user)="ANONYMOUS") & (pass="") then pass=anonpass
         if (translate(user)<>"ANONYMOUS") & (pass="") then
            if visual then call GetHost
            else
               do
               call charout ,"Enter the password: "
               pass=getpasswd()
               end
         if pos(".",host)="" then phost=host
         else parse var host phost".".
         if \quiet then say "Connecting to "user"@"host"..."
         call FtpSetUser host, user, pass
         sys=""
         err = FtpSYS('sys')
         if err<>0 & FTPERRNO<>0 & FTPERRNO<>"FTPCOMMAND" then
            do
            if attempt=retries then
               do;
               if \quiet then say "Connection failed: "english(FTPERRNO)
               host=""
               phost=""
               user=""
               do queued()
                  parse pull .
               end
               leave
               end
            else
               do
               if \quiet then say "Connection failed: "english(FTPERRNO) "retrying... (try "attempt")"
               call SysSleep Delay
               iterate
               end
            end
         if word(sys,1)="VM" then
            do
            if visual then
               do
               end
            else
            do;
            say "Remote system is VM/CMS.  Please enter the minidisk password:"
            account=getpasswd()
            end
            call FtpSetUser host, user, pass, account
            end
         err = FtpPWD('dir')
         if err<>0 & FTPERRNO<>0 then
            do
            if attempt=retries then
               do;
               say "Connection failed: "english(FTPERRNO)
               host=""
               phost=""
               user=""
               do queued()
                  parse pull .
               end
               end
            else
               do
               if \quiet then say "Connection failed: "english(FTPERRNO) "retrying... (try "attempt")"
               call SysSleep Delay
               end
            end
         else
            do
            if \quiet & bell then call beep 278,200
            leave;
            end
end
return  err

toggle: procedure expose debug prompt clobber display unique quiet touch netrc longname history bell
arg toggles

do i=1 to words(toggles)
toggle=word(toggles,i)
select
   when (toggle="PROMPT") | (toggle="MPROMPT") then prompt=\prompt
   when toggle="CLOBBER" then clobber=\clobber
   when toggle="STATUS" | toggle="DISPLAY" then display=\display
   when toggle="UNIQUE" then unique=\unique
   when toggle="QUIET" then quiet=\quiet
   when toggle="TOUCH" then touch=\touch
   when toggle="NETRC" then netrc=\netrc
   when toggle="HISTORY" then history=\history
   when toggle="LONGNAME" then longname=\longname
   when toggle="BELL" then bell=\bell
otherwise
   say "Unknown option: "toggle
   return
end
end
return

processargs:

parse arg args

do until length(args)=0
   tf=1
   key=translate(left(args,1))
   args=substr(args,2)
   if key=" " then iterate
   if key='"' then
      do
      parse var args '"'.'"'args
      iterate
      end
   if left(args,1)="-" then
      do
      tf=0
      args=substr(args,2)
      end
   select
      when key="B" then if tf then mode="BINARY" else mode="ASCII"
      when key="A" then /* Anonymous password */
         if left(args,1)<>" " then
            do
            if left(args,1)='"' then
               parse var args '"'anonpass'"'args
            else
               do
               anonpass=subword(args,1,1)
               args=subword(args,2)
               end
            end
      when key="R" then /* speficy retries[:delay] */
         do
         time=subword(args,1,1)
         args=subword(args,2)
         parse var time retries":"delay
         if \datatype(delay,"W") then delay=60
         if \datatype(retries,"W") then retries=1
         end
      when key="L" then /* change local directory */
         if left(args,1)<>" " then
            do
            if left(args,1)='"' then
               parse var args '"'ldir'"'args
            else
               do
               ldir=subword(args,1,1)
               args=subword(args,2)
               end
            call directory ldir
            end
      when key="H" |key="?" then /* Help */
         do
         if \quiet then call Credits
         if left(args,1)<>" " then
            do
            if left(args,1)='"' then
               parse var args '"'topic'"'args
            else
               do
               topic=subword(args,1,1)
               args=subword(args,2)
               end
            Call Usage topic
            end
         else if host<>"" then call Usage host
         else Call Usage "INTRO"
         exitcode=0
         signal done
         end
      when key="U" then unique=tf
      when key="C" then clobber=tf
      when key="P" then prompt=tf
      when key="D" then display=tf
      when key="Q" then quiet=tf
      when key="T" then touch=tf
      when key="N" then netrc=tf
      when key="X" then nop;
      when key="V" then
         do
         visual=tf
         if visual then visual=1
         end
   otherwise
      if \quiet then say "Invalid option: "key
   end
end

return

Credits:

do
   call charout, greenonblack

   if translate(progname)<>"MAXIFTP" then say name "is ..."
   say version
   do i=1 to credits.0
   say credits.i
   end
   junk=FtpVersion('vsn')
   say "Using RxFTP version "vsn normvideo
end
return

LoadFunctions:

/*------------------------------------------------------------------
 * load functions, if needed
 *------------------------------------------------------------------*/
if RxFuncQuery("FtpLoadFuncs") then
   do
   rc = RxFuncAdd("FtpLoadFuncs","RxFtp","FtpLoadFuncs")
   if rc\=0 then
      do
      say "Error loading the rxFtp package.  rxFtp is an extension to REXX"
      say "that allows it to utilize the FTP protocol and API. You can"
      say "obtain rxSock via anonymous FTP from software.watson.ibm.com or"
      say "ftp-os2.cdrom.com."
      end
   rc = FtpLoadFuncs()
   end

if RxFuncQuery("SysLoadFuncs") then
   do
   rc = RxFuncAdd("SysLoadFuncs","RexxUtil","SysLoadFuncs")
   rc = SysLoadFuncs()
   end

if pos(" X-",translate(args))=0 & RxFuncQuery("SockLoadFuncs") then
   do
   rc = RxFuncAdd("SockLoadFuncs","RxSock","SockLoadFuncs")
   if rc\=0 then
      do
      hostname=value("HOSTNAME",,"OS2ENVIRONMENT")
      end
   else rc = SockLoadFuncs()
   end
else hostname=value("HOSTNAME",,"OS2ENVIRONMENT")

return

touch: procedure

parse arg direntry, file

sys=""
err=FtpSYS('sys')
sys=word(sys,1)

if right(file,1)=":" then return 0
if wordpos(translate(file),"NUL CON LPT1 LPT2 LPT3 LPT4 PRN -") then return 0

select
   when sys="Netware" then
      do
      parse var direntry . 42 time 57 .
      time=subword(time,1,2)||", "||subword(time,3)
      end
   when sys="Windows_NT" | sys="UNIX" | left(direntry,1)="-" then
      do
      time=subword(direntry,words(direntry)-3,3)
      if pos(":",time)=0 then
         time=subword(time,1,2)||", "||subword(time,3)
      end
   when sys="OS/2" then
      do;
      parse var direntry . 36 time 52 .
      months="Jan Feb Mar Apr May June July Aug Sep Oct Nov Dec"
      parse var time month"-"day"-"year time
      time=word(months,month)||" "||day||", "||year||" "||time
      end
   when sys="Windows_NT" then parse var direntry . 45 time 57 .
   when sys="VM" then parse var direntry . 54 time 71 .
otherwise
   say "Cannot determine timestamp for operating system "SYS
   say "If you would like to have TOUCH updated for this OS, contact the author"
   say "with the OS information and the contents of the next line."
   say direntry
   say file
   return -1
end

'touch -d "'strip(time)'"' file
if rc=1041 then say "The TOUCH mode requires a TOUCH program compatible with the UNIX touch command."
if rc<>0 then say "TOUCH appears to have failed.  You may want to contact the author for assistance."

return 0

create: procedure expose debug quiet bell

parse arg fn

if \quiet then say "Creating message "fn
tempfile=systempfilename("tmp?????")
call lineout tempfile
call stream tempfile,'C','CLOSE'
oq=quiet
quiet=1
unique=0
binaries=""
err=put(tempfile,fn)
quiet=oq
call SysFileDelete tempfile
return 1

lookupnetrc: procedure expose debug host newhost newuser newpass netrcfile hostlist.

newhost=""
newuser=""
newpass=""

if host="" then return 0

do i=1 to hostlist.0
   if \abbrev(translate(word(hostlist.i,1)),translate(host)) then iterate
   host=word(hostlist.i,1)
   leave
end

if SysFileSearch(host, netrcfile,'hits.','N')<>0 then
   return -1
if hits.0=0 then return 0
if datatype(arg(1),'W') then hits.1=arg(1)
do i=1 to word(hits.1,1)-1
   call linein netrcfile
end

found=0
do while (stream(netrcfile,'s')="READY")
   line=linein(netrcfile)
   if \found & (left(line,1)="#") | (left(line,1)=";") | (length(line)=0) then iterate
   if (substr(line,2,1)="#") | (substr(line,2,1)=";") then iterate
   tline=translate(line)
   if \found & pos('MACHINE',tline)=0 then iterate;
   if pos("MACHINE",tline)<>0 then
      if found then leave
      else machinename=word(line,wordpos("MACHINE",tline)+1)
   if \abbrev(translate(machinename),translate(host)) then iterate
   found=1
   if (left(line,1)<>"#") & (left(line,1)<>";") then
      do
      if pos("LOGIN",tline)<>0 then newuser=word(line,wordpos("LOGIN",tline)+1)
      if pos("PASSWORD",tline)<>0 then newpass=word(line,wordpos("PASSWORD",tline)+1)
      end
   else
      do
      parse var line 2 cmd cmdargs
      Queue cmd cmdargs
      end
end
call Stream netrcfile, 'c', 'close'
if found then newhost=machinename
return found

dir: procedure expose stem. pager sys host dir phost status quiet bell visual dircmd

parse arg cmd, mask, dest

   if cmd="" then cmd="DIR"
   if mask="" then mask="."

   if ((cmd="DIR")|(cmd="PDIR")) & left(mask,1)<>"-" then
      do
      if cmd="PDIR" then cmd="P"||translate(word(dircmd,1))
      else cmd=translate(word(dircmd,1))
      mask=subword(dircmd,2) mask

      end

   err=0
   select
   when (cmd="LS") | (cmd="PLS") then
      if (mask=".") & (pos("UNIX",translate(sys))<>0)
         then err=FtpLS("-CF",'stem.')
         else err=FtpLS(mask,'stem.')
   when (cmd="DIR")| (cmd="PDIR") then err=FtpDIR(mask,'stem.')
   when (cmd='ls') then err=FtpLS(mask,'stem.')
   when (cmd="REDIR") | (cmd="PREDIR") then nop;
   otherwise return -1
   end

   if (left(cmd,1)<>"P") & (left(dest,1)<>'|') & (left(dest,1)<>'>') then
      do i = 1 to stem.0
         say stem.i
      end
   else
      do
      if left(cmd,1)="P" then dest="|"||pager
      tempfile=systempfilename("ftp?????")
      if left(dest,2)='>>' then tempfile=substr(dest,3)
      else if left(dest,1)='>' then
         do;
         tempfile=substr(dest,2)
         call SysFileDelete tempfile
         end;
      do i = 1 to stem.0
         call lineout tempfile, stem.i
      end
      if left(dest,1)="|" then substr(dest,2) "<" tempfile
      call stream tempfile,'C','CLOSE'
      if left(dest,1)<>'>' then call SysFileDelete tempfile
      end
   if (err <> 0) & (ftperrno <>0) then
      do
      say "Error from FTP:" english(FTPERRNO)
      if ftperrno="FTPCONNECT" then
         do
         say "Remote server closed connection."
         host=""
         phost=""
         dir=""
         end
      end
return err

ProcessCMD:

parse arg cmd, cmdargs

   if cmd="" then return 0

   if left(cmdargs,1)='"' then
      parse var cmdargs '"'file1'"' rest
   else parse var cmdargs file1 rest
   if left(cmdargs,1)='"' then
      parse var rest '"'file2'"' rest
   else parse var rest file2 rest

   if (left(file1,1)="|") then
      do
      rest=file2||" "||rest
      file2=file1
      file1=""
      end
   if (left(file1,1)=">") then
      do
      rest=file2||" "||rest
      file2=file1
      file1=""
      end
   if (file1 = "") then file1 = "."
   if (file2 = "") then file2 = file1

   /*------------------------------------------------------------------
    * sanity check
    *------------------------------------------------------------------*/
   origcmd=cmd
   cmd = translate(cmd)

   if (host="") & (left(cmd,1)<>"!") & (wordpos(cmd,"CONNECT FTP OPEN VERSION ? HELP QUIT TOGGLE SHOW ASCII LCD SET BINARY VISUAL ECHO CREDITS ADDHOST")=0) then
      do
      say "You have not provided host, userid, and password information."
      say "Use the CONNECT command to provide this information."
      return 0
      end

   /*---------------------------------------------------------------
    * run command
    *---------------------------------------------------------------*/
   err = 0
   select
      when left(cmd,1)="!"   then
         do
         if cmd="!" then value("COMSPEC",,"OS2ENVIRONMENT")
         else substr(origcmd,2) cmdargs
         end
      when (cmd = "MGET")    then  err=mget(file1)
      when (cmd = "ECHO")    then say cmdargs
      when (cmd = "MPUT")    then err=mput(file1)
      when (cmd = "QUIT")    then return 0
      when (cmd = "SET")     then Call Set cmdargs
      when (cmd = "BINARY")  then err = Mode("BINARY")
      when (cmd = "ASCII")   then err = Mode("ASCII")
      when (cmd = "GET")     then err = Get(file1,file2)
      when (cmd = "AGET")     then err = Get(file1,file2,"ASCII")
      when (cmd = "BGET")     then err = Get(file1,file2,"BINARY")
      when (cmd = "PUT")     then err = Put(file1,file2)
      when (cmd = "UPUT")    then err = Put(file1,file2,1)
      when (cmd = "CREATE")  then err = Create(file1)
      when (cmd = "DELETE")  then err = FtpDelete(file1)
      when (cmd = "RENAME")  then err = FtpRename(file1,file2)
      when (cmd = "APPEND")  then err = FtpAppend(file1,file2,"ASCII")
      when (cmd = "MODE")    then err = Mode(file1)
      when (cmd = "QUOTE")   then err = FtpQuote(cmdargs)
      when (cmd = "SITE")    then err = FtpSite(cmdargs)
      when (cmd = "CD")      then err = FtpChDir(file1)
      when (cmd = "CDUP")    then err = FtpChDir('..')
      when (cmd = "MD")      then err = FtpMkDir(file1)
      when (cmd = "RD")      then err = FtpRmDir(file1)
      when (cmd = "CREDITS") then call Credits
      when (cmd = "ADDHOST") then
         do
         hostlist.0=hostlist.0+1
         i=hostlist.0
         hostlist.i=cmdargs
         end
      when (cmd = "VISUAL")  then
         if \visual then
            do;
            visual=visinit();
            if visual then call visftp;
            end
      when (cmd = "TOGGLE")  then Call toggle cmdargs
      when (cmd = "VERSION") then say version credits.1
      when (cmd = "SHOW")    then Call QueryStatus
      when (cmd="DIR") | (cmd="PDIR") | (cmd="REDIR") | (cmd="PREDIR") | (cmd="LS")
                             then err = Dir(cmd,file1,file2)
      when (cmd = "?") | (cmd="HELP")
                             then call Usage file1

      when (cmd = "TYPE")|(cmd = "PAGE")|(cmd="MORE")    then
         if file2==file1 then
            do
            if cmd="TYPE" then err=get(file1,"-")
            else err=get(file1,"|"||pager)
            end
         else err=get(file1,file2)

      when (cmd = "CONNECT") | (cmd="OPEN") | (cmd="FTP") then
         do
         if left(cmdargs,1)='"' then
            parse var cmdargs '"'host'"' rest
         else parse var cmdargs host rest
         if left(cmdargs,1)='"' then
            parse var rest '"'user'"' rest
         else parse var rest user rest
         parse var rest pass
         err=Connect()
         end

      when (cmd = "LCD") then
         do
         ldir=directory(file1)
         if \quiet then say "Local working directory is now "ldir
         end

      when (cmd = "CLOSE")   then
         do
         if host="" then return
         rc = FtpLogoff()
         host = ""
         user = ""
         pass = ""
         end

      when (cmd = "PWD")     then
         do
         junk = FtpPwd('dir')
         say "Current Remote Directory :" dir
         end

      when (cmd = "SYS")     then
         do
         sys=""
         junk = FtpSys('sys')
         say "Remote operating system is:" sys
         end

      otherwise /* Try changing to a directory with the name of command. */
         err = FtpChDir(origcmd)
         if (err<>0) then
            do
            say "Invalid command. Use ? for help."
            return 0
            end
         else
            do
            err=FtpPWD('dir')
            if visual then needdir=1
            end
         return err
   end

if debug then say sourceline() "Error code is "err "/ftp error no. "ftperrno "["english(FTPERRNO)"]"

return err

ProcessNETRC:

call stream netrcfile, 'c', 'open read'
do while (stream(netrcfile,'s')="READY")
   line=linein(netrcfile)
   if (left(line,1)<>"#") & (left(line,1)<>";") then leave
   if (substr(line,2,1)="#") | (substr(line,2,1)=";") then iterate
   parse var line 2 cmd cmdargs
   if (translate(cmd)="VISUAL") then visual=1
   else Call ProcessCMD cmd, cmdargs
end
call Stream netrcfile, 'c', 'close'
return

ProcessINI:

arg inifile

call stream inifile, 'c', 'open read'
do while (stream(inifile,'s')="READY")
   line=linein(inifile)
   if (left(line,1)="#") | (left(line,1)=";") then iterate
   parse var line cmd cmdargs
   if (translate(cmd)="VISUAL") then visual=1
   else Call ProcessCMD cmd, cmdargs
end
call Stream inifile, 'c', 'close'
return

set:
parse arg command

if (pos('=',command)<>0) then parse var command var"="parm
else parse var command var parm
var=translate(var)
if left(parm,1)='"' then parse var parm '"'parm'"'

select
   when (var='BINARIES') then binaries=parm
   when (var='ASCIIS') then asciis=parm
   when (var='ANONPASS') then anonpass=parm
   when (var='VISCMD') then viscmd=parm
   when (var='PAGER') then pager=parm
   when (var='DIRCMD') then dircmd=parm
   when (var='LDIR') then ldir=directory(parm)
   when (var='MODE') then Call Mode(parm)
   when (var='NETRCFILE') then
      do
      oldnetrc=netrcfile
      netrcfile=stream(parm,'c','query exists')
      if netrcfile="" then netrcfile=oldnetrcfile
      end
   when (var='MPROMPT') then
      do
      if parm=1 then prompt=1
      if parm=0 then prompt=0
      end
   when wordpos(var,"TOUCH UNIQUE CLOBBER DISPLAY QUIET TOUCH NETRC MACROS")<>0 then
      do
      if parm=1 then interpret var||'=1'
      if parm=0 then interpret var||'=0'
      end
   when (var='PROMPT') then
      do
      promptstr='""'
      do while (length(parm)>0)
         char=left(parm,1)
         parm=substr(parm,2)
         if char='@' then
            do
            var=translate(left(parm,1))
            parm=substr(parm,2)
            select
               when var="B" then promptstr=promptstr||'||boldvideo'
               when var="0" then promptstr=promptstr||'||progname'
               when var="D" then promptstr=promptstr||'||dirname'
               when var="U" then promptstr=promptstr||'||user'
               when var="L" then promptstr=promptstr||'||directory()'
               when var="H" then promptstr=promptstr||'||phost'
               when (var="I") | (var="R")
                            then promptstr=promptstr||'||inversevideo'
               when var="N" then promptstr=promptstr||'||d2c(13)||d2c(10)'
               when var="P" then promptstr=promptstr||'||normvideo'
               when var="T" then promptstr=promptstr||'||time()'
               when var="S" then promptstr=promptstr||'||status'
               when var="E" then promptstr=promptstr||'||FTPERRNO'
               when var="_" then promptstr=promptstr||'||" "'
               when var="@" then promptstr=promptstr||'||"@"'
               when var="C" then
                  do
                  colors=left(parm,2)
                  if (length(colors)=2) & (verify(colors,"01234567")=0) then
                     do
                     parm=substr(parm,3)
                     promptstr=promptstr||'||d2c(27)||"['||left(colors,1)+30||';'||right(colors,1)+40||'m"'
                     end
                  end
            otherwise nop
            end
            end
         else if char='"' then promptstr=promptstr||'||""""'
         else promptstr=promptstr||'||"'char'"'
      end
      end
   when (var="") then nop
   otherwise
      do
      say "You cannot set the value of "var
      return 0
      end
end
return 1

mode: procedure expose mode quiet

parse upper arg modename

err=0
if modename="ASCII" then
    err = FtpSetBinary("ASCII")
else if modename="BINARY" then err= FtpSetBinary("BINARY")
else
   do
   if \quiet then say "Invalid value for mode: "modename
   return 0
   end
mode=modename
if \quiet then say "File transfer mode set to "mode "("err")"

return 0

PutComment: procedure

parse arg file, user, remotehost, remotedir, remotename

if pos('"',remotedir)<>0 then parse var remotedir '"'remotedir'"'.

message="Transferred from "user"@"remotehost":"remotedir

if pos(right(message,1),"/\")=0 then message=message||'/'

message=translate(message,'/','\')||remotename||" at "||time()||" on "||date()"."

RetCode = SysPutEA(File, '.HISTORY','FDFF'x||D2C(LENGTH(Message))||'00'x||Message)
return RetCode

putlong: procedure
parse arg FileName, LongName

if FileName = '' | LongName= '' then DO
   return 0
   end  /* Do */

Return SysPutEA(FileName, '.LONGNAME','FDFF'x||D2C(LENGTH(LongName))||'00'x||LongName)

visinit: procedure expose origdir

if RxFuncQuery("VInit") then
   do
   rc = RxFuncAdd("VInit","VREXX","VINIT")
   if rc\=0 then
      do
      say "Error loading the VRexx/2 package.  VRexx/2 is an extension to REXX"
      say "that allows it to create PM list boxes and dialogs.  It is necessary"
      say "to use MaxiFTP's VISUAL mode.  You can obtain VRexx/2 via anonymous"
      say "FTP from software.watson.ibm.com or ftp-os2.cdrom.com."
      say
      say "Unable to switch to Visual mode."
      visual=0
      return 0
      end
   end

initcode = Vinit()
if initcode = 'ERROR' then
   do
   say "Unable to switch to Visual mode."
   visual=0
   return 0
   end

signal on halt name CLEANUP
signal on failure name CLEANUP
signal on syntax name CLEANUP

call VdialogPos 50,50

return 1

visftp:

say "MaxiFTP is entering Visual mode."

needdir=1
do forever
   if connect()=0 then leave
   host=""
   user=""
   pass=""
end

do queued()
   parse pull cmd cmdargs
   call processcmd cmd, cmdargs
end

request=""
do forever
   request=visdir()
   if request="**CANCEL**" then
      do
      if vmsg("Leave MaxiFTP?","Do you wish to leave MaxiFTP? ",6)=="YES" then signal cleanup
      iterate
      end
   if left(request,1)='<' then
      do
      cmd=word(request,1)
      select
         when cmd="<MODE>" then call toggle 'MODE'
         when cmd="<DIR>" then call dir
         when cmd="<HOST>" then
            do
               oldhost=host
               olduser=user
               oldpass=pass
               host=""
               user=""
               pass=""
               if connect()<>0 then
                  do
                     host=oldhost
                     user=olduser
                     pass=oldpass
                     do forever
                        if connect()=0 then leave
                        host=""
                        user=""
                        pass=""
                     end
                  end
               do queued()
                  parse pull cmd cmdargs
                  call processcmd cmd, cmdargs
               end
            end
         when cmd="<LCD>" then
            do
            prompt.0=1
            prompt.1="Enter the new local directory "
            prompt.vstring=directory()
            button=VInputBox("Change Local Directory",'prompt',60,3)
            if button<>"CANCEL" then call directory prompt.vstring
            end
         when cmd="<PUT>" then
            do
            filespec=directory()
            if right(filespec,1)="\" then filespec=filespec||"*.*"
            else filespec=filespec||"\*.*"
            button=VFileBox("Choose the file to send.",filespec,'file')
            if button="OK" then put(file.vstring)
            end
         when cmd="<CMD>" then
            do
            prompt.0=2
            prompt.1="Enter a MaxiFTP command          "
            prompt.2="(Output will go the window where MaxiFTP started.)          "
            prompt.vstring="dir"
            button=VInputBox("MaxiFTP Command Line",'prompt',75,3)
            if button<>"CANCEL" then
               do
               parse var prompt.vstring cmd cmdargs
               call processcmd cmd, cmdargs
               end
            say "MaxiFTP is in Visual mode."
            end
         otherwise say "Unimplemented: "cmd
      end
      end
   else do
      if pos(right(request,1),'/@*')<>0 then request=left(request,length(request)-1)
      err = FtpChDir(request)
      if err<>0 then call ProcessCMD VisCMD, request
      else needdir=1
      if err<>0 then
         if word(request,1)<>request then
            do
            err=FtpChDir(word(request,1))
            if err<>0 then err=Get(word(request,1))
            end
      end
end

signal cleanup

visdir:
if needdir then
   do
   err=dir('LS','-F','>nul')
   if err<>0 then err=dir('ls','.','>nul')
   if err<>0 then
      do
      stem.0=1
      stem.1="<NO FILES AVAILABLE>"
      end
   list.0=6
   list.1="<HOST> "||user||"@"||host
   list.2="<LCD> Current local dir: "directory()
   list.3="<CMD> Issue a MaxiFTP command"
   list.4="<DIR> Show long information about this listing in the text window"
   list.5="<PUT> Transfer a file TO "host
   list.6=".."
   do i=1 to stem.0
      j=list.0+1
      list.j=stem.i
      list.0=j
   end
   needdir=0
   end
err = FtpPwd('dir')
if pos('"',dir)<>0 then parse var dir '"'dirname'"'.
else dirname=dir
button=VlistBox('Directory Listing: 'dirname,list,80,8,3)
if button="CANCEL" then return "**CANCEL**"
return list.vstring

GetHost: procedure expose host user pass netrcfile hostnetrcline
p.0=3
p.1="Remote host: "
p.2="Username: "
p.3="Password: "
w.0=3
w.1=40
w.2=40
w.3=40
h.0=3
h.1=0
h.2=0
h.3=1
r.=""
r.0=3
if host<>"" then r.1=host
if user<>"" then r.2=user
else r.2="anonymous"
if pass<>"" then r.3=pass
do until host<>""
button=VMultBox('Specify a host',p,w,h,r,3)
if button="CANCEL" then
   do
   if vmsg("Leave MaxiFTP?","Do you wish to leave MaxiFTP? ",6)=="YES" then signal cleanup
   host=""
   user=""
   pass=""
   end
else
   do
   host=r.1
   user=r.2
   pass=r.3
   end
if host<>"" then
   if (vmsg("Update NETRC file","Add this entry to the end of the NETRC file? ",6)=="YES") then
   do
   p.0=1
   p.1="Alias: "
   w.0=1
   w.1=50
   h.0=1
   h.1=0
   r.=""
   r.0=1
   alias=""
   button=VMultBox('Alias for host 'host,p,w,h,r,3)
   if button<>"CANCEL" then alias="#alias "r.1
   say "Updating "netrcfile
   call lineout netrcfile, "##Following entry added by MaxiFTP on "date()
   call lineout netrcfile, "machine "host alias
   if user<>"" then call lineout netrcfile, "     login "user
   if pass<>"" then call lineout netrcfile, "     password "pass
   call lineout netrcfile
   end
if host="" then host=VListNETRC()
end
return button

vmsg: procedure expose origdir

n=0
do i=2 to arg()-1
   n=n+1
   prompt.n=arg(i)
end
prompt.0=n

return VMsgBox(arg(1),'prompt',arg(arg()))

VListNETRC: procedure expose visual origdir netrcfile hostnetrcline hostlist.

say "Presenting a visual list of hosts..."

Call SysFileSearch 'machine', netrcfile,'hits.','N'

hostnetrcline=""

n=1
do i=1 to hostlist.0
   n=n+1
   hosts.0=n
   if words(hostlist.i)=1 then hosts.n=hostlist.i
   else hosts.n=left(subword(hostlist.i,2),100," ")||"@"||word(hostlist.i,1)
end

do i=1 to hits.0
   if left(word(hits.i,2),1)="#" then iterate
   n=n+1
   hosts.0=n
   parse var hits.i "#alias "alias
   if alias<>"" then
      hosts.n=left(alias,100," ")||"@"||word(hits.i,1+wordpos('MACHINE',translate(hits.i)))||" <"||word(hits.i,1)||">"
   else hosts.n=left(word(hits.i,1+wordpos('MACHINE',translate(hits.i))),100," ")||"<"||word(hits.i,1)||">"
end
if n=1 then return ""

hosts.1="<Enter a different host>"

button=VlistBox('Host Selection: ','hosts',45,8,3)
if button="CANCEL" | hosts.vstring="<Enter a different host>" then return ""
parse var hosts.vstring host "<"hostnetrcline">"
if pos("@",host)<>0 then parse var host with " @"host
return strip(host)

addslash: procedure

parse arg path
if right(path,1)="\" then return path
else return path||"\"

CLEANUP:
   call VExit
signal done