/*---------------------------------------------------------------------------*\
|  Get/Set Access Control List                (C) Alain Rykaert - AUG95-FEB01 |
\*---------------------------------------------------------------------------*/
    Version = '4.01'
    Say '* LSACL Version' Version

    Parse Arg ServerName SourceDir FileName

    If ServerName = '' | SourceDir = '' | FileName = ''
      Then Do
             Say '! error: invalid syntax'
             Say '.'
             Say '. get all access control files - (C) Alain Rykaert - Verion' Version
             Say '.'
             Say '. syntax: lsacl servername directoryname filename'
             Say '.'
             Say '. sample: lsacl srv042 f:\ srv042.csv'
             Exit
           End
      Else Nop

    Call Init                                  /* Load DLLs and other stuff*/
    Signal On Halt Name Quit                   /* Quit if CTRL-C is pressed*/

    ServerName = Strip(ServerName,'L','\')

    Say '> FileName:' FileName
    Call SysFileDelete FileName

    RC = NetGetInfo(370, 'ServerModalInfo', '\\'ServerName) /* Check Server*/
    If RC = 0
      Then Nop
      Else Call ChkError RC

    Resource = '\\'ServerName'\'Left(SourceDir,1)'$'SubStr(SourceDir,3)
    SourceDir = Strip(Resource,'T','\')
    Say '> UNC Resource:' SourceDir
    Call SysFiletree SourceDir'\','DirCheck','DO'
    If DirCheck.0 > 0
      Then Nop
      Else Do
             Say '! error: no dirs exist on' SourceDir
             Exit
           End

    Dirs.0.0 = 1
    Dirs.0.1 = SourceDir
    Call Doit 0 1

    Exit

  Doit: Procedure Expose Dirs. FileName /* --------------------------------*/

    Parse Arg x y
 /* Say Dirs.x.y */
    Call Dir2Check Dirs.x.y
    j = x + 1
    z = 'Dirs.'j
    Call SysFileTree Dirs.x.y'\', z, 'DO'
    If Dirs.j.0 > 0
       Then Do a = 1 to Dirs.j.0
              Call Doit j a
            End
       Else Nop

     Return

 DIR2CHECK:/* -------------------------------------------------------------*/

    ESC = '1B'x

    Parse Arg Dir2Check

    If Length(Dir2Check) < 70
      Then Dir2Say = Dir2Check
      Else Dir2Say = Left(Dir2Check,37) || '...' || Right(Dir2Check,30)
    Call CharOut '', Copies(' ',70) '0D'x Dir2Say '0D'x

    RC = NetGetInfo(10, 'Access', '\\'ServerName, Dir2Check)     /* get acp*/
    If RC = 0
      Then Do
             AccessList = ''
             Do j = 1 to Access.Count
               AccessList = AccessList || Access.j.UgName || ':' || Access.j.Access || 'Ý'
             End
             AccessList = Strip(AccessList,,'Ý')
             LogText = Right(Access.Count,2,'0') || ';' || AccessList || ';' || Dir2Check
           End
      Else LogText =  '00;-none-;' || Dir2Check

    If Length(LogText) < 70
      Then Log2Say = LogText
      Else Log2Say = Left(LogText,37) || '...' || Right(LogText,30)
/*  Call CharOut '', ESC'[0;1;33m' Log2Say ESC'[0m' '0A0D'x */

    If FileName = ''
      Then Nop
      Else Call Logit FileName LogText          /* write the result to file*/

    Return

 INIT:/* ------------------------------------------------------------------*/

    If RxFuncQuery('SysLoadFuncs')
      Then Do
             Call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs'
             Call SysLoadFuncs
           End
      Else Nop

    LSRDrive = Left(SysSearchPath('PATH', 'NET.EXE'), 2)    /* IBMLAN Drive*/
    If LSRDrive <> ''
      Then Nop
      Else Do
             Say '! Could not determine the Lan Requester path' '07'x
             Exit X2D('1604')
           End

    If Stream(LSRDrive'\ibmlan\netlib\lsrxut.dll', 'C', 'Query Exists') <> ''
      Then Do
             If RxFuncQuery('LoadLSRXUTFuncs')
               Then Do
                      Call RxFuncAdd 'LoadLsRxutFuncs', 'LSRXUT', 'LoadLsRxutFuncs'
                      Call LoadLsRxutFuncs
                    End
               Else Nop
           End
      Else Do
             Say '! Could not find' LSRDrive'\IBMLAN\NETLIB\LSRXUT.DLL' '07'x
             Exit X2D('0800')
           End

   '@echo off'

    Return

 CHKERROR:/* ----------------------------------------------------------------*/

    Parse Arg RCode

    Say '! Error:' RCode '07'x
    Exit X2D('1600')

    Return

 LOGIT:/* ------------------------------------------------------------------*/

    Parse Arg Log_FileName Log_Text

    If LineOut(Log_FileName, Log_Text) = 0
      Then Call Stream Log_FileName, 'C', 'Close'
      Else Say '! Error while writing to' Log_FileName

    Return


 QUIT:/* --------------------------------------------------------------------*/

    Say
    Say '...Interupted by User...'

    Exit

