/* Samba REXX Routines to enable smb resource browsing */

/*
Copyright (C) 2007-2017 Herwig Bauernfeind for bww bitwise works GmbH.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/


/*:VRX         _dropdeprecated
*/
_dropdeprecated:
    /* The stem-less counterparts of these variables are considered deprecated and should be removed wherever possible
       The _dropdeprecated routine will drop any value in order to make sure the stem actually works
       If another variable is added to the stem, ensure to also drop it in dropdeprecated otherwise it will not be exported
     */
    drop rh
    drop parentrh
    drop gparentrh
    drop icon
    drop resname
    drop comment
    drop udatatype
    drop udatamsg
return

/*:VRX */
_GetSMBObjectProperties: procedure expose samba. options. SMBObj. rh icon resname udatatype udatamsg parentrh icons.
    if options.!debug == 1 then say time()' _GetSMBObjectProperties started'

    /* Purpose of this subroutine:
       The current SMB object's frequently used properties should be stored in a stem
       SMBObj.rh        = recordhandle of the object
       SMBObj.resname   = resourcename of the object
       SMBObj.comment   = commentstring of the object
       SMBObj.icon      = icon of the object
       SMBObj.udatatype = type of object (WORKGROUP, SERVER, DISK, PRINTER, FILE, DIRECTORY)
       SMBObj.udatamsg  = arbitrary object related data (Login message, file properties)
       SMBObj.parentrh  = recordhandle of the object's parent
       SMBObj.gparentrh = recordhandle of the object's grandparent

       The stem-less counterparts of these variables are considered deprecated and should be removed wherever possible
       The _dropdeprecated routine will drop any value in order to make sure the stem actually works
       If another variable is added to the stem, ensure to also drop it in dropdeprecated otherwise it will not be exported
     */
    call _dropdeprecated

    SMBObj. = ""
    SMBObj.rh = arg(1)

    if VRMethod( "CN_SMBTREE", "ValidateRecord", SMBObj.rh) <> 1 | SMBObj.rh = "" then do
        if options.!debug == 1 then say time()' _GetSMBObjectProperties aborted'
        return
    end

    SMBObj.Icon = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Icon")

    SMBObj.parentrh = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Parent")
    if SMBObj.parentrh = ""
        then SMBObj.gparentrh = ""
        else SMBObj.gparentrh = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.parentrh, "Parent")

    SMBObj.resname  = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Caption")
    parse var SMBObj.resname SMBObj.resname '0D0A'x SMBObj.comment
    SMBObj.resname = strip(SMBObj.resname)
    SMBObj.comment = strip(SMBObj.comment)

    Userdata = VRMethod("CN_SMBTREE", "GetRecordAttr", SMBObj.rh, "Userdata")
    parse var userdata SMBObj.udatatype '|' SMBObj.udatamsg
    SMBObj.udatatype = strip(SMBObj.udatatype)
    SMBObj.udatamsg  = strip(SMBObj.udatamsg)

    if options.!debug == 1 then do
        say '  Handle:   "'SMBObj.rh'"'
        say '  GParentrh "'SMBObj.gparentrh'"'
        say '  Resource: "'SMBObj.resname'"'
        say '  Comment:  "'SMBObj.comment'"'
        say '  Type:     "'SMBObj.udatatype'"'
        say '  Message:  "'SMBObj.udatamsg'"'
        say '  Icon:     "'SMBObj.icon'"'
    end

    if options.!debug == 1 then say time()' _GetSMBObjectProperties done'
return

/*:VRX */
_BrowseResetObject: procedure
    ok = VRSet("CN_SMBTREE","Painting", 0 )
    rh = arg(1)

    /* Remove all files and directories whose parent is our share */
    ok = VRMethod( "CN_SMBTREE", "GetRecordList", "All", "AllRH." )
    do I = 1 to AllRH.0
        AllParentRH  = VRMethod("CN_SMBTREE","GetRecordAttr",AllRH.I,"Parent")
        if AllParentRH = rh then ok = VRMethod( "CN_SMBTREE", "RemoveRecord", AllRH.I )
    end
    ok = VRSet("CN_SMBTREE","Painting", 1 )
return

/*:VRX */
_BrowseDirectory: /* This must not be a procedure */
    if options.!debug == 1 then say time()' _BrowseDirectory started'

    /* Turn off painting */
    ok = VRSet("CN_SMBTREE","Painting", 0 )
    call VRSet VRWindow(), 'Pointer', 'Wait'

    /* Make sure credentials are usable */
    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'

    /* We have to remove the double % for smbclient.exe - not entirely clear why */
    OldUserCred = ""
    if pos('%%',UserCred) > 0 & pos("4OS2", value("COMSPEC",,"OS2ENVIRONMENT")) = 0  then do
        OldUserCred = UserCred
        parse var UserCred '--user='username'%%'password
        UserCred = '--user='username'%'password
        call lineout "debug", "  Strip double %%!!!"
    end

    say '  'samba.!smbclientexe' \\'machine'\'sharename' 'UserCred' --command="dir 'browsepath'"'
    address cmd samba.!smbclientexe' \\'machine'\'sharename' 'UserCred' --command="dir 'browsepath'" 'debuglevel' 2>NUL 1>'samba.!msg

    if UserCred   = '-N' then UserCred = ''

    if OldUserCred <> "" then do
        UserCred = OldUserCred
        OldUserCred = ""
        say "  Restore double %%!!!"
    end

    I = 0
    call _StatusBarWrapper ""
    do until lines(samba.!msg) = 0
        infoline = linein(samba.!msg)
        select
            when pos('blocks',infoline) > 0 then do /* Last line */
                /* we should handle size information here */
                iterate
            end
            when I = 0 & length(infoline) > 0 & left(infoline,2) <> "  " then do /* Login message */
                say '  Login message "'Infoline'"'
                ok = VRMethod("CN_SMBTREE", "SetRecordAttr", SMBObj.rh, "Userdata", SMBObj.udatatype'|'infoline )
                call _StatusBarWrapper infoline
            end
            when left(infoline,2) = "  " & length(infoline) > 0 then do /* file or DIR */
                wn       = words(infoline)
                fyear    = word(infoline,wn)
                ftime    = word(infoline,wn-1)
                fday     = word(infoline,wn-2)
                fmonth   = word(infoline,wn-3)
                fwday    = word(infoline,wn-4)
                /* FIXME: This is flaky! */
                pos_attr = max(pos(fwday,infoline)-16,4)
                fsize    = word(infoline,wn-5)
                fattr    = substr(infoline,pos_attr,6)
                fname    = strip( substr(infoline,3,pos_attr-3))
                if fname = '.' | fname = '..' then iterate /* we do not display these */
                if pos('H',fattr) > 0  then iterate /* we do not display hidden files */
                if pos('S',fattr) > 0  then iterate /* we do not display system files */
                I = I + 1
                fh.I = VRMethod( "CN_SMBTREE", "AddRecord", SMBObj.rh, , fname)
                if pos('D',fattr) = 0 then do
                    Ext = translate(VRParseFIleName(fname,'E'))
                    select
                        when Ext = 'EXE' then ficon = icons.!exe /* executable */
                        when Ext = 'CMD' then ficon = icons.!cmd /* OS/2 or NT batch */
                        when Ext = 'BAT' then ficon = icons.!bat /* DOS batch */
                        when Ext = 'PDF' then ficon = icons.!pdf /* PDF document */
                        when wordpos(Ext, 'XLS SXC ODS CSV') > 0     then ficon = icons.!spreadsheet
                        when wordpos(Ext, 'DOC SXW ODT') > 0         then ficon = icons.!textdocument
                        when wordpos(Ext, 'FW2 FW3 FW4') > 0         then ficon = icons.!framework
                        when wordpos(Ext, 'JPG BMP PNG GIF TIF') > 0 then ficon = icons.!image
                        when wordpos(Ext, 'AVI MPG FLV WMV MP4') > 0 then ficon = icons.!movie
                        when wordpos(Ext, 'WAV MP3 OGG MID') > 0     then ficon = icons.!sound
                        when wordpos(Ext, 'WPI') > 0                 then ficon = icons.!warpin
                        when wordpos(Ext, 'ZIP') > 0                 then ficon = icons.!zip
                        when wordpos(Ext, 'INF HLP') > 0             then ficon = icons.!view
                        when wordpos(Ext, 'TXT') > 0                 then ficon = icons.!plaintext
                        otherwise ficon = icons.!defaultfile /* default file icon */
                    end
                    ftype = 'FILE'
                end
                else do
                    ficon = icons.!folder
                    ftype = 'DIRECTORY'
                end

                ok = VRmethod("CN_SMBTREE", "SetRecordAttr", fh.I, "userdata", ftype'|'fsize' Bytes 'fday'-'fmonth'-'fyear' 'ftime,'icon',Ficon)

            end
            otherwise nop /* no other line type */
        end
    end
    if I > 0 then ok = VRMethod("CN_SMBTREE","SetRecordAttr",SMBObj.rh, "Icon", icons.!folder_open)
    ok = stream(samba.!msg,'c','close')
    ok = SysFileDelete(samba.!msg)

    ok = VRMethod( "CN_SMBTREE", "SetRecordAttr", SMBObj.rh,"Collapsed", 0)
    /* Turn on painting */
    call VRSet VRWindow(), 'Pointer', '<default>'
    ok = VRSet("CN_SMBTREE","Painting", 1 )
    if options.!debug == 1 then say time()' _BrowseDirectory done'
return

/*:VRX */
_BrowseBuildPath: procedure expose options. icons. samba. sharerh
    if options.!debug == 1 then say time()' _BrowseBuildPath started'
    rh = arg(1)

    finished = 0
    BrowsePathStr = ''

    do while \finished
        parentrh = VRMethod("CN_SMBTREE","GetRecordAttr",rh,"Parent")
        resname  = VRMethod("CN_SMBTREE","GetRecordAttr",rh,"caption")
        userdata = VRMethod("CN_SMBTREE","GetRecordAttr",rh,"userdata")
        parse var userdata udatatype '|' udatamsg
        parse var resname resname '0D0A'x .
        resname = strip(resname)
        /* say "  Not connected - cannot open!" */
        select
            when udatatype = "SERVER" then do
                BrowsePathStr = '\\'resname'\'BrowsePathStr
                finished = 1
            end
            when udatatype = "DISK" then do
                BrowsePathStr = resname'\'BrowsePathStr
                sharerh =rh
                rh = parentrh
            end
            otherwise do
                BrowsePathStr = resname'\'BrowsePathStr
                rh = parentrh
            end
        end
        /* say '  BrowsePathStr = "'BrowsePathStr'"' */
    end
    BrowsePathStr = strip(BrowsePathStr,'T','\')
    if options.!debug == 1 then say time()' _BrowseBuildPath done, returning "'BrowsePathStr'"'
return BrowsePathStr

/*:VRX */
_BrowseObjectOpen: procedure expose samba. options. cd. icons.
    machine    = arg(1)
    sharename  = arg(2)
    browsepath = arg(3)

    OpenOk = 0
    
    if VRIsValidObject("CN_CONDET") then do
        CALL VRMethod "CN_CONDET", 'GetRecordList', 'All', 'records.'
	    
        DO i = 1 TO records.0
            if VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.StatusFH) = icons.!active then do
                if options.!debug == 1 then say '  'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.StatusFH)' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.MPointFH)' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ServerFH)' 'VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ShareFH)
                if machine = VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ServerFH) &,
                   sharename = VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.ShareFH) then do
                    Object = strip(VRMethod( "CN_CONDET", "GetFieldData", records.i, CD.MPointFH),'T','\')'\'browsepath
                    if options.!debug == 1 then say '  Non UNC object: "'Object'"'
                    ID = VRMethod( "Application", "StartThread", "wps_open", Object, "DEFAULT" )
                    OpenOK = 1
                end
            end
            if OpenOK = 1 then leave
        end
    end
return OpenOK /* 1 = Success 0 = Could not open */

/*:VRX */
_BrowseIconsInit:
    if options.!debug == 1 then say time()'  _BrowseIconsInit() started. '
    icons.                  = '#24:PMWP.DLL'
    icons.!bat              = '#1:PMWP.DLL'
    icons.!cmd              = '#2:PMWP.DLL'
    icons.!exe              = '#3:PMWP.DLL'
    icons.!template         = '#10:PMWP.DLL'
    icons.!drive            = '#16:PMWP.DLL'
    icons.!defaultfile      = '#24:PMWP.DLL'
    icons.!folder           = '#26:PMWP.DLL'
    icons.!folder_open      = '#34:PMWP.DLL'
    icons.!machine_awake    = '#35:PMWP.DLL'
    icons.!machine_sleeping = '#61:PMWP.DLL'
    icons.!workgroup        = '#62:PMWP.DLL'
    icons.!pdc              = '#63:PMWP.DLL'
    icons.!active           = '#64:PMWP.DLL'
    icons.!passive          = '#68:PMWP.DLL'
    icons.!printer          = '#65:PMWP.DLL'
    icons.!drive_inactive   = '#70:PMWP.DLL'
    icons.!pdf              = '#80'
    icons.!spreadsheet      = '#82'
    icons.!textdocument     = '#86'
    icons.!framework        = '#87'
    icons.!image            = '#88'
    icons.!movie            = '#89'
    icons.!sound            = '#90'
    icons.!warpin           = '#91'
    icons.!zip              = '#92'
    icons.!view             = '#93'
    icons.!plaintext        = '#94'
    if options.!debug == 1 then say time()'  _BrowseIconsInit() done.'
return

/*:VRX */
_ACLSBrowse:
    browsepath = _browsebuildpath(SMBObj.rh)
    ok = VRSet("SW_ACLS","Caption", browsepath)

    parse var browsepath '\\'machine'\'sharename '\' browsepath

    if browsepath = '' then browsepath = '\'
    if pos(" ",browsepath)> 0 then browsepath = '"'browsepath'"'
    if UserCred = "" then UserCred = "-N"

    /* Make sure credentials are usable */
    if UserCred   = 'USERCRED'   | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'

    /* We have to remove the double % for smbclient.exe - not entirely clear why */
    OldUserCred = UserCred
    if pos('%%',UserCred) > 0 & pos("4OS2", value("COMSPEC",,"OS2ENVIRONMENT")) = 0  then do
        OldUserCred = UserCred
        parse var UserCred '--user='username'%%'password
        UserCred = '--user='username'%'password
        call lineout "debug", "  Strip double %%!!!"
    end
    if options.!debug == 1 then say "smbcacls \\"machine"\"sharename" "browsepath" "UserCred" "aclsnumeric
    address cmd samba.!smbcaclsexe' \\'machine'\'sharename' 'browsepath' 'UserCred' 'aclsnumeric' 2>'samba.!err' 1>'samba.!msg
    ok = file2stem(samba.!msg,"aclsout.")    
    ok = file2stem(samba.!err,"aclserr.")
    if aclserr.0 > 0 then do
        call _StatusBarWrapper aclserr.1
        call SW_ACLS_Close
    end
    if aclsout.0 > 2 then ok = VRSet("DT_REV_CONT","Caption",aclsout.1" "aclsout.2)
    do I = 3 to aclsout.0
        parse var aclsout.I ACLS.ACL':'ACLS.User':'ACLS.A_D'/'ACLS.Flags'/'ACLS.Permissions
        parse var ACLS.User ACLS.Group'\'ACLS.User
        arh = VRMethod("CN_ACLS","AddRecord")
        ok = VRMethod("CN_ACLS","SetFieldData", arh, ACL.typeFH,  ACLS.ACL)
        ok = VRMethod("CN_ACLS","SetFieldData", arh, ACL.groupFH, ACLS.Group)
        ok = VRMethod("CN_ACLS","SetFieldData", arh, ACL.userFH,  ACLS.User)
        ok = VRMethod("CN_ACLS","SetFieldData", arh, ACL.ADFH,    ACLS.A_D)
        ok = VRMethod("CN_ACLS","SetFieldData", arh, ACL.flagsFH, ACLS.Flags)
        ok = VRMethod("CN_ACLS","SetFieldData", arh, ACL.accessFH,ACLS.Permissions)
    end

    UserCred = OldUserCred
return