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