/* ftpdctl - control Moylan ftp server
   Commands are start stop status etc.
   Return 0 if OK else error code

   Copyright (c) 2009, 2015 Steven Levine and Associates, Inc.
   All rights reserved.

   2009-11-12 SHL Baseline
   2010-04-07 SHL Show hostname
   2010-10-15 SHL Correct location
   2011-02-22 SHL Use G.! style globals
   2011-02-22 SHL Support log view request
   2011-04-03 SHL On stop merge ftptrans.$$$ and ftptrans.log until fixed by Peter
   2011-06-01 SHL Show transaction log if it exists
   2011-07-05 SHL Support viewing help
   2012-11-09 SHL Show betacat.dnsalias.org host name more often
   2014-05-08 SHL Switch to betacat.dnsd.info / warpcave.dnsd.info
   2014-06-02 SHL Sync with templates
   2014-06-05 SHL Update host names
   2014-07-16 SHL Sync with templates
   2014-12-03 SHL Avoid call setlocal
   2015-01-28 SHL FindLogFile: use LOGFILES if defined
   2015-02-02 SHL Sync with GetPidForProcess, drop unused
*/

signal on Error
signal on FAILURE name Error
signal on Halt
signal on NOTREADY name Error
signal on NOVALUE name Error
signal on SYNTAX name Error

'@setlocal'				/* 2014-12-03 SHL was call SetLocal */

call Initialize

G.!Version = '0.1'

G.!AppTitle = 'Moylan FTP deamon'
G.!AppName = 'ftpd'
G.!CfgExe = 'setup'
G.!CfgFile = 'ftpd.ini'

call FindAppDir

/* Run from application directory */
call directory G.!AppDir

if \ ChkExeInPath(G.!AppName) then
  call Fatal G.!AppTitle 'not found in PATH'

if \ ChkExeInPath(G.!CfgExe) then
  call Fatal G.!CfgExe 'not found in PATH'

if \ ChkExeInPath(G.!CfgFile) then
  call Fatal G.!CfgFile 'not found in' G.!AppDir

G.!Err = 0
G.!Killer = ''
G.!Pid = ''				/* decimal */
G.!RxuLoaded = 0

Main:
  parse arg cmdLine
  call ScanArgs cmdLine
  drop cmdLine

  do argNum = 1 to G.!ArgList.0
    curArg = G.!ArgList.argNum
    call DoArg curArg
  end

  call CleanUp

  exit G.!Err

/* end main */

/*=== DoArg(action) Process requests, return rc ===*/

DoArg: procedure expose G.
  parse arg curArg
  select
  when curArg == 'start' then
    call DoStart
  when curArg == 'stop' then
    call DoStop
  when curArg == 'kill' then
    call DoKill
  when curArg == 'log' then
    call DoLog
  when curArg == 'restart' then
    call DoRestart
  when curArg == 'status' then
    call DoStatus
  when curArg == 'config' then
    call DoConfig
  when curArg == 'help' then
    call DoViewHelp
  otherwise
    call ScanArgsUsage 'Request' curArg 'unexpected'
  end
  return

/* end DoArg */

/*=== DoStart() Start server ===*/

DoStart: procedure expose G.
  if ChkRunning() then
    say G.!AppTitle 'already running and can be accessed remotely as' G.!HostName
  else do
    if G.!Verbose then
      say 'Starting' G.!AppTitle 'from' directory()
    if G.!Foreground then do
      signal off Error
      G.!AppName
      signal on Error
      if RC \= 0 then do
	say G.!AppTitle 'exited with rc ' RC
	G.!Err = 1
      end
    end
    else do
      signal off Error
      'start "' || G.!AppTitle || '" /min /c' G.!AppName
      signal on Error
      if RC \= 0 & RC \= 457 then
	signal Error
      If \ ChkRunning(1) then do
	say 'Can not start' G.!AppTitle
	G.!Err = 1
      end
      else
	say G.!AppTitle 'started and can be accessed remotely as' G.!HostName
    end
  end
  return

/* end DoStart */

/*=== DoStop() Stop ===*/

DoStop: procedure expose G.
  if \ ChkRunning() then
    say G.!AppTitle 'is not running'
  else do
    if \ G.!RxuLoaded then do
      call LoadRxu
      G.!RxuLoaded = 1
    end
    semName = "\SEM32\FTPSERVER\SHUTDOWN"
    /* Requires LoadRxu */
    if RxOpenEventSem('hev', semName) \= 0 then
      say 'Can not open' G.!AppTitle 'shutdown semaphore'
    else do
      call RxPostEventSem hev
      call RxResetEventSem hev
      call RxCloseEventSem hev
    end
    if ChkRunning(0) then do
      say G.!AppTitle 'did not stop'
      G.!Err = 1
    end
    else do
      say G.!AppTitle 'has stopped'
      f1 = G.!TmpDir '\ftptrans.log'
      /* 2011-06-01 SHL fixme to be gone when no longer needed */
      f2 = G.!TmpDir '\ftptrans.$$$'
      if IsFile(f1) & IsFile(f2) then do
	say 'Appending' f2 'to' f1
	'copy' f1 || '+' || f2 f1
	call SysFileDelete f2
      end
    end
  end
  return

/* end DoStop */

/*=== DoKill() Kill ===*/

DoKill: procedure expose G.
  if \ ChkRunning() then
    say G.!AppTitle 'is not running'
  else do
    call RunKiller '-KILL'
    if ChkRunning(0) then do
      say G.!AppTitle 'will not die'
      G.!Err = 1
    end
    else
      say G.!AppTitle 'has stopped'
  end
  return

/* end DoKill */

/*=== DoLog() Log ===*/

DoLog: procedure expose G.

  call FindLogFile 1
  call FindTransFile 1
  s = ''
  if symbol('G.!LogFile') \== 'VAR' then
    say 'Log file probably not yet created'
  else
    s = G.!LogFile
  if symbol('G.!TransFile') \== 'VAR' then
    say 'Trans file probably not yet created'
  else
    s = strip(s G.!TransFile)
  if s \== '' then do
    call FindEditor
    say 'Starting' G.!AppTitle 'viewer'
    G.!Editor s
  end
  return

/* end DoLog */

/*=== DoRestart() Restart ===*/

DoRestart: procedure expose G.
  call DoStop
  if G.!Err = 0 then
    call DoStart
  else
    say G.!AppTitle 'stop failed'
  return

/* end DoRestart */

/*=== DoStatus() Status ===*/

DoStatus: procedure expose G.
  if ChkRunning() then do
    if \ G.!Verbose then do
      say G.!AppTitle 'is running as Pid' G.!Pid'('d2x(G.!Pid)') and'
      say 'can be accessed remotely as' G.!HostName
    end
  end
  else do
    say G.!AppTitle 'is not running'
    G.!Err = 1
  end
  return

/* end DoStatus */

/*=== DoConfig() Config ===*/

DoConfig: procedure expose G.
  'start' G.!CfgExe 'L'
  say G.!AppTitle 'configurator started'
  return

/* end DoConfig */

/*=== DoViewHelp() View help ===*/

DoViewHelp: procedure expose G.
  helpfile = G.!AppDir || '\ftpserver.inf'
  if IsFile(helpfile) then do
    call FindHelpViewer
    /* Start avoids error 184 when using existing session */
    'start' G.!HelpViewer helpfile
  end
  else
    say 'Cannot find' helpfile
  return

/* end DoViewHelp */

/*=== ChkRunning(waitFor) Return TRUE if exe running, caches PID, optionally waits for expected state ===*/

ChkRunning: procedure expose G.
  parse arg waitFor
  do c = 1 to 10
    pid = GetPidForProcess(G.!AppName)
    signal on Error		/* Restore GetPidForProcess override */
    running = pid \== ''
    if waitfor == '' | waitFor == running then leave
    call SysSleep 1
  end
  G.!Pid = pid
  if G.!Verbose & pid \== '' then do
    if symbol('G.!WrkFile') \== 'VAR' then do
      if \ ChkExeInPath('grep') then
	call Fatal 'grep not in PATH'
      s = AddDirSlash(G.!TmpDir) || G.!CmdName || '_???.wrk'
      G.!WrkFile = SysTempFileName(s)
    end
    signal off Error
    '@pstat /c | grep -i' G.!AppName'.exe >'G.!WrkFile
    signal on Error
    '@type' G.!WrkFile
    say 'Pid is' G.!Pid'('d2x(G.!Pid)')'
  end
  return running

/* end ChkRunning */

/*=== CleanUp() Clean up work files ===*/

CleanUp: procedure expose G.
  if symbol('G.!WrkFile') == 'VAR' then do
    '@del /q' G.!WrkFile
    drop G.!WrkFile
  end
  return

/* end CleanUp */

/*=== FindAppDir() Find base directory and set G.!AppDir or die ===*/

FindAppDir: procedure expose G.
  if symbol('G.!AppDir') \== 'VAR' then do
    /* Check current directory */
    s = GetEnv('HOSTNAME')
    if IsFile(G.!CfgFile) & IsFile(G.!AppName || '.exe') then do
      d = directory()
      G.!HostName = 'ftp.' || s || '.com'	/* Guess */
    end
    else do
      /* Check well-known locations */
      select
      when s == 'slamain' | s == 'slat42-1' | s == 'slat60-1' then do
	d = 'd:\Internet\FtpServer'
	G.!HostName = 'warpcave.dnsd.info or betacat.dnsd.info'
      end
      when s == 'acru' then do
	d = 'D:\Apps\ftp'
	G.!HostName = 'ftp.acru.com'
      end
      otherwise
	d = ''
      end
    end
    if d == '' then
      call Fatal 'Can not guess' G.!AppTitle 'base directory for host' s
    if \ IsDir(d) then
      call Fatal G.!AppTitle 'base directory' d 'not found'
    G.!AppDir = d
  end
  return

/* end FindAppDir */

/*=== FindEditor() Find editor ===*/

FindEditor: procedure expose G.

  if symbol('G.!Editor') \== 'VAR' then do
    s = GetEnv('EDITOR')
    if s \== '' then
      G.!Editor = s
    else if ChkExeInPath('vim') then
      G.!Editor = 'vim'
    else if ChkExeInPath('vimx.cmd') then
      G.!Editor = '4os2 /c vimx'
    else if ChkExeInPath('tedit') then
      G.!Editor = 'tedit'
    else
      call Fatal 'Can not select EDITOR'
  end
  return

/* end FindEditor */

/*=== FindLogFile() Find log file ===*/

FindLogFile: procedure expose G.

  parse arg query

  if symbol('G.!LogFile') \== 'VAR' then do
    dir = ''
    do 1
      /* Use LOGFILES or TMP directory */
      dir = value('LOGFILES',, G.!Env)
      if dir \== '' then leave
      if symbol('G.!TMPDIR') == 'VAR' then do
	dir = G.!TmpDir
	leave
      end
      dir = value('TMP',, G.!Env)
    end
    wc = AddDirSlash(dir) || 'ftpusers.log'
    call SysFileTree wc, 'files', 'O'
    if RESULT \= 0 then
      call Fatal 'FindLogFile' wc 'failed'
    select
    when files.0 = 0 then do
      if query = '' then
	call Fatal 'Can not find' wc
    end
    when files.0 = 1 then
      G.!LogFile = files.1
    otherwise
      call Fatal wc 'must match exactly 1 file'
    end
  end
  return

/* end FindLogFile */

/*=== FindTransFile() Find transaction file ===*/

FindTransFile: procedure expose G.

  parse arg query

  if symbol('G.!TransFile') \== 'VAR' then do
    wc = AddDirSlash(G.!TmpDir) || 'ftptrans.log'
    call SysFileTree wc, 'files', 'O'
    if RESULT \= 0 then
      call Fatal 'FindTransFile' wc 'failed'
    select
    when files.0 = 0 then do
      if query = '' then
	call Fatal 'Can not find' wc
    end
    when files.0 = 1 then
      G.!TransFile = files.1
    otherwise
      call Fatal wc 'must match exactly 1 file'
    end
  end
  return

/* end FindTransFile */

/*=== FindHelpViewer() Find help viewer ===*/

FindHelpViewer: procedure expose G.

  if symbol('G.!HelpViewer') \== 'VAR' then do
    do 1
      G.!HelpViewer = 'viewx'
      if ChkExeInPath(G.!HelpViewer) then leave
      G.!HelpViewer = 'ibmview'
      if ChkExeInPath(G.!HelpViewer) then leave
      G.!HelpViewer = 'view'
      if ChkExeInPath(G.!HelpViewer) then leave
      G.!HelpViewer = 'newview'
      if ChkExeInPath(G.!HelpViewer) then leave
      call Fatal 'Can not select help viewer'
    end
  end
  return

/* end FindHelpViewer */

/*=== Initialize() Initialize globals ===*/

Initialize: procedure expose G.
  call GetCmdName
  call LoadRexxUtil
  call LoadRxu
  call LoadRxUtilEx
  G.!Env = 'OS2ENVIRONMENT'
  call GetTmpDir
  return

/* end Initialize */

/*=== RunKiller(signal) Run process killer, default signal to kill if omitted ===*/

RunKiller: procedure expose G.

  parse arg sig

  if sig == '' then
    sig = '-KILL'

  if G.!Pid == '' then
    call Fatal 'Pid not set'

  if G.!Killer = '' then do
    if ChkExeInPath('apache_kill') then
      G.!Killer = 'apache_kill'
    else if ChkExeInPath('emxkill') then
      G.!Killer = 'emxkill'
    if G.!Killer == '' then
      call Fatal 'G.!Killer not defined'
  end
  select
  when G.!Killer == 'apache_kill' then nop
  when G.!Killer == 'emxkill' then nop
  otherwise
    sigTbl = '-HUP 1 -KILL -9 -TERM 15 -USR1 16'
    do i = 1 to word(sigTbl) step 2
      if translate(sig) == word(sigTbl, i) then do
	sig = word(sigTbl, i + 1)
	leave
      end
    end
  end
  cmd = G.!Killer sig G.!Pid
  say G.!Killer sig G.!Pid'('d2x(G.!Pid)')'
  '@'G.!Killer sig G.!Pid

  return

/* end RunKiller */

/*=== ScanArgsInit() ScanArgs initialization exit routine ===*/

ScanArgsInit: procedure expose G. cmdTail swCtl keepQuoted

  if cmdTail == '' then
    call ScanArgsHelp			/* Show script help if no args */

  /* Preset defaults */
  G.!Foreground = 0			/* Start in foreground */
  G.!Verbose = 0			/* Verbose messages */
  G.!ArgList.0 = 0			/* Reset arg count */

  /* Configure scanner */
  swCtl = ''				/* Switches that take args, append ? if arg optional */
  keepQuoted = 0			/* Set to 1 to keep arguments quoted */

  return

/* end ScanArgsInit */

/*=== ScanArgsSwitch() ScanArgs switch option exit routine ===*/

ScanArgsSwitch: procedure expose G. curSw curSwArg
  select
  when curSw == 'f' then
    G.!Foreground = 1
  when curSw == 'h' | curSw == '?' then
    call ScanArgsHelp
  when curSw == 'v' then
    G.!Verbose = 1
  when curSw == 'V' then do
    say G.!CmdName G.!Version
    exit
  end
  otherwise
    call ScanArgsUsage 'switch '''curSw''' unexpected'
  end /* select */
  return

/* end ScanArgsSwitch */

/*=== ScanArgsArg() ScanArgs argument option exit routine ===*/

ScanArgsArg: procedure expose G. curArg
  i = G.!ArgList.0 + 1
  G.!ArgList.i = curArg
  G.!ArgList.0 = i
  return

/* end ScanArgsArg */

/*=== ScanArgsTerm() ScanArgs scan end exit routine ===*/

ScanArgsTerm: procedure expose G.
  if G.!ArgList.0 = 0 then
    call ScanArgsUsage 'action required (i.e. start, stop)'
  return

/* end ScanArgsTerm */

/*=== ScanArgsHelp() Display ScanArgs usage help exit routine ===*/

ScanArgsHelp:
  say
  say 'Control Moylan FTP server for' G.!HostName
  say
  say 'Usage:' G.!CmdName '[-f] [-h] [-v] [-V] [-?] action...'
  say
  say '  -f      Start in foreground (default is background)'
  say '  -h -?   Display this message'
  say '  -v      Enable verbose output'
  say '  -V      Display version'
  say
  say '  action  start, stop, restart, kill, status, config, log, help'
  exit 255

/* end ScanArgsHelp */

/*=== ScanArgsUsage(message) Report Scanargs usage error exit routine ===*/

ScanArgsUsage:
  parse arg msg
  say
  if msg \== '' then
    say msg
  say 'Usage:' G.!CmdName '[-f] [-h] [-v] [-V] [-?] action...'
  exit 255

/* end ScanArgsUsage */

/*==============================================================================*/
/*=== SkelRexxFunc standards - Delete unused - Move modified above this mark ===*/
/*==============================================================================*/

/*=== AddDirSlash(directory) Append trailing \ to directory name unless just drive ===*/

AddDirSlash: procedure
  parse arg dir
  ch = right(dir, 1)
  if dir \== '' & ch \== '\' & ch \== ':' then
    dir = dir || '\'
  return dir

/* end AddDirSlash */

/*=== ChkExeInPath(exe) return TRUE if executable is in PATH, supplies .exe if no extension ===*/

ChkExeInPath: procedure
  parse arg exe
  if exe == '' then
    inPath = 0
  else do
    i = lastpos('.', exe)
    j = lastpos('\', exe)
    if i = 0 | i < j then exe = exe || '.exe'	/* No extension */
    inPath = SysSearchPath('PATH', exe) \== ''
  end
  return inPath

/* end ChkExeInPath */

/*=== ChopDirSlash(directory) Chop trailing \ from directory name unless root ===*/

ChopDirSlash: procedure
  parse arg dir
  if right(dir, 1) == '\' & right(dir, 2) \== ':\' & dir \== '\' then
    dir = substr(dir, 1, length(dir) - 1)
  return dir

/* end ChopDirSlash */

/*=== GetEnv(var) Return value for environment variable or empty string ===*/

GetEnv: procedure expose G.
  parse arg var
  if var = '' then
    call Fatal 'GetEnv requires an argument'
  return value(var,, G.!Env)

/* end GetEnv */

/*=== GetPidForProcess(procname) Return decimal pid for named process or empty string ===*/

GetPidForProcess: procedure expose G.
  /* Requires LoadRxUtilEx */
  parse arg procName
  /* If process name omitted, get own pid */
  if procName = '' then do
    procName = 0
    req = 'P'
  end
  else do
    req = 'N'
  end
  /* Get pid parent-pid process-type priority cpu-time executable-name */
  info = Sys2QueryProcess(procName, req)
  if info == '' then
    decpid = ''				/* Failed */
  else
    parse var info decpid .
  return decpid

/* end GetPidForProcess */

/*=== IsDir(dirName[, full]) return true if directory is valid, accessible directory ===*/

IsDir: procedure
  /* If arg(2) not omitted, return full directory name or empty string */
  parse arg dir, full
  fulldir = ''
  do 1
    if dir == '' then
      leave
    dir = translate(dir, '\', '/')	/* Allow unix slashes */
    s = strip(dir, 'T', '\')		/* Chop trailing slashes unless root */
    if s \== '' & right(s, 1) \== ":" then
      dir = s				/* Chop */
    drv = filespec('D', dir)
    cwd = directory()			/* Remember */
    if drv \== '' & translate(drv) == translate(left(cwd, 2)) then do
      /* Requested directory not on current drive - avoid slow failures and unwanted directory changes */
      drvs = SysDriveMap('A:')
      if pos(translate(drv), drvs) = 0 then
	leave				/* Unknown drive */
      if SysDriveInfo(drv) == '' then
	leave				/* Drive not ready */
      cwd2 = directory(drv)		/* Remember current directory on other drive */
      newdir = directory(dir)		/* Try to change and get full pathname */
      call directory cwd2		/* Restore current directory on other drive */
    end
    else do
      /* No drive letter or same drive */
      newdir = directory(dir)		/* Try to change and get full pathname */
    end
    call directory cwd			/* Restore original directory and drive */
    fulldir = newdir
  end /* 1 */
  if full \== '' then
    ret = fulldir			/* Return full directory name or empty string */
  else
    ret = fulldir \== ''		/* Return true if valid and accessible */
  return ret

/* end IsDir */

/*=== IsFile(fileSpec) return true if arg is file ===*/

IsFile: procedure expose G.
  parse arg fileSpec
  if fileSpec == '' then
    yes = 0
  else do
    call SysFileTree fileSpec, 'fileList', 'F'
    if RESULT \= 0 then
      call Fatal 'IsFile' wildCard 'failed'
    /* Assume caller knows if arg contains wildcards */
    yes = fileList.0 \= 0
  end
  return yes

/* end IsFile */

/*=== LoadRxu() Load rxu functions ===*/

LoadRxu:
  /* We must RxFuncQuery RxuTerm because
     RxuTerm does not deregister RxuInit
  */
  if RxFuncQuery('RxuTerm') then do
    call RxFuncAdd 'RxuInit','RXU','RxuInit'
    call RxuInit
  end
  return

/* end LoadRxu */

/*=== LoadRxUtilEx() Load Alex's RxUtilEx functions ===*/

LoadRxUtilEx:
  if RxFuncQuery('Sys2LoadFuncs') then do
    call RxFuncAdd 'Sys2LoadFuncs', 'RXUTILEX', 'Sys2LoadFuncs'
    if RESULT then
      call Fatal 'Cannot load Sys2LoadFuncs'
    call Sys2LoadFuncs
  end
  return

/* end LoadRxUtilEx */

/*==========================================================================*/
/*=== SkelRexx standards - Delete unused - Move modified above this mark ===*/
/*==========================================================================*/

/*=== Error() Report ERROR etc. to STDOUT and trace and exit or return if called ===*/

Error:
  say
  parse source . . cmd
  say condition('C') 'signaled at line' SIGL 'of' cmd'.'
  if condition('D') \= '' then say 'REXX reason =' condition('D')'.'
  if condition('C') == 'SYNTAX' & symbol('RC') == 'VAR' then
    say 'REXX error =' RC '-' errortext(RC)'.'
  else if symbol('RC') == 'VAR' then
    say 'RC =' RC'.'
  say 'Source =' sourceline(SIGL)

  if condition('I') \== 'CALL' | condition('C') == 'NOVALUE' | condition('C') == 'SYNTAX' then do
    trace '?A'
    say 'Enter REXX commands to debug failure.  Press enter to exit script.'
    call SysSleep 2
    if symbol('RC') == 'VAR' then exit RC; else exit 255
  end

  return

/* end Error */

/*=== Fatal([message,...]) Write multi-line fatal error message to stderr and exit ===*/

Fatal:
  call lineout 'STDERR', ''
  do i = 1 to arg()
    call lineout 'STDERR', arg(i)
  end
  call lineout 'STDERR', G.!CmdName 'aborting at script line' SIGL
  call Beep 200, 300
  call SysSleep 2
  exit 254

/* end Fatal */

/*=== GetCmdName() Get short script name and set G.!CmdName ===*/

GetCmdName: procedure expose G.
  parse source . . cmd
  cmd = filespec('N', cmd)		/* Chop path */
  c = lastpos('.', cmd)
  if c > 1 then
    cmd = left(cmd, c - 1)		/* Chop extension */
  G.!CmdName = translate(cmd, xrange('a', 'z'), xrange('A', 'Z'))	/* Lowercase */
  return

/* end GetCmdName */

/*=== GetTmpDir() Get TMP dir name with trailing backslash and set G.!TmpDir ===*/

GetTmpDir: procedure expose G.
  s = value('TMP',,G.!Env)
  if s \= '' & right(s, 1) \= ':' & right(s, 1) \== '\' then
    s = s'\'				/* Stuff backslash */
  G.!TmpDir = s
  return

/* end GetTmpDir */

/*=== Halt() Report HALT condition and exit ===*/

Halt:
  say
  parse source . . cmd
  say condition('C') 'signaled at' cmd 'line' SIGL'.'
  say 'Source = ' sourceline(SIGL)
  say 'Sleeping for 2 seconds...'
  call SysSleep 2
  exit 253

/* end Halt */

/*=== LoadRexxUtil() Load RexxUtil functions ===*/

LoadRexxUtil:
  if RxFuncQuery('SysLoadFuncs') then do
    call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
    if RESULT then
      call Fatal 'Cannot load SysLoadFuncs'
    call SysLoadFuncs
  end
  return

/* end LoadRexxUtil */

/*=== ScanArgs(cmdLine) Scan command line ===*/

ScanArgs: procedure expose G.

  /* Calls user exits to process arguments and switches */

  parse arg cmdTail
  cmdTail = strip(cmdTail)

  call ScanArgsInit

  /* Ensure optional settings initialized */
  if symbol('SWCTL') \== 'VAR' then
    swCtl = ''				/* Switches that take args, append ? if optional */
  if symbol('KEEPQUOTED') \== 'VAR' then
    keepQuoted = 0			/* Set to 1 to keep arguments quoted */

  /* Scan */
  curArg = ''				/* Current arg string */
  curSwList = ''			/* Current switch list */
  /* curSwArg = '' */			/* Current switch argument, if needed */
  noMoreSw = 0				/* End of switches */

  do while cmdTail \== '' | curArg \== '' | curSwList \== ''

    if curArg == '' then do
      /* Buffer empty, refill */
      qChar = left(cmdTail, 1)		/* Remember quote */
      if \ verify(qChar,'''"', 'M') then do
	parse var cmdTail curArg cmdTail	/* Not quoted */
      end
      else do
	/* Arg is quoted */
	curArg = ''
	do forever
	  /* Parse dropping quotes */
	  parse var cmdTail (qChar)quotedPart(qChar) cmdTail
	  curArg = curArg || quotedPart
	  /* Check for escaped quote within quoted string (i.e. "" or '') */
	  if left(cmdTail, 1) \== qChar then
	    leave			/* No, done */
	  curArg = curArg || qChar	/* Append quote */
	  if keepQuoted then
	    curArg = curArg || qChar	/* Append escaped quote */
	  parse var cmdTail (qChar) cmdTail
	end /* do */
	if keepQuoted then
	  curArg = qChar || curArg || qChar	/* requote */
      end /* if quoted */
    end

    /* If switch buffer empty, refill */
    if curSwList == '' then do
      if left(curArg, 1) == '-' & curArg \== '-' then do
	if noMoreSw then
	  call ScanArgsUsage 'switch '''curArg''' unexpected'
	else if curArg == '--' then
	  noMoreSw = 1
	else do
	  curSwList = substr(curArg, 2)	/* Remember switch string */
	  curArg = ''			/* Mark empty */
	  iterate			/* Refill arg buffer */
	end
	parse var cmdTail curArg cmdTail
      end
    end

    /* If switch in progress */
    if curSwList \== '' then do
      curSw = left(curSwList, 1)	/* Next switch */
      curSwList = substr(curSwList, 2)	/* Drop from pending */
      /* Check switch allows argument, avoid matching ? */
      if pos(curSw, translate(swCtl,,'?')) \= 0 then do
	if curSwList \== '' then do
	  curSwArg = curSwList		/* Use rest of switch string for switch argument */
	  curSwList = ''
	end
	else if curArg \== '' & left(curArg, 1) \== '-' then do
	  curSwArg = curArg		/* Arg string is switch argument */
	  curArg = ''			/* Mark arg string empty */
	end
	else if pos(curSw'?', swCtl) = 0 then
	  call ScanArgsUsage 'Switch' curSw 'requires argument'
	else
	  curSwArg = ''			/* Optional arg omitted */
      end

      call ScanArgsSwitch		/* Passing curSw and curSwArg */
      drop curSwArg			/* Must be used by now */
    end /* if switch */

    /* If arg */
    else if curArg \== '' then do
      noMoreSw = 1
      call ScanArgsArg			/* Passing curArg */
      curArg = ''
    end

  end /* while not done */

  call ScanArgsTerm

  return

/* end ScanArgs */

/* The end */
