########################################################################### # _ _ ____ _ # Project ___| | | | _ \| | # / __| | | | |_) | | # | (__| |_| | _ <| |___ # \___|\___/|_| \_\_____| # # Copyright (C) 2016, Evgeny Grin (Karlson2k), <k2k@narod.ru>. # # This software is licensed as described in the file COPYING, which # you should have received as part of this distribution. The terms # are also available at https://curl.haxx.se/docs/copyright.html. # # You may opt to use, copy, modify, merge, publish, distribute and/or sell # copies of the Software, and permit persons to whom the Software is # furnished to do so, under the terms of the COPYING file. # # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY # KIND, either express or implied. # ########################################################################### # This Perl package helps with path transforming when running curl tests on # Win32 platform with Msys or Cygwin. # Three main functions 'sys_native_abs_path', 'sys_native_path' and # 'build_sys_abs_path' autodetect format of given pathnames. Following formats # are supported: # (1) /some/path - absolute path in Unix-style # (2) D:/some/path - absolute path in Win32-style # (3) some/path - relative path # (4) D:some/path - path relative to current directory on Win32 drive (paths # like 'D:' are treated as 'D:./') (*) # (5) \some/path - path from root directory on current Win32 drive (*) # All forward '/' and back '\' slashes are treated identically except leading # slash in forms (1) and (5). # Forward slashes are simpler processed in Perl, do not require extra escaping # for shell (unlike back slashes) and accepted by Win32 native programs, so # all functions return paths with only forward slashes except # 'sys_native_path' which returns paths with first forward slash for form (5). # All returned paths don't contain any duplicated slashes, only single slashes # are used as directory separators on output. # On non-Windows platforms functions acts as transparent wrappers for similar # Perl's functions or return unmodified string (depending on functionality), # so all functions can be unconditionally used on all platforms. # # (*) CAUTION! Forms (4) and (5) are not recommended to use as they can be # interpreted incorrectly in Perl and Msys/Cygwin environment have low # control on Win32 current drive and Win32 current path on specific drive. package pathhelp; use strict; use warnings; use Cwd 'abs_path'; BEGIN { require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw( sys_native_abs_path sys_native_path ); our @EXPORT_OK = qw( build_sys_abs_path sys_native_current_path normalize_path os_is_win $use_cygpath should_use_cygpath drives_mounted_on_cygdrive ); } ####################################################################### # Block for cached static variables # { # Cached static variable, Perl 5.0-compatible. my $is_win = $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys'; # Returns boolean true if OS is any form of Windows. sub os_is_win { return $is_win; } # Cached static variable, Perl 5.0-compatible. my $cygdrive_present; # Returns boolean true if Win32 drives mounted with '/cygdrive/' prefix. sub drives_mounted_on_cygdrive { return $cygdrive_present if defined $cygdrive_present; $cygdrive_present = ((-e '/cygdrive/') && (-d '/cygdrive/')) ? 1 : 0; return $cygdrive_present; } } our $use_cygpath; # Only for Win32: # undef - autodetect # 1 - use cygpath # 0 - do not use cygpath # Returns boolean true if 'cygpath' utility should be used for path conversion. sub should_use_cygpath { unless (os_is_win()) { $use_cygpath = 0; return 0; } return $use_cygpath if defined $use_cygpath; $use_cygpath = (qx{cygpath -u '.\\' 2>/dev/null} eq "./\n" && $? == 0); return $use_cygpath; } ####################################################################### # Performs path "normalization": all slashes converted to forward # slashes (except leading slash), all duplicated slashes are replaced # with single slashes, all relative directories ('./' and '../') are # resolved if possible. # Path processed as string, directories are not checked for presence so # path for not yet existing directory can be "normalized". # sub normalize_path; ####################################################################### # Returns current working directory in Win32 format on Windows. # sub sys_native_current_path { return Cwd::getcwd() unless os_is_win(); my $cur_dir; if($^O eq 'msys') { # MSys shell has built-in command. chomp($cur_dir = `bash -c 'pwd -W'`); if($? != 0) { warn "Can't determine Win32 current directory.\n"; return undef; } # Add final slash if required. $cur_dir .= '/' if length($cur_dir) > 3; } else { # Do not use 'cygpath' - it falsely succeed on paths like '/cygdrive'. $cur_dir = `cmd "/c;" echo %__CD__%`; if($? != 0 || substr($cur_dir, 0, 1) eq '%') { warn "Can't determine Win32 current directory.\n"; return undef; } # Remove both '\r' and '\n'. $cur_dir =~ s{\n|\r}{}g; # Replace back slashes with forward slashes. $cur_dir =~ s{\\}{/}g; } return $cur_dir; } ####################################################################### # Returns Win32 current drive letter with colon. # sub get_win32_current_drive { # Notice parameter "/c;" - it's required to turn off Msys's # transformation of '/c' and compatible with Cygwin. my $drive_letter = `cmd "/c;" echo %__CD__:~0,2%`; if($? != 0 || substr($drive_letter, 1, 1) ne ':') { warn "Can't determine current Win32 drive letter.\n"; return undef; } return substr($drive_letter, 0, 2); } # Internal function. Converts path by using Msys's built-in transformation. # Returned path may contain duplicated and back slashes. sub do_msys_transform; # Internal function. Gets two parameters: first parameter must be single # drive letter ('c'), second optional parameter is path relative to drive's # current working directory. Returns Win32 absolute normalized path. sub get_abs_path_on_win32_drive; # Internal function. Tries to find or guess Win32 version of given # absolute Unix-style path. Other types of paths are not supported. # Returned paths contain only single forward slashes (no back and # duplicated slashes). # Last resort. Used only when other transformations are not available. sub do_dumb_guessed_transform; ####################################################################### # Converts given path to system native format, i.e. to Win32 format on # Windows platform. Relative paths converted to relative, absolute # paths converted to absolute. # sub sys_native_path { my ($path) = @_; # Return untouched on non-Windows platforms. return $path unless (os_is_win()); # Do not process empty path. return $path if ($path eq ''); if($path =~ s{^([a-zA-Z]):$}{\u$1:}) { # Path is single drive with colon. (C:) # This type of paths is not processed correctly by 'cygpath'. # WARNING! # Be careful, this relative path can be accidentally transformed # into wrong absolute path by adding to it some '/dirname' with # slash at font. return $path; } elsif($path =~ m{^\\} || $path =~ m{^[a-zA-Z]:[^/\\]}) { # Path is a directory or filename on Win32 current drive or relative # path on current directory on specific Win32 drive. # ('\path' or 'D:path') # First type of paths is not processed by Msys transformation and # resolved to absolute path by 'cygpath'. # Second type is not processed by Msys transformation and may be # incorrectly processed by 'cygpath' (for paths like 'D:..\../.\') my $first_char = ucfirst(substr($path, 0, 1)); # Replace any back and duplicated slashes with single forward slashes. $path =~ s{[\\/]+}{/}g; # Convert leading slash back to forward slash to indicate # directory on Win32 current drive or capitalize drive letter. substr($path, 0, 1) = $first_char; return $path; } elsif(should_use_cygpath()) { # 'cygpath' is available - use it. # Remove leading duplicated forward and back slashes, as they may # prevent transforming and may be not processed. $path =~ s{^([\\/])[\\/]+}{$1}g; my $has_final_slash = ($path =~ m{[/\\]$}); # Use 'cygpath', '-m' means Win32 path with forward slashes. chomp($path = `cygpath -m '$path'`); if ($? != 0) { warn "Can't convert path by \"cygpath\".\n"; return undef; } # 'cygpath' may remove last slash for existing directories. $path .= '/' if($has_final_slash); # Remove any duplicated forward slashes (added by 'cygpath' for root # directories) $path =~ s{//+}{/}g; return $path; } elsif($^O eq 'msys') { # Msys transforms automatically path to Windows native form in staring # program parameters if program is not Msys-based. $path = do_msys_transform($path); return undef unless defined $path; # Capitalize drive letter for Win32 paths. $path =~ s{^([a-z]:)}{\u$1}; # Replace any back and duplicated slashes with single forward slashes. $path =~ s{[\\/]+}{/}g; return $path; } elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) { # Path is already in Win32 form. ('C:\path') # Replace any back and duplicated slashes with single forward slashes. $path =~ s{[\\/]+}{/}g; return $path; } elsif($path !~ m{^/}) { # Path is in relative form. ('path/name', './path' or '../path') # Replace any back and duplicated slashes with single forward slashes. $path =~ s{[\\/]+}{/}g; return $path; } # OS is Windows, but not Msys, path is absolute, path is not in Win32 # form and 'cygpath' is not available. return do_dumb_guessed_transform($path); } ####################################################################### # Converts given path to system native absolute path, i.e. to Win32 # absolute format on Windows platform. Both relative and absolute # formats are supported for input. # sub sys_native_abs_path { my ($path) = @_; unless(os_is_win()) { # Convert path to absolute form. $path = Cwd::abs_path($path); # Do not process further on non-Windows platforms. return $path; } if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) { # Path is single drive with colon or relative path on Win32 drive. # ('C:' or 'C:path') # This kind of relative path is not processed correctly by 'cygpath'. # Get specified drive letter return get_abs_path_on_win32_drive($1, $2); } elsif($path eq '') { # Path is empty string. Return current directory. # Empty string processed correctly by 'cygpath'. return sys_native_current_path(); } elsif(should_use_cygpath()) { # 'cygpath' is available - use it. my $has_final_slash = ($path =~ m{[\\/]$}); # Remove leading duplicated forward and back slashes, as they may # prevent transforming and may be not processed. $path =~ s{^([\\/])[\\/]+}{$1}g; print "Inter result: \"$path\"\n"; # Use 'cygpath', '-m' means Win32 path with forward slashes, # '-a' means absolute path chomp($path = `cygpath -m -a '$path'`); if($? != 0) { warn "Can't resolve path by usung \"cygpath\".\n"; return undef; } # 'cygpath' may remove last slash for existing directories. $path .= '/' if($has_final_slash); # Remove any duplicated forward slashes (added by 'cygpath' for root # directories) $path =~ s{//+}{/}g; return $path } elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) { # Path is already in Win32 form. ('C:\path') # Replace any possible back slashes with forward slashes, # remove any duplicated slashes, resolve relative dirs. return normalize_path($path); } elsif(substr($path, 0, 1) eq '\\' ) { # Path is directory or filename on Win32 current drive. ('\Windows') my $w32drive = get_win32_current_drive(); return undef unless defined $w32drive; # Combine drive and path. # Replace any possible back slashes with forward slashes, # remove any duplicated slashes, resolve relative dirs. return normalize_path($w32drive . $path); } unless (substr($path, 0, 1) eq '/') { # Path is in relative form. Resolve relative directories in Unix form # *BEFORE* converting to Win32 form otherwise paths like # '../../../cygdrive/c/windows' will not be resolved. my $cur_dir = `pwd -L`; if($? != 0) { warn "Can't determine current working directory.\n"; return undef; } chomp($cur_dir); $path = $cur_dir . '/' . $path; } # Resolve relative dirs. $path = normalize_path($path); return undef unless defined $path; if($^O eq 'msys') { # Msys transforms automatically path to Windows native form in staring # program parameters if program is not Msys-based. $path = do_msys_transform($path); return undef unless defined $path; # Replace any back and duplicated slashes with single forward slashes. $path =~ s{[\\/]+}{/}g; return $path; } # OS is Windows, but not Msys, path is absolute, path is not in Win32 # form and 'cygpath' is not available. return do_dumb_guessed_transform($path); } # Internal function. Converts given Unix-style absolute path to Win32 format. sub simple_transform_win32_to_unix; ####################################################################### # Converts given path to build system format absolute path, i.e. to # Msys/Cygwin Unix-style absolute format on Windows platform. Both # relative and absolute formats are supported for input. # sub build_sys_abs_path { my ($path) = @_; unless(os_is_win()) { # Convert path to absolute form. $path = Cwd::abs_path($path); # Do not process further on non-Windows platforms. return $path; } if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) { # Path is single drive with colon or relative path on Win32 drive. # ('C:' or 'C:path') # This kind of relative path is not processed correctly by 'cygpath'. # Get specified drive letter # Resolve relative dirs in Win32-style path or paths like 'D:/../c/' # will be resolved incorrectly. # Replace any possible back slashes with forward slashes, # remove any duplicated slashes. $path = get_abs_path_on_win32_drive($1, $2); return undef unless defined $path; return simple_transform_win32_to_unix($path); } elsif($path eq '') { # Path is empty string. Return current directory. # Empty string processed correctly by 'cygpath'. chomp($path = `pwd -L`); if($? != 0) { warn "Can't determine Unix-style current working directory.\n"; return undef; } # Add final slash if not at root dir. $path .= '/' if length($path) > 2; return $path; } elsif(should_use_cygpath()) { # 'cygpath' is avalable - use it. my $has_final_slash = ($path =~ m{[\\/]$}); # Resolve relative directories, as they may be not resolved for # Unix-style paths. # Remove duplicated slashes, as they may be not processed. $path = normalize_path($path); return undef unless defined $path; # Use 'cygpath', '-u' means Unix-stile path, # '-a' means absolute path chomp($path = `cygpath -u -a '$path'`); if($? != 0) { warn "Can't resolve path by usung \"cygpath\".\n"; return undef; } # 'cygpath' removes last slash if path is root dir on Win32 drive. # Restore it. $path .= '/' if($has_final_slash && substr($path, length($path) - 1, 1) ne '/'); return $path } elsif($path =~ m{^[a-zA-Z]:[/\\]}) { # Path is already in Win32 form. ('C:\path') # Resolve relative dirs in Win32-style path otherwise paths # like 'D:/../c/' will be resolved incorrectly. # Replace any possible back slashes with forward slashes, # remove any duplicated slashes. $path = normalize_path($path); return undef unless defined $path; return simple_transform_win32_to_unix($path); } elsif(substr($path, 0, 1) eq '\\') { # Path is directory or filename on Win32 current drive. ('\Windows') my $w32drive = get_win32_current_drive(); return undef unless defined $w32drive; # Combine drive and path. # Resolve relative dirs in Win32-style path or paths like 'D:/../c/' # will be resolved incorrectly. # Replace any possible back slashes with forward slashes, # remove any duplicated slashes. $path = normalize_path($w32drive . $path); return undef unless defined $path; return simple_transform_win32_to_unix($path); } # Path is not in any Win32 form. unless (substr($path, 0, 1) eq '/') { # Path in relative form. Resolve relative directories in Unix form # *BEFORE* converting to Win32 form otherwise paths like # '../../../cygdrive/c/windows' will not be resolved. my $cur_dir = `pwd -L`; if($? != 0) { warn "Can't determine current working directory.\n"; return undef; } chomp($cur_dir); $path = $cur_dir . '/' . $path; } return normalize_path($path); } ####################################################################### # Performs path "normalization": all slashes converted to forward # slashes (except leading slash), all duplicated slashes are replaced # with single slashes, all relative directories ('./' and '../') are # resolved if possible. # Path processed as string, directories are not checked for presence so # path for not yet existing directory can be "normalized". # sub normalize_path { my ($path) = @_; # Don't process empty paths. return $path if $path eq ''; unless($path =~ m{(?:^|\\|/)\.{1,2}(?:\\|/|$)}) { # Speed up processing of simple paths. my $first_char = substr($path, 0, 1); $path =~ s{[\\/]+}{/}g; # Restore starting backslash if any. substr($path, 0, 1) = $first_char; return $path; } my @arr; my $prefix; my $have_root = 0; # Check whether path starts from Win32 drive. ('C:path' or 'C:\path') if($path =~ m{^([a-zA-Z]:(/|\\)?)(.*$)}) { $prefix = $1; $have_root = 1 if defined $2; # Process path separately from drive letter. @arr = split(m{\/|\\}, $3); # Replace backslash with forward slash if required. substr($prefix, 2, 1) = '/' if $have_root; } else { if($path =~ m{^(\/|\\)}) { $have_root = 1; $prefix = $1; } else { $prefix = ''; } @arr = split(m{\/|\\}, $path); } my $p = 0; my @res; for my $el (@arr) { if(length($el) == 0 || $el eq '.') { next; } elsif($el eq '..' && @res > 0 && $res[$#res] ne '..') { pop @res; next; } push @res, $el; } if($have_root && @res > 0 && $res[0] eq '..') { warn "Error processing path \"$path\": " . "Parent directory of root directory does not exist!\n"; return undef; } my $ret = $prefix . join('/', @res); $ret .= '/' if($path =~ m{\\$|/$} && scalar @res > 0); return $ret; } # Internal function. Converts path by using Msys's built-in # transformation. sub do_msys_transform { my ($path) = @_; return undef if $^O ne 'msys'; return $path if $path eq ''; # Remove leading double forward slashes, as they turn off Msys # transforming. $path =~ s{^/[/\\]+}{/}; # Msys transforms automatically path to Windows native form in staring # program parameters if program is not Msys-based. # Note: already checked that $path is non-empty. $path = `cmd //c echo '$path'`; if($? != 0) { warn "Can't transform path into Win32 form by using Msys" . "internal transformation.\n"; return undef; } # Remove double quotes, they are added for paths with spaces, # remove both '\r' and '\n'. $path =~ s{^\"|\"$|\"\r|\n|\r}{}g; return $path; } # Internal function. Gets two parameters: first parameter must be single # drive letter ('c'), second optional parameter is path relative to drive's # current working directory. Returns Win32 absolute normalized path. sub get_abs_path_on_win32_drive { my ($drv, $rel_path) = @_; my $res; # Get current directory on specified drive. # "/c;" is compatible with both Msys and Cygwin. my $cur_dir_on_drv = `cmd "/c;" echo %=$drv:%`; if($? != 0) { warn "Can't determine Win32 current directory on drive $drv:.\n"; return undef; } if($cur_dir_on_drv =~ m{^[%]}) { # Current directory on drive is not set, default is # root directory. $res = ucfirst($drv) . ':/'; } else { # Current directory on drive was set. # Remove both '\r' and '\n'. $cur_dir_on_drv =~ s{\n|\r}{}g; # Append relative path part. $res = $cur_dir_on_drv . '/'; } $res .= $rel_path if defined $rel_path; # Replace any possible back slashes with forward slashes, # remove any duplicated slashes, resolve relative dirs. return normalize_path($res); } # Internal function. Tries to find or guess Win32 version of given # absolute Unix-style path. Other types of paths are not supported. # Returned paths contain only single forward slashes (no back and # duplicated slashes). # Last resort. Used only when other transformations are not available. sub do_dumb_guessed_transform { my ($path) = @_; # Replace any possible back slashes and duplicated forward slashes # with single forward slashes. $path =~ s{[/\\]+}{/}g; # Empty path is not valid. return undef if (length($path) == 0); # RE to find Win32 drive letter my $drv_ltr_re = drives_mounted_on_cygdrive() ? qr{^/cygdrive/([a-zA-Z])($|/.*$)} : qr{^/([a-zA-Z])($|/.*$)}; # Check path whether path is Win32 directly mapped drive and try to # transform it assuming that drive letter is matched to Win32 drive letter. if($path =~ m{$drv_ltr_re}) { return ucfirst($1) . ':/' if(length($2) == 0); return ucfirst($1) . ':' . $2; } # This may be some custom mapped path. ('/mymount/path') # Must check longest possible path component as subdir can be mapped to # different directory. For example '/usr/bin/' can be mapped to '/bin/' or # '/bin/' can be mapped to '/usr/bin/'. my $check_path = $path; my $path_tail = ''; do { if(-d $check_path) { my $res = `(cd "$check_path" && cmd /c "echo %__CD__%") 2>/dev/null`; if($? == 0 && substr($path, 0, 1) ne '%') { # Remove both '\r' and '\n'. $res =~ s{\n|\r}{}g; # Replace all back slashes with forward slashes. $res =~ s{\\}{/}g; if(length($path_tail) > 0) { return $res . $path_tail; } else { $res =~ s{/$}{} unless $check_path =~ m{/$}; return $res; } } } if($check_path =~ m{(^.*/)([^/]+/*)}) { $check_path = $1; $path_tail = $2 . $path_tail; } else { # Shouldn't happens as root '/' directory should always # be resolvable. warn "Can't determine Win32 directory for path \"$path\".\n"; return undef; } } while(1); } # Internal function. Converts given Unix-style absolute path to Win32 format. sub simple_transform_win32_to_unix { my ($path) = @_; if(should_use_cygpath()) { # 'cygpath' gives precise result. my $res; chomp($res = `cygpath -a -u '$path'`); if($? != 0) { warn "Can't determine Unix-style directory for Win32 " . "directory \"$path\".\n"; return undef; } # 'cygpath' removes last slash if path is root dir on Win32 drive. $res .= '/' if(substr($res, length($res) - 1, 1) ne '/' && $path =~ m{[/\\]$}); return $res; } # 'cygpath' is not available, use guessed transformation. unless($path =~ s{^([a-zA-Z]):(?:/|\\)}{/\l$1/}) { warn "Can't determine Unix-style directory for Win32 " . "directory \"$path\".\n"; return undef; } $path = '/cygdrive' . $path if(drives_mounted_on_cygdrive()); return $path; } 1; # End of module