cygolddll.pl

#!/usr/bin/perl 

use strict;

use Getopt::Std;
use Getopt::Config::FromPod;
use Pod::Usage;
use File::Basename;
use Term::ANSIColor;
use PerlIO::via::gzip;
use Win32::Ldd qw(pe_dependencies);

sub versplit
{
	my $basename = shift @_;
	if(my ($name, $ver) = $basename =~ /(.*)-(\d+(?:[._]\d+)?)\.dll/) {
		$ver =~ s/_/./;
		return ($name, $ver);
	} elsif(my ($name, $ver) = $basename =~ /^(cygicu\D*)(\d+)\.dll/) {
		return ($name, $ver);
	}
	return undef;
}

sub collect
{
	my ($folders, $exts) = @_;
	my $filter = '(?:'.join('|', map { "\\.$_" } @$exts).')$';
	my @result;
	foreach my $folder (@$folders) {
		opendir(DIR, $folder);
		push @result, map { "$folder/$_" } grep { /$filter/ } readdir(DIR);
		closedir(DIR);
	}
	return @result;
}

my %opts;
getopts(Getopt::Config::FromPod->string, \%opts);
pod2usage(-verbose => 2) if exists $opts{h};

STDOUT->autoflush(1);

my (%package, $i, $total, %target);

open my $fh, '<', '/var/cache/rebase/rebase_all';
while(<$fh>) {
	chop;
	$target{$_} = 1;
}
close $fh;

my @spec = collect(['/etc/setup'], ['gz']);
$i = 0; $total = @spec;
print "Loading package list:\n";
while(my $spec = shift @spec)
{
	++$i;
	print "$i / $total\r";
	my $package = fileparse($spec);
	$package =~ s/\.lst\.gz$//;
	open my $fh, '<:via(gzip)', $spec;
	while(<$fh>) {
		chop;
		if(/\.(dll|so)$/) {
			my $dll = fileparse($_);
			$package{lc($dll)} = $package;
		}
		if(/\.(dll|exe|so)$/) {
			my $exe = "/$_" unless m,^/,,; #/
			$target{$exe} = 1;
		}
	}
	close $fh;
}

$target{$_} = 1 for collect(['/usr/bin', '/usr/local/bin'], ['dll','exe','so']);
my @target = keys %target;

my (%exist, %ref, %refp, %ver);
my ($i, $total);
print "Loading DLL info:\n";
$i = 0; $total = @target;
while(my $target = shift @target)
{
	++$i;
	print "$i / $total\r";
	my $basename = fileparse($target);
	if($target =~ m,/bin/.*\.dll,i) { # .so is loadable object for almost all cases
		$exist{$basename} = 1;
		if(my @ver = versplit($basename)) {
			$ver{$ver[0]} ||= 0;
			$ver{$ver[0]} = $ver[1] if $ver{$ver[0]} < $ver[1];
		}
	}
# heavy
#	open my $fh, '-|', "objdump -p $target";
#	while(<$fh>) {
#		if(/DLL Name: (\S+)/) {
#			my $ref = $1;
#			$ref{lc($ref)} = $basename;
#			$refp{$package{lc($ref)}} = $basename if exists $package{lc($ref)};
#		}
#	}
#	close $fh;
	foreach my $ref (map { $_->{module} } @{pe_dependencies(Cygwin::posix_to_win_path("/bin/cyggc-1.dll"))->{children}}) {
		my $ref = $1;
		$ref{lc($ref)} = $basename;
		$refp{$package{lc($ref)}} = $basename if exists $package{lc($ref)};
	}
}
foreach my $i (sort keys %exist) {
	my $installed = exists $package{lc($i)};
	my @ver = versplit($i);
	my $obsoleted = $ver{$ver[0]} > $ver[1];
	next unless ($opts{o} && $obsoleted) || ($opts{n} && !$installed) || (!$opts{o} && !$opts{n});
	if(! exists $ref{lc($i)} && ! exists $refp{$package{lc($i)}}) {
		print "$i";
		print " ($package{lc($i)})" if $installed;
		print colored(['red'], ' [not installed]') unless $installed;
		print colored(['yellow'], ' [obsoleted]') if $obsoleted;
		print "\n";
	}
}

__END__

=head1 NAME

cygolddll.pl - Check old unreferenced DLLs

=head1 SYNOPSIS

perl cygolddll.pl -h

perl cygolddll.pl [-o|-n]

=head1 DESCRIPTION

Output DLL files unreferenced from other exe/dll/so.

The following sources are considered for dependency check:

=over 4

=item *

Contents of /var/cache/rebase/rebase_all

=item *

Contents of /etc/setup/*.lst.gz

=item *

Files in /usr/bin and /usr/local/bin

=back

Output target is limited to files in /usr/bin and /usr/local/bin.

=head1 OPTIONS

=over 4

=item C<-h>

Show POD help

=for getopt 'h'

=item C<-o>

Suppress to output unreferenced only files and show obsoleted files

=for getopt 'o'

=item C<-n>

Suppress to output unreferenced only files and show not-installed files

=for getopt 'n'

=back

=cut

Win32-Ldd-0.02.cygwin.patch

diff -ur Win32-Ldd-0.02-orig/Ldd.xs Win32-Ldd-0.02/Ldd.xs
--- Win32-Ldd-0.02-orig/Ldd.xs	2017-06-26 21:57:35.000000000 +0900
+++ Win32-Ldd-0.02/Ldd.xs	2018-05-09 21:23:20.769338100 +0900
@@ -62,7 +62,7 @@
 static struct DepTreeElement *
 build_dep_tree(char *pe_file,
                SearchPaths *search_paths,
-               int datarelocs, int recursive, int functionrelocs) {
+               int recursive, int datarelocs, int functionrelocs) {
     /* warn("build_dep_tree(%s, %p, %d, %d)", pe_file, search_paths, datarelocs, functionrelocs); */
     struct DepTreeElement root;
     memset(&root, 0, sizeof(root));
Win32-Ldd-0.02-orig のみに存在: Makefile
diff -ur Win32-Ldd-0.02-orig/Makefile.PL Win32-Ldd-0.02/Makefile.PL
--- Win32-Ldd-0.02-orig/Makefile.PL	2017-06-26 22:23:19.000000000 +0900
+++ Win32-Ldd-0.02/Makefile.PL	2018-05-09 20:59:28.824157900 +0900
@@ -1,15 +1,15 @@
 use 5.010;
 use ExtUtils::MakeMaker;
 
-$^O =~ /^MSWin32/i or warn "This module only works on Windows!!!\nContinuing anyway...\n";
+$^O =~ /^(MSWin32|cygwin)/i or warn "This module only works on Windows!!!\nContinuing anyway...\n";
 
 WriteMakefile( NAME              => 'Win32::Ldd',
                VERSION_FROM      => 'lib/Win32/Ldd.pm',
                ABSTRACT_FROM     => 'lib/Win32/Ldd.pm',
                AUTHOR            => 'Salvador Fandino <[email protected]>',
                LICENSE           => 'gpl',
-               LIBS              => ['-limagehlp'],
-               DEFINE            => '',
+               LIBS              => ($^O =~ /^cygwin/ ? ['-L/usr/lib/w32api -limagehlp'] : ['-limagehlp']),
+               DEFINE            => ($^O =~ /^cygwin/ ? '-Dstricmp=strcasecmp -Dstrnicmp=strncasecmp' : ''),
                INC               => '-I.',
                OBJECT            => '$(O_FILES)' );