pathhelp.pm 27 KB

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