tests/pathhelp.pm

   1 ###########################################################################
   2 #                                  _   _ ____  _
   3 #  Project                     ___| | | |  _ \| |
   4 #                             / __| | | | |_) | |
   5 #                            | (__| |_| |  _ <| |___
   6 #                             \___|\___/|_| \_\_____|
   7 #
   8 # Copyright (C) Evgeny Grin (Karlson2k), <k2k@narod.ru>.
   9 #
  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.se/docs/copyright.html.
  13 #
  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.
  17 #
  18 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  19 # KIND, either express or implied.
  20 #
  21 # SPDX-License-Identifier: curl
  22 #
  23 ###########################################################################
  24
  25 # This Perl package helps with path transforming when running curl tests on
  26 # Win32 platform with Msys or Cygwin.
  27 # Three main functions 'sys_native_abs_path', 'sys_native_path' and
  28 # 'build_sys_abs_path' autodetect format of given pathnames. Following formats
  29 # are supported:
  30 #  (1) /some/path   - absolute path in Unix-style
  31 #  (2) D:/some/path - absolute path in Win32-style
  32 #  (3) some/path    - relative path
  33 #  (4) D:some/path  - path relative to current directory on Win32 drive (paths
  34 #                     like 'D:' are treated as 'D:./') (*)
  35 #  (5) \some/path   - path from root directory on current Win32 drive (*)
  36 # All forward '/' and back '\' slashes are treated identically except leading
  37 # slash in forms (1) and (5).
  38 # Forward slashes are simpler processed in Perl, do not require extra escaping
  39 # for shell (unlike back slashes) and accepted by Win32 native programs, so
  40 # all functions return paths with only forward slashes except
  41 # 'sys_native_path' which returns paths with first forward slash for form (5).
  42 # All returned paths don't contain any duplicated slashes, only single slashes
  43 # are used as directory separators on output.
  44 # On non-Windows platforms functions acts as transparent wrappers for similar
  45 # Perl's functions or return unmodified string (depending on functionality),
  46 # so all functions can be unconditionally used on all platforms.
  47 #
  48 # (*) CAUTION! Forms (4) and (5) are not recommended to use as they can be
  49 #     interpreted incorrectly in Perl and Msys/Cygwin environment have low
  50 #     control on Win32 current drive and Win32 current path on specific drive.
  51
  52 package pathhelp;
  53
  54 use strict;
  55 use warnings;
  56 use Cwd 'abs_path';
  57
  58 BEGIN {
  59     use base qw(Exporter);
  60
  61     our @EXPORT_OK = qw(
  62         os_is_win
  63         exe_ext
  64         sys_native_abs_path
  65         sys_native_current_path
  66         build_sys_abs_path
  67         normalize_path
  68         should_use_cygpath
  69         drives_mounted_on_cygdrive
  70     );
  71 }
  72
  73
  74 #######################################################################
  75 # Block for cached static variables
  76 #
  77 {
  78     # Cached static variable, Perl 5.0-compatible.
  79     my $is_win = $^O eq 'MSWin32'
  80               || $^O eq 'cygwin'
  81               || $^O eq 'msys';
  82
  83     # Returns boolean true if OS is any form of Windows.
  84     sub os_is_win {
  85         return $is_win;
  86     }
  87
  88     # Cached static variable, Perl 5.0-compatible.
  89     my $cygdrive_present;
  90
  91     # Returns boolean true if Win32 drives mounted with '/cygdrive/' prefix.
  92     sub drives_mounted_on_cygdrive {
  93         return $cygdrive_present if defined $cygdrive_present;
  94         $cygdrive_present = ((-e '/cygdrive/') && (-d '/cygdrive/')) ? 1 : 0;
  95         return $cygdrive_present;
  96     }
  97 }
  98
  99 my $use_cygpath;     # Only for Win32:
 100                      #  undef - autodetect
 101                      #      0 - do not use cygpath
 102                      #      1 - use cygpath
 103
 104 # Returns boolean true if 'cygpath' utility should be used for path conversion.
 105 sub should_use_cygpath {
 106     return $use_cygpath if defined $use_cygpath;
 107     if(os_is_win()) {
 108         $use_cygpath = (qx{cygpath -u '.\\' 2>/dev/null} eq "./\n" && $? == 0);
 109     } else {
 110         $use_cygpath = 0;
 111     }
 112     return $use_cygpath;
 113 }
 114
 115 #######################################################################
 116 # Performs path "normalization": all slashes converted to forward
 117 # slashes (except leading slash), all duplicated slashes are replaced
 118 # with single slashes, all relative directories ('./' and '../') are
 119 # resolved if possible.
 120 # Path processed as string, directories are not checked for presence so
 121 # path for not yet existing directory can be "normalized".
 122 #
 123 sub normalize_path;
 124
 125 #######################################################################
 126 # Returns current working directory in Win32 format on Windows.
 127 #
 128 sub sys_native_current_path {
 129     return Cwd::getcwd() if !os_is_win();
 130
 131     my $cur_dir;
 132     if($^O eq 'msys') {
 133         # MSys shell has built-in command.
 134         chomp($cur_dir = `bash -c 'pwd -W'`);
 135         if($? != 0) {
 136             warn "Can't determine Win32 current directory.\n";
 137             return undef;
 138         }
 139         # Add final slash if required.
 140         $cur_dir .= '/' if length($cur_dir) > 3;
 141     }
 142     else {
 143         # Do not use 'cygpath' - it falsely succeed on paths like '/cygdrive'.
 144         $cur_dir = `cmd "/c;" echo %__CD__%`;
 145         if($? != 0 || substr($cur_dir, 0, 1) eq '%') {
 146             warn "Can't determine Win32 current directory.\n";
 147             return undef;
 148         }
 149         # Remove both '\r' and '\n'.
 150         $cur_dir =~ s{\n|\r}{}g;
 151
 152         # Replace back slashes with forward slashes.
 153         $cur_dir =~ s{\\}{/}g;
 154     }
 155     return $cur_dir;
 156 }
 157
 158 #######################################################################
 159 # Returns Win32 current drive letter with colon.
 160 #
 161 sub get_win32_current_drive {
 162     # Notice parameter "/c;" - it's required to turn off Msys's
 163     # transformation of '/c' and compatible with Cygwin.
 164     my $drive_letter = `cmd "/c;" echo %__CD__:~0,2%`;
 165     if($? != 0 || substr($drive_letter, 1, 1) ne ':') {
 166         warn "Can't determine current Win32 drive letter.\n";
 167         return undef;
 168     }
 169
 170     return substr($drive_letter, 0, 2);
 171 }
 172
 173 # Internal function. Converts path by using Msys's built-in transformation.
 174 # Returned path may contain duplicated and back slashes.
 175 sub do_msys_transform;
 176
 177 # Internal function. Gets two parameters: first parameter must be single
 178 # drive letter ('c'), second optional parameter is path relative to drive's
 179 # current working directory. Returns Win32 absolute normalized path.
 180 sub get_abs_path_on_win32_drive;
 181
 182 # Internal function. Tries to find or guess Win32 version of given
 183 # absolute Unix-style path. Other types of paths are not supported.
 184 # Returned paths contain only single forward slashes (no back and
 185 # duplicated slashes).
 186 # Last resort. Used only when other transformations are not available.
 187 sub do_dumb_guessed_transform;
 188
 189 #######################################################################
 190 # Converts given path to system native format, i.e. to Win32 format on
 191 # Windows platform. Relative paths converted to relative, absolute
 192 # paths converted to absolute.
 193 #
 194 sub sys_native_path {
 195     my ($path) = @_;
 196
 197     # Return untouched on non-Windows platforms.
 198     return $path if (!os_is_win());
 199
 200     # Do not process empty path.
 201     return $path if ($path eq '');
 202
 203     if($path =~ s{^([a-zA-Z]):$}{\u$1:}) {
 204         # Path is single drive with colon. (C:)
 205         # This type of paths is not processed correctly by 'cygpath'.
 206         # WARNING!
 207         # Be careful, this relative path can be accidentally transformed
 208         # into wrong absolute path by adding to it some '/dirname' with
 209         # slash at font.
 210         return $path;
 211     }
 212     elsif($path =~ m{^\\} || $path =~ m{^[a-zA-Z]:[^/\\]}) {
 213         # Path is a directory or filename on Win32 current drive or relative
 214         # path on current directory on specific Win32 drive.
 215         # ('\path' or 'D:path')
 216         # First type of paths is not processed by Msys transformation and
 217         # resolved to absolute path by 'cygpath'.
 218         # Second type is not processed by Msys transformation and may be
 219         # incorrectly processed by 'cygpath' (for paths like 'D:..\../.\')
 220
 221         my $first_char = ucfirst(substr($path, 0, 1));
 222
 223         # Replace any back and duplicated slashes with single forward slashes.
 224         $path =~ s{[\\/]+}{/}g;
 225
 226         # Convert leading slash back to forward slash to indicate
 227         # directory on Win32 current drive or capitalize drive letter.
 228         substr($path, 0, 1, $first_char);
 229         return $path;
 230     }
 231     elsif(should_use_cygpath()) {
 232         # 'cygpath' is available - use it.
 233
 234         # Remove leading duplicated forward and back slashes, as they may
 235         # prevent transforming and may be not processed.
 236         $path =~ s{^([\\/])[\\/]+}{$1}g;
 237
 238         my $has_final_slash = ($path =~ m{[/\\]$});
 239
 240         # Use 'cygpath', '-m' means Win32 path with forward slashes.
 241         chomp($path = `cygpath -m '$path'`);
 242         if ($? != 0) {
 243             warn "Can't convert path by \"cygpath\".\n";
 244             return undef;
 245         }
 246
 247         # 'cygpath' may remove last slash for existing directories.
 248         $path .= '/' if($has_final_slash);
 249
 250         # Remove any duplicated forward slashes (added by 'cygpath' for root
 251         # directories)
 252         $path =~ s{//+}{/}g;
 253
 254         return $path;
 255     }
 256     elsif($^O eq 'msys') {
 257         # Msys transforms automatically path to Windows native form in staring
 258         # program parameters if program is not Msys-based.
 259
 260         $path = do_msys_transform($path);
 261         return undef if !defined $path;
 262
 263         # Capitalize drive letter for Win32 paths.
 264         $path =~ s{^([a-z]:)}{\u$1};
 265
 266         # Replace any back and duplicated slashes with single forward slashes.
 267         $path =~ s{[\\/]+}{/}g;
 268         return $path;
 269     }
 270     elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) {
 271         # Path is already in Win32 form. ('C:\path')
 272
 273         # Replace any back and duplicated slashes with single forward slashes.
 274         $path =~ s{[\\/]+}{/}g;
 275         return $path;
 276     }
 277     elsif($path !~ m{^/}) {
 278         # Path is in relative form. ('path/name', './path' or '../path')
 279
 280         # Replace any back and duplicated slashes with single forward slashes.
 281         $path =~ s{[\\/]+}{/}g;
 282         return $path;
 283     }
 284
 285     # OS is Windows, but not Msys, path is absolute, path is not in Win32
 286     # form and 'cygpath' is not available.
 287     return do_dumb_guessed_transform($path);
 288 }
 289
 290 #######################################################################
 291 # Converts given path to system native absolute path, i.e. to Win32
 292 # absolute format on Windows platform. Both relative and absolute
 293 # formats are supported for input.
 294 #
 295 sub sys_native_abs_path {
 296     my ($path) = @_;
 297
 298     if(!os_is_win()) {
 299         # Convert path to absolute form.
 300         $path = Cwd::abs_path($path);
 301
 302         # Do not process further on non-Windows platforms.
 303         return $path;
 304     }
 305
 306     if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) {
 307         # Path is single drive with colon or relative path on Win32 drive.
 308         # ('C:' or 'C:path')
 309         # This kind of relative path is not processed correctly by 'cygpath'.
 310         # Get specified drive letter
 311         return get_abs_path_on_win32_drive($1, $2);
 312     }
 313     elsif($path eq '') {
 314         # Path is empty string. Return current directory.
 315         # Empty string processed correctly by 'cygpath'.
 316
 317         return sys_native_current_path();
 318     }
 319     elsif(should_use_cygpath()) {
 320         # 'cygpath' is available - use it.
 321
 322         my $has_final_slash = ($path =~ m{[\\/]$});
 323
 324         # Remove leading duplicated forward and back slashes, as they may
 325         # prevent transforming and may be not processed.
 326         $path =~ s{^([\\/])[\\/]+}{$1}g;
 327
 328         print "Inter result: \"$path\"\n";
 329         # Use 'cygpath', '-m' means Win32 path with forward slashes,
 330         # '-a' means absolute path
 331         chomp($path = `cygpath -m -a '$path'`);
 332         if($? != 0) {
 333             warn "Can't resolve path by usung \"cygpath\".\n";
 334             return undef;
 335         }
 336
 337         # 'cygpath' may remove last slash for existing directories.
 338         $path .= '/' if($has_final_slash);
 339
 340         # Remove any duplicated forward slashes (added by 'cygpath' for root
 341         # directories)
 342         $path =~ s{//+}{/}g;
 343
 344         return $path
 345     }
 346     elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) {
 347         # Path is already in Win32 form. ('C:\path')
 348
 349         # Replace any possible back slashes with forward slashes,
 350         # remove any duplicated slashes, resolve relative dirs.
 351         return normalize_path($path);
 352     }
 353     elsif(substr($path, 0, 1) eq '\\' ) {
 354         # Path is directory or filename on Win32 current drive. ('\Windows')
 355
 356         my $w32drive = get_win32_current_drive();
 357         return undef if !defined $w32drive;
 358
 359         # Combine drive and path.
 360         # Replace any possible back slashes with forward slashes,
 361         # remove any duplicated slashes, resolve relative dirs.
 362         return normalize_path($w32drive . $path);
 363     }
 364
 365     if(substr($path, 0, 1) ne '/') {
 366         # Path is in relative form. Resolve relative directories in Unix form
 367         # *BEFORE* converting to Win32 form otherwise paths like
 368         # '../../../cygdrive/c/windows' will not be resolved.
 369
 370         my $cur_dir;
 371         # MSys shell has built-in command.
 372         if($^O eq 'msys') {
 373             $cur_dir = `bash -c 'pwd -L'`;
 374         }
 375         else {
 376             $cur_dir = `pwd -L`;
 377         }
 378         if($? != 0) {
 379             warn "Can't determine current working directory.\n";
 380             return undef;
 381         }
 382         chomp($cur_dir);
 383
 384         $path = $cur_dir . '/' . $path;
 385     }
 386
 387     # Resolve relative dirs.
 388     $path = normalize_path($path);
 389     return undef unless defined $path;
 390
 391     if($^O eq 'msys') {
 392         # Msys transforms automatically path to Windows native form in staring
 393         # program parameters if program is not Msys-based.
 394         $path = do_msys_transform($path);
 395         return undef if !defined $path;
 396
 397         # Replace any back and duplicated slashes with single forward slashes.
 398         $path =~ s{[\\/]+}{/}g;
 399         return $path;
 400     }
 401     # OS is Windows, but not Msys, path is absolute, path is not in Win32
 402     # form and 'cygpath' is not available.
 403
 404     return do_dumb_guessed_transform($path);
 405 }
 406
 407 # Internal function. Converts given Unix-style absolute path to Win32 format.
 408 sub simple_transform_win32_to_unix;
 409
 410 #######################################################################
 411 # Converts given path to build system format absolute path, i.e. to
 412 # Msys/Cygwin Unix-style absolute format on Windows platform. Both
 413 # relative and absolute formats are supported for input.
 414 #
 415 sub build_sys_abs_path {
 416     my ($path) = @_;
 417
 418     if(!os_is_win()) {
 419         # Convert path to absolute form.
 420         $path = Cwd::abs_path($path);
 421
 422         # Do not process further on non-Windows platforms.
 423         return $path;
 424     }
 425
 426     if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) {
 427         # Path is single drive with colon or relative path on Win32 drive.
 428         # ('C:' or 'C:path')
 429         # This kind of relative path is not processed correctly by 'cygpath'.
 430         # Get specified drive letter
 431
 432         # Resolve relative dirs in Win32-style path or paths like 'D:/../c/'
 433         # will be resolved incorrectly.
 434         # Replace any possible back slashes with forward slashes,
 435         # remove any duplicated slashes.
 436         $path = get_abs_path_on_win32_drive($1, $2);
 437         return undef if !defined $path;
 438
 439         return simple_transform_win32_to_unix($path);
 440     }
 441     elsif($path eq '') {
 442         # Path is empty string. Return current directory.
 443         # Empty string processed correctly by 'cygpath'.
 444
 445         # MSys shell has built-in command.
 446         if($^O eq 'msys') {
 447             chomp($path = `bash -c 'pwd -L'`);
 448         }
 449         else {
 450             chomp($path = `pwd -L`);
 451         }
 452         if($? != 0) {
 453             warn "Can't determine Unix-style current working directory.\n";
 454             return undef;
 455         }
 456
 457         # Add final slash if not at root dir.
 458         $path .= '/' if length($path) > 2;
 459         return $path;
 460     }
 461     elsif(should_use_cygpath()) {
 462         # 'cygpath' is available - use it.
 463
 464         my $has_final_slash = ($path =~ m{[\\/]$});
 465
 466         # Resolve relative directories, as they may be not resolved for
 467         # Unix-style paths.
 468         # Remove duplicated slashes, as they may be not processed.
 469         $path = normalize_path($path);
 470         return undef if !defined $path;
 471
 472         # Use 'cygpath', '-u' means Unix-stile path,
 473         # '-a' means absolute path
 474         chomp($path = `cygpath -u -a '$path'`);
 475         if($? != 0) {
 476             warn "Can't resolve path by usung \"cygpath\".\n";
 477             return undef;
 478         }
 479
 480         # 'cygpath' removes last slash if path is root dir on Win32 drive.
 481         # Restore it.
 482         $path .= '/' if($has_final_slash &&
 483                         substr($path, length($path) - 1, 1) ne '/');
 484
 485         return $path
 486     }
 487     elsif($path =~ m{^[a-zA-Z]:[/\\]}) {
 488         # Path is already in Win32 form. ('C:\path')
 489
 490         # Resolve relative dirs in Win32-style path otherwise paths
 491         # like 'D:/../c/' will be resolved incorrectly.
 492         # Replace any possible back slashes with forward slashes,
 493         # remove any duplicated slashes.
 494         $path = normalize_path($path);
 495         return undef if !defined $path;
 496
 497         return simple_transform_win32_to_unix($path);
 498     }
 499     elsif(substr($path, 0, 1) eq '\\') {
 500         # Path is directory or filename on Win32 current drive. ('\Windows')
 501
 502         my $w32drive = get_win32_current_drive();
 503         return undef if !defined $w32drive;
 504
 505         # Combine drive and path.
 506         # Resolve relative dirs in Win32-style path or paths like 'D:/../c/'
 507         # will be resolved incorrectly.
 508         # Replace any possible back slashes with forward slashes,
 509         # remove any duplicated slashes.
 510         $path = normalize_path($w32drive . $path);
 511         return undef if !defined $path;
 512
 513         return simple_transform_win32_to_unix($path);
 514     }
 515
 516     # Path is not in any Win32 form.
 517     if(substr($path, 0, 1) ne '/') {
 518         # Path in relative form. Resolve relative directories in Unix form
 519         # *BEFORE* converting to Win32 form otherwise paths like
 520         # '../../../cygdrive/c/windows' will not be resolved.
 521
 522         my $cur_dir;
 523         # MSys shell has built-in command.
 524         if($^O eq 'msys') {
 525             $cur_dir = `bash -c 'pwd -L'`;
 526         }
 527         else {
 528             $cur_dir = `pwd -L`;
 529         }
 530         if($? != 0) {
 531             warn "Can't determine current working directory.\n";
 532             return undef;
 533         }
 534         chomp($cur_dir);
 535
 536         $path = $cur_dir . '/' . $path;
 537     }
 538
 539     return normalize_path($path);
 540 }
 541
 542 #######################################################################
 543 # Performs path "normalization": all slashes converted to forward
 544 # slashes (except leading slash), all duplicated slashes are replaced
 545 # with single slashes, all relative directories ('./' and '../') are
 546 # resolved if possible.
 547 # Path processed as string, directories are not checked for presence so
 548 # path for not yet existing directory can be "normalized".
 549 #
 550 sub normalize_path {
 551     my ($path) = @_;
 552
 553     # Don't process empty paths.
 554     return $path if $path eq '';
 555
 556     if($path !~ m{(?:^|\\|/)\.{1,2}(?:\\|/|$)}) {
 557         # Speed up processing of simple paths.
 558         my $first_char = substr($path, 0, 1);
 559         $path =~ s{[\\/]+}{/}g;
 560         # Restore starting backslash if any.
 561         substr($path, 0, 1, $first_char);
 562         return $path;
 563     }
 564
 565     my @arr;
 566     my $prefix;
 567     my $have_root = 0;
 568
 569     # Check whether path starts from Win32 drive. ('C:path' or 'C:\path')
 570     if($path =~ m{^([a-zA-Z]:(/|\\)?)(.*$)}) {
 571         $prefix = $1;
 572         $have_root = 1 if defined $2;
 573         # Process path separately from drive letter.
 574         @arr = split(m{\/|\\}, $3);
 575         # Replace backslash with forward slash if required.
 576         substr($prefix, 2, 1, '/') if $have_root;
 577     }
 578     else {
 579         if($path =~ m{^(\/|\\)}) {
 580             $have_root = 1;
 581             $prefix = $1;
 582         }
 583         else {
 584             $prefix = '';
 585         }
 586         @arr = split(m{\/|\\}, $path);
 587     }
 588
 589     my $p = 0;
 590     my @res;
 591
 592     for my $el (@arr) {
 593         if(length($el) == 0 || $el eq '.') {
 594             next;
 595         }
 596         elsif($el eq '..' && @res > 0 && $res[-1] ne '..') {
 597             pop @res;
 598             next;
 599         }
 600         push @res, $el;
 601     }
 602     if($have_root && @res > 0 && $res[0] eq '..') {
 603         warn "Error processing path \"$path\": " .
 604              "Parent directory of root directory does not exist!\n";
 605         return undef;
 606     }
 607
 608     my $ret = $prefix . join('/', @res);
 609     $ret .= '/' if($path =~ m{\\$|/$} && scalar @res > 0);
 610
 611     return $ret;
 612 }
 613
 614 # Internal function. Converts path by using Msys's built-in
 615 # transformation.
 616 sub do_msys_transform {
 617     my ($path) = @_;
 618     return undef if $^O ne 'msys';
 619     return $path if $path eq '';
 620
 621     # Remove leading double forward slashes, as they turn off Msys
 622     # transforming.
 623     $path =~ s{^/[/\\]+}{/};
 624
 625     # Msys transforms automatically path to Windows native form in staring
 626     # program parameters if program is not Msys-based.
 627     # Note: already checked that $path is non-empty.
 628     $path = `cmd //c echo '$path'`;
 629     if($? != 0) {
 630         warn "Can't transform path into Win32 form by using Msys" .
 631              "internal transformation.\n";
 632         return undef;
 633     }
 634
 635     # Remove double quotes, they are added for paths with spaces,
 636     # remove both '\r' and '\n'.
 637     $path =~ s{^\"|\"$|\"\r|\n|\r}{}g;
 638
 639     return $path;
 640 }
 641
 642 # Internal function. Gets two parameters: first parameter must be single
 643 # drive letter ('c'), second optional parameter is path relative to drive's
 644 # current working directory. Returns Win32 absolute normalized path.
 645 sub get_abs_path_on_win32_drive {
 646     my ($drv, $rel_path) = @_;
 647     my $res;
 648
 649     # Get current directory on specified drive.
 650     # "/c;" is compatible with both Msys and Cygwin.
 651     my $cur_dir_on_drv = `cmd "/c;" echo %=$drv:%`;
 652     if($? != 0) {
 653         warn "Can't determine Win32 current directory on drive $drv:.\n";
 654         return undef;
 655     }
 656
 657     if($cur_dir_on_drv =~ m{^[%]}) {
 658         # Current directory on drive is not set, default is
 659         # root directory.
 660
 661         $res = ucfirst($drv) . ':/';
 662     }
 663     else {
 664         # Current directory on drive was set.
 665         # Remove both '\r' and '\n'.
 666         $cur_dir_on_drv =~ s{\n|\r}{}g;
 667
 668         # Append relative path part.
 669         $res = $cur_dir_on_drv . '/';
 670     }
 671     $res .= $rel_path if defined $rel_path;
 672
 673     # Replace any possible back slashes with forward slashes,
 674     # remove any duplicated slashes, resolve relative dirs.
 675     return normalize_path($res);
 676 }
 677
 678 # Internal function. Tries to find or guess Win32 version of given
 679 # absolute Unix-style path. Other types of paths are not supported.
 680 # Returned paths contain only single forward slashes (no back and
 681 # duplicated slashes).
 682 # Last resort. Used only when other transformations are not available.
 683 sub do_dumb_guessed_transform {
 684     my ($path) = @_;
 685
 686     # Replace any possible back slashes and duplicated forward slashes
 687     # with single forward slashes.
 688     $path =~ s{[/\\]+}{/}g;
 689
 690     # Empty path is not valid.
 691     return undef if (length($path) == 0);
 692
 693     # RE to find Win32 drive letter
 694     my $drv_ltr_re = drives_mounted_on_cygdrive() ?
 695                         qr{^/cygdrive/([a-zA-Z])($|/.*$)} :
 696                         qr{^/([a-zA-Z])($|/.*$)};
 697
 698     # Check path whether path is Win32 directly mapped drive and try to
 699     # transform it assuming that drive letter is matched to Win32 drive letter.
 700     if($path =~ m{$drv_ltr_re}) {
 701         return ucfirst($1) . ':/' if(length($2) == 0);
 702         return ucfirst($1) . ':' . $2;
 703     }
 704
 705     # This may be some custom mapped path. ('/mymount/path')
 706
 707     # Must check longest possible path component as subdir can be mapped to
 708     # different directory. For example '/usr/bin/' can be mapped to '/bin/' or
 709     # '/bin/' can be mapped to '/usr/bin/'.
 710     my $check_path = $path;
 711     my $path_tail = '';
 712     while(1) {
 713         if(-d $check_path) {
 714             my $res =
 715                 `(cd "$check_path" && cmd /c "echo %__CD__%") 2>/dev/null`;
 716             if($? == 0 && substr($path, 0, 1) ne '%') {
 717                 # Remove both '\r' and '\n'.
 718                 $res =~ s{\n|\r}{}g;
 719
 720                 # Replace all back slashes with forward slashes.
 721                 $res =~ s{\\}{/}g;
 722
 723                 if(length($path_tail) > 0) {
 724                     return $res . $path_tail;
 725                 }
 726                 else {
 727                     $res =~ s{/$}{} if $check_path !~ m{/$};
 728                     return $res;
 729                 }
 730             }
 731         }
 732         if($check_path =~ m{(^.*/)([^/]+/*)}) {
 733             $check_path = $1;
 734             $path_tail = $2 . $path_tail;
 735         }
 736         else {
 737             # Shouldn't happens as root '/' directory should always
 738             # be resolvable.
 739             warn "Can't determine Win32 directory for path \"$path\".\n";
 740             return undef;
 741         }
 742     }
 743 }
 744
 745
 746 # Internal function. Converts given Unix-style absolute path to Win32 format.
 747 sub simple_transform_win32_to_unix {
 748     my ($path) = @_;
 749
 750     if(should_use_cygpath()) {
 751         # 'cygpath' gives precise result.
 752         my $res;
 753         chomp($res = `cygpath -a -u '$path'`);
 754         if($? != 0) {
 755             warn "Can't determine Unix-style directory for Win32 " .
 756                  "directory \"$path\".\n";
 757             return undef;
 758         }
 759
 760         # 'cygpath' removes last slash if path is root dir on Win32 drive.
 761         $res .= '/' if(substr($res, length($res) - 1, 1) ne '/' &&
 762                        $path =~ m{[/\\]$});
 763         return $res;
 764     }
 765
 766     # 'cygpath' is not available, use guessed transformation.
 767     if($path !~ s{^([a-zA-Z]):(?:/|\\)}{/\l$1/}) {
 768         warn "Can't determine Unix-style directory for Win32 " .
 769              "directory \"$path\".\n";
 770         return undef;
 771     }
 772
 773     $path = '/cygdrive' . $path if(drives_mounted_on_cygdrive());
 774     return $path;
 775 }
 776 #
 777 #***************************************************************************
 778 # Return file extension for executable files on this operating system
 779 #
 780 sub exe_ext {
 781     my ($component, @arr) = @_;
 782     if ($ENV{'CURL_TEST_EXE_EXT'}) {
 783         return $ENV{'CURL_TEST_EXE_EXT'};
 784     }
 785     if ($ENV{'CURL_TEST_EXE_EXT_'.$component}) {
 786         return $ENV{'CURL_TEST_EXE_EXT_'.$component};
 787     }
 788     if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys' ||
 789         $^O eq 'dos' || $^O eq 'os2') {
 790         return '.exe';
 791     }
 792     return '';
 793 }
 794
 795 1;    # End of module