Subversion Repositories DevTools

Rev

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

Rev 6415 Rev 6423
Line 762... Line 762...
762 
#
 762 
#
763 
# Returns         : Cleaned up path elements
 763 
# Returns         : Cleaned up path elements
764 
#
 764 
#
765 
sub CatPaths
 765 
sub CatPaths
766 
{
 766 
{
- 
 
 767 
    my @paths = grep defined , @_;
767 
    Debug("CatPaths: @_ ");
 768 
    Debug("CatPaths: ", @paths );
768 
    return CleanPath join ('/', @_);
 769 
    return CleanPath join ('/', @paths );
769 
}
 770 
}
770 
 
 771 
 
771 
#-------------------------------------------------------------------------------
 772 
#-------------------------------------------------------------------------------
772 
# Function        : StripDrive
 773 
# Function        : StripDrive
773 
#
 774 
#
Line 1044... Line 1045...
1044 
#
 1045 
#
1045 
sub ValidatePath
 1046 
sub ValidatePath
1046 
{
 1047 
{
1047 
    my ($path, $mode) = @_;
 1048 
    my ($path, $mode) = @_;
1048 
    Error("Internal: ValidatePath. ProjectBase not known" ) unless defined $::ProjectBase;
 1049 
    Error("Internal: ValidatePath. ProjectBase not known" ) unless defined $::ProjectBase;
- 
 
 1050 
    Debug("ValidatePath. $::ProjectBase, $path, $mode");
1049 
 
 1051 
 
1050 
    my $errPath = $path;
 1052 
    my $errPath = $path;
1051 
 
 1053 
 
- 
 
 1054 
    $path = CleanPath($path);
1052 
    if ($mode & 1 && $path =~ m~^/~ ) {
 1055 
    if ($mode & 1 && $path =~ m~^/~ ) {
1053 
        return $errPath, 'Absolute path not allowed';
 1056 
        return $errPath, 'Absolute path not allowed';
1054 
    }
 1057 
    }
1055 
 
 - 
 
1056 
    $path =~ s~^/~~;
 1058 
    $path =~ s~^/~~;
1057 
    $path = CleanPath($path);
 - 
 
1058 
 
 1059 
 
1059 
    if ($mode & 2 && $path =~ m~^[./]+$~ ) {
 1060 
    if ($mode & 2 && $path =~ m~^[./]+$~ ) {
1060 
        return $errPath, 'Parent directory not allowed';
 1061 
        return $errPath, 'Parent directory not allowed';
1061 
    }
 1062 
    }
1062 
 
 1063 
 
Line 1064... Line 1065...
1064 
        return $errPath, 'Directory does not exist';
 1065 
        return $errPath, 'Directory does not exist';
1065 
    }
 1066 
    }
1066 
 
 1067 
 
1067 
    my $dirFromBase = RelPath(AbsPath($path), AbsPath($::ProjectBase));
 1068 
    my $dirFromBase = RelPath(AbsPath($path), AbsPath($::ProjectBase));
1068 
    if ( $dirFromBase =~ m~\.\.~ ) {
 1069 
    if ( $dirFromBase =~ m~\.\.~ ) {
- 
 
 1070 
        Debug("ProjectBase:", AbsPath($::ProjectBase));
- 
 
 1071 
        Debug("User Path  :", AbsPath($path));
1069 
        return $errPath, 'Path outside the current package';
 1072 
        return $errPath, 'Path outside the current package';
1070 
    }
 1073 
    }
1071 
    return $path;
 1074 
    return $path;
1072 
}
 1075 
}
1073 
 
 1076