Subversion Repositories DevTools

#                       DebianControlFile       - Specify control and script files

#                       DebianDepends           - Add Depends entry to control file

use JatsLocateFiles;

# Function        : SetPermissions 

#

# Description     : Called to set permissions of files/dirs in a directory structure.

#                   With no options sets DirTag and all files/dirs in it to perms

#   

# Inputs          : path        - The directory tag to start setting permissions on

#                   Options     - See below

#       

#   Required Options:

#       One or both of

#               --FilePerms=    Sets the permissions of files to this permission.

#                               If not supplied then no files have their permissions changed

#               --DirPerms=     Sets the permissions of directories to this permission

#                               If not supplied then no directories have their permissions changed

#       OR

#               --Perms=        Sets the permissions of both files and directories to this permissions

#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X

#               

#   Options:                    

#               --RootOnly      Only sets the permissions on the 'path' directory/file, 

#                               all other options ignored

#               --SkipRoot      Does not set permissions on the 'path' directory/file, 

#                               obviously mutually exlusive with --RootOnly

#   

#       Any option supported by JatsLocateFiles. 

#       Some of these include:

#               

#               --Recurse       Recurse the directory tree.  Does a depth first recurse so that all 

#                               dir entries are processed before the dir itself (default)

#               --NoRecurse     Dont recurse

#               --FilterIn=     Apply permissions to files/directories that matches this value.

#               --FilterInRe=   Perl RE's can be used (Not Shell wildcards) and this option

#                               can be supplied mulitple times

#               --FilterOut=    Dont apply permissions to any files/directories matching this value

#               --FilterOutRe=  Perl RE's can be used (Not Shell wildcards) and this option

#                               can be supplied mulitple times

#               

#                               FilterIn is applied before FilterOut.  If Recurse is specified 

#                               the directory will be recursed regardless of these filters, however

#                               the filter will be applied when it comes time to chmod the dir 

#

#------------------------------------------------------------------------------

sub SetPermissions

{

    my ( $path, $filePerms, $dirPerms, $someDone );

    my ( $rootOnly, $skipRoot ) = ( 0, 0 );

    my $search =  JatsLocateFiles->new( '--Recurse', '--DirsToo' );

    foreach ( @_ )

    {

        if ( m/^--Perms=(.*)/ ) {

            $filePerms = $1;

            $dirPerms = $1;

        } elsif (m/^--FilePerms=(.*)/ )  {

            $filePerms = $1;

        } elsif ( m/^--DirPerms=(.*)/ )  {

            $dirPerms = $1;

        }  elsif ( m/^--RootOnly/ ) {

            $rootOnly = 1;

        } elsif ( m/^--SkipRoot/ )  {

            $skipRoot = 1;

        } elsif ( m/^--Filter/ && $search->option( $_ ) ) {

            Verbose2 ("Search Option: $_" );

        } elsif ( m/^--Recurse|--NoRecurse/ && $search->option( $_ ) ) {

            Verbose2 ("Search Option: $_" );

        } elsif (m/^--/ ) {

            Error ("SetPermissions: Unknown option: $_");

        } else  {

            Error("SetPermissions 'path' already set", "Path: $_") if ( $path );

            $path = $_;

        }

    }

    #

    #   Sanity test

    #

    Error("SetPermissions called with out a 'path' parameter") if ( !defined($path) );

    Error("SetPermissions called with out any Permissions specified") if ( !defined($filePerms) && !defined($dirPerms) );

    Error("SetPermissions: Options --RootOnly & --SkipRoot are mutually exclusive" ) if ( $rootOnly && $skipRoot );

    #   Convert the target directory name into a physical path

    #   User specifies '/' as the root of the image

    #   User specifies 'name' as relateve to the root of the image

    #

    my $topDir = $DebianWorkDir . '/' . $path;

    $topDir =~ s~/+$~~;

    Verbose("SetPermissions: Called with options " . join(", ", @_));

    #

    #   Only set perms on the root directory

    #       This is a trivial operation

    #

    if ( $rootOnly )

    {

        $someDone += chmodItem( $topDir, $filePerms, $dirPerms );

    }

    else

    {

        #

        #   Create a list of files/dirs to process

        #

        my @elements = $search->search( $topDir );

        foreach my $dirEntry ( @elements )

        {

            my $fullPath = "$topDir/$dirEntry";

            # A dir and we dont have dirperms, so skip

            if ( -d $fullPath && !defined($dirPerms) )

            {

                Verbose2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");

                next;

            }

            # A file and we dont have fileperms, so skip

            if ( -f $fullPath && !defined($filePerms) )

            {

                Verbose2("SetPermissions: Skipping file $fullPath as we have no file permissions");

                next;

            }

            # a file or a dir and have the right permissions and we are not recursing

            if ( -f $fullPath || -d $fullPath )

            {

                $someDone += chmodItem( $fullPath, $filePerms, $dirPerms );

            }

            else

            {

                Warning("SetPermissions: Skipping $fullPath as its not a file or directory");

            }

        }

        #

        #   Process the topDir

        #   May not be modified if --SkipRoot has been requested

        #

        if ( !$skipRoot && -e $topDir )

        {

            $someDone += chmodItem( $topDir, $filePerms, $dirPerms );

        }

    }

    #   Final warning

    #

    Warning ("SetPermissions: No files located", "Args: @_") unless ( $someDone );

}

#-------------------------------------------------------------------------------

# Function        : chmodItem 

#

# Description     : Internal

#                   chmod a file or a folder

#

# Inputs          : item                        - Item to mod

#                   filePerms                   - File perms

#                   dirPerms                    - dire perms

#

# Returns         : 1   - Item modified

#                   0   - Item not modified

#

sub chmodItem

{

    my ($item, $filePerms, $dirPerms) = @_;

    if ( -d $item && defined $dirPerms)

    {

        Verbose("SetPermissions: $dirPerms : $item");

        System ('chmod', $dirPerms, $item );

        return 1;

    }

    if ( -f $item  && defined $filePerms)

    {

        Verbose("SetPermissions: $filePerms : $item");

        System ('chmod', $filePerms, $item );

        return 1;

    }

    return 0;

}

#-------------------------------------------------------------------------------