#!/v/openpkg/sw/bin/perl
##
##  Copyright (c) 2000-2006 OpenPKG Foundation e.V. <http://openpkg.net/>
##  Copyright (c) 2000-2006 Ralf S. Engelschall <http://engelschall.com/>
##
##  Permission to use, copy, modify, and distribute this software for
##  any purpose with or without fee is hereby granted, provided that
##  the above copyright notice and this permission notice appear in all
##  copies.
##
##  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
##  SUCH DAMAGE.
##
##  tracker-cron.pl -- OpenPKG Tool Chain, Version Tracker, Cron Job
##

require 5;
use Getopt::Long;
use DBI;
use DBD::SQLite;
use DBIx::Simple;
use File::Find;
use IO;
use strict;

#   program information
my $progname = "tracker-cron";
my $progvers = "3.0.1";

#   parameters (defaults)
my $version  = 0;
my $verbose  = 0;
my $help     = 0;
my $tmpdir   = ($ENV{TMPDIR} || "/tmp");
my $database = 'tracker.db';
my $rpm      = 'openpkg rpm';
my $openssl  = 'openssl';
my $vcheck   = 'vcheck';
my $update   = 0;

#   exception handling support
$SIG{__DIE__} = sub {
    my ($err) = @_;
    $err =~ s|\s+at\s+.*||s if (not $verbose);
    print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
    exit(1);
};
#   command line parsing
Getopt::Long::Configure("bundling");
my $result = GetOptions(
    'V|version'     => \$version,
    'v|verbose'     => \$verbose,
    'h|help'        => \$help,
    't|tmpdir=s'    => \$tmpdir,
    'd|database=s'  => \$database,
    'r|rpm=s'       => \$rpm,
    'o|openssl=s'   => \$openssl,
    'c|vcheck=s'    => \$vcheck,
    'u|update'      => \$update,
) || die "option parsing failed";
if ($help) {
    print "Usage: $progname [options] [SPECFILE ...]\n" .
          "Available options:\n" .
          " -v,--verbose         enable verbose run-time mode\n" .
          " -h,--help            print out this usage page\n" .
          " -t,--tmpdir=PATH     filesystem path to temporary directory\n" .
          " -d,--database=PATH   filesystem path to SQLite database file\n" .
          " -r,--rpm=FILE        filesystem path to OpenPKG RPM program\n" .
          " -o,--openssl=FILE    filesystem path to OpenSSL program\n" .
          " -c,--vcheck=FILE     filesystem path to VCheck program\n" .
          " -u,--update          just perform quick information update\n" .
          " -V,--version         print program version\n";
    exit(0);
}
if ($version) {
    print "OpenPKG $progname $progvers\n";
    exit(0);
}

#   verbose message printing
sub msg_verbose {
    my ($msg) = @_;
    print STDERR "$msg\n" if ($verbose);
}

#   warning message printing
sub msg_warning {
    my ($msg) = @_;
    print STDERR "$progname:WARNING: $msg\n";
}

#   error message printing
sub msg_error {
    my ($msg) = @_;
    print STDERR "$progname:ERROR: $msg\n";
    exit(1);
}

#   determine vcheck(1) path
if ($vcheck eq '') {
    $vcheck = `$rpm --eval '%{l_vcheck}'`;
    $vcheck =~ s|^\s+||s;
    $vcheck =~ s|\s+$||s;
    die "no path to vcheck(1) known"
        if ($vcheck eq '');
}

#   open (and on-the-fly create) database
my $db_init = (-f $database ? 0 : 1);
my $db = DBIx::Simple->connect(
    "dbi:SQLite:dbname=$database", "", "",
    { RaiseError => 0, AutoCommit => 0 }
);
if ($db_init) {
    msg_verbose("++ creating new tracking database");
    $db->query(q{
        CREATE TABLE tracking (
            tracking        INTEGER PRIMARY KEY NOT NULL,
            time            INTEGER,
            duration_rpm    INTEGER,
            duration_vcheck INTEGER
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE status (
            tracking        INTEGER,
            time            INTEGER,
            duration        INTEGER,
            package         TEXT,
            component       TEXT,
            old             TEXT,
            new             TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package (
            package         TEXT,
            component       TEXT,
            version         TEXT,
            disabled        INTEGER,
            tracking_last   INTEGER,
            comment         TEXT,
            url             URL,
            md5             TEXT,
            class           TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE cache (
            filename        TEXT,
            package         TEXT,
            md5             TEXT,
            track           TEXT,
            tracking_last   INTEGER,
            class           TEXT
        );
    }) or die $db->error();
    $db->commit();
}

#   sanity check .spec files
die "no .spec files given" if (@ARGV == 0);
my @specs = ();
foreach my $spec (@ARGV) {
    if (-d $spec) {
        sub wanted { 
            if (-f $_ and $_ =~ m/\.spec$/) {
                push(@specs, $File::Find::name);
            }
        }
        finddepth(\&wanted, $spec);
    }
    else {
        die "invalid .spec filename \"$spec\""
            if ($spec !~ m/^(.+\/)?([^\/]+)\.spec$/);
        push(@specs, $spec);
    }
}

#   timekeeping
my $t_all  = time();

#   start tracking
my ($t_id) = $db->query(q{
    SELECT MAX(tracking) FROM tracking;
})->flat();
$t_id ||= 0;
$t_id++;
if (not $update) {
    msg_verbose("++ start tracking #$t_id");
    $db->query(q{
        INSERT INTO tracking (tracking, time, duration_rpm, duration_vcheck) VALUES (??);
    }, $t_id, $t_all, 0, 0) or die $db->error();
    $db->commit();
}

#   prune database
my $t_id_min = $t_id - 60;
$db->query(q{
    DELETE FROM tracking WHERE tracking < ?;
}, $t_id_min) or die $db->error();
$db->query(q{
    DELETE FROM status WHERE tracking < ?;
}, $t_id_min) or die $db->error();
$db->query(q{
    DELETE FROM package WHERE tracking_last < ?;
}, $t_id_min) or die $db->error();
$db->query(q{
    DELETE FROM cache WHERE tracking_last < ?;
}, $t_id_min) or die $db->error();
$db->commit();

#   timekeeping
my $t_step = time();

#   assemble all-in-one vcheck(1) configuration
msg_verbose("++ preparing vcheck(1) configuration by assembling \%track sections");
my $cache = {};
foreach my $q ($db->query(q{
    SELECT * FROM cache;
})->hashes()) {
    $cache->{$q->{"filename"}} = {-md5old => $q->{"md5"}, -track => $q->{"track"}, -class => $q->{"class"}};
}
for (my $i = 0; $i <= $#specs; $i += 500) {
    my @files = @specs[$i..($i+500)-1];
    my $io = new IO::File sprintf("%s md5 %s|", $openssl, join(" ", @files)) or die "$!";
    while (my $line = <$io>) {
        if ($line =~ m/MD5\(([^)]+)\)\s*=\s*([0-9a-fA-F]+)/s) {
            my ($filename, $md5) = ($1, $2);
            $cache->{$filename} = {} if not (defined($cache->{$filename}));
            $cache->{$filename}->{-md5new} = $md5;
        }
    }
    $io->close();
}
my $pc = {};
my $vc = '';
$vc .= "config = {\n}\n";
foreach my $filename (@specs) {
    my $package = $filename;
    $package =~ s/^.+\/([^\/]+)\.spec$/$1/s;
    my $track = "";
    my $class = "";
    if (    defined($cache->{$filename})
        and ($cache->{$filename}->{-md5new} eq $cache->{$filename}->{-md5old})) {
        $track = $cache->{$filename}->{-track};
        $class = $cache->{$filename}->{-class};
    }
    else {
        msg_verbose("   -- extracting \%track from \"$filename\"");
        my $query = {};
        my $io = new IO::File "$rpm --specfile -q --qf 'CLASS=\"\%{CLASS}\"\\n' $filename 2>/dev/null |"
            or die "unable to extract \"Class\" header from \"$filename\": $!";
        while (<$io>) {
            if (m/^([A-Z][A-Za-z0-9-]+)="(.*)"\n?$/s) {
                $query->{$1} = $2;
            }
        }
        $io->close();
        $class = $query->{"CLASS"};
        $io = new IO::File "$rpm --track-dump $filename 2>/dev/null |"
            or die "unable to extract \"%track\" section from \"$filename\": $!";
        $track .= $_ while (<$io>);
        $io->close();
        my $result = $db->query(q{
            UPDATE cache SET package = ?, md5 = ?, track = ?, class = ? WHERE filename = ?;
        }, $package, $cache->{$filename}->{-md5new}, $track, $class, $filename);
        if ($result->rows() == 0) {
            $db->query(q{
                INSERT INTO cache (filename, package, md5, track, class) VALUES (??);
            }, $filename, $package, $cache->{$filename}->{-md5new}, $track, $class) or die $db->error();
        }
        $db->commit();
    }
    if ($track eq '') {
        print STDERR "WARNING: empty \%track for spec $filename\n";
    }
    $vc .= $track;
    if ($class eq '') {
        print STDERR "WARNING: empty Class: for spec $filename\n";
    }
    $pc->{$package} = $class;
}
$db->commit();

#   short-circuit processing
if ($update) {
    goto MYEXIT;
}

#   determine current information
$db->query(q{ UPDATE package SET version = 'NONE'; });
my $VERSION = {};
my $cfg = $vc;
$cfg =~ s|\nprog\s+(\S+)\s+=\s*\{(.+?)\}|&do_cfg($1, $2), ''|sge;
sub do_cfg {
    my ($package, $cfg) = ($1, $2);
    my $component = "";
    if ($package =~ m/^(\S+):(\S+)$/) {
        $package = $1;
        $component = $2;
    }
    if ($cfg =~ m|version\s+=\s+(\S+)|s) {
        my $version = $1;
        my $disabled = 0;
        if ($cfg =~ m|disabled\s*\n|s) {
            $disabled = 1;
        }
        my $comment = "";
        if ($cfg =~ m|comment\s+=\s+"([^""]*)"|s) {
            $comment = $1;
        }
        my $url = "";
        if ($cfg =~ m/url\s+=\s+((?:https?|ftp):\/\/\S+)/s) {
            $url = $1;
        }
        my $result = $db->query(q{
            UPDATE package SET version = ?, disabled = ?, comment = ?, url = ?, tracking_last = ?, class = ? WHERE package = ? AND component = ?;
        }, $version, $disabled, $comment, $url, $t_id, $pc->{$package}, $package, $component);
        if ($result->rows() == 0) {
            $db->query(q{
                INSERT INTO package (package, component, version, disabled, comment, url, tracking_last, class) VALUES (??);
            }, $package, $component, $version, $disabled, $comment, $url, $t_id, $pc->{$package}) or die $db->error();
        }
        $VERSION->{"$package:$component"} = $version;
    }
}
$db->query(q{ DELETE FROM package WHERE version = 'NONE'; });
$db->query(q{ UPDATE package SET md5 = (SELECT md5 FROM cache WHERE package.package = cache.package); });
$db->commit();

#   timekeeping
$t_step = (time() - $t_step);
$db->query(q{
    UPDATE tracking SET duration_rpm = ? WHERE tracking = ?;
}, $t_step, $t_id);
$db->commit();
$t_step = time();

#   run vcheck(1) to determine new package status
msg_verbose("++ running vcheck(1) on \%track sections for determining new versions");
my $t_all = time();
my $io = new IO::File ">$tmpdir/tracker.vc"
    or die "unable to write \"$tmpdir/tracker.vc\": $!";
$io->print($vc);
$io->close();
$io = new IO::File "$vcheck --plain --no-update -f $tmpdir/tracker.vc |" or die "$!";
my $t_comp = time();
while (my $line = <$io>) {
    if ($line =~ m|^Checking for (\S+)\.\.\.\s+(.+)$|) {
        my ($package, $report) = ($1, $2);
        &msg_verbose("    -- tracking results: $package: $report");
        my $component = "";
        if ($package =~ m/^(\S+):(\S+)$/) {
            $package = $1;
            $component = $2;
        }
        my $old = $VERSION->{"$package:$component"} || "?";
        my $new = "?";
        if ($report =~ m|new version:\s+(\S+)\.\s*$|) {
            $new = $1;
        }
        elsif ($report =~ m|(\S+)\s+remains latest version\.\s*$|) {
            $new = $1;
        }
        else {
            $new = "ERROR: ". $report;
        }
        $db->query(q{
            INSERT INTO status (tracking, time, duration, package, component, old, new) VALUES (??);
        }, $t_id, $t_comp, time() - $t_comp, $package, $component, $old, $new) or die $db->error();
        $db->commit();
    }
    else {
        print STDERR "WARNING: vcheck returned: $line\n";
    }
    $t_comp = time();
}
$io->close();
# unlink("$tmpdir/tracker.vc");

#   timekeeping
msg_verbose("++ end tracking #$t_id");
$t_step = (time() - $t_step);
$db->query(q{
    UPDATE tracking SET duration_vcheck = ? WHERE tracking = ?;
}, $t_step, $t_id);
$db->commit();
$t_step = time();

#   close database
MYEXIT:
$db->commit();
$db->disconnect();
undef $db;

#   die gracefully
exit(0);