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 52package pathhelp; 53 54use strict; 55use warnings; 56use Cwd 'abs_path'; 57 58BEGIN { 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 99my $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. 105sub 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# 123sub normalize_path; 124 125####################################################################### 126# Returns current working directory in Win32 format on Windows. 127# 128sub 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# 161sub 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. 175sub 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. 180sub 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. 187sub 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# 194sub 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# 295sub 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. 408sub 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# 415sub 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# 550sub 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. 616sub 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. 645sub 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. 683sub 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. 747sub 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# 780sub 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 7951; # End of module 796
