#!/usr/bin/perl -wT
#
# $Id: bit-report 24 2012-02-05 19:20:34Z sanders $
# BIT Support <support@bit.nl>
# 
BEGIN {
    $ENV{PATH} = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/X11R6/bin";
    push @INC, '/usr/lib/bit-report/';
}
use strict;
use IPC::Open3;
use IO::Select;
use LWP::UserAgent;
use JSON;
use Bitreport::Version;
use Time::HiRes qw(usleep);
use Symbol;
use Fcntl qw(:flock F_GETFL F_SETFL O_NONBLOCK);
use POSIX qw(:sys_wait_h);
$|++;


##
# Configuration
my $tmp_base        = "/tmp";
my $default_file    = "/etc/default/bit-report";
my $archive_base    = "http://nl.archive.ubuntu.com/ubuntu";
my $partner_base    = "http://archive.canonical.com/ubuntu";
my $http_submit_url = "https://bit-report.bit.nl/br-submit.cgi";


##
#
my $svn_bit_report_version = '$Revision: 51 $'; # svn updates this
my ($bit_report_version) = $svn_bit_report_version =~ /Revision: (\d+)/;
my $http_user_agent = "bit-report/$bit_report_version ";
my $debugvalue = ""; # used for errormessages


##
#
my $euid = $>;
die "Run this as root.\n" if ($euid != 0);


##
# Older versions of bit-report left a pile of crap, clean up.
# This way we only leave the last pile of crap. Not all of em.
cleanTempFiles();


##
# Identify server and initialise hostinfo hash
my $hostinfo = {
    'BITReportRevision' => $bit_report_version,
    'UpdatesAvailable' => 0,
    'UpdatesSecurity' => 0,
    'UpdatesNeedReboot' => 0,
};
identifyServer();


##
# Process package information [installed / available]
my $installed = parsePackagesFile("/var/lib/dpkg/status");
my $available = parsePackagesFile( findAptSources() );


##
# Fill hostinfo hash with package information & available updates
foreach my $key (keys %$installed) {
    $$hostinfo{Packages}{Installed}{ $$installed{$key}{Package} } = $$installed{$key}{Version};

    if ((exists $$available{$key}) and 
            ($$available{$key}{Version} ne $$installed{$key}{Version}) and
            IsNewer($$available{$key}{Version}, $$installed{$key}{Version}) ) {

        $$hostinfo{UpdatesAvailable}++;
        $$hostinfo{UpdatesNeedReboot} = 1 if ( $$installed{$key}{Package} =~ m#^linux-image# );

        $$hostinfo{Packages}{Updates}{ $$installed{$key}{Package} }{OldVersion} = $$installed{$key}{Version};
        $$hostinfo{Packages}{Updates}{ $$installed{$key}{Package} }{NewVersion} = $$available{$key}{Version};

        # store current packagename in debugvalue, safeExec uses it on errors
        $debugvalue = $key;
        my @changelog = getChangeLogFromDeb($$available{$key}{Filename});
        $$hostinfo{Packages}{Updates}{ $$installed{$key}{Package} }{ChangeLog} = \@changelog;

        if (grep { /security|cve/si } @changelog) {
            $$hostinfo{UpdatesSecurity}++;
            $$hostinfo{Packages}{Updates}{ $$installed{$key}{Package} }{IsSecurity} = "Yes";
        }
    }
}


##
# See what this Ubuntu distribution uses to produce JSON blobs
my $blob = "";
eval { $blob = encode_json($hostinfo) };
if ($@ =~ m#Undefined subroutine.*encode_json called#) {
    eval { $blob = objToJson($hostinfo) };
    die "$@\n" if ($@ ne "");
} elsif ($@ ne "") {
    die "$@\n";
}
die "JSON failed.\n" if ($blob eq "");


##
# Push results to server
sendHostInfo($blob);
exit 0;



###############################################################################
###############################################################################
###############################################################################


# Cleans out /tmp of pkgparse tempdirs
sub cleanTempFiles {
    foreach my $tmpdir (glob($tmp_base . '/pkgparse*')) {
        next if $tmpdir !~ m#^($tmp_base/pkgparse[A-Za-z0-9]{8})$#;
        my $dir = $1;
        safeExec("/bin/rm", "-rf", $dir);
    }
}



# Fetches .deb files for available updates and extracts changelog files
sub getChangeLogFromDeb {
    my ($uri) = @_;
    
    my $tmpdir = $tmp_base . "/pkgparse" . join("", (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62, rand 62, rand 62]);
    mkdir $tmpdir or warn "Can't mkdir $tmpdir: $!\n";
    chdir $tmpdir;

    my $deb_tgt = $tmpdir . "/temp.deb";
    
    my $url = "$archive_base/$uri";
    if ($uri =~ m#/partner/#) { $url = "$partner_base/$uri" };

    my $ret = 0;
    ($ret, undef) = safeExec("/usr/bin/wget", "-T", "30", "-o", "$tmpdir/wget.log", "-O", $deb_tgt, $url);
    if ((stat($deb_tgt))[7] == 0) {
        print STDERR "[E] Download of $url failed.\n";
        chdir("/"); safeExec("/bin/rm", "-rf", $tmpdir);
        return ("Download of $url failed.");
    }

    safeExec("/usr/bin/ar", "x", $deb_tgt);

    # Find data.tar.<something>
    my @data_tgt = glob("$tmpdir/data.tar.*");
    if (not scalar(@data_tgt)) {
        print STDERR "[E] No data.tar.* found in deb from $url\n";
        chdir("/"); safeExec("/bin/rm", "-rf", $tmpdir);
        return ("No data.tar.* found in deb.");

    } else {
        my ($filename) = $data_tgt[0] =~ m#.*/(data\.tar\..*)$#;
        my $data_tgt = $tmpdir . "/" . $filename;
        safeExec("/bin/tar", "-xa", "--wildcards", "-f", $data_tgt, "./usr/share/doc");

    }

    my @changes = ();
    my @changelogs = glob ("$tmpdir/usr/share/doc/*/changelog.gz $tmpdir/usr/share/doc/*/changelog.Debian.gz");
    for my $changelog (@changelogs) {
        my $fnam = "";
        $fnam = $1 if ($changelog =~ m#($tmpdir/usr/share/doc/.*/changelog.*)#);
        next if (-l $fnam);
        safeExec("/bin/gunzip", $fnam);
        $changelog =~ s/\.gz$//;
        push @changes, processChangeLog($changelog);
    }

    if ($ret == 0) { chdir("/"); safeExec("/bin/rm", "-rf", $tmpdir); } 
    push @changes, "No changelog found" if not scalar(@changes);
    return @changes;
}


# Cuts out the top most changelog entry and filters crust.
sub processChangeLog {
    my ($file) = @_;
    my $blob = "";
    if (open (FD, "<$file")) {
        while (my $line = <FD>) {
            next if ($line =~ /^$/);
            next if ($line =~ /urgency=/);
            $blob .= $line;
            last if ($line =~ /^ --.*>\s\s/);
        }
    } else {
        warn "Can't read $file: $!\n";
    }
    if ($blob !~ /^ -- .*>\s\s/ms) {
        $file =~ s#.*share/doc/##;
        $blob = "Changelog not well formed: $file";
    } else {
        $blob =~ s/^ -- .*$//ms;
        $blob =~ s/\r?\n$//;
    }
    return $blob;
}


# Parses dpkg status and apt lists packages files
sub parsePackagesFile {
    my ($pattern) = @_;
    my $pkghash = {}; my $tmphash = {}; my $lastkey = "";
    my @files = glob($pattern);
    foreach my $file (@files) {
        open (FD, "<$file") or die "Can't read $file: $!\n";
        while (<FD>) {
            if ($_ =~ m/^([A-Z0-9][^\s]+):(?:\s(.*))?/) {
                $$tmphash{$1} = $2;
                $lastkey = $1;
            }
            if ($_ =~ m/^\s(.*)/) {
                $lastkey = "LongDescription" if $lastkey eq "Description";
                $$tmphash{$lastkey} .= (length(($$tmphash{$lastkey}||""))?$1:" $1");
            }
            if ($_ =~ m/^$/) {
                next if (exists $$tmphash{Status} and $$tmphash{Status} !~ m#install ok installed#);
                my $uniquename = $$tmphash{Package} . "-" . ($$tmphash{Architecture}||"all");
                if (exists $$pkghash{$uniquename}) { next if IsNewer($$pkghash{$uniquename}{Version}, $$tmphash{Version}); }
                foreach my $key (keys %$tmphash) { $$pkghash{$uniquename}{$key} = $$tmphash{$key}; }
                $$pkghash{$uniquename}{AptPkgFile} = $file;
                $tmphash = {};
            }
        }
    }
    return $pkghash;
}


# Uses apt configfiles to find all configured aptsources
sub findAptSources {
    my $patternlist = {};
    my @aptsources = glob ("/etc/apt/sources.list /etc/apt/sources.list.d/*.list");
    foreach my $aptsource (@aptsources) {
        if (open (FD, "<$aptsource")) {
            while (<FD>) {
                chomp();
                if ($_ =~ m/^\s*deb\s+http:\/\/([^\s]+)\s([^\s]+)/) {
                    my ($uri, $dist) = ($1, $2);

                    # Detect unofficial/untrusted aptsources, store them in hostinfo
                    if ($uri !~ /(?:(?:archive|extras|security)\.(?:canonical|ubuntu)\.com|bit\.nl|debian\.org)/) {
                        push @{ $$hostinfo{ForeignAptSources} }, $_;
                    }

                    # Filename is based on the url info
                    $uri =~ s/\/$//; $uri .= " "; $uri =~ tr/-a-zA-Z0-9\.\_/_/c;
                    $dist =~ s/\/$//; $dist =~ tr/-a-zA-Z0-9\.\_/_/c;
                    if ($dist ne ".") { $dist = "dists_" . $dist; }
                    my $key = "/var/lib/apt/lists/" . $uri . $dist . "_*Packages";
                    $$patternlist{$key}++;
                }
            }
            close(FD);
        } else {
            print STDERR "[W] Can't read $aptsource: $!\n";
        }
    }
    return join(" ", keys %$patternlist);
}


sub IsNewer {
    my ($a, $b) = @_;
    my $v1 = Bitreport::Version->new($a);
    my $v2 = Bitreport::Version->new($b);
    return 1 if ($v1 > $v2);
    return 0;
}


sub sendHostInfo {
    my ($blob) = @_;

    my $tmpfile = $tmp_base . "/pkgparse" . join("", (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62, rand 62, rand 62]);
    if (open(FD, ">" . $tmpfile)) {
        print FD $blob;
        close(FD);
    } else {
        die "Can't make tempfile: $!\n";
    }

    # Try with LWP
    my $ua = LWP::UserAgent->new(
        agent => $http_user_agent,
        ssl_opts => {
                verify_hostname => 1,
                SSL_cipher_list => 'ALL:!LOW:!aNULL',
            },
        timeout => 60,
    );

    my $res = $ua->post(
        $http_submit_url,
        'Content-type' => 'multipart/form-data',
        'Content'      => [ 'hostinfo' => [ $tmpfile ] ]
    );

    if (not $res->is_success) {
        print "[W] LWP Failed sumitting results to $http_submit_url\n";
        print "[W] LWP returned: " . $res->status_line . "\n";
    } else {
        unlink $tmpfile or die "Can't unlink $tmpfile: $!\n";
        print $res->content();
    }
}


sub identifyServer {
    my $output = my $tmp = "";

    # UUID
    $$hostinfo{uuid} = "undefined";
    if (open(FD, "<".$default_file)) {
        while (<FD>) {
            if ($_ =~ m#^uuid=([-a-z0-9]+)$#) {
                $$hostinfo{uuid} = $1;
                last;
            }
        }
        close(FD);

        if ($$hostinfo{uuid} !~ m#^[-a-f0-9]+$#) {
            die "Server UUID unknown? Check $default_file. Reinstall package?\n";
        }

    } else {
        die "Can't read $default_file: $!\n";
    }

    # Hostname
    $$hostinfo{Hostname} = `/bin/hostname -f`; chomp($$hostinfo{Hostname});

    # Default source IPv4
    $tmp = "failed";
    $output = `/bin/ip ro get 8.8.8.8`;
    ($tmp) = $output =~ m#via.+?dev.+?src\s([^\s]+)#;
    $$hostinfo{DefaultIP4} = $tmp;

    # Default source IPv6
    $tmp = "failed";
    $output = `/bin/ip -6 ro get 2006::`;
    ($tmp) = $output =~ m#via.+?dev.+?src\s([^\s]+)#;
    $$hostinfo{DefaultIP6} = $tmp;

    # Configured IPs
    $output = `/bin/ip -o ad sh`; 
    while ($output =~ m/^(.*)$/gm) {
        my $line = $1;

        if ($line =~ m/\d+:\s([^:]+):.*UP,LOWER_UP.*ether\s([^\s]+)/) {
            $$hostinfo{Interfaces}{$1}{mac} = $2;
        } elsif ($line =~ m/\d+:\s([^\s]+)\s*inet\s([^\s]+)\s/) {
            push @{ $$hostinfo{Interfaces}{$1}{ip4} }, $2;
        } elsif ($line =~ m/\d+:\s([^\s]+)\s*inet6\s([^\s]+)\s/) {
            push @{ $$hostinfo{Interfaces}{$1}{ip6} }, $2;
        }
    }

    # lsb_information
    if (open (LSB, "</etc/lsb-release")) {
        while (<LSB>) {
            next unless $_ =~ m#([^=]+)=(.*)#;
            my $key = $1; my $val = $2; $val =~ s/"//g;
            $$hostinfo{LsbRelease}{$key} = $val;
        }
        close(LSB);
    } else {
        warn "Can't read /etc/lsb-release\n";
    }
}

sub safeExec {
    my (@cmd) = @_;

    my $io_select = IO::Select->new();
    my ($stdin, $stdout, $stderr) = (gensym, gensym, gensym);
    my $pid = open3($stdin, $stdout, $stderr, @cmd);
    $io_select->add($stdout, $stderr);

    # Read data from child, but we may not block on this.
    my $wpid = 0;
    my $process_output = "";
    while (kill 0, $pid) {
        foreach my $handle ($io_select->can_read(1)) {
            my $flags = fcntl($handle, F_GETFL, 0);
            fcntl($handle, F_SETFL, $flags | O_NONBLOCK);
            my $rsize = read($handle, my $buf, 10485760);
            $process_output .= "$buf" if ($rsize);
        }
        $wpid = waitpid($pid, WNOHANG);
        usleep(50000); # grace in this loop
    }

    my ($exitval, $signal, $core) = ( ($? >> 8), ($? & 127), ($? & 128) );
    # get residual output from process
    foreach my $handle ($io_select->can_read(1)) {
        my $flags = fcntl($handle, F_GETFL, 0);
        fcntl($handle, F_SETFL, $flags | O_NONBLOCK);
        my $rsize = read($handle, my $buf, 10485760);
        $process_output .= "$buf" if ($rsize);
    }

    if ($exitval != 0) {
        print STDERR "cmd returned $exitval (signal: $signal, core: $core)\n";
        print STDERR "cmd was: " . join (" ", @cmd) . "\n";
        print STDERR "output follows:\n$process_output\n";
    }

    return ($exitval, $process_output);
}
