Subversion Repositories DevTools

Rev

Rev 4163 | Rev 4261 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4163 Rev 4257
Line 6094... Line 6094...
6094 
sub PackageFile
 6094 
sub PackageFile
6095 
{
 6095 
{
6096 
    my( $platforms, @elements ) = @_;
 6096 
    my( $platforms, @elements ) = @_;
6097 
    my( $base, $dir, $full, $path, $dist, $strip, $exefile, $type );
 6097 
    my( $base, $dir, $full, $path, $dist, $strip, $exefile, $type );
6098 
    my( $name, $basename, $len, $srcfile );
 6098 
    my( $name, $basename, $len, $srcfile );
6099 
    my( $dir_tree, @dir_tree_exclude, @dir_tree_include, $strip_base );
 6099 
    my( $dir_tree, @dir_tree_exclude, @dir_tree_include, $strip_base, $strip_dots );
6100 
    my $recurse = 1;
 6100 
    my $recurse = 1;
6101 
 
 6101 
 
6102 
    Debug2( "PackageFile($platforms, @elements)" );
 6102 
    Debug2( "PackageFile($platforms, @elements)" );
6103 
 
 6103 
 
6104 
    return if ( !$ScmPackage );                 # Packaging enabled ?
 6104 
    return if ( !$ScmPackage );                 # Packaging enabled ?
Line 6110... Line 6110...
6110 
    $base = $PackageInfo{'File'}{'PBase'};          # Base of target
 6110 
    $base = $PackageInfo{'File'}{'PBase'};          # Base of target
6111 
    $dir = $base . $PackageInfo{'File'}{'Dir'};     # Installation path (default)
 6111 
    $dir = $base . $PackageInfo{'File'}{'Dir'};     # Installation path (default)
6112 
    $full = 0;
 6112 
    $full = 0;
6113 
    $strip = 0;
 6113 
    $strip = 0;
6114 
    $strip_base = 0;
 6114 
    $strip_base = 0;
- 
 
 6115 
    $strip_dots = 0;
6115 
    $exefile = 0;
 6116 
    $exefile = 0;
6116 
 
 6117 
 
6117 
    foreach ( @elements )
 6118 
    foreach ( @elements )
6118 
    {
 6119 
    {
6119 
        my $rv = __TargetDir($T_PKG|$T_MACH|$T_GBE|$T_FILE, $base, $_, \$dir, \$type);
 6120 
        my $rv = __TargetDir($T_PKG|$T_MACH|$T_GBE|$T_FILE, $base, $_, \$dir, \$type);
Line 6137... Line 6138...
6137 
            $exefile = "X";
 6138 
            $exefile = "X";
6138 
 
 6139 
 
6139 
        } elsif ( /^--DirTree=(.*)/ ) {
 6140 
        } elsif ( /^--DirTree=(.*)/ ) {
6140 
            Error("DirTree. Multiple directories not allowed.") if ( $dir_tree );
 6141 
            Error("DirTree. Multiple directories not allowed.") if ( $dir_tree );
6141 
            $dir_tree =  $1;
 6142 
            $dir_tree =  $1;
- 
 
 6143 
            Error("DirTree. No path specified") unless ( defined($dir_tree) && $dir_tree ne "" );
6142 
 
 6144 
 
6143 
            # Prevent the user from escaping from the current directory
 6145 
            # Prevent the user from escaping from the current directory
6144 
            Error("DirTree. Absolute paths are not allowed",
 6146 
            Error("DirTree. Absolute paths are not allowed",
6145 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~^/~ || $dir_tree =~ m~^.\:~ );
 6147 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~^/~ || $dir_tree =~ m~^.\:~ );
6146 
 
 6148 
 
6147 
            #
 6149 
            #
6148 
            #   Convert the relative path to one that is truely relative to the current
 6150 
            #   Convert the relative path to one that is truely relative to the current
6149 
            #   directory. This may occur when the user uses $ProjectBase
 6151 
            #   directory. This may occur when the user uses $ProjectBase
6150 
            #
 6152 
            #
6151 
            $dir_tree = RelPath(AbsPath($dir_tree));
 6153 
            my $abs_dir_tree = AbsPath($dir_tree);
6152 
            Debug2( "PackageFile. DirTree: $dir_tree" );
 6154 
            $dir_tree = RelPath($abs_dir_tree);
6153 
 
 6155 
 
- 
 
 6156 
            #
- 
 
 6157 
            #   Ensure that the user is not trying to escape the package
- 
 
 6158 
            #   Done allow the user to attempt to package the entire package either
- 
 
 6159 
            #
- 
 
 6160 
            #   Calculate the relative path from $ProjectBase to the target directory
- 
 
 6161 
            #   It must not be above the $ProjectBase
- 
 
 6162 
            #
- 
 
 6163 
            my $dirFromBase = RelPath($abs_dir_tree, AbsPath($ProjectBase));
6154 
            Error("DirTree cannot extend outside current subtree. '..' not allowed.",
 6164 
            Error("DirTree cannot extend outside current package.",
6155 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~\.\.~ );
 6165 
                  "Directory: $dirFromBase") if ( $dirFromBase =~ m~\.\.~ );
- 
 
 6166 
            Error("DirTree cannot package entire package.",
- 
 
 6167 
                "Directory: $dirFromBase") if ( $dirFromBase eq '.' );
- 
 
 6168
- 
 
 6169 
            Debug2( "PackageFile. DirTree: $dir_tree" );
6156 
 
 6170 
 
6157 
            Error("DirTree. Directory not found",
 6171 
            Error("DirTree. Directory not found",
6158 
                  "Directory: $dir_tree") unless  ( -d $dir_tree );
 6172 
                  "Directory: $dir_tree") unless  ( -d $dir_tree );
6159 
 
 6173 
 
- 
 
 6174 
            # If packaging a parent directory then force dot_stripping of the base directory
- 
 
 6175 
            # strip_base will have precedence if both are active
- 
 
 6176 
            if ( $dir_tree =~ m~\.\.~ )
- 
 
 6177 
            {
- 
 
 6178 
                $dir_tree =~ m~(\.\./)+~;
- 
 
 6179 
                $strip_dots = length($1);
- 
 
 6180 
            }
- 
 
 6181 
 
6160 
        } elsif ( /^--FilterOut=(.*)/ ) {
 6182 
        } elsif ( /^--FilterOut=(.*)/ ) {
6161 
            push @dir_tree_exclude, $1;
 6183 
            push @dir_tree_exclude, $1;
6162 
 
 6184 
 
6163 
        } elsif ( /^--FilterIn=(.*)/ ) {
 6185 
        } elsif ( /^--FilterIn=(.*)/ ) {
6164 
            push @dir_tree_include, $1;
 6186 
            push @dir_tree_include, $1;
Line 6187... Line 6209...
6187 
        $search->recurse($recurse);
 6209 
        $search->recurse($recurse);
6188 
        $search->filter_in_re ( $_ ) foreach ( @dir_tree_include );
 6210 
        $search->filter_in_re ( $_ ) foreach ( @dir_tree_include );
6189 
        $search->filter_out_re( $_ ) foreach ( @dir_tree_exclude );
 6211 
        $search->filter_out_re( $_ ) foreach ( @dir_tree_exclude );
6190 
        $search->filter_out_re( '/\.svn/' );
 6212 
        $search->filter_out_re( '/\.svn/' );
6191 
        @elements = $search->search ( $dir_tree );
 6213 
        @elements = $search->search ( $dir_tree );
- 
 
 6214 
        if ($strip_base){
6192 
        $strip_base = length( $dir_tree ) if ( $strip_base );
 6215 
            $strip_base = length( $dir_tree ) if ( $strip_base );
- 
 
 6216 
        } elsif ($strip_dots) {
- 
 
 6217 
            $strip_base = $strip_dots;
- 
 
 6218 
        }
6193 
    }
 6219 
    }
6194 
 
 6220 
 
6195 
#.. Files
 6221 
#.. Files
6196 
#
 6222 
#
6197 
    foreach ( @elements )
 6223 
    foreach ( @elements )