#! /usr/bin/perl
#------------------------------------------------------------------------------
# check-files.pl - show differences between files.txt and SVN tree
#
# usage: check-files.pl help
#
# Creation:    11.09.2003 jw5
# Last Update: $Id$
#------------------------------------------------------------------------------

# --- MODULES ---
use File::Find;
use strict;
use warnings;

# --- CONFIG ---
$ENV{'LANG'} = 'C';

# These are pre-compiled pattern, add new ones the same way
my @ignore = (
    qr{\.svn},
    qr{src/src/buildroot/dl/},
    qr{src/src/buildroot/build/},
    qr{src/src/buildroot/target/},
    qr{src/src/fbr/build_i386/},
    qr{src/src/fbr/dl/},
    qr{src/src/fbr2/build/},
    qr{src/src/fbr2/dl/},
    qr{src/src/kernel-[.[:digit:]]+/patch_[-[:alnum:]._]+_log$/},
    qr{src/src/kernel-[.[:digit:]]+/out/},
    qr{src/src/kernel-[.[:digit:]]+/out-[-[:alnum:].]*/},
    qr{src/src/kernel-[.[:digit:]]+/linux-.+.bz2},
    qr{src/src/kernel-[.[:digit:]]+/linux-.+/},
    qr{src/src/kernel-[.[:digit:]]+/build-.+/},
    qr{src/src/kernel-[.[:digit:]]+/drivers/build-.+/},
    qr{src/src/kernel-[.[:digit:]]+/drivers/avm-.+},
    qr{src/src/kernel-[.[:digit:]]+/drivers/avm/},
    qr{src/src/kernel-[.[:digit:]]+/drivers/avm.sh},
    qr{src/src/kernel-[.[:digit:]]+/drivers/dl/},
    qr{src/src/fbr/toolchain_build_i386/},
    qr{rrdtool3.dertiger/},
    qr{freeswitch},
    qr{ruby_lang},
    qr{.+~},
    );
# These are the fileslists where all files should be listed...
my @filelists = (
    "files.txt"
    );

# --- GLOBAL VARS ---
our (%real_files, %binfiles, %txtfiles, %files, %svn_files, %alias, %modules, %modules_missing, %versions, %svn_links, %files_excl_lnkd,
     @files, @args, @params, @res, @libs,
     $key, $name, $type, $first, $arg, $verbose);
our $svn = (-d ".svn")? "svn" : "svk";

# --- SUBS ---
sub process_file {
    return unless -f;

    foreach my $pat (@ignore) {
        return if $File::Find::name =~ /$pat/;
    }
    $real_files{$File::Find::name} = 1;
}

sub process_link {
    return unless -l;
    my $type = `$svn pg svn:special $File::Find::name 2>/dev/null`;
    return unless $type eq "*\n";
    $svn_links{"(?-xism:$File::Find::name)"} = 1;
}    

# return all keys from the first hash that are not present in the second hash
sub weedout {
    my ($one, $two) = @_;
    grep { !defined($two->{$_}) } keys(%$one);
}

sub get_args {
    my ($aref) = @_;
    my @retlist = ();
    my ($i);
    for ($i=0; $i<20 && $#{$aref} >= 0; $i++) {
        push @retlist, shift @$aref;
    }
    return @retlist;
}

sub print_verb {
    my ($txt, $serverity) = @_;
    return unless $verbose || $serverity;

    if ($first) {
        print "$name:\n";
        $first = 0;
    }
    print "    $txt";
}
# --- MAIN ---

if (@ARGV == 0) {
    @params = ('files', 'opts', 'svn', 'props', 'libs');
} else {
    @params = @ARGV;
}

#
# read files.txt
#
foreach my $list (@filelists) {
    open (FILES, "<", $list) or die "can't open '$list': $!";

    while (<FILES>) {
        /^(.) (.*)$/o;
        $type = $1;
        $name = $2;
        if ( -f $name ) {
            $binfiles{"\"$name\""} = 1 if ( $type =~ /[bBo]/);
            $txtfiles{"\"$name\""} = 1 if ( $type =~ /[dDuU]/);
        }
        $files{$name} = 1;
    }
    close FILES;
}
#
# get list of directories to search
#
my @dirs = ();
foreach my $dir (sort <*>) {
    # ignore files, dirs not under version control and
    # internal directories
    push (@dirs, $dir) unless ! -d "$dir/.svn" || $dir =~ /^(_|toolchain|testsuite).*/;
}

print "* * * * * * * * * *\n";
print "* check-files.pl  *\n";
print "* * * * * * * * * *";

foreach my $arg (@params) {
    if ($arg eq "files") {
       # read files in directories
        print "\nSearching for files... create filelists...\n";
        print "------------------------------------------\n";
        find({ wanted => \&process_file, follow_fast => 1, follow_skip => 2 }, @dirs);

        print "Missing files:\n";
        print "--------------\n";
        print " ".join("\n ", sort(weedout(\%files,\%real_files)))."\n";
        
        print "\nNot in files.txt:\n";
        print "-----------------\n";
        print " ".join("\n ", sort(weedout(\%real_files,\%files)))."\n";
    } elsif ($arg eq "opts" || $arg eq "opts-all") {
        print "\nChecking opt/*.txt files ...\n";
        print "----------------------------\n";
        my %opt_files = ();
        my %stripped_files = ();

        # create a hash without leading paket names and opt prefix
        foreach (keys %files) {
            s#^[^/]+/opt/##;
            $stripped_files{$_} = 1;
        }

        # lookup kernel versions
        foreach my $dir (@dirs) {
            next unless $dir =~ /^kernel.*/;
            for my $version (sort glob("$dir/opt/files/lib/modules/[0-9]*")) {
                next unless -d $version;
                # check if kernel directory will be removed from svn
                my $ignore_deleted_kernel_directories = 0;
                open (SVN, "$svn info --depth empty $version |") || die "unable to fork svn";
                while (<SVN>) {
                    if(/^Schedule:\s+delete$/) { $ignore_deleted_kernel_directories = 1; }
                }
                close SVN;
                if(!$ignore_deleted_kernel_directories) {
                    $version =~ s#.*/##;
                    $versions{$version} = $dir;
                }
            }
        }
        
        # filter out all kernel modules
        foreach (keys %files) {
            next unless /^kernel_.*/;
            if (m#^kernel_.*/modules/([^/]+)/.*/([^/]+).ko#) {
                $modules{$1}{$2} = 1;
            }
        }

        # add aliases
        for my $version (keys %versions) {
            my $name = $versions{$version} . '/opt/files/lib/modules/' . $version . '/modules.alias';
            open (ALIAS, "<", $versions{$version} . '/opt/files/lib/modules/' . $version . '/modules.alias') || die "Unable to open '$name'";
            while (<ALIAS>) {
                next if /^#.*|.*:.*/;
                my ($foo, $alias, $bar) = split;
                $modules{$version}{$alias} = 1;
            }
        }

        foreach my $dir (@dirs) {
            next unless -f "$dir/opt/$dir.txt";
            for my $file (sort glob("$dir/opt/*.txt")) {
                my $OPT;
                $name = $file;
                $first = 1;
                open (OPT, "<", $file);
                while (<OPT>) {
                    # skip comments, format indicator, weak declaration
                    next if (/^(#|opt_format|weak).*/); 
                    # skip empty lines
                    next if (/^\s*$/);
                    # remove rootfs prefixes
                    s/rootfs://;
                    # remove trailing comments
                    s/\#.*//;

                    my ($var, $val, $name) = split;
                    
                    if ($name =~ /.*\/.*/) {
                        if ($name =~ /\${[^}]+}/) {
                            # print "checking $name\n";
                            $name =~ s#\${[^}]+}#[^/]*#;
                            my @res = grep {$_ =~ m#$name#} keys %stripped_files;
                            if ($#res < 0) {
                                print_verb("$name\n", 1);
                            }
                        } else {
                            next if defined $stripped_files{$name};
                            next if $name eq "etc/rc.cfg";
                            my @res = grep {$_ =~ m#$name/.*#} keys %stripped_files;
                            if ($#res >= 0) {
                                print_verb("# $name (dir)\n", 0);
                                next;
                            }
                            print_verb("$name\n", 1);
                        }
                        next;
                    }
                    # check presens of kernel module in all kernel versions
                    $name =~ s/\.k?o//;
                    for my $version (keys %versions) {
                        next if defined $modules{$version}{$name};
                        push(@{ $modules_missing{$version}{$name} }, $dir);
                    }
                }
            }
        }
        # skip module checking
        next unless ($arg eq "opts-all");

        foreach my $version (keys %modules_missing) {
            my %list = ();
            print "\nMissing Modules in version $version:\n";
            while (my ($key, $value) = each %{ $modules_missing{$version} } ) {
                foreach my $p (@{ $value }) {
                    push (@{ $list{$p} }, $key);
                    # print "# $p: @{ $list{$p} }\n";
                }
            }
            foreach my $key (sort keys %list) {
                print "$key:\n";
                print "    ".join("\n    ", @{ $list{$key} });
                print "\n";
            }
        }
    } elsif ($arg eq "svn") {
        my $file;

        print "\nGetting svn state of files ...\n";
        print "------------------------------\n";
        open (SVN, "$svn info --depth=infinity |") || die "unable to fork svn";
        while (<SVN>) {
            chomp;
            if(/^Path:\s+/) {
                $file = $_;
                $file =~ s/^Path:\s+//;
                next if $file eq ".";
            }
            if(/^Schedule:\s+(normal|add|delete)$/) {
                $svn_files{$file} = 1 ;
            }
        }
        close SVN;
        
        print "\nFiles not in repository:\n";
        print "------------------------\n";

        # skip linked files from %files
        find({ wanted => \&process_link, no_chdir => 1 }, @dirs);
        FILE_LOOP:
        foreach my $file (keys %files) {
            foreach my $pat (keys(%svn_links)) {
                if ( $file =~ /$pat/ ) {
                    next FILE_LOOP;
                }  
            }
            $files_excl_lnkd{$file} = 1;
        }

        print " ".join("\n ", sort(weedout(\%files_excl_lnkd,\%svn_files)))."\n";
    } elsif ($arg eq "props") {
        print "\nChecking text file svn properties...\n";
        print "------------------------------------\n";
        @files = sort (keys %txtfiles);
        for (@args = get_args(\@files); @args != 0; @args = get_args(\@files)) 
        {
            open (SVN, "$svn pg svn:keywords @args |") || die "unable to fork svn";
            while (<SVN>) {
                /^(\S+)\s+-\s(.*)/;
                $name = $1;
                $type = $2;
                next if ($type =~ /Author\s+Date\s+Id\s+Revision$/);
                print "$name: Wrong value of 'svn:keywords' property: $type\n";
            }
            close SVN;
        }

        print "\nChecking binary file svn properties...\n";
        print "--------------------------------------\n";
        @files = sort (keys %binfiles);
        for (@args = get_args(\@files); @args != 0; @args = get_args(\@files)) 
        {
            open (SVN, "$svn proplist -v --xml @args |") || die "unable to fork svn";
            while (<SVN>) {
                if (/path=\"(.*)\"/) {
                    $name=$1;
                    next;
                }
                next if ! / *name=\"/;
                next if /svn:mime-type\">application\/octet-stream/;
                next if /svn:executable/;
                my $property = $_;
                $property =~ s/ *name=\"//;
                $property =~ s/\">/: /;
                $property =~ s/<\/property>//;
                print "$name Wrong property or wrong value of property: $property";
            }
            close SVN;
        }
    } elsif ($arg eq "libs" || $arg eq "libdeps") {
        $verbose = 1 if $arg eq "libdeps";

        print "\nLibrary dependencies:\n";
        @libs = grep (/(.*lib\/(ebtables\/)?lib.*\.so.*)|(.*lib\/ld-uClibc.*\.so)/,  sort keys %files);
        s#.*/## for @libs;

        foreach $key (grep (/.*-\d+\.\d+.*/, @libs)) {
            my($a) = $key;
            $a =~ s#-\d+\.\d+.*#.so.0#;
            $alias{$a} = $key;
        }
        @files = grep (!/.*vdr\/.*/, sort keys %binfiles);
        for (@args = get_args(\@files); @args != 0; @args = get_args(\@files)) 
        {
            open (STRINGS, "readelf -d @args 2> /dev/null |") || die "unable to fork readelf";
            while (<STRINGS>) {
                if (/^File: (.*)/) {
                    $name = $1;
                    $first = 1;
                    next;
                }
                if (/.*NEEDED.*\[([^\]]+)\]/) {

                    next if $1 eq "libc.so.0";
                    if ($1 eq "libc.so.6") {
                        print_verb("Wrong libc versions: $1\n", 1) unless $name =~ /src\/src\/fbr\/package\/config\/.*/;
                        next;
                    }
                    
                    @res =  grep (/.*$1.*/,  @libs);
                    my ($txt, $err) = ("'$1' ", 0);
                        
                    if ($#res < 0) {
                        if (defined($alias{$1})) {
                            $txt = "$txt ($alias{$1})\n";
                        } else {
                            $txt = "$txt (missing)\n";
                            $err = 1;
                        }
                    } elsif ($#res == 0) {
                        $txt = "$txt ($res[0])\n";
                    } else {
                        $txt = "$txt (ambiguous: @res)\n";
                        $err = 1 unless $name =~ /faxrcv\/.*\/capifaxrcvd/ || $name =~ /rcapid\/.*\/rcapid/ || $name =~ /lcd4linux\/.*lcd4linux.*/ || $name =~ /umts\/.*usb_modeswitch/;
                    }
                    print_verb ($txt, $err);
                }
            }
            close STRINGS;
        }
        if ($verbose) {
            print "\n#\n# Available Libraries:\n#\n";
            print "    ".join("\n    ",  @libs);
            print "\n";
        }
    
    } else {
        print <<USAGE

Usage: check-files.pl [ files | opts | opts-all | svn | props | libs | libdeps ]\n
    default: files opts svn props libs

    files - check whether all files referenced in files.txt are present and
            whether all present files are referenced in files.txt

    opts  - checks whether all files referenced in opt/*.txt are present 
            in files.txt (except kernel modules)

    opts-all - additionally checks kernel modules

    svn  - checks wheter all files are under version control

    props - checks whether all files have the corrent svn properties

    libs - checks whether all needed libraries are present in files.txt
           (uses readelf to get dependencies)

    libdeps - creates a list of library dependencies
USAGE
    }
}
