#!/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.
##
##  browser-cron.pl -- OpenPKG Tool Chain, Package Browser, Cron Job
##

require 5;
use Getopt::Long;
use OSSP::cfg;
use DBI;
use DBD::SQLite;
use DBIx::Simple;
use LWP::Simple;
use IO::All;
use Data::Dumper;
use strict;

#   program information
my $progname = "browser-cron";
my $progvers = "0.9.0";

#   parameters (defaults)
my $version  = 0;
my $verbose  = 0;
my $help     = 0;
my $cfgfile  = 'browser.cfg';
my $tmpdir   = ($ENV{TMPDIR} || "/tmp");
my $database = 'browser.db';
my $rpm      = 'openpkg rpm';
my $openssl  = 'openssl';
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,
    'c|cfgfile=s'   => \$cfgfile,
    't|tmpdir=s'    => \$tmpdir,
    'd|database=s'  => \$database,
    'r|rpm=s'       => \$rpm,
    'o|openssl=s'   => \$openssl,
    'u|update'      => \$update,
) || die "option parsing failed";
if ($help) {
    print "Usage: $progname [options]\n" .
          "Available options:\n" .
          " -v,--verbose         enable verbose run-time mode\n" .
          " -h,--help            print out this usage page\n" .
          " -c,--cfgfile=PATH    filesystem path to configuration file\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" .
          " -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);
}

#   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 browsing database");
    $db->query(q{
        CREATE TABLE distribution (
            distribution    TEXT PRIMARY KEY NOT NULL,
            date            TEXT,
            url_dir         TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package (
            package         TEXT PRIMARY KEY NOT NULL,
            summary         TEXT,
            url             TEXT,
            vendor          TEXT,
            packager        TEXT,
            distribution    TEXT,
            class           TEXT,
            xgroup          TEXT,
            license         TEXT,
            version         TEXT,
            release         TEXT,
            description     TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package_prereq (
            package         TEXT,
            class           TEXT,
            condition       TEXT,
            name            TEXT,
            value           TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package_source (
            package         TEXT,
            url_source      TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package_conflict (
            package         TEXT,
            name            TEXT,
            value           TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package_provide (
            package         TEXT,
            name            TEXT,
            value           TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE package_distribution (
            package         TEXT,
            distribution    TEXT,
            url_rpm         TEXT
        );
    }) or die $db->error();
    $db->query(q{
        CREATE TABLE security_advisory (
            advisory        TEXT,
            status          TEXT,
            package         TEXT,
            version         TEXT,
            release         TEXT
        );
    }) or die $db->error();
    $db->commit();
}

#   read configuration
my $txt < io($cfgfile) or die;
my $cs = new OSSP::cfg::simple;
$cs->parse($txt);
my $cfg = $cs->unpack(-index => qr/^(?:rdf|url|date)$/);
undef $cs;
my $dist = [];
foreach my $dir (@{$cfg}[1..$#{$cfg}]) {
    if ($dir->[0] eq 'distribution') {
        push(@{$dist}, { -name => $dir->[1], -date => $dir->[2]->{'date'}->[1], -url => $dir->[2]->{'url'}->[1], -rdf => $dir->[2]->{'rdf'}->[1]->[1] });
    }
}

#   fetch and parse Security Advisory information
my $url = "http://www.openpkg.com/security/advisories/?format=pkg";
msg_verbose("++ fetching $url");
my $xml = get($url) or die;
msg_verbose("++ parsing $url");
$db->query(q{
    DELETE FROM security_advisory;
}) or die $db->error();
$xml =~ s/<package\s+id="([^""]+)".*?\s+package=\"([^""]+)\"\s+version_affected=\"([^""]+)\"\s+release_affected=\"([^""]+)\"\s+version_corrected=\"([^""]+)\"\s+release_corrected=\"([^""]+)\"/
    store_status($db, $1, $2, $3, $4, $5, $6), ''/sge;
sub store_status {
    my ($db, $id, $package, $version_affected, $release_affected, $version_corrected, $release_corrected) = @_;
    $id =~ s/^OpenPKG-SA-//s;
    $db->query(q{
        INSERT INTO security_advisory VALUES (??);
    }, $id, "affected", $package, $version_affected, $release_affected) or die $db->error();
    $db->query(q{
        INSERT INTO security_advisory VALUES (??);
    }, $id, "corrected", $package, $version_corrected, $release_corrected) or die $db->error();
}

#   fetch and parse RDFs
foreach my $d (@{$dist}) {
    msg_verbose("++ crawling $d->{-name}");
    $db->query(q{
        DELETE FROM distribution WHERE distribution = ?;
    }, $d->{-name}) or die $db->error();
    $db->query(q{
        INSERT INTO distribution (distribution, url_dir) VALUES (??);
    }, $d->{-name}, $d->{-url}) or die $db->error();
    my $url = $d->{-url};
    foreach my $rdf (@{$d->{-rdf}}) {
        #   fetch RDF content
        msg_verbose("   -- fetching $url$rdf");
        my $xml = get("$url$rdf") or die;
        if ($rdf =~ m/\.bz2$/) {
            unlink("/tmp/browser.tmp");
            $xml > io("/tmp/browser.tmp");
            $xml < io("bzip2 -d </tmp/browser.tmp|");
            unlink("/tmp/browser.tmp");
        }

        #   parse RDF content
        msg_verbose("   -- parsing $url$rdf");
        $xml =~ s/<rdf:Description\s+about="(.+?)"\s+href="(.+?)">(.+?)<\/rdf:Description>/parse_rdf($url, $rdf, $d, $1, $2, $3), ''/sgei;
        sub parse_rdf {
            my ($url, $rdf, $d, $about, $href, $xml) = @_;
            my @tag_simple     = (qw(name version release distribution group class license packager summary url vendor description));
            my @tag_complex    = (qw(buildprereq prereq conflicts provides source));
            my $re_tag_simple  = '(?:' . (join "|", @tag_simple)  . ')';
            my $re_tag_complex = '(?:' . (join "|", @tag_complex) . ')';
            my $pkg = {};
            $xml =~ s/<($re_tag_simple)>(.+?)<\/\1>/$pkg->{"-".lc($1)} = $2, ''/sgei;
            $xml =~ s/<($re_tag_complex)(?:\s+cond="(.*?)")?>(.+?)<\/\1>/parse_tag_complex($about, $pkg, "-".lc($1), $2, $3), ''/sgei;
            sub parse_tag_complex {
                my ($about, $pkg, $name, $cond, $xml) = @_;
                $pkg->{$name} = [] if (not exists $pkg->{$name});
                if ($xml =~ m/<rdf:li/si) {
                    $xml =~ s/<rdf:li>(.+?)<\/rdf:li>/
                        push(@{$pkg->{$name}}, { -cond => ($cond || ""), -li => $1 }), ''/sgei;
                }
                elsif ($xml =~ m/<resource/si) {
                    $xml =~ s/<resource(?:\s+([a-z]+)="(.+?)")?>(.+?)<\/resource>/
                        push(@{$pkg->{$name}}, { -cond => ($cond || ""), -op => ($1 || "equ"), -value => ($2 || "*"), -name => $3 }), ''/sgei;
                }
            }
            foreach my $tag (@tag_simple) {
                $pkg->{"-$tag"} ||= "";
            }
            foreach my $tag (@tag_complex) {
                $pkg->{"-$tag"} ||= [];
            }

            #   store package information into database (for CURRENT packages only)
            my $opmap = {
                'equ' => '=',
                'geq' => '>=',
                'leq' => '<=',
                'gt'  => '>', 
                'lt'  => '<',
            };
            if ($d->{-name} =~ m/^OpenPKG-CURRENT.*/) {
                 $db->query(q{
                     INSERT INTO package VALUES (??);
                 }, $pkg->{-name}, $pkg->{-summary}, $pkg->{-url},
                    $pkg->{-vendor}, $pkg->{-packager}, $pkg->{-distribution},
                    $pkg->{-class}, $pkg->{-group}, $pkg->{-license},
                    $pkg->{-version}, $pkg->{-release}, $pkg->{-description},
                 ) or die $db->error();
                 foreach my $prereq (@{$pkg->{-buildprereq}}) {
                     $db->query(q{
                         INSERT INTO package_prereq VALUES (??);
                     }, $pkg->{-name}, "B", $prereq->{-cond},
                        $prereq->{-name}, sprintf("%s %s", $opmap->{$prereq->{-op}}, $prereq->{-value})
                     ) or die $db->error();
                 }
                 foreach my $prereq (@{$pkg->{-prereq}}) {
                     $db->query(q{
                         INSERT INTO package_prereq VALUES (??);
                     }, $pkg->{-name}, "I", $prereq->{-cond},
                        $prereq->{-name}, sprintf("%s %s", $opmap->{$prereq->{-op}}, $prereq->{-value})
                     ) or die $db->error();
                 }
                 foreach my $source (@{$pkg->{-source}}) {
                     $db->query(q{
                         INSERT INTO package_source VALUES (??);
                     }, $pkg->{-name}, $source->{-li}) or die $db->error();
                 }
                 foreach my $conflict (@{$pkg->{-conflicts}}) {
                     $db->query(q{
                         INSERT INTO package_conflict VALUES (??);
                     }, $pkg->{-name}, $conflict->{-name}, sprintf("%s %s", $opmap->{$conflict->{-op}}, $conflict->{-value})) or die $db->error();
                 }
                 foreach my $provide (@{$pkg->{-provides}}) {
                     $db->query(q{
                         INSERT INTO package_provide VALUES (??);
                     }, $pkg->{-name}, $provide->{-name}, sprintf("%s %s", $opmap->{$provide->{-op}}, $provide->{-value})) or die $db->error();
                 }
            }

            #   store package download URL into database (for all packages)
            my $pkg_url = $url . $rdf;
            $pkg_url =~ s/\/[^\/]+$/\//s;
            $pkg_url .= $href;
            $pkg_url =~ s/^\Q${url}\E//s;
            $db->query(q{
                INSERT INTO package_distribution (package, distribution, url_rpm) VALUES (??);
            }, $pkg->{-name}, $d->{-name}, $pkg_url) or die $db->error();
        }
    }
}

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

#   die gracefully
exit(0);