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 )