Subversion Repositories DevTools

Rev

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

Rev 4128 Rev 4163
Line 2541... Line 2541...
2541 
        #   Basically present so that we can use .exe files without the .exe name
 2541 
        #   Basically present so that we can use .exe files without the .exe name
2542 
        #
 2542 
        #
2543 
        my @extension_list;
 2543 
        my @extension_list;
2544 
        push @extension_list, '.exe' if ( $::ScmHost ne "Unix" );
 2544 
        push @extension_list, '.exe' if ( $::ScmHost ne "Unix" );
2545 
        push @extension_list, '.pl', '.sh', '.ksh', '';
 2545 
        push @extension_list, '.pl', '.sh', '.ksh', '';
2546 
 
 - 
 
2547 
        TOOL_SEARCH:
 2546 
        TOOL_SEARCH:
2548 
        {
 2547 
        {
2549 
            #
 2548 
            #
2550 
            #   Locate tool with package
 2549 
            #   Locate tool with package
2551 
            #
 2550 
            #
Line 6137... Line 6136...
6137 
        } elsif (/^--Executable$/) {            # Mark the file as executable
 6136 
        } elsif (/^--Executable$/) {            # Mark the file as executable
6138 
            $exefile = "X";
 6137 
            $exefile = "X";
6139 
 
 6138 
 
6140 
        } elsif ( /^--DirTree=(.*)/ ) {
 6139 
        } elsif ( /^--DirTree=(.*)/ ) {
6141 
            Error("DirTree. Multiple directories not allowed.") if ( $dir_tree );
 6140 
            Error("DirTree. Multiple directories not allowed.") if ( $dir_tree );
6142 
            $dir_tree = $1;
 6141 
            $dir_tree =  $1;
6143 
 
 6142 
 
6144 
            Error("DirTree cannot extend outside current subtree. '..' not allowed.",
 6143 
            # Prevent the user from escaping from the current directory
6145 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~\.\.~ );
 - 
 
6146 
            Error("DirTree. Absolute paths are not allowed",
 6144 
            Error("DirTree. Absolute paths are not allowed",
6147 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~^/~ || $dir_tree =~ m~^.\:~ );
 6145 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~^/~ || $dir_tree =~ m~^.\:~ );
- 
 
 6146 
 
- 
 
 6147 
            #
- 
 
 6148 
            #   Convert the relative path to one that is truely relative to the current
- 
 
 6149 
            #   directory. This may occur when the user uses $ProjectBase
- 
 
 6150 
            #
- 
 
 6151 
            $dir_tree = RelPath(AbsPath($dir_tree));
- 
 
 6152 
            Debug2( "PackageFile. DirTree: $dir_tree" );
- 
 
 6153 
 
- 
 
 6154 
            Error("DirTree cannot extend outside current subtree. '..' not allowed.",
- 
 
 6155 
                  "Directory: $dir_tree") if ( $dir_tree =~ m~\.\.~ );
- 
 
 6156 
 
6148 
            Error("DirTree. Directory not found",
 6157 
            Error("DirTree. Directory not found",
6149 
                  "Directory: $dir_tree") unless  ( -d $dir_tree );
 6158 
                  "Directory: $dir_tree") unless  ( -d $dir_tree );
6150 
 
 6159 
 
6151 
        } elsif ( /^--FilterOut=(.*)/ ) {
 6160 
        } elsif ( /^--FilterOut=(.*)/ ) {
6152 
            push @dir_tree_exclude, $1;
 6161 
            push @dir_tree_exclude, $1;