pathhelp.pm 26 KB

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