X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/548d69a4ee38cc59612e787f479ac198d5c37741..c1bfe3c380707e7cc6b0582b63f31a77d6f8751a:/modules/Tool.pm diff --git a/modules/Tool.pm b/modules/Tool.pm index e3056c5..1f72b75 100644 --- a/modules/Tool.pm +++ b/modules/Tool.pm @@ -6,7 +6,7 @@ package Tool; # Some shared sub routines # # Author: Patrick Canterino -# Last modified: 2005-01-06 +# Last modified: 2005-01-08 # use strict; @@ -61,18 +61,22 @@ sub check_path($$) # We extract the last part of the path and create the absolute path my $first = upper_path($path); + $first = abs_path($first); + my $last = file_name($path); + $last = '' if($last eq '.'); - $first = abs_path($first); - $path = $first.'/'.$last; + if($last eq '..' || ($^O eq 'MSWin32' && $last =~ m!^\.\.\.+$!)) + { + $first = abs_path($first.'/'.$last); + $last = ''; + } - $first = File::Spec->canonpath($first); - $path = File::Spec->canonpath($path); + $path = File::Spec->canonpath($first.'/'.$last); # Check if the path is above the root directory return if(index($path,$root) != 0); - return if($first eq $root && $last =~ m!^(/|\\)?\.\.(/|\\)?$!); # Create short path name @@ -219,7 +223,7 @@ sub file_name($) my $path = shift; $path =~ tr!\\!/!; - unless($path eq '/') + unless($path =~ m!^/+$! || ($^O eq 'MSWin32' && $path =~ m!^[a-z]:/+$!)) { $path =~ s!/+$!!; $path = substr($path,rindex($path,'/')+1); @@ -279,7 +283,7 @@ sub upper_path($) my $path = shift; $path =~ tr!\\!/!; - unless($path eq '/') + unless($path =~ m!^/+$! || ($^O eq 'MSWin32' && $path =~ m!^[a-z]:/+$!)) { $path =~ s!/+$!!; $path = substr($path,0,rindex($path,'/')+1);