#!/usr/bin/perl

use strict;
use warnings;

use Debian::Debhelper::Dh_Lib;

init();

# dh_fixperms resets ".js" files to mode 0644 and doesn't follow the
# symlinks stored in the binary directories. As a consequence a /usr/bin
# link to a node script would point to a non-executable file.
#
# Restore the executable bit on the target of every symlink found in a
# standard binary directory, as long as this target belongs to the package.
# Missing (dangling) or external targets are simply ignored.
on_pkgs_in_parallel {
    foreach my $package (@_) {
        my $tmp = tmpdir($package);

        foreach my $bindir (qw(usr/bin usr/sbin bin sbin)) {
            my $dir = "$tmp/$bindir";
            opendir my $dh, $dir or next;
            my @entries = map { "$dir/$_" } grep { !/^\.\.?$/ } readdir $dh;
            closedir $dh;
            foreach my $link (@entries) {
                next unless -l $link;
                my $target = readlink($link);
                next unless defined $target and length $target;
                my $file = canonpath(
                    ( $target =~ m#^/# ? "$tmp$target" : "$dir/$target" ) );

                # Ignore links pointing outside of the package
                next unless $file =~ m#^\Q$tmp\E/#;
                next unless -f $file;
                verbose_print("Making $file executable ($link target)");
                chmod 0755, $file;
            }
        }
    }
};

# Canonicalize a path without resolving symbolic links: drop "." and ".."
# components, keeping a leading "/" when present.
sub canonpath {
    my $path = shift;
    my $abs  = ( $path =~ s#^/+## ) ? '/' : '';
    my @parts;
    foreach my $part ( split m#/+#, $path ) {
        next if $part eq '' or $part eq '.';
        if ( $part eq '..' and @parts and $parts[-1] ne '..' ) {
            pop @parts;
        }
        elsif ( $part eq '..' ) {
            push @parts, '..';
        }
        else {
            push @parts, $part;
        }
    }
    return $abs . join( '/', @parts );
}
