/******************************************************************************
 *                                                                            *
 * ExternalSearchSecurityManager                                              *
 *                                                                            *
 ******************************************************************************/

::Class ExternalSearchSecurityManager Public

/* The following BIFs trigger the CALL method, for some reason (bug no. 1885) */
::Constant BIF (beep, directory, filespec)     /* Add more BIFs as needed     */

/* Add more RexxUtil functions as needed                                      */
::Constant RexxUtil                                                            -
(                                                                              -
  ( /* Windows and Unix */                                                     -
    SysAddRexxMacro, SysClearRexxMacroSpace, SysCls, SysDropRexxMacro,         -
	SysDumpVariables, SysFileCopy, SysFileDelete, SysFileExists, SysFileMove,  -
	SysFileSearch, SysFileTree, SysFormatMessage, SysGetErrorText,             -
	SysGetFileDateTime, SysGetKey, SysIsFile, SysIsFileDirectory,              -
	SysIsFileLink, SysLoadRexxMacroSpace, SysMkDir, SysQueryProcess,           -
	SysQueryRexxMacro, SysReorderRexxMacro, SysRmDir, SysSaveRexxMacroSpace,   -
	SysSearchPath, SysSetFileDateTime, SysSleep, SysStemCopy, SysStemDelete,   -
	SysStemInsert, SysStemSort, SysTempFileName, SysUtilVersion, SysVersion    -
  )~union(                                                                     -
    (.File~separator == "\")~?(                                                -
	  ( /* Windows-only */                                                     -
	    RxMessageBox, RxWinExec, SysBootDrive, SysCurPos, SysCurState,         -
		SysDriveInfo, SysDriveMap, SysFileSystemType, SysFromUnicode,          -
		SysGetLongPathName, SysGetShortPathName, SysIni, SysIsFileCompressed,  -
		SysIsFileEncrypted, SysIsFileNotContentIndexed, SysIsFileOffline,      -
		SysIsFileSparse, SysIsFileTemporary, SysShutdownSystem,                -
		SysSetPriority, SysSwitchSession, SysSystemDirectory,                  -
		SysTextScreenRead, SysTextScreenSize, SysToUnicode, SysVolumeLabel,    -
		SysWaitNamedPipe, SysWinDecryptFile, SysWinEncryptFile,                -
		SysWinGetPrinters, SysWinGetDefaultPrinter, SysWinSetDefaultPrinter,   -
		SysWinVer                                                              -
	  )                                                                        -
	,                                                                          -
	  ( /* Unix-only */                                                        -
	    SysCreatePipe, SysFork, SysGetMessage, SysGetMessageX, SysLinVer,      -
		SysWait                                                                -
	  )                                                                        -
	)                                                                          -
  )                                                                            -
) 

::Method init
  Expose SearcherClass
  Use Arg SearcherClass
::Method Unknown
  Return 0
::Method Call
  Expose SearcherClass
  Use Arg info
  name = info~name
  args = info~arguments
    
  -- BIFs and RexxUtil functions are OK, we want "real" external calls
  If self~BIF~hasItem(name)         Then Return 0
  If self~RexxUtil~hasItem(name)    Then Return 0
  -- We are OK with macrospace functions too
  If SysQueryRexxMacro(name) \== "" Then Return 0
  -- Calling a ::Routine does not trigger the security manager
  -- Calling a .Routine  does not trigger it either
  
  -- Try to get the caller's directory
  callerPackage = .Context~stackFrames[2]~executable~package
  callerName = callerPackage~name
  -- Try to resolve the caller name to an absolute filename.
  callerName = callerPackage~findprogram(callerName)
  lastSep = callerName~lastPos(.File~separator)
  callerDir = Left(callerName, lastSep - 1)
  -- Get caller's extension
  callerFilename = Substr(callerName, lastSep + 1) 
  dotPos = callerFilename~lastPos(".")
  If dotPos == 0 Then extension = "_"
  Else                extension = Substr(callerFilename,dotpos)
   
  -- Create an external search object
  searcher = SearcherClass~new("same="callerdir, "same="extension)
  -- Search the supplied name
  program = searcher~search(name)
  -- If not found, this is a syntax error
  If program~isNil Then Raise Syntax 43.1 Array(name)
  
  -- Found. Create a Routine object and call our program
  routine = .Routine~newFile(program)
  -- Ensure we pass on ourselves as a security manager too
  -- (this will be recursive)
  routine~setSecurityManager(self)  
  routine~callWith(args)
  If Var("RESULT") Then info~result = result
  Return 1 -- We handled this

/******************************************************************************
 * ExternalSearch                                                             *
 *                                                                            *
 * This is the base class for the external search order algorithms            *
 ******************************************************************************/

::Class ExternalSearch Public Abstract

/* Install an external search class using a security manager                  */
::Method "[]=" Class
  Use Strict Arg externalSearch, routine
  routine~setSecurityManager(.ExternalSearchSecurityManager~new(externalSearch))

/* Abstract method - Implements the location exception algorithm              */
::Method locationsToCheck Abstract  

/* Abstract method - Implements the qualifier exception algorithm             */
::Method qualifierExceptions Abstract  

/* Abstract method - Returns Qualifier(name), if present, or .nil             */
::Method getQualifier Abstract

/* Abstract method - Implements the search - Allows for qualifier-first       */
/*                   and location-first subclasses                            */
::Method doSearch Abstract

/* driveRelative - Activate drive-relative filename compositions              */
::Attribute driveRelative Get
::Method "DRIVERELATIVE="
  Expose driveRelative
  Use Strict Arg driveRelative
  .Validate~logical("driveRelative",driveRelative)
 
/* DistinguishedLocations  - Used when the location exception applies         */
/* DistinguishedQualifiers - Used when the qualifier exception applies        */
/* Locations - An array of locations                                          */
/* Qualifier - An array of qualifiers                                         */
::Method init 
  Expose Locations DistinguishedLocations Qualifiers DistinguishedQualifiers driveRelative
  Use Strict Arg Locations, DistinguishedLocations, Qualifiers, DistinguishedQualifiers
  driveRelative = .false
  self~init:super

::Method getLocations
  Expose Locations
  Return Locations~makeArray            /* Return a copy                      */
  
::Method getDistinguishedLocations
  Expose DistinguishedLocations
  Return DistinguishedLocations~makeArray  /* Return a copy                   */ 
  
::Method getQualifiers
  Expose Qualifiers
  Return Qualifiers~makeArray           /* Return a copy                      */

::Method getDistinguishedQualifiers
  Expose DistinguishedQualifiers
  Return DistinguishedQualifiers~makeArray /* Return a copy                   */

/* Check both exception algorithms and then call doSearch                     */
::Method search
  Use Strict Arg name  
  Return self~doSearch(name, self~locationsToCheck(name), self~qualifiersToCheck(name))
    
/* Handle filenames in filesystems where case is significant. The default is  */
/* to do leave the filename as-is                                             */  
::Method nameVariants
  Use Strict Arg loc, name, qua
  Return loc || name || qua
  
/* Compose location, name and qualifier to create a more complete filename    */  
/* Returns "" when composition is impossible                                  */
::Method compose
  Expose driveRelative
  Use Strict Arg location, name, qualifier
  sep = .File~separator
  Unix = sep == "/"
  
  /* name is absolute -> ignore location                                      */
  If Unix, ( name~startsWith("/") | name~startsWith("~") ) Then loc = ""
  /* That's Windows SysFileSystem:hasDirectory -- Not very good               */
  Else If \Unix, \driveRelative, (name~startsWith("\")  | name[2,1] == ":" ) Then loc = ""
  /* That seems more accurate                                                 */
  Else If \Unix,  driveRelative, (name~startsWith("\\") | name[2,2] == ":\") Then loc = ""
  /* name is relative -> ensure there is a final separator                    */
  Else If location~endsWith(sep) Then loc = Left(location, Length(location)-1)
  Else loc = location||sep
  
  /* Experimental code                                                        */
  If driveRelative, loc \== "" Then Do
    If name~startsWith("\") Then Do
	  If loc[2] == ":", loc~length == 2 Then Nop
	  Else If loc[2,2] == ":\" Then loc = loc[1,2]
	  Else If loc[1,2] == "\\" Then Do
	    Parse Var loc "\\"server"\"share"\"
		If server \== "", share \== "" Then loc = "\\"server"\"share
		Else Return ""
	    End
	  Else Return ""
      End
	Else If name[2] == ":", name~length > 2, name[3] \== "\" Then Do
	  If loc[1,2] == name[1,2] Then name = name~substr(3)
	  Else Return ""
	End
	--Return ""
  End
  
  qua = qualifier
  
  Select 
    When qualifier == ""           Then Nop
	When qualifier~startsWith(".") Then Nop
	Otherwise qua = "."qualifier
  End
  Return self~nameVariants(loc, name, qua)
  
/******************************************************************************
 * QualifierFirstExternalSearch                                               *
 *                                                                            *
 * Implements qualifier-first external search algorithms                      *
 ******************************************************************************/

::Class QualifierFirstExternalSearch Subclass ExternalSearch Public
::Method doSearch
  Use Strict Arg name, locationsToCheck, qualifiersToCheck
  Do qualifier over qualifiersToCheck
    Do location over locationsToCheck
	  Do filename over self~compose(location,name,qualifier)
	    If filename == "" Then Iterate
	    file = .File~new(filename)
	    If file~exists, file~isFile Then Return file
	  End
	End
  End
  Return .nil

/******************************************************************************
 * LocationFirstExternalSearch                                                *
 *                                                                            *
 * Implements location-first external search algorithms                       *
 ******************************************************************************/

::Class LocationFirstExternalSearch Subclass ExternalSearch Public
::Method doSearch
  Use Strict Arg name, locationsToCheck, qualifiersToCheck
  Do location over locationsToCheck
    Do qualifier over qualifiersToCheck
	  Do filename over self~compose(location,name,qualifier)
	    If filename == "" Then Iterate	  
	    file = .File~new(filename)
	    If file~exists, file~isFile Then Return file
	  End
	End
  End
  Return .nil
  
/******************************************************************************
 * ObjectRexxExternalSearch                                              *
 *                                                                            *
 * External Search Order Algorithm for Object Rexx                            *
 ******************************************************************************/

::Class ObjectRexxExternalSearch Subclass QualifierFirstExternalSearch Public
::Method locationExceptions
  Use Strict Arg name
  Return .nil
::Method qualifierExceptions
  Use Strict Arg Qualifiers, DistinguishedQualifiers, name
  sep = .File~separator
  sepName = sep || Name
  lastDot = sepName~lastPos(".")
  lastSep = sepName~lastPos(sep)
  If lastDot == 0 Then Return .nil
  If lastDot > lastSep Then Return .Array~of("")
  Return .nil

/******************************************************************************
 *                                                                            *
 * GetParameters internal routine                                             *
 *                                                                            *
 ******************************************************************************/
 
::Routine GetParameters
  Use arg name, parameters  
  Select
    When parameters~isNil Then Return .StringTable~new
	When parameters~isA(.String) Then Do
	  Parse Var parameters name"="value
	  Return .StringTable~of((name~strip~upper, value~strip))
	  End
    When parameters~isA(.Array) Then Do
	  Do with index i item param over parameters
	    If param~isA(.String) Then Do
	      Parse Var param name"="value		
		  parameters[i] = (name~strip~upper, value~strip)
		End
	  End
	  Return .StringTable~sendWith("OF",parameters)
	  End
    Otherwise 
	  .Validate~classType(name, parameters, .MapCollection)
	  Return parameters
  End

/******************************************************************************
 *                                                                            *
 * CallerInfo internal routine                                                *
 *                                                                            *
 ******************************************************************************/

::Routine CallerInfo Public
  Use Strict Arg depth = 4
  /* Default use from the init method of a class
     stackFrames[1]: this routine; 
     stackFrames[2]: caller (init) method; 
     stackFrames[3]: "new" method; 
     stackFrames[4]: caller
  */
  callerName = .context~stackFrames[depth]~executable~package~name
  /* Check that callerName is absolute (it might be REXX, INSTORE, etc.)      */
  sep = .File~separator
  If sep = "/", callerName[1] \== "/"                           Then callerName = .Nil
  If sep = "\", callerName[2] \== ":", callerName[1,2] \== "\\" Then callerName = .Nil
  
  caller = .StringTable~new 
  caller~name = callerName
 
  /* If we have a caller name, collect filename, directory and extension      */
  If \callerName~isNil Then Do
	caller~directory = Left( callerName,callerName~lastPos(sep)-1)
	caller~filename = Substr(callerName,callerName~lastPos(sep)+1)
    If caller~filename~contains(".") Then Do
      dotPos = caller~filename~lastPos(".")
	  caller~extension = Substr(caller~filename,dotPos)
      End
	Else caller~extension = ""
  End
  Return caller

  /* Cfr. SysFileSystem::extractExtension
  
        // is this the extension dot?
        else if (*endPtr == '.')
        {
            // return everything from the period on.  Keeping the period on is a convenience.
            return new_string(endPtr);
        }
		
  */

/******************************************************************************
 *                                                                            *
 * BuildArray internal routine                                                *
 *                                                                            *
 ******************************************************************************/

/*
 * TODO: Regina files.c, get_external_routine_paths:
 *   "An empty string is counted as "." in unix systems and ignored in
 *    all other systems."
 */
 
 ::Routine BuildArray
  Use Strict Arg collection, indexes, separator
  array = .Array~new
  Do index over indexes
    item = collection[index]
	If item~isNil Then Iterate
	If item == "" Then Iterate
	Do element over item~makeArray(separator)
	  If element == "" Then Iterate
	  /* "_" codes the empty extension                                        */
	  If element == "_", separator == "," Then element = ""
	  If \array~hasItem(element) Then array~append(element)
	End
  End
  Return array
  
/******************************************************************************
 * ooRexxExternalSearch                                                       *
 *                                                                            *
 * External Search for Open Object Rexx (ooRexx)                              *
 ******************************************************************************/

::Class ooRexxExternalSearch Subclass QualifierFirstExternalSearch Public

::Method init
/*
 * Called via .ooRexxExternalSearch~new(directories, extensions)
 * 
 * directories is a MapCollection or an array of pairs (see GetParameters)
 *      directories~same, default same directory as caller
 *      directories~current, default the current directory
 *      directories~application, the application-defined path
 *      directories~rexx_path, default the value of the REXX_PATH env. variable
 *      directories~path, default the value of the PATH environment variable
 *
 * extensions is a MapCollection or an array of pairs (see GetParameters)
 *      extensions~required, if present (any value) the ".cls" extension is searched
 *      extensions~same, default the same extension as the caller, if any
 *      extensions~application, the application defined extensions
 *
 * The init method will create extensions~final: ".rex", ".REX" and the empty
 * extension.
 *
 * This method collects the information provided in "directories" and
 * "extensions" and prepares it to be supplied to the superclass.
 *
 */
  Use Strict Arg directories = .Nil, extensions = .Nil
  
  directories = GetParameters("directories", directories)
  extensions  = GetParameters("extensions",  extensions)
  
  caller = CallerInfo()
  
  /* When a parameter has not been supplied, set the default value            */
  If \directories~hasIndex("SAME"), \callerName~isNil Then 
	                                         directories~same      = caller~directory
  If \directories~hasIndex("CURRENT")   Then directories~current   = Directory()
  If \directories~hasIndex("REXX_PATH") Then directories~rexx_path = Value("REXX_PATH",,"ENVIRONMENT")
  If \directories~hasIndex("PATH")      Then directories~path      = Value("PATH",,"ENVIRONMENT")  

  /* For extensions too                                                      */
  If \extensions~requires~isNil   Then extensions~requires = ".cls"
  If \extensions~hasIndex("SAME") Then
    If \caller~name~isNil, caller~extension \== "" Then 
                                       extensions~same = caller~extension
  If .File~separator = "/"        Then extensions~final = ".rex,.REX,_"
  Else                                 extensions~final = ".REX,_"
  
  /* Store all the directories in the "dirs" array                            */
  dirs = BuildArray(directories, ("SAME", "CURRENT", "APPLICATION", "REXX_PATH", "PATH"), .File~pathSeparator)

  /* Store all the extensions in the "exts" array                             */
  exts = BuildArray(extensions, ("REQUIRES","SAME", "APPLICATION", "FINAL"), ",")

  self~init:super(dirs, .Array~of(directories~current), exts, .Array~of(""))
  Return

/*
 * ooRexx Location exception algorithm
 *
 * In Unix-like systems, check the provided filename as-is first, and then
 * check it again after converting it to lowercase (when this makes sense).
 *
 */

::Method nameVariants
  Use Strict Arg loc, name, qua
  If .File~separator == "\" Then Return loc || name || qua
  If name == name~lower Then 
    Return loc || name || qua
  Return (loc || name || qua, loc || name~lower || qua)

::Method locationsToCheck
/*
 * ooRexx Location exception algorithm
 *
 * A location exception is produced when (1) the filename is absolute
 * (it starts with "/" or "~" under Unix-like, or it starts with "\" or has a drive
 * letter under Windows), or (2) when it starts with "." or "..".
 *
 */
  Use Strict Arg name
  Windows = .File~separator == "\"
  
  /* From Unix-like SysFileSystem::hasDirectory:
  
      return name[0] == '~' || name[0] == '/' ||
          (name[0] == '.' && name[1] == '/') ||
          (name[0] == '.' && name[1] == '.' && name[2] == '/');

  */
  
  If \Windows, ( name~startsWith("~") | name~startsWith("/") | name~startsWith("./") | name~startsWith("../") )
	Then Return self~getDistinguishedLocations
	
  /* From Windows SysFileSystem::hasDirectory:
  
      return name[0] == '\\' || name[1] == ':' ||
          (name[0] == '.' && name[1] == '\\') ||
          (name[0] == '.' && name[1] == '.' && name[2] == '\\');

  */
  
  If  Windows, ( name~startsWith("\") | name[2] == ":" | name~startsWith(".\") | name~startsWith("..\") )
    Then Return self~getDistinguishedLocations
	
  Return self~getLocations
  
::Method qualifiersToCheck
/*
 * ooRexx Qualifier exception algorithm
 *
 * A qualifier exception is produced when (1) the filename is
 * "extension qualified", i.e., it contains a dot (".") after the last
 * path separator character. In this case, the file is searched
 * without appending any extension.
 *
 */
  Use Strict Arg name
  sep = .File~separator
  sepName = sep || Name
  lastDot = sepName~lastPos(".")
  lastSep = sepName~lastPos(sep)
  If lastDot == 0      Then Return self~getQualifiers
  If lastDot > lastSep Then Return self~getDistinguishedQualifiers
  Return self~getQualifiers

/******************************************************************************
 * ooRexxEnhancedExternalSearch                                               *
 *                                                                            *
 * Enhanced External Search for Open Object Rexx (ooRexx)                     *
 ******************************************************************************/

::Class ooRexxEnhancedExternalSearch SubClass ooRexxExternalSearch Public
::Method init
  Forward Continue Class (super)
  self~driveRelative = .true -- Activate experimental drive-relative features  
::Method locationsToCheck
/*
 * Enhanced ooRexx Location exception algorithm
 *
 * We simply remove the restrictions for "../" and "./"
 *
 */
  Use Strict Arg name
  Windows = .File~separator == "\"
    
  If \Windows, ( name~startsWith("~") | name~startsWith("/") )
	Then Return self~getDistinguishedLocations
	  
  -- Caution when driveRelative is .true!	  
  If  Windows, self~driveRelative Then Return self~getLocations
  If  Windows, ( name~startsWith("\") | name[2] == ":"  )
    Then Return self~getDistinguishedLocations
	
  Return self~getLocations


/******************************************************************************
 * ReginaExternalSearch                                                       *
 *                                                                            *
 * External Search Order Algorithm for Regina Rexx                            *
 ******************************************************************************/

::Class ReginaRexxExternalSearch Subclass LocationFirstExternalSearch Public

::Method init
/*
 * Called via .ReginaRexxExternalSearch~new(directories, extensions)
 * 
 * directories is a MapCollection or an array of pairs (see GetParameters)
 *      directories~regina_macros, default the value of the REGINA_MACROS env. variable 
 *      directories~current, default the current directory
 *      directories~path, default the value of the PATH environment variable
 *
 * extensions is a MapCollection or an array of pairs (see GetParameters)
 *      extensions~regina_suffixes, default the value of the REGINA_SUFFIXES environment variable
 *
 * The init method will create extensions~final: "" (the empty extension), 
 * ".rexx", ".rex", ".cmd", ".rx".
 *
 * This method collects the information provided in "directories" and
 * "extensions" and prepares it to be supplied to the superclass.
 *
 */
  Use Strict Arg directories = .Nil, extensions = .Nil
  
  directories = GetParameters("directories", directories)
  extensions  = GetParameters("extensions",  extensions)
  
  /* When a parameter has not been supplied, set the default value            */
  If \directories~hasIndex("REGINA_MACROS")  Then directories~regina_macros  = Value("REGINA_MACROS",,"ENVIRONMENT")
  If \directories~hasIndex("CURRENT")        Then directories~current        = Directory()
  If \directories~hasIndex("PATH")           Then directories~path           = Value("PATH",,"ENVIRONMENT")  

  /* For extensions too                                                      */
  If \extensions~hasIndex("REGINA_SUFFIXES") Then extensions~regina_suffixes = Value("REGINA_SUFFIXES",,"ENVIRONMENT")
  extensions~regina_suffixes = ReginaNormalizeSuffixes( extensions~regina_suffixes )
  extensions~final = "_,.rexx,.rex,.cmd,.rx"
  
  /* Store all the directories in the "dirs" array                            */
  dirs = BuildArray(directories, ("REGINA_MACROS", "CURRENT", "PATH"), .File~pathSeparator)
  
  /* Store all the extensions in the "exts" array                             */
  exts = BuildArray(extensions, ("REGINA_SUFFIXES", "FINAL"), ",")

  self~init:super(dirs, .Array~of(directories~current), exts, .Array~of(""))
  Return

ReginaNormalizeSuffixes: Procedure
/*
 * REGINA_SUFFIXES: 'REGINA_SUFFIXES has to contain a space or 
 * comma separated list of extensions, a dot in front of each entry 
 * is allowed, e.g. ".macro,.mac,.regina" or "macro mac regina"'.
 *
 * [Cfr. The Regina Rexx Interpreter, v. 3.9.5, section 1.4.2,
 * External Rexx programs].
 *
 * This routine normalizes the value: on return, the separator will be a comma,
 * and all the extensions will start with a dot.
 */
  Parse arg suffixes
  If suffixes~contains(" ") Then v = suffixes~makeArray(" ")
  Else                           v = suffixes~makeArray(",")
  Do i = 1 To v~items
    If \v[i]~startsWith(".") Then v[i] = "."v[i]
  End
  Return v~makeString("Line",",")


::Method locationsToCheck
/*
 * Regina Rexx Location exception algorithm
 *
 * A location exception is produced when the filename contains a separator,
 * i.e., "/" for Unix-like, and one of "\/:" for Windows.
 *
 * If no location exception applies, the null string is returned
 *
 * Cfr. The Regina Rexx Interpreter, Version 3.9.5, section 1.4.2: 
 *   "Note that the search algorithm to this point is ignored if the 
 *    program name contains a file path specification. eg. 
 *    if "CALL .\MYPROG" is called, then no searching of REGINA_MACROS 
 *    or PATH is done; only the concatenation of suffixes is carried out."
 *
 * [Cfr. files.c, routine get_external_routine, and configur.h,
 * # define FILE_SEPARATORS]
 */
  Use Strict Arg name
  If .File~separator == "/", name~contains("/")
    Then Return self~getDistinguishedLocations
  If .File~separator == "\", ( name~contains("/") | name~contains("\") | name~contains(":") )
	Then Return self~getDistinguishedLocations
  Return self~getLocations

::Method qualifiersToCheck
/*
 * Regina Rexx qualifier exception algorithm
 * 
 * Cfr. The Regina Rexx Interpreter, Version 3.9.5, section 1.4.2: 
 *   "If a known file extension is part of the file name only this file 
 *    is searched, otherwise the file name is extended by the 
 *    extensions "" (empty string), ".rexx", ".rex", ".cmd", and ".rx" 
 *    in this order."
 *
 * [Cfr. files.c, routine get_external_routine_path]
 */  
  Use Strict Arg name
  Do qua Over Qualifiers
    case = .File~new(name)~isCaseSensitive
    If  case, name~endsWith(qua)         Then Return self~getDistinguishedQualifiers
	If \case, name~caselessEndsWith(qua) Then Return self~getDistinguishedQualifiers
  End
  Return self~getQualifiers