• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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