Subversion Repositories DevTools

Rev

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

Rev 7320 Rev 7322
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 760... Line 762...
760 
#
 762 
#
761 
# Returns         : Cleaned up path elements
 763 
# Returns         : Cleaned up path elements
762 
#
 764 
#
763 
sub CatPaths
 765 
sub CatPaths
764 
{
 766 
{
- 
 
 767 
    my @paths = grep defined , @_;
765 
    Debug("CatPaths: @_ ");
 768 
    Debug("CatPaths: ", @paths );
766 
    return CleanPath join ('/', @_);
 769 
    return CleanPath join ('/', @paths );
767 
}
 770 
}
768 
 
 771 
 
769 
#-------------------------------------------------------------------------------
 772 
#-------------------------------------------------------------------------------
770 
# Function        : StripDrive
 773 
# Function        : StripDrive
771 
#
 774 
#
Line 1021... Line 1024...
1021 
        }
 1024 
        }
1022 
    }
 1025 
    }
1023 
    return ( -e $path );
 1026 
    return ( -e $path );
1024 
}
 1027 
}
1025 
 
 1028 
 
- 
 
 1029 
#-------------------------------------------------------------------------------
- 
 
 1030 
# Function        : ValidatePath
- 
 
 1031 
#
- 
 
 1032 
# Description     : Ensure that the user provided path does not escape the current
- 
 
 1033 
#                   package and is sane
- 
 
 1034 
#
- 
 
 1035 
# Inputs          : $path       - One path to validate
- 
 
 1036 
#                   $mode       - 0 : No sanity test (only escape test)
- 
 
 1037 
#                                 1 : Abs path not allowed
- 
 
 1038 
#                                 2 : Parent directory not allowed
- 
 
 1039 
#                                 4 : Path must exist
- 
 
 1040 
#                                 Mode options are bit mask and may be combined
- 
 
 1041 
#
- 
 
 1042 
# Returns         : Array:
- 
 
 1043 
#                       - Clean pathname (unless error)
- 
 
 1044 
#                       - Error message
- 
 
 1045 
#
- 
 
 1046 
sub ValidatePath
- 
 
 1047 
{
- 
 
 1048 
    my ($path, $mode) = @_;
- 
 
 1049 
    Error("Internal: ValidatePath. ProjectBase not known" ) unless defined $::ProjectBase;
- 
 
 1050 
    Debug("ValidatePath. $::ProjectBase, $path, $mode");
- 
 
 1051 
 
- 
 
 1052 
    my $errPath = $path;
- 
 
 1053 
 
- 
 
 1054 
    $path = CleanPath($path);
- 
 
 1055 
    if ($mode & 1 && $path =~ m~^/~ ) {
- 
 
 1056 
        return $errPath, 'Absolute path not allowed';
- 
 
 1057 
    }
- 
 
 1058 
    $path =~ s~^/~~;
- 
 
 1059 
 
- 
 
 1060 
    if ($mode & 2 && $path =~ m~^[./]+$~ ) {
- 
 
 1061 
        return $errPath, 'Parent directory not allowed';
- 
 
 1062 
    }
- 
 
 1063 
 
- 
 
 1064 
    if ($mode & 4 && ! -d $path ) {
- 
 
 1065 
        return $errPath, 'Directory does not exist';
- 
 
 1066 
    }
- 
 
 1067 
 
- 
 
 1068 
    my $dirFromBase = RelPath(AbsPath($path), AbsPath($::ProjectBase));
- 
 
 1069 
    if ( $dirFromBase =~ m~\.\.~ ) {
- 
 
 1070 
        Debug("ProjectBase:", AbsPath($::ProjectBase));
- 
 
 1071 
        Debug("User Path  :", AbsPath($path));
- 
 
 1072 
        return $errPath, 'Path outside the current package';
- 
 
 1073 
    }
- 
 
 1074 
    return $path;
- 
 
 1075 
}
- 
 
 1076 
 
1026 
1;
 1077 
1;
1027 
 
 1078 
 
1028 
 
 1079