Subversion Repositories DevTools

Rev

Rev 1588 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1588 Rev 1589
Line 39... Line 39...
39
use DeployUtils::RmPkgInfo;
39
use DeployUtils::RmPkgInfo;
40
use BuildConfig;
40
use BuildConfig;
41
use Exporter();
41
use Exporter();
42
 
42
 
43
use ArrayHashUtils;
43
use ArrayHashUtils;
-
 
44
use JatsEnv;
44
use JatsError;
45
use JatsError;
45
use JatsSystem;
46
use JatsSystem;
46
 
47
 
47
#
48
#
48
#   The LWP is a part of the Active State Perl, but not the solaris perl
49
#   The LWP is a part of the Active State Perl, but not the solaris perl
Line 114... Line 115...
114
                    &updatePrototypeFileItemClass
115
                    &updatePrototypeFileItemClass
115
                    &useReplaceClass
116
                    &useReplaceClass
116
                    &setReplaceClassFiles
117
                    &setReplaceClassFiles
117
                    &createPkginfoFile
118
                    &createPkginfoFile
118
                    &updatePrototypeFileItemOwner
119
                    &updatePrototypeFileItemOwner
-
 
120
                    &setPermissions
119
                    &chmod
121
                    &chmod
120
                    &chmodRecursive
122
                    &chmodRecursive
121
                    &chmodDir
123
                    &chmodDir
122
                    &chmodFile
124
                    &chmodFile
123
                    &createSymbolicLink
125
                    &createSymbolicLink
Line 5609... Line 5611...
5609
 
5611
 
5610
}
5612
}
5611
 
5613
 
5612
 
5614
 
5613
#------------------------------------------------------------------------------
5615
#------------------------------------------------------------------------------
5614
sub chmod
5616
sub setPermissions
-
 
5617
#   Called to set permissions of files/dirs in a directory structure.
-
 
5618
#       With no options sets DirTag and all files/dirs in it to perms
5615
#
5619
#   
5616
# Description:
5620
#   Parameters:  
5617
#       This sub-routine is used to change the ownership of a file or
5621
#               DirTag:  The directory tag to start setting permissions on
-
 
5622
#       
-
 
5623
#   Required Options:
5618
#       directory structure.
5624
#       One or both of
-
 
5625
#               --FilePerms=    Sets the permissions of files to this permission.
-
 
5626
#                               If not supplied then no files have their permissions changed
-
 
5627
#               --DirPerms=     Sets the permissions of directories to this permission
-
 
5628
#                               If not supplied then no directories have their permissions changed
-
 
5629
#       OR
-
 
5630
#               --Perms=        Sets the permissions of both files and directories to this permissions
-
 
5631
#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X
-
 
5632
#               
-
 
5633
#   Options:
-
 
5634
#               --Recurse       Recurse the directory tree.  Does a deptth first recurse so that all 
-
 
5635
#                               dir entries are processed before the dir itself
-
 
5636
#               --NoRecurse     Dont recurse, default
-
 
5637
#               --DirTagOnly    Only sets the permissions on the DirTag directory, 
-
 
5638
#                               all other options ignored
-
 
5639
#               --SkipDirTag    Does not set permissions on the DirTag Directory, 
-
 
5640
#                               obviously mutually exlusive with --DirTagOnly
-
 
5641
#               --FilterIn=     Apply permissions to files/directories that matches this value.
-
 
5642
#                               Perl RE's can be used (Not Shell wildcards) and this option
-
 
5643
#                               can be supplied mulitple times
-
 
5644
#               --FilterOut=    Dont apply permissions to any files/directories matching this value
-
 
5645
#                               Perl RE's can be used (Not Shell wildcards) and this option
-
 
5646
#                               can be supplied mulitple times
-
 
5647
#               
-
 
5648
#                               FilterIn is applied before FilterOut.  If Recurse is specified 
-
 
5649
#                               the directory will be recursed regardless of these filters, however
-
 
5650
#                               the filter will be applied when it comes time to chmod the dir 
5619
#
5651
#
-
 
5652
#               --RecursedCall  Used internally to indicate a recursed call
5620
#------------------------------------------------------------------------------
5653
#------------------------------------------------------------------------------
5621
{
5654
{
5622
    # correct number of parameters?
5655
    my ( @filterIn, @filterOut );
-
 
5656
    my ( @recurseArgs ) = ( "--RecursedCall" );
-
 
5657
    my ( $dirTag, $filePerms, $dirPerms );
-
 
5658
    my ( $recurse, $dirTagOnly, $skipDirTag, $recursedCall ) = ( 0, 0, 0, 0 );
-
 
5659
 
5623
    if ( ($#_+1) != 3 )
5660
    foreach ( @_ )
5624
    {
5661
    {
-
 
5662
        if ( m/^--Perms=(.*)/ ) 
-
 
5663
        {
-
 
5664
            $filePerms = $1;
-
 
5665
            $dirPerms = $1;
5625
        Error("Incorrect number of params passed to " .
5666
            push(@recurseArgs, $_);         # Pass this on in recursive calls
-
 
5667
        } 
-
 
5668
        elsif ( m/^--FilePerms=(.*)/ ) 
-
 
5669
        {
-
 
5670
            $filePerms = $1;
-
 
5671
            push(@recurseArgs, $_);         # Pass this on in recursive calls
-
 
5672
        } 
-
 
5673
        elsif ( m/^--DirPerms=(.*)/ ) 
-
 
5674
        {
-
 
5675
            $dirPerms = $1;
-
 
5676
            push(@recurseArgs, $_);         # Pass this on in recursive calls
-
 
5677
        }
-
 
5678
        elsif ( m/^--RecursedCall/ ) 
-
 
5679
        {
-
 
5680
            $recurse = 1;
-
 
5681
            $recursedCall = 1;
-
 
5682
        } 
-
 
5683
        elsif ( m/^--Recurse/ ) 
-
 
5684
        {
-
 
5685
            $recurse = 1;
-
 
5686
        } 
-
 
5687
        elsif ( m/^--NoRecurse/ ) 
-
 
5688
        {
-
 
5689
            $recurse = 0;
-
 
5690
        } 
-
 
5691
        elsif ( m/^--DirTagOnly/ ) 
-
 
5692
        {
-
 
5693
            $dirTagOnly = 1;
-
 
5694
        } 
-
 
5695
        elsif ( m/^--SkipDirTag/ ) 
-
 
5696
        {
-
 
5697
            $skipDirTag = 1;
-
 
5698
        } 
-
 
5699
        elsif ( m/^--FilterIn=(.*)/ ) 
-
 
5700
        {
-
 
5701
            push @filterIn, $1;
-
 
5702
            push(@recurseArgs, $_);         # Pass this on in recursive calls
-
 
5703
        } 
-
 
5704
        elsif ( m/^--FilterOut=(.*)/ ) 
-
 
5705
        {
-
 
5706
            push @filterOut, $1;
5626
                  "chmod() function. Check deploy config.");
5707
            push(@recurseArgs, $_);         # Pass this on in recursive calls
-
 
5708
        } 
-
 
5709
        else 
-
 
5710
        {
-
 
5711
            $dirTag = $_;
-
 
5712
        }
5627
    }
5713
    }
5628
 
5714
 
5629
 
-
 
5630
    # lets setup the passed values.
5715
    Error("SetPermissions called with out DirTag parameter") if ( !defined($dirTag) );
-
 
5716
    Error("SetPermissions called with out any Permission options") if ( !defined($filePerms) && !defined($dirPerms) );
-
 
5717
    Error("SetPermissions: Options --DirTagOnly & --SkipDirTag are mutually exclusive" ) if ( $dirTagOnly && $skipDirTag );
-
 
5718
    # Sanity check for internal recursed calls, cant have --DirTagOnly or --NotDirTag on recursed calls
-
 
5719
    Error("SetPermissions Internal Error:  Recursively called with --DirTagOnly or --SkipDirTag")
5631
    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
5720
        if ( $recursedCall && ( $dirTagOnly || $skipDirTag ) );
5632
 
-
 
5633
 
5721
 
5634
    # lets just check to see if the perms are in correct format.
5722
    # lets just check to see if the perms are in correct format.
5635
    #
5723
    #
5636
    if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ )
5724
    if ( (defined($filePerms) && $filePerms !~ m/^\d{4}$/) || (defined($dirPerms) && $dirPerms !~ m/^\d{4}$/) )
5637
    {
5725
    {
5638
        Error("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");
5726
        Error("setPermissions called with invalid permissions format");
5639
        return 1;
-
 
5640
    }
5727
    }
5641
 
5728
 
-
 
5729
    # if there is no filterIn set the first element of filterIn to match evrything
-
 
5730
    push(@filterIn, '^.*$') if ( $#filterIn == -1 );
-
 
5731
    # if there is no filterOut set the first element of filterOut to emtpy string which should not match anything
5642
    # lets get the absolute src dir value
5732
    push(@filterOut, '') if ( $#filterOut == -1 );
-
 
5733
 
-
 
5734
 
-
 
5735
    # if recursed call then dirTag is already a path, otherwise get path for dirTag
5643
    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
5736
    my ($topDir) = ( $recursedCall ) ? $dirTag : getTargetDstDirValue($dirTag, "A");
5644
 
5737
 
5645
    my($item);
-
 
5646
    if ( "x$m_sfile" eq "x" )
5738
    if ( $dirTagOnly )
5647
    {
5739
    {
-
 
5740
        Error("SetPermissions:  --DirPerms or --Perms not supplied for setting perms with --DirTagOnly") 
-
 
5741
            if ( ! defined($dirPerms) );
-
 
5742
        Information("SetPermissions: Setting permissions on top level dir only [$topDir] to " . $dirPerms);
5648
        $item = "$m_sDirAbsoluteValue";
5743
        chmodFile($topDir, $dirPerms);
-
 
5744
        return;
-
 
5745
    }
-
 
5746
 
-
 
5747
    if ( $recursedCall )
-
 
5748
    {
-
 
5749
        Debug2("SetPermissions: Processing Dir $topDir");
5649
    }
5750
    }
5650
    else
5751
    else
5651
    {
5752
    {
5652
        $item = "$m_sDirAbsoluteValue/$m_sfile";
5753
        Information("SetPermissions: Called with options " . join(", ", @_));
5653
    }
5754
    }
5654
 
5755
 
-
 
5756
    local *DIR;
-
 
5757
    opendir(DIR, $topDir) or Error("SetPermissions: Error opening dir $topDir: $!");
-
 
5758
 
5655
    # check to see if item exists
5759
    my ($dirEntry, $fullPath);
-
 
5760
    while (defined($dirEntry = readdir(DIR)))
5656
    #
5761
    {
-
 
5762
        next if ( $dirEntry =~ /^\.{1,2}$/ );   # skip . & ..
-
 
5763
        
-
 
5764
        $fullPath = "$topDir/$dirEntry";
-
 
5765
 
-
 
5766
        # if we have a dir and recurse is on then recurse into it first
5657
    if ( ! -f "$item" && 
5767
        if ( -d $fullPath && $recurse )
-
 
5768
        {
-
 
5769
            # This dirs permissions will be set at the end of this call
-
 
5770
            setPermissions($fullPath, @recurseArgs);
-
 
5771
        }
-
 
5772
        # else a dir and we dont have dirperms, so skip
-
 
5773
        elsif ( -d $fullPath && !defined($dirPerms) )
-
 
5774
        {
-
 
5775
            Debug2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");
-
 
5776
        }
-
 
5777
        # else a file and we dont have fileperms, so skip
-
 
5778
        elsif ( -f $fullPath && !defined($filePerms) )
-
 
5779
        {
-
 
5780
            Debug2("SetPermissions: Skipping file $fullPath as we have no file permissions");
-
 
5781
        }
-
 
5782
        # else a file or a dir and have the right permissions and we are not recursing
-
 
5783
        elsif ( -f $fullPath || -d $fullPath )
-
 
5784
        {
-
 
5785
            my $matchIn  = grep { $dirEntry =~ /$_/ } @filterIn;
-
 
5786
            my $matchOut = grep { $dirEntry =~ /$_/ } @filterOut;
-
 
5787
 
-
 
5788
            if ( $matchIn > 0 && $matchOut == 0 )
-
 
5789
            {
-
 
5790
                chmodFile($fullPath, ( -f $fullPath ) ? $filePerms : $dirPerms);
-
 
5791
            }
5658
         ! -d "$item" )
5792
            else
-
 
5793
            {
-
 
5794
                Debug2("SetPermissions: Skipping element $fullPath on non filter match, (In,Out) = (" . $matchIn . "," . $matchOut . ")" );
-
 
5795
            }
-
 
5796
        }
-
 
5797
        else
-
 
5798
        {
-
 
5799
            Warning("SetPermissions: Skipping $fullPath as its not a file or directory");
-
 
5800
        }
-
 
5801
    }
-
 
5802
    close (DIR);
-
 
5803
 
-
 
5804
    # lets deal with topDir
-
 
5805
    # If --SkipDirTag is on then we skip this, this is only applicable to first call, not recursed calls
-
 
5806
    if ( !$skipDirTag && defined($dirPerms) )
5659
    {
5807
    {
-
 
5808
        $dirEntry = basename($topDir);
-
 
5809
        my $matchIn  = grep { $dirEntry =~ /$_/ } @filterIn;
5660
        Error("Failed to find item [$item]. Check deploy config."); 
5810
        my $matchOut = grep { $dirEntry =~ /$_/ } @filterOut;
-
 
5811
 
-
 
5812
        if ( $matchIn > 0 && $matchOut == 0 )
-
 
5813
        {
-
 
5814
            chmodFile($topDir, $dirPerms);
-
 
5815
        }
-
 
5816
        else
-
 
5817
        {
-
 
5818
            Debug2("SetPermissions: Skipping dir $topDir on non filter match, (In,Out) = (" . $matchIn . "," . $matchOut . ")" );
-
 
5819
        }
5661
    }
5820
    }
-
 
5821
    else
-
 
5822
    {
-
 
5823
        Debug2("SetPermissions: Skipping dir $topDir " . 
-
 
5824
              (($skipDirTag) ? "because of --SkipDirTag option" : "as we have no dir permissions") );
-
 
5825
    }
-
 
5826
}   # setPermissions
-
 
5827
 
-
 
5828
 
-
 
5829
#------------------------------------------------------------------------------
-
 
5830
sub chmod
-
 
5831
#
-
 
5832
# Description:
-
 
5833
#       This sub-routine is used to change the ownership of a file or
-
 
5834
#       directory structure.
-
 
5835
#
-
 
5836
#------------------------------------------------------------------------------
-
 
5837
{
-
 
5838
    # correct number of parameters?
5662
    Verbose("chmod: Changing permisions of file [$m_sfile] in dirtag [$m_sDirTag] to [$m_ownPerms]");
5839
    Error("Incorrect number of params passed to chmod() function. Check deploy config.") if ( ($#_+1) != 3 );
-
 
5840
 
-
 
5841
    # lets setup the passed values.
5663
    chmodFile("$item", $m_ownPerms);
5842
    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
-
 
5843
 
-
 
5844
    Warning("chmod has been deprecated by and now calls setPermissions, see deploylib.pm");
-
 
5845
 
-
 
5846
    # call setPermissions, if no File then do DirTagOnly, otherwise set FilterIn=File
-
 
5847
    setPermissions($m_sDirTag, "--NoRecurse", "--Perms=$m_ownPerms", 
-
 
5848
                    ($m_sfile eq "") ? "--DirTagOnly" : "--FilterIn=$m_sfile" );
5664
 
5849
 
5665
    return 1;
5850
    return 1;
5666
}
5851
}
5667
 
5852
 
5668
 
5853
 
Line 5674... Line 5859...
5674
#       the target packgae.
5859
#       the target packgae.
5675
#
5860
#
5676
#------------------------------------------------------------------------------
5861
#------------------------------------------------------------------------------
5677
{
5862
{
5678
    # correct number of parameters?
5863
    # correct number of parameters?
5679
    if ( ($#_+1) != 2 )
-
 
5680
    {
-
 
5681
        Error("Incorrect number of params passed to " .
-
 
5682
                  "chmodRecursive() function. Check deploy config.");
5864
    Error("Incorrect number of params passed to chmodRecursive() function. Check deploy config.") if ( ($#_+1) != 2 );
5683
    }
-
 
5684
 
5865
 
5685
    # lets setup the passed values.
5866
    # lets setup the passed values.
5686
    my ($m_sDirTag, $m_ownPerms) = @_;
5867
    my ($m_sDirTag, $m_ownPerms) = @_;
5687
 
5868
 
5688
    # lets just check to see if the perms are in correct format.
-
 
5689
    #
-
 
5690
    if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ )
-
 
5691
    {
-
 
5692
        Error("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");
5869
    Warning("chmodRecursive has been deprecated by and now calls setPermissions, see deploylib.pm");
5693
        return 1;
-
 
5694
    }
-
 
5695
 
-
 
5696
 
-
 
5697
    # lets get the absolute src dir value
-
 
5698
    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
-
 
5699
 
5870
 
5700
 
-
 
5701
    # check to see if item exists
-
 
5702
    #
-
 
5703
    if ( ! -f "$m_sDirAbsoluteValue" &&
-
 
5704
         ! -d "$m_sDirAbsoluteValue" )
-
 
5705
    {
-
 
5706
        Error("Failed to find item [$m_sDirAbsoluteValue]. " .
-
 
5707
                  "Check deploy config."); 
-
 
5708
    }
-
 
5709
 
-
 
5710
 
-
 
5711
    # if its a not a dir
-
 
5712
    #
-
 
5713
    if ( ! -d "$m_sDirAbsoluteValue" && -f "$m_sDirAbsoluteValue" )
-
 
5714
    {
-
 
5715
        Warning("chmodRecursive: This should not happen as dirtag [$m_sDirTag] is a file, changings perms to [$m_ownPerms] anyway");
-
 
5716
        chmodFile("$m_sDirAbsoluteValue", $m_ownPerms);
-
 
5717
    }
-
 
5718
    else
-
 
5719
    {
-
 
5720
        # it must be a dir
-
 
5721
        Verbose("chmodRecursive: Recursively setting perms on dirtag [$m_sDirTag] to [$m_ownPerms]");
5871
    # call setPermissions, if no File then do DirTagOnly, otherwise set FilterIn=File
5722
        chmodDir("$m_sDirAbsoluteValue", $m_ownPerms);
5872
    setPermissions($m_sDirTag, "--Recurse", "--Perms=$m_ownPerms");
5723
    }
-
 
5724
 
5873
 
5725
    return 1;
5874
    return 1;
5726
}
5875
}
5727
 
5876
 
5728
 
5877
 
Line 5738... Line 5887...
5738
#       finds a dir it recurses into that dir chmod'ing it as well.
5887
#       finds a dir it recurses into that dir chmod'ing it as well.
5739
#
5888
#
5740
#------------------------------------------------------------------------------
5889
#------------------------------------------------------------------------------
5741
{
5890
{
5742
    # correct number of parameters?
5891
    # correct number of parameters?
5743
    if ( ($#_+1) != 2 )
-
 
5744
    {
-
 
5745
        Error("Incorrect number of params passed to " .
5892
    Error("Incorrect number of params passed to chmodDir() function.") if ( ($#_+1) != 2 );
5746
                  "chmodDir() function.");
-
 
5747
    }
-
 
5748
 
5893
 
5749
    my ($startingPoint, $perms) = @_;
5894
    my ($startingPoint, $perms) = @_;
5750
 
5895
 
-
 
5896
    Warning("chmodDir has been deprecated by setPermissions, see deploylib.pm");
-
 
5897
 
5751
    Verbose("chmodDir: Recursively setting permsision of [$startingPoint] to [$perms]");
5898
    Verbose("chmodDir: Recursively setting permsision of [$startingPoint] to [$perms]");
5752
 
5899
 
5753
    local *DIR;
5900
    local *DIR;
5754
    opendir(DIR, $startingPoint) or
-
 
5755
        Error("can't opendir $startingPoint: $!");
5901
    opendir(DIR, $startingPoint) or Error("can't opendir $startingPoint: $!");
5756
 
5902
 
5757
    my ($item);
5903
    my ($item);
5758
    while (defined($item = readdir(DIR)))
5904
    while (defined($item = readdir(DIR)))
5759
    {
5905
    {
5760
        if ( "$item" !~ /^\.$/  &&
-
 
5761
             "$item" !~ /^\.\.$/ )
5906
        if ( "$item" !~ /^\.$/  && "$item" !~ /^\.\.$/ )
5762
        {
5907
        {
5763
            if ( -d "$startingPoint/$item" )
5908
            if ( -d "$startingPoint/$item" )
5764
            {
5909
            {
5765
                chmodDir("$startingPoint/$item", $perms);
5910
                chmodDir("$startingPoint/$item", $perms);
5766
            }
5911
            }
Line 5790... Line 5935...
5790
#
5935
#
5791
#------------------------------------------------------------------------------
5936
#------------------------------------------------------------------------------
5792
{
5937
{
5793
    my ($item, $perms) = @_;
5938
    my ($item, $perms) = @_;
5794
 
5939
 
5795
    my ($cmd) = "CORE::chmod $perms, $item";
-
 
5796
    my ($noItems) = CORE::chmod oct($perms), $item;
5940
    my ($noItems) = CORE::chmod oct($perms), $item;
5797
    if ( $noItems == 0 )
5941
    if ( $noItems == 0 )
5798
    {
5942
    {
5799
        Error("Failed to complete command [$cmd], retVal=[$noItems]");
5943
        Error("ERROR: Failed to chmod $item=$perms, retVal=[$noItems]");
5800
    }
5944
    }
5801
    else
5945
    else
5802
    {
5946
    {
5803
        Debug("Executed command: [$cmd]");
5947
        Debug("Successfully chmod $item=$perms");
5804
    }
5948
    }
5805
 
5949
 
5806
    return 1;
5950
    return 1;
5807
}
5951
}
5808
 
5952