From 585acd0e474fff852876fa5f3a8a51b43514a5c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A5kon=20H=C3=A6gland?= Date: Thu, 21 Jan 2021 20:59:50 +0100 Subject: [PATCH 1/3] Fixes issue #213 --- lib/Alien/Build/Util.pm | 12 ++++++++++++ t/alien_build_util.t | 11 ++++++++--- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/lib/Alien/Build/Util.pm b/lib/Alien/Build/Util.pm index e9a9745f..e7229503 100644 --- a/lib/Alien/Build/Util.pm +++ b/lib/Alien/Build/Util.pm @@ -65,7 +65,19 @@ sub _mirror { unlink "$dst" } my $target = readlink "$src"; Alien::Build->log("ln -s $target $dst") if $opt->{verbose}; + if (path($target)->is_relative) { + if (!$src->parent->child($target)->exists) { + die "cannot create symlink to nonexistent file $target on MSYS2"; + } + # NOTE: On linux, it is OK to create broken symlinks, but it is not allowed on + # windows MSYS2, so make sure the target exists. + $dst->parent->child($target)->touchpath; + } + my $curdir = Path::Tiny->cwd; + # CD into the directory, such that symlink will work on MSYS2 + chdir $dst->parent or die "could not chdir to $src->parent : $!"; symlink($target, $dst) || die "unable to symlink $target => $dst"; + chdir $curdir or die "could not chdir to $curdir: $!"; } elsif(-d "$src") { diff --git a/t/alien_build_util.t b/t/alien_build_util.t index dfe2a79f..d69c8a99 100644 --- a/t/alien_build_util.t +++ b/t/alien_build_util.t @@ -47,11 +47,16 @@ subtest 'mirror' => sub { if($Config{d_symlink}) { - foreach my $new (map { $tmp1->child("lib/libfoo$_") } qw( .so.1.2 .so.1 .so )) + my $newdir = $tmp1->child("lib"); + my $savedir = Path::Tiny->cwd; + # CD into the the $newdir such that symlink will work on MSYS2 + chdir $newdir->stringify or die "unable to chdir to $newdir: $!"; + foreach my $new (map { "libfoo$_" } qw( .so.1.2 .so.1 .so )) { - my $old = 'libfoo.so.1.2.3'; - symlink($old, $new->stringify) || die "unable to symlink $new => $old $!"; + my $old = $lib->basename; + symlink($old, $new) || die "unable to symlink $new => $old $!"; } + chdir $savedir or die "unable to chdir to $savedir: $!"; } my $tmp2 = Path::Tiny->tempdir("mirror_dst_XXXX"); From cad2b39063dacd0f7a8346610fb992a2a8518547 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A5kon=20H=C3=A6gland?= Date: Sat, 23 Jan 2021 18:10:25 +0100 Subject: [PATCH 2/3] Be more specific. Be more specific/accurate when testing the cases that cannot create broken symlinks. --- compilet-Y7gS9.c | 1 + lib/Alien/Build/Util.pm | 15 +++++++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) create mode 100644 compilet-Y7gS9.c diff --git a/compilet-Y7gS9.c b/compilet-Y7gS9.c new file mode 100644 index 00000000..801efbe0 --- /dev/null +++ b/compilet-Y7gS9.c @@ -0,0 +1 @@ +int boot_compilet() { return 1; } diff --git a/lib/Alien/Build/Util.pm b/lib/Alien/Build/Util.pm index e7229503..53346460 100644 --- a/lib/Alien/Build/Util.pm +++ b/lib/Alien/Build/Util.pm @@ -66,12 +66,19 @@ sub _mirror my $target = readlink "$src"; Alien::Build->log("ln -s $target $dst") if $opt->{verbose}; if (path($target)->is_relative) { + my $nativesymlink = + (($^O eq "msys" && defined $ENV{MSYS} && $ENV{MSYS} eq "winsymlinks:nativestrict") + || ($^O eq "cygwin" && defined $ENV{CYGWIN} && $ENV{CYGWIN} eq "winsymlinks:nativestrict")); if (!$src->parent->child($target)->exists) { - die "cannot create symlink to nonexistent file $target on MSYS2"; + if ($nativesymlink) { + # NOTE: On linux, it is OK to create broken symlinks, but it is not allowed on + # windows MSYS2/Cygwin when nativestrict is used. + die "cannot create native symlink to nonexistent file $target on $^O"; + } + } + if ($nativesymlink) { + $dst->parent->child($target)->touchpath; } - # NOTE: On linux, it is OK to create broken symlinks, but it is not allowed on - # windows MSYS2, so make sure the target exists. - $dst->parent->child($target)->touchpath; } my $curdir = Path::Tiny->cwd; # CD into the directory, such that symlink will work on MSYS2 From aa4787c9e0ac8c283c4a05135114202e4050ccec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A5kon=20H=C3=A6gland?= Date: Fri, 18 Jun 2021 22:43:06 +0200 Subject: [PATCH 3/3] Update to clarify code. --- compilet-Y7gS9.c | 1 - lib/Alien/Build/Util.pm | 42 +++++++++++++++++++++++++++++++++-------- 2 files changed, 34 insertions(+), 9 deletions(-) delete mode 100644 compilet-Y7gS9.c diff --git a/compilet-Y7gS9.c b/compilet-Y7gS9.c deleted file mode 100644 index 801efbe0..00000000 --- a/compilet-Y7gS9.c +++ /dev/null @@ -1 +0,0 @@ -int boot_compilet() { return 1; } diff --git a/lib/Alien/Build/Util.pm b/lib/Alien/Build/Util.pm index 53346460..ff963e76 100644 --- a/lib/Alien/Build/Util.pm +++ b/lib/Alien/Build/Util.pm @@ -6,6 +6,7 @@ use 5.008004; use base qw( Exporter ); use Path::Tiny qw( path ); use Config; +use File::chdir; # ABSTRACT: Private utility functions for Alien::Build # VERSION @@ -28,6 +29,21 @@ L our @EXPORT_OK = qw( _mirror _dump _destdir_prefix _perl_config _ssl_reqs _has_ssl ); +# This helper sub is intended to be called with string argument "MSYS" or "CYGWIN" +# According to https://cygwin.com/cygwin-ug-net/using-cygwinenv.html : +# The CYGWIN environment variable is used to configure many global settings for the Cygwin +# runtime system. It contain options separated by blank characters. +# TODO: We assume the same format for the MSYS environment variable. Where is it documented? +sub _check_native_symlink { + my ($var) = @_; + if (defined $ENV{$var}) { + if ($ENV{$var} =~ /(?:^|\s+)\Qwinsymlinks:nativestrict\E(?:$|\s+)/) { + return 1; + } + } + return 0; +} + # usage: _mirror $source_directory, $dest_direction, \%options # # options: @@ -44,7 +60,6 @@ sub _mirror require Alien::Build; require File::Find; require File::Copy; - File::Find::find({ wanted => sub { next unless -e $File::Find::name; @@ -66,9 +81,16 @@ sub _mirror my $target = readlink "$src"; Alien::Build->log("ln -s $target $dst") if $opt->{verbose}; if (path($target)->is_relative) { - my $nativesymlink = - (($^O eq "msys" && defined $ENV{MSYS} && $ENV{MSYS} eq "winsymlinks:nativestrict") - || ($^O eq "cygwin" && defined $ENV{CYGWIN} && $ENV{CYGWIN} eq "winsymlinks:nativestrict")); + my $nativesymlink = (($^O eq "msys" && _check_native_symlink("MSYS")) + || ($^O eq "cygwin" && _check_native_symlink("CYGWIN"))); + # NOTE: there are two cases to consider here, 1. the target might not + # exist relative to the source dir, and 2. the target might not exist relative + # to the destination directory. + # + # 1. If the file does not exist relative to the source, it is a broken symlink, + # 2. If the file does not exist relative to the destination, it means that + # it has not been copied by this File::Find::find() call yet. So it will only + # be temporarily broken. if (!$src->parent->child($target)->exists) { if ($nativesymlink) { # NOTE: On linux, it is OK to create broken symlinks, but it is not allowed on @@ -77,14 +99,18 @@ sub _mirror } } if ($nativesymlink) { + # If the target does not exist relative to the parent yet (it should be existing at the end of + # this File::Find::find() call), make a temporary empty file such that the symlink + # call does not fail. $dst->parent->child($target)->touchpath; } } my $curdir = Path::Tiny->cwd; - # CD into the directory, such that symlink will work on MSYS2 - chdir $dst->parent or die "could not chdir to $src->parent : $!"; - symlink($target, $dst) || die "unable to symlink $target => $dst"; - chdir $curdir or die "could not chdir to $curdir: $!"; + { + local $CWD = $dst->parent; + # CD into the directory, such that symlink will work on MSYS2 + symlink($target, $dst) || die "unable to symlink $target => $dst"; + } } elsif(-d "$src") {