1 ###########################################################################
3 # Project ___| | | | _ \| |
5 # | (__| |_| | _ <| |___
6 # \___|\___/|_| \_\_____|
8 # Copyright (C) 2016, Evgeny Grin (Karlson2k), <k2k@narod.ru>.
10 # This software is licensed as described in the file COPYING, which
11 # you should have received as part of this distribution. The terms
12 # are also available at https://curl.haxx.se/docs/copyright.html.
14 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
15 # copies of the Software, and permit persons to whom the Software is
16 # furnished to do so, under the terms of the COPYING file.
18 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
19 # KIND, either express or implied.
21 ###########################################################################
23 # This Perl package helps with path transforming when running cURL tests on
24 # Win32 platform with Msys or Cygwin.
25 # Three main functions 'sys_native_abs_path', 'sys_native_path' and
26 # 'build_sys_abs_path' autodetect format of given pathnames. Following formats
28 # (1) /some/path - absolute path in Unix-style
29 # (2) D:/some/path - absolute path in Win32-style
30 # (3) some/path - relative path
31 # (4) D:some/path - path relative to current directory on Win32 drive (paths
32 # like 'D:' are treated as 'D:./') (*)
33 # (5) \some/path - path from root directory on current Win32 drive (*)
34 # All forward '/' and back '\' slashes are treated identically except leading
35 # slash in forms (1) and (5).
36 # Forward slashes are simpler processed in Perl, do not require extra escaping
37 # for shell (unlike back slashes) and accepted by Win32 native programs, so
38 # all functions return paths with only forward slashes except
39 # 'sys_native_path' which returns paths with first forward slash for form (5).
40 # All returned paths don't contain any duplicated slashes, only single slashes
41 # are used as directory separators on output.
42 # On non-Windows platforms functions acts as transparent wrappers for similar
43 # Perl's functions or return unmodified string (depending on functionality),
44 # so all functions can be unconditionally used on all platforms.
46 # (*) CAUTION! Forms (4) and (5) are not recommended to use as they can be
47 # interpreted incorrectly in Perl and Msys/Cygwin environment have low
48 # control on Win32 current drive and Win32 current path on specific drive.
59 our @ISA = qw(Exporter);
68 sys_native_current_path
73 drives_mounted_on_cygdrive
78 #######################################################################
79 # Block for cached static variables
82 # Cached static variable, Perl 5.0-compatible.
83 my $is_win = $^O eq 'MSWin32'
87 # Returns boolean true if OS is any form of Windows.
92 # Cached static variable, Perl 5.0-compatible.
95 # Returns boolean true if Win32 drives mounted with '/cygdrive/' prefix.
96 sub drives_mounted_on_cygdrive {
97 return $cygdrive_present if defined $cygdrive_present;
98 $cygdrive_present = ((-e '/cygdrive/') && (-d '/cygdrive/')) ? 1 : 0;
99 return $cygdrive_present;
103 our $use_cygpath; # Only for Win32:
106 # 0 - do not use cygpath
108 # Returns boolean true if 'cygpath' utility should be used for path conversion.
109 sub should_use_cygpath {
110 unless (os_is_win()) {
114 return $use_cygpath if defined $use_cygpath;
116 $use_cygpath = (qx{cygpath -u '.\\' 2>/dev/null} eq "./\n" && $? == 0);
121 #######################################################################
122 # Performs path "normalization": all slashes converted to forward
123 # slashes (except leading slash), all duplicated slashes are replaced
124 # with single slashes, all relative directories ('./' and '../') are
125 # resolved if possible.
126 # Path processed as string, directories are not checked for presence so
127 # path for not yet existing directory can be "normalized".
131 #######################################################################
132 # Returns current working directory in Win32 format on Windows.
134 sub sys_native_current_path {
135 return Cwd::getcwd() unless os_is_win();
139 # MSys shell has built-in command.
140 chomp($cur_dir = `bash -c 'pwd -W'`);
142 warn "Can't determine Win32 current directory.\n";
145 # Add final slash if required.
146 $cur_dir .= '/' if length($cur_dir) > 3;
149 # Do not use 'cygpath' - it falsely succeed on paths like '/cygdrive'.
150 $cur_dir = `cmd "/c;" echo %__CD__%`;
151 if($? != 0 || substr($cur_dir, 0, 1) eq '%') {
152 warn "Can't determine Win32 current directory.\n";
155 # Remove both '\r' and '\n'.
156 $cur_dir =~ s{\n|\r}{}g;
158 # Replace back slashes with forward slashes.
159 $cur_dir =~ s{\\}{/}g;
164 #######################################################################
165 # Returns Win32 current drive letter with colon.
167 sub get_win32_current_drive {
168 # Notice parameter "/c;" - it's required to turn off Msys's
169 # transformation of '/c' and compatible with Cygwin.
170 my $drive_letter = `cmd "/c;" echo %__CD__:~0,2%`;
171 if($? != 0 || substr($drive_letter, 1, 1) ne ':') {
172 warn "Can't determine current Win32 drive letter.\n";
176 return substr($drive_letter, 0, 2);
179 # Internal function. Converts path by using Msys's built-in transformation.
180 # Returned path may contain duplicated and back slashes.
181 sub do_msys_transform;
183 # Internal function. Gets two parameters: first parameter must be single
184 # drive letter ('c'), second optional parameter is path relative to drive's
185 # current working directory. Returns Win32 absolute normalized path.
186 sub get_abs_path_on_win32_drive;
188 # Internal function. Tries to find or guess Win32 version of given
189 # absolute Unix-style path. Other types of paths are not supported.
190 # Returned paths contain only single forward slashes (no back and
191 # duplicated slashes).
192 # Last resort. Used only when other transformations are not available.
193 sub do_dumb_guessed_transform;
195 #######################################################################
196 # Converts given path to system native format, i.e. to Win32 format on
197 # Windows platform. Relative paths converted to relative, absolute
198 # paths converted to absolute.
200 sub sys_native_path {
203 # Return untouched on non-Windows platforms.
204 return $path unless (os_is_win());
206 # Do not process empty path.
207 return $path if ($path eq '');
209 if($path =~ s{^([a-zA-Z]):$}{\u$1:}) {
210 # Path is single drive with colon. (C:)
211 # This type of paths is not processed correctly by 'cygpath'.
213 # Be careful, this relative path can be accidentally transformed
214 # into wrong absolute path by adding to it some '/dirname' with
218 elsif($path =~ m{^\\} || $path =~ m{^[a-zA-Z]:[^/\\]}) {
219 # Path is a directory or filename on Win32 current drive or relative
220 # path on current directory on specific Win32 drive.
221 # ('\path' or 'D:path')
222 # First type of paths is not processed by Msys transformation and
223 # resolved to absolute path by 'cygpath'.
224 # Second type is not processed by Msys transformation and may be
225 # incorrectly processed by 'cygpath' (for paths like 'D:..\../.\')
227 my $first_char = ucfirst(substr($path, 0, 1));
229 # Replace any back and duplicated slashes with single forward slashes.
230 $path =~ s{[\\/]+}{/}g;
232 # Convert leading slash back to forward slash to indicate
233 # directory on Win32 current drive or capitalize drive letter.
234 substr($path, 0, 1) = $first_char;
237 elsif(should_use_cygpath()) {
238 # 'cygpath' is available - use it.
240 # Remove leading duplicated forward and back slashes, as they may
241 # prevent transforming and may be not processed.
242 $path =~ s{^([\\/])[\\/]+}{$1}g;
244 my $has_final_slash = ($path =~ m{[/\\]$});
246 # Use 'cygpath', '-m' means Win32 path with forward slashes.
247 chomp($path = `cygpath -m '$path'`);
249 warn "Can't convert path by \"cygpath\".\n";
253 # 'cygpath' may remove last slash for existing directories.
254 $path .= '/' if($has_final_slash);
256 # Remove any duplicated forward slashes (added by 'cygpath' for root
262 elsif($^O eq 'msys') {
263 # Msys transforms automatically path to Windows native form in staring
264 # program parameters if program is not Msys-based.
266 $path = do_msys_transform($path);
267 return undef unless defined $path;
269 # Capitalize drive letter for Win32 paths.
270 $path =~ s{^([a-z]:)}{\u$1};
272 # Replace any back and duplicated slashes with single forward slashes.
273 $path =~ s{[\\/]+}{/}g;
276 elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) {
277 # Path is already in Win32 form. ('C:\path')
279 # Replace any back and duplicated slashes with single forward slashes.
280 $path =~ s{[\\/]+}{/}g;
283 elsif($path !~ m{^/}) {
284 # Path is in relative form. ('path/name', './path' or '../path')
286 # Replace any back and duplicated slashes with single forward slashes.
287 $path =~ s{[\\/]+}{/}g;
291 # OS is Windows, but not Msys, path is absolute, path is not in Win32
292 # form and 'cygpath' is not available.
293 return do_dumb_guessed_transform($path);
296 #######################################################################
297 # Converts given path to system native absolute path, i.e. to Win32
298 # absolute format on Windows platform. Both relative and absolute
299 # formats are supported for input.
301 sub sys_native_abs_path {
304 unless(os_is_win()) {
305 # Convert path to absolute form.
306 $path = Cwd::abs_path($path);
308 # Do not process further on non-Windows platforms.
312 if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) {
313 # Path is single drive with colon or relative path on Win32 drive.
315 # This kind of relative path is not processed correctly by 'cygpath'.
316 # Get specified drive letter
317 return get_abs_path_on_win32_drive($1, $2);
320 # Path is empty string. Return current directory.
321 # Empty string processed correctly by 'cygpath'.
323 return sys_native_current_path();
325 elsif(should_use_cygpath()) {
326 # 'cygpath' is available - use it.
328 my $has_final_slash = ($path =~ m{[\\/]$});
330 # Remove leading duplicated forward and back slashes, as they may
331 # prevent transforming and may be not processed.
332 $path =~ s{^([\\/])[\\/]+}{$1}g;
334 print "Inter result: \"$path\"\n";
335 # Use 'cygpath', '-m' means Win32 path with forward slashes,
336 # '-a' means absolute path
337 chomp($path = `cygpath -m -a '$path'`);
339 warn "Can't resolve path by usung \"cygpath\".\n";
343 # 'cygpath' may remove last slash for existing directories.
344 $path .= '/' if($has_final_slash);
346 # Remove any duplicated forward slashes (added by 'cygpath' for root
352 elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) {
353 # Path is already in Win32 form. ('C:\path')
355 # Replace any possible back slashes with forward slashes,
356 # remove any duplicated slashes, resolve relative dirs.
357 return normalize_path($path);
359 elsif(substr($path, 0, 1) eq '\\' ) {
360 # Path is directory or filename on Win32 current drive. ('\Windows')
362 my $w32drive = get_win32_current_drive();
363 return undef unless defined $w32drive;
365 # Combine drive and path.
366 # Replace any possible back slashes with forward slashes,
367 # remove any duplicated slashes, resolve relative dirs.
368 return normalize_path($w32drive . $path);
371 unless (substr($path, 0, 1) eq '/') {
372 # Path is in relative form. Resolve relative directories in Unix form
373 # *BEFORE* converting to Win32 form otherwise paths like
374 # '../../../cygdrive/c/windows' will not be resolved.
375 my $cur_dir = `pwd -L`;
377 warn "Can't determine current working directory.\n";
382 $path = $cur_dir . '/' . $path;
385 # Resolve relative dirs.
386 $path = normalize_path($path);
387 return undef unless defined $path;
390 # Msys transforms automatically path to Windows native form in staring
391 # program parameters if program is not Msys-based.
392 $path = do_msys_transform($path);
393 return undef unless defined $path;
395 # Replace any back and duplicated slashes with single forward slashes.
396 $path =~ s{[\\/]+}{/}g;
399 # OS is Windows, but not Msys, path is absolute, path is not in Win32
400 # form and 'cygpath' is not available.
402 return do_dumb_guessed_transform($path);
405 # Internal function. Converts given Unix-style absolute path to Win32 format.
406 sub simple_transform_win32_to_unix;
408 #######################################################################
409 # Converts given path to build system format absolute path, i.e. to
410 # Msys/Cygwin Unix-style absolute format on Windows platform. Both
411 # relative and absolute formats are supported for input.
413 sub build_sys_abs_path {
416 unless(os_is_win()) {
417 # Convert path to absolute form.
418 $path = Cwd::abs_path($path);
420 # Do not process further on non-Windows platforms.
424 if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) {
425 # Path is single drive with colon or relative path on Win32 drive.
427 # This kind of relative path is not processed correctly by 'cygpath'.
428 # Get specified drive letter
430 # Resolve relative dirs in Win32-style path or paths like 'D:/../c/'
431 # will be resolved incorrectly.
432 # Replace any possible back slashes with forward slashes,
433 # remove any duplicated slashes.
434 $path = get_abs_path_on_win32_drive($1, $2);
435 return undef unless defined $path;
437 return simple_transform_win32_to_unix($path);
440 # Path is empty string. Return current directory.
441 # Empty string processed correctly by 'cygpath'.
443 chomp($path = `pwd -L`);
445 warn "Can't determine Unix-style current working directory.\n";
449 # Add final slash if not at root dir.
450 $path .= '/' if length($path) > 2;
453 elsif(should_use_cygpath()) {
454 # 'cygpath' is avalable - use it.
456 my $has_final_slash = ($path =~ m{[\\/]$});
458 # Resolve relative directories, as they may be not resolved for
460 # Remove duplicated slashes, as they may be not processed.
461 $path = normalize_path($path);
462 return undef unless defined $path;
464 # Use 'cygpath', '-u' means Unix-stile path,
465 # '-a' means absolute path
466 chomp($path = `cygpath -u -a '$path'`);
468 warn "Can't resolve path by usung \"cygpath\".\n";
472 # 'cygpath' removes last slash if path is root dir on Win32 drive.
474 $path .= '/' if($has_final_slash &&
475 substr($path, length($path) - 1, 1) ne '/');
479 elsif($path =~ m{^[a-zA-Z]:[/\\]}) {
480 # Path is already in Win32 form. ('C:\path')
482 # Resolve relative dirs in Win32-style path otherwise paths
483 # like 'D:/../c/' will be resolved incorrectly.
484 # Replace any possible back slashes with forward slashes,
485 # remove any duplicated slashes.
486 $path = normalize_path($path);
487 return undef unless defined $path;
489 return simple_transform_win32_to_unix($path);
491 elsif(substr($path, 0, 1) eq '\\') {
492 # Path is directory or filename on Win32 current drive. ('\Windows')
494 my $w32drive = get_win32_current_drive();
495 return undef unless defined $w32drive;
497 # Combine drive and path.
498 # Resolve relative dirs in Win32-style path or paths like 'D:/../c/'
499 # will be resolved incorrectly.
500 # Replace any possible back slashes with forward slashes,
501 # remove any duplicated slashes.
502 $path = normalize_path($w32drive . $path);
503 return undef unless defined $path;
505 return simple_transform_win32_to_unix($path);
508 # Path is not in any Win32 form.
509 unless (substr($path, 0, 1) eq '/') {
510 # Path in relative form. Resolve relative directories in Unix form
511 # *BEFORE* converting to Win32 form otherwise paths like
512 # '../../../cygdrive/c/windows' will not be resolved.
513 my $cur_dir = `pwd -L`;
515 warn "Can't determine current working directory.\n";
520 $path = $cur_dir . '/' . $path;
523 return normalize_path($path);
526 #######################################################################
527 # Performs path "normalization": all slashes converted to forward
528 # slashes (except leading slash), all duplicated slashes are replaced
529 # with single slashes, all relative directories ('./' and '../') are
530 # resolved if possible.
531 # Path processed as string, directories are not checked for presence so
532 # path for not yet existing directory can be "normalized".
537 # Don't process empty paths.
538 return $path if $path eq '';
540 unless($path =~ m{(?:^|\\|/)\.{1,2}(?:\\|/|$)}) {
541 # Speed up processing of simple paths.
542 my $first_char = substr($path, 0, 1);
543 $path =~ s{[\\/]+}{/}g;
544 # Restore starting backslash if any.
545 substr($path, 0, 1) = $first_char;
553 # Check whether path starts from Win32 drive. ('C:path' or 'C:\path')
554 if($path =~ m{^([a-zA-Z]:(/|\\)?)(.*$)}) {
556 $have_root = 1 if defined $2;
557 # Process path separately from drive letter.
558 @arr = split(m{\/|\\}, $3);
559 # Replace backslash with forward slash if required.
560 substr($prefix, 2, 1) = '/' if $have_root;
563 if($path =~ m{^(\/|\\)}) {
570 @arr = split(m{\/|\\}, $path);
577 if(length($el) == 0 || $el eq '.') {
580 elsif($el eq '..' && @res > 0 && $res[$#res] ne '..') {
586 if($have_root && @res > 0 && $res[0] eq '..') {
587 warn "Error processing path \"$path\": " .
588 "Parent directory of root directory does not exist!\n";
592 my $ret = $prefix . join('/', @res);
593 $ret .= '/' if($path =~ m{\\$|/$} && scalar @res > 0);
598 # Internal function. Converts path by using Msys's built-in
600 sub do_msys_transform {
602 return undef if $^O ne 'msys';
603 return $path if $path eq '';
605 # Remove leading double forward slashes, as they turn off Msys
607 $path =~ s{^/[/\\]+}{/};
609 # Msys transforms automatically path to Windows native form in staring
610 # program parameters if program is not Msys-based.
611 # Note: already checked that $path is non-empty.
612 $path = `cmd //c echo '$path'`;
614 warn "Can't transform path into Win32 form by using Msys" .
615 "internal transformation.\n";
619 # Remove double quotes, they are added for paths with spaces,
620 # remove both '\r' and '\n'.
621 $path =~ s{^\"|\"$|\"\r|\n|\r}{}g;
626 # Internal function. Gets two parameters: first parameter must be single
627 # drive letter ('c'), second optional parameter is path relative to drive's
628 # current working directory. Returns Win32 absolute normalized path.
629 sub get_abs_path_on_win32_drive {
630 my ($drv, $rel_path) = @_;
633 # Get current directory on specified drive.
634 # "/c;" is compatible with both Msys and Cygwin.
635 my $cur_dir_on_drv = `cmd "/c;" echo %=$drv:%`;
637 warn "Can't determine Win32 current directory on drive $drv:.\n";
641 if($cur_dir_on_drv =~ m{^[%]}) {
642 # Current directory on drive is not set, default is
645 $res = ucfirst($drv) . ':/';
648 # Current directory on drive was set.
649 # Remove both '\r' and '\n'.
650 $cur_dir_on_drv =~ s{\n|\r}{}g;
652 # Append relative path part.
653 $res = $cur_dir_on_drv . '/';
655 $res .= $rel_path if defined $rel_path;
657 # Replace any possible back slashes with forward slashes,
658 # remove any duplicated slashes, resolve relative dirs.
659 return normalize_path($res);
662 # Internal function. Tries to find or guess Win32 version of given
663 # absolute Unix-style path. Other types of paths are not supported.
664 # Returned paths contain only single forward slashes (no back and
665 # duplicated slashes).
666 # Last resort. Used only when other transformations are not available.
667 sub do_dumb_guessed_transform {
670 # Replace any possible back slashes and duplicated forward slashes
671 # with single forward slashes.
672 $path =~ s{[/\\]+}{/}g;
674 # Empty path is not valid.
675 return undef if (length($path) == 0);
677 # RE to find Win32 drive letter
678 my $drv_ltr_re = drives_mounted_on_cygdrive() ?
679 qr{^/cygdrive/([a-zA-Z])($|/.*$)} :
680 qr{^/([a-zA-Z])($|/.*$)};
682 # Check path whether path is Win32 directly mapped drive and try to
683 # transform it assuming that drive letter is matched to Win32 drive letter.
684 if($path =~ m{$drv_ltr_re}) {
685 return ucfirst($1) . ':/' if(length($2) == 0);
686 return ucfirst($1) . ':' . $2;
689 # This may be some custom mapped path. ('/mymount/path')
691 # Must check longest possible path component as subdir can be mapped to
692 # different directory. For example '/usr/bin/' can be mapped to '/bin/' or
693 # '/bin/' can be mapped to '/usr/bin/'.
694 my $check_path = $path;
699 `(cd "$check_path" && cmd /c "echo %__CD__%") 2>/dev/null`;
700 if($? == 0 && substr($path, 0, 1) ne '%') {
701 # Remove both '\r' and '\n'.
704 # Replace all back slashes with forward slashes.
707 if(length($path_tail) > 0) {
708 return $res . $path_tail;
711 $res =~ s{/$}{} unless $check_path =~ m{/$};
716 if($check_path =~ m{(^.*/)([^/]+/*)}) {
718 $path_tail = $2 . $path_tail;
721 # Shouldn't happens as root '/' directory should always
723 warn "Can't determine Win32 directory for path \"$path\".\n";
730 # Internal function. Converts given Unix-style absolute path to Win32 format.
731 sub simple_transform_win32_to_unix {
734 if(should_use_cygpath()) {
735 # 'cygpath' gives precise result.
737 chomp($res = `cygpath -a -u '$path'`);
739 warn "Can't determine Unix-style directory for Win32 " .
740 "directory \"$path\".\n";
744 # 'cygpath' removes last slash if path is root dir on Win32 drive.
745 $res .= '/' if(substr($res, length($res) - 1, 1) ne '/' &&
750 # 'cygpath' is not available, use guessed transformation.
751 unless($path =~ s{^([a-zA-Z]):(?:/|\\)}{/\l$1/}) {
752 warn "Can't determine Unix-style directory for Win32 " .
753 "directory \"$path\".\n";
757 $path = '/cygdrive' . $path if(drives_mounted_on_cygdrive());