Subversion Repositories DevTools

Rev

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

Rev 6276 Rev 6415
Line 32... Line 32...
32 
#                    FileAppend                 - Append to a simple text file
 32 
#                    FileAppend                 - Append to a simple text file
33 
#                    TagFileMatch               - Simple (oneline) file content matcher
 33 
#                    TagFileMatch               - Simple (oneline) file content matcher
34 
#                    TagFileRead                - Return the contents of the tagfile
 34 
#                    TagFileRead                - Return the contents of the tagfile
35 
#                    RmDirTree                  - Remove a directory tree
 35 
#                    RmDirTree                  - Remove a directory tree
36 
#                    CatPaths                   - Concatenate Paths
36 
#                    CatPaths                   - Concatenate Paths
- 
 
 37 
#                    ValidatePath               - Validate directory is sane and within package
37 
#           ReExported
 38 
#           ReExported
38 
#                    catdir                     - Concatenate path elements
 39 
#                    catdir                     - Concatenate path elements
39 
#                    catfile                    - Concatenate path elements and a file
 40 
#                    catfile                    - Concatenate path elements and a file
40 
#
 41 
#
41 
#......................................................................#
 42 
#......................................................................#
Line 85... Line 86...
85 
                TagFileRead
 86 
                TagFileRead
86 
                RmDirTree
 87 
                RmDirTree
87 
                CatPaths
 88 
                CatPaths
88 
                catfile
 89 
                catfile
89 
                catdir
 90 
                catdir
- 
 
 91 
                ValidatePath
90 
 
 92 
 
91 
                $ScmPathSep
 93 
                $ScmPathSep
92 
                $ScmDirSep
 94 
                $ScmDirSep
93 
                $Cwd
 95 
                $Cwd
94 
                $CwdFull
 96 
                $CwdFull
Line 1021... Line 1023...
1021 
        }
 1023 
        }
1022 
    }
 1024 
    }
1023 
    return ( -e $path );
 1025 
    return ( -e $path );
1024 
}
 1026 
}
1025 
 
 1027 
 
- 
 
 1028 
#-------------------------------------------------------------------------------
- 
 
 1029 
# Function        : ValidatePath
- 
 
 1030 
#
- 
 
 1031 
# Description     : Ensure that the user provided path does not escape the current
- 
 
 1032 
#                   package and is sane
- 
 
 1033 
#
- 
 
 1034 
# Inputs          : $path       - One path to validate
- 
 
 1035 
#                   $mode       - 0 : No sanity test (only escape test)
- 
 
 1036 
#                                 1 : Abs path not allowed
- 
 
 1037 
#                                 2 : Parent directory not allowed
- 
 
 1038 
#                                 4 : Path must exist
- 
 
 1039 
#                                 Mode options are bit mask and may be combined
- 
 
 1040 
#
- 
 
 1041 
# Returns         : Array:
- 
 
 1042 
#                       - Clean pathname (unless error)
- 
 
 1043 
#                       - Error message
- 
 
 1044 
#
- 
 
 1045 
sub ValidatePath
- 
 
 1046 
{
- 
 
 1047 
    my ($path, $mode) = @_;
- 
 
 1048 
    Error("Internal: ValidatePath. ProjectBase not known" ) unless defined $::ProjectBase;
- 
 
 1049 
 
- 
 
 1050 
    my $errPath = $path;
- 
 
 1051 
 
- 
 
 1052 
    if ($mode & 1 && $path =~ m~^/~ ) {
- 
 
 1053 
        return $errPath, 'Absolute path not allowed';
- 
 
 1054 
    }
- 
 
 1055 
 
- 
 
 1056 
    $path =~ s~^/~~;
- 
 
 1057 
    $path = CleanPath($path);
- 
 
 1058 
 
- 
 
 1059 
    if ($mode & 2 && $path =~ m~^[./]+$~ ) {
- 
 
 1060 
        return $errPath, 'Parent directory not allowed';
- 
 
 1061 
    }
- 
 
 1062 
 
- 
 
 1063 
    if ($mode & 4 && ! -d $path ) {
- 
 
 1064 
        return $errPath, 'Directory does not exist';
- 
 
 1065 
    }
- 
 
 1066 
 
- 
 
 1067 
    my $dirFromBase = RelPath(AbsPath($path), AbsPath($::ProjectBase));
- 
 
 1068 
    if ( $dirFromBase =~ m~\.\.~ ) {
- 
 
 1069 
        return $errPath, 'Path outside the current package';
- 
 
 1070 
    }
- 
 
 1071 
    return $path;
- 
 
 1072 
}
- 
 
 1073 
 
1026 
1;
 1074 
1;
1027 
 
 1075 
 
1028 
 
 1076