xref: /curl/tests/pathhelp.pm (revision e70c22b6)
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