#!perl -w
use strict;
use Algorithm::Diff;
use Getopt::Long;
use File::Find;
use File::stat;
use Net::SSH2;

=head1 NAME

diff-servers.pl

=head1 ABSTRACT

Generate a diff between two directory trees. The directory trees must be local or reachable
via ssh. Only the ssh2 protocol is supported.

=head1 SYNOPSIS

  perl -w diff-servers.pl corion@production:/opt/mychat corion@staging:/tmp/deploy-0.025 --ignore .bak --ignore .gpg --ignore .pgp --ignore random_seed

Quick diff, showing only added/missing files without comparing their content

  perl -w diff-servers.pl c:\mychat\old-versions\0.025 corion@staging:/tmp/deploy-0.025 -q

=head1 OPTIONS

=over 4

=item B<--ignore>

Regexp of directory entries to ignore

=item B<--no-mode>

Don't compare the file mode.

=item B<--no-owner>

Don't compare the file owner.

=item B<--quick>

Don't compare file contents

=item B<--verbose>

Be somewhat more verbose

=back

=head1 PREREQUISITES

Currently, the script expects C<find> and C<perl> to be available on the remote
side. The dependency on C<find> could be eliminated by implementing the functionality
in Perl. The dependency on C<perl> on the remote side could be eliminated by using
the SFTP protocol for retrieving the directory tree, at an added complexity.

=cut

GetOptions(
    'verbose|v' => \my $verbose,
	'ignore|i:s' => \my @ignore,
	'no-owner|o' => \my $ignore_owner,
	'no-mode|m' => \my $ignore_mode,
	'quick|q' => \my $skip_contents,
);

use vars qw(%connections);

sub run_remote {
    my( $server, $command )= @_;
	my $user;
	if( $server =~ /(.*)\@(.*)/ ) {
	    $user = $1;
		$server = $2;
	};
    if( ! $connections{ $server }) {
        my $ssh2 = Net::SSH2->new();

        $ssh2->connect($server) or die "Couldn't connect to '$server': $!";

        if ($ssh2->auth( username => $user, interact => 1 )) {
            $connections{ $server } = $ssh2;
        } else {
		    die "No auth to $server.";
		};
    };
	
	my $fh = $connections{ $server }->channel;
	warn "[$command]" if $verbose;
	$fh->exec($command) or die;
	my @lines = map {s/\s+$//; $_ } <$fh>;
	#warn "$server:[$_]" for @lines;
	return @lines
}

sub get_local {
    my( $file )= @_;
	open my $fh, '<', $file
	    or warn "Couldn't read '$file': $!";
    binmode $fh;
	my @lines = map {s/\s+$//; $_ } <$fh>;
	return @lines
}

sub split_serverpath {
    my( $serverpath ) = @_;
	if( $serverpath =~ /((?:\w+\@)[\w.]+):(.*)/ ) {
	    return ("$1","$2");
    } else {
	    # Must be local
	    return (undef, $serverpath);
	}
};

use Data::Dumper;
sub filelist {
    my( $serverpath ) = @_;
	my( $host, $dir ) = split_serverpath( $serverpath );
	if( $host ) {
	    # Outputs a line per file
		# mode user group type filename
		my $uid_gid_file = q!perl -Mstrict -MFile::stat -nle 'next if /^\s*$/;my $s=stat($_);my($p,$u,$g,$t)=(0,q(-),q(-),q(f)); if($s and not -l) {$p=$s->mode;$u=(getpwuid($s->uid))[0];$g=(getgrgid($s->gid))[0] } else { $t=q(l)}; print sprintf qq(%08o %s %s %s %s), $p, $u,$g,$t,$_'!;
		
		# Read all directory entries
		my @remote_entries = map { my( $mode,$u,$g,$t,$name ) = split / +/, $_, 6 ;
		                           $name =~ s!^\Q$dir!!;
		                           { user => $u, group => $g, type => $t, name => $name, mode => $mode };
                                 } run_remote( $host, qq{find '$dir' -type f -o -type l| $uid_gid_file } );
		return @remote_entries;
	} else{
	    my @files;
	    find({ wanted =>  sub {
		    return if -d $_;
			my $s = stat($_)
			    or warn "Couldn't stat [$_]: $!", return;
			my $name = $_;
			my $u='-';
			my $g='-';
			my $t='f';
			my $mode = $s->mode;
			$name =~ s!^\Q$dir!!;
			push @files, { user => $u, group => $g, type => $t, name => $name, mode => $mode };
	      }, no_chdir => 1 },
	      $dir );
		#warn "local: $_" for @files;
		return @files;
	};
}

sub wanted_file {
    my( $fileinfo )= @_;
	my $file = $fileinfo->{name};
	if( my @why = grep { $file =~ /\Q$_/ } @ignore ) {
		#warn "Ignoring $file (@why)";
	} else {
		#warn "Allowing [$file] ...";
	}
	! grep { $file =~ /\Q$_/ } @ignore;
}

sub diff {
    my( $name, $server1, $server2 )= @_;
	
	my($host1, $path1) = split_serverpath( $server1 );
	my($host2, $path2) = split_serverpath( $server2 );
	
	my @left  = $host1 ? run_remote( $host1, qq{cat '$path1$name'} ) : get_local( "$server1$name" );
	my @right = $host2 ? run_remote( $host2, qq{cat '$path2$name'} ) : get_local( "$server2$name" );
	
	my $diff = Algorithm::Diff->new( \@left, \@right );

    $diff->Base( 1 );   # Return line numbers, not indices
	my $has_diff;
    while(  $diff->Next()  ) {
        next   if  $diff->Same();
		if( ! $has_diff ) {
			$has_diff = 1;
			print "$name\n";
		};
        my $sep = '';
        if(  ! $diff->Items(2)  ) {
            printf "%d,%dd%d\n",
                $diff->Get(qw( Min1 Max1 Max2 ));
        } elsif(  ! $diff->Items(1)  ) {
            printf "%da%d,%d\n",
                $diff->Get(qw( Max1 Min2 Max2 ));
        } else {
            $sep = "---\n";
            printf "%d,%dc%d,%d\n",
                $diff->Get(qw( Min1 Max1 Min2 Max2 ));
        }
        print "< $_\n"   for  $diff->Items(1);
        print $sep;
        print "> $_\n"   for  $diff->Items(2);
    }
	$has_diff
};

my( $server1, $server2 )= @ARGV;

#warn "Old: $server1";
#warn "New: $server2";

my %left_info = map { $_->{name} => $_ } grep { wanted_file($_) } filelist( $server1 );
my %right_info = map { $_->{name} => $_ } grep { wanted_file($_) } filelist( $server2 );

my @left_names = sort keys %left_info;
my @right_names = sort keys %right_info;

my $filediff = Algorithm::Diff->new( \@left_names, \@right_names );
my @samelist;

$filediff->Base( 1 );   # Return line numbers, not indices
while(  $filediff->Next()  ) {
    if( $filediff->Same() ) {
	    # entry exists in both trees
		push @samelist, $filediff->Items(1);
	} else {
	    # Entries only on tree 2, but no symlink
		my @new_items = grep { ! $right_info{ $_ }->{type} ne 'l' } $filediff->Items(2);
		print "new: $_\n" for @new_items;

	    # Entries only on tree 1, but no symlink
		my @old_items = grep { ! $left_info{ $_ }->{type} ne 'l' } $filediff->Items(1);
		print "del: $_\n" for @old_items;
	};
}

for my $same (@samelist) {
	my $linfo = $left_info{ $same };
	my $rinfo = $right_info{ $same };
	#warn "File: $same";
	#warn Dumper $linfo;
	#warn Dumper $rinfo;
	if( $linfo->{type} ne $rinfo->{type} ) {
	    print "$same: Link vs. file: $linfo->{type} => $rinfo->{type}\n";
	};
	next if $linfo->{type} eq 'l' or $rinfo->{type} eq 'l';

	if( ! $ignore_owner ) {
		if(    $left_info{ $same }->{user}  ne $right_info{ $same }->{user}
			or $left_info{ $same }->{group} ne $right_info{ $same }->{group}
		  ) {
		  print "$same: Ownership different: $left_info{ $same }->{user}:$left_info{$same}->{group} ne $right_info{ $same }->{user}:$right_info{$same}->{group}\n";
		};
	};
	if( ! $ignore_mode ) {
		if(    $left_info{ $same }->{mode} ne $right_info{ $same }->{mode}
		  ) {
		  print "$same: Mode different: $left_info{ $same }->{mode} $right_info{$same}->{mode}\n";
		};
	};
	if( ! $skip_contents ) {
		diff( $same, $server1, $server2 );
	};
};