#!/bin/sh
#### #### #### ####     #     ##  #  # ####
#    #  #  ##  #  #     #     ##  ## # #        150
# ## #  #  ##  #  #     #     ##  # ## ####
#  # #  #  ##  #  #     #     ##  #  # #   
#### ####  ##  ####     ####  ##  #  # ####

######### bootstrap     ######### bootstrap     ######### bootstrap     ########
######### bootstrap     ######### bootstrap     ######### bootstrap     ########

PATHS="~/bin /usr/bin /bin /usr/local/bin";
for PATH in $PATHS; do
        if [ -x $PATH/perl ]; then
                $PATH/perl -x "$0" $@;
                exit $?;
        fi;
done;
echo "$0 ERROR: Can't find perl interpreter in $PATHS" 1>&2;
echo "Add your perl path to the PATHS list at the top of this $0 file." 1>&2;
exit 1;

######### initialize    ######### initialize    ######### initialize    ########
######### initialize    ######### initialize    ######### initialize    ########

#!perl
use strict;
use Storable;
use LWP::Simple;
&loadProgramMeta();

use Getopt::Std;
our( %Conf, %opts );
getopts( 'cdDhquva:r:A:R:f:F:l:', \%opts );
$Conf{'checkFeeds'    } = $opts{'c'};
$Conf{'diagnostics'   } = $opts{'d'};
$Conf{'dumpDb'        } = $opts{'D'};
&showHelp() if (          $opts{'h'} or
                          $opts{'v'} );
$Conf{'quiet'         } = $opts{'q'};
$Conf{'sshUpdate'     } = $opts{'u'};
$Conf{'addFeed'       } = $opts{'a'};
$Conf{'removeFeed'    } = $opts{'r'};
$Conf{'addHost'    } = $opts{'A'};
$Conf{'removeHost' } = $opts{'R'};
$Conf{'dbFile'        } = $opts{'f'};
$Conf{'hostFile'      } = $opts{'F'};
$Conf{'logFile'       } = $opts{'l'};
&showHelp() unless ( $Conf{'checkFeeds' } or $Conf{'sshUpdate'  } or
                     $Conf{'addFeed'    } or $Conf{'removeFeed' } or
                     $Conf{'addHost'    } or $Conf{'removeHost' } or
                     $Conf{'hostFile'   } or $Conf{'dumpDb'     } );
undef %opts;

if( $Conf{'diagnostics'} ) {
        use utf8;
        use warnings;
        use diagnostics;
}

&debug( 'initialized' );
print &getCopyright() if( ( $Conf{'checkFeeds'} or $Conf{'help'} or
                            $Conf{'diagnostics'} ) and ! $Conf{'quiet'} );
&main();

######### generic code  ######### generic code  ######### generic code  ########
######### generic code  ######### generic code  ######### generic code  ########

# returns copyright string
sub getCopyright { return <<COPYRIGHT;
####
##      $Conf{progName} v$Conf{version} :: $Conf{description}
#       Copyright (c) $Conf{copyrightYear} $Conf{copyrightHolder}, $Conf{www}

COPYRIGHT
}

# wrapper
sub showHelp {
        my @changes = split /\n20/, "\n" . &getChangeLog();
        print STDERR &getCopyright() . &getUsage();
        unless( $#changes == -1 ) {
                print STDERR "\nCHANGELOG:\n";
                for( my $i = 2; $i > -1; $i-- ) {
                        next if $#changes <= $i;
                        print STDERR '20' . $changes[ $#changes - $i ] . "\n";
                }
        }
        exit 0;
}

# logs log messages with lvl error
sub error {
        return if $#_ == -1;
        warn &_log( 'ERROR', \@_, ( caller( 1 ) )[3] );
        exit 1;
}

# logs log messages with lvl alert
sub alert {
        return if $#_ == -1;
        warn &_log( 'ALERT', \@_, ( caller( 1 ) )[3] );
}

# logs log messages with lvl info
sub info {
        return if $#_ == -1;
        my $text = &_log( 'INFO', \@_, ( caller( 1 ) )[3] );
        print $text unless $Conf{'quiet'};
}

# logs log messages with lvl debug
sub debug {
        return unless $Conf{'diagnostics'};
        return if $#_ == -1;
        my $text = &_log( 'DEBUG', \@_, ( caller( 1 ) )[3] );
        print $text unless $Conf{'quiet'};
}
# backend function for logging messages
sub _log {
        # build log message
        my( $level, $caller ) = ( $_[0], $_[2] );
        my @messages = @{ $_[1] };
        $caller = 'main::unknown' unless $caller;
        $caller =~ s/main\:\://;
        my $logMesg;
        my $time = localtime();
        $time =~ s/^\w+\ //;
        $time =~ s/\ \d+$//;
        foreach my $mesg ( @messages ) {
                $logMesg .= sprintf(
                        "$time $Conf{progName}\[$$\]/%-10s %-5s: $mesg\n",
                        $caller,
                        $level
                );
        }

        # write log file
        if( $Conf{'logFile'} ) {
                open LOG, '>>', $Conf{logFile}
                        or die "Can't open log for writing: $!", @messages;
                print LOG $logMesg;
                close LOG or die "Can't write to log: $!", @messages;
        }

        return $logMesg;
}

######### custom code   ######### custom code   ######### custom code   ########
######### custom code   ######### custom code   ######### custom code   ########

# meta information about this program
sub loadProgramMeta {
        $Conf{'version'    } = '1.03';
        $Conf{'description'} = "reads advisories so you don't have to";

        $Conf{'progName'       } = $1 if $0 =~ /\/?([^\/]+)$/;
        $Conf{'www'            } = "http://$Conf{progName}.unixgu.ru";
        $Conf{'copyrightHolder'} = 'Stephan Schmieder';
        $Conf{'copyrightYear'  } = '2006, 2007';
}

# keep track of your changes...
sub getChangeLog { return <<CHANGELOG;
2006-06-17 ssc\@unixgu.ru
  v0.3  - intial freshmeat announcement
2006-07-11 ssc\@unixgu.ru
  v0.31 - This release adds three more RSS feeds to addFeeds.sh
2006-09-16 ssc\@unixgu.ru
  v0.9  - complete rewrite: bigger, better, faster and no more nmap =)
2006-09-16 ssc\@unixgu.ru
  v0.91 - added support for portage package manager (Gentoo)
          thanks to bsx for sending in the patch
2006-10-03 ssc\@unixgu.ru
  v0.92 - fixed a small bug in enableSshUpdate.sh,
          which led to an error on missing .ssh/.id_?sa
        - added ruby and django lists via google groups
2006-10-05 ssc\@unixgu.ru
  v0.93 - sshUpdate.sh is now quite when running in cron
2006-10-07 ssc\@unixgu.ru
  v0.98 - added support for AIX lslpp and Solaris pkginfo
          thanks to dag for sending in the patch for both
2006-10-12 ssc\@unixgu.ru
  v1.00 - integrated (enable)SshUpdate.sh functionalities into main program
        - added -D option for Dumping the database
        - turned README into a manual page
2006-10-26 ssc\@unixgu.ru
  v1.01 - SSH-Update can now use multiple remote package managers on same host.
          Upgrade to v1.01 requires "advchk -R host -A host" for each host.
2006-11-15
  v1.02 - Ludwig Ortmann pointed out that touch(1) isn't always in /bin.
2007-01-26
  v1.03 - A LICENSE file was added in order to comply with DFSG.
CHANGELOG
}


# documents synopsis and usage information
sub getUsage{ return <<USAGE;
SYNOPSIS: [ -cdDhquv ] [-ar url] [-AR [user@]host[:port]] [-fFl file]
-c        check for advisories            -d        enabes (perl) diagnostics
-D        dump database to STDOUT         -h, -v    shows this help
-q        quiet mode (for cronjobs)       -u        update package lists via ssh
-a url    add feed                        -r url    remove feed
-A host   add host to update-pool         -R host   remove host from update-pool
-f file   database file (advchk.db)       -F file   package list (myhost.list)
-l file   logs messages to file

Specifying an empty "myhost.list" file will remove "myhost" from database.
See "man 1 advchk" for details.
USAGE
}

# main part of this program
sub main {
        $Conf{'db'} = &loadDb( $Conf{'dbFile'} );

        # add/remove/update hosts?
        if( $Conf{'hostFile'} ) {
                $Conf{'db'}{'hosts'} = &loadHost( $Conf{'hostFile'},
                                                  $Conf{'db'}{'hosts'} );
        }
        if( $Conf{'addHost'} ) {
                if( $Conf{'db'}{'sshUpdate'}{ $Conf{'addHost'} } ) {
                        &alert( "Can't add host '$Conf{'addHost'}:",
                                'Host already in update-pool.'
                        );
                } else {
                        $Conf{'db'}{'sshUpdate'} = &addHost(
                                $Conf{'addHost'},
                                $Conf{'db'}{'sshUpdate'}
                        );
                }
        }
        if( $Conf{'removeHost'} ) {
                if( delete $Conf{'db'}{'sshUpdate'}{ $Conf{'removeHost'} } ){
                        &info(  "removed host '$Conf{'removeHost'}'" .
                                'from update-pool' );
                } else {
                        &alert( "Can't remove host '$Conf{'removeHost'}':",
                                'Host not in update-pool.'
                        );
                }
        }
        if( $Conf{'sshUpdate'} ) {
                $Conf{'db'} = &sshUpdate( $Conf{'db'} );
        }

        # add/remove/check feeds?
        if( $Conf{'addFeed'} ) {
                $Conf{'db'}{'feeds'}{ $Conf{'addFeed'} } = 1;
                &info( "added feed '$Conf{'addFeed'}' to database" );
        }
        if( $Conf{'removeFeed'} ) {
                if( delete $Conf{'db'}{'feeds'}{ $Conf{'removeFeed'} } ) {
                        &info(  "removed feed '$Conf{'removeFeed'}' from db" );
                } else {
                        &alert( "Can't remove feed '$Conf{'removeFeed'}':",
                                'Feed not in database.'
                        );
                }
        }
        if( $Conf{'checkFeeds'} ) {
                $Conf{'db'} = &checkFeeds( $Conf{'db'} );
        }

        if( $Conf{'dumpDb'} ) {
                use Dumpvalue;
                my $d = new Dumpvalue;
                print $d->dumpValue( $Conf{'db'} );
        }

        &storeDb( $Conf{'dbFile'}, $Conf{'db'} );
}

# updates package lists via ssh
sub sshUpdate {
        my %db = %{ $_[0] };
        &error( "\$HOME environment variable is not set!" )
                unless ( $ENV{'HOME'} and -d $ENV{'HOME'} );
        mkdir "$ENV{'HOME'}/.advchk"
                unless -d "ENV{'HOME'}/.advchk";
        &info( 'updating package lists via ssh ...' );

        foreach my $host ( keys %{ $db{'sshUpdate'} } ) {
                &debug( "updating host '$host' ..." );
                my $hostName;
                $hostName = $1 if $host =~ /^(?:[^\@]+\@)?([^\@\:]+)(?:\:\d+)?/;
                &error( "Can't extract hostname from '$host'!" ) if ! $hostName;
                my $hostFile = "$ENV{'HOME'}/.advchk/$hostName.list";

                &debug( "adding host '$host' ..." );
                my $sshHost =  $host;
                $sshHost =~ s/\:/\ -p\ /;
                my $cmd  =  "/bin/sh -c 'ssh -T $sshHost \"" .
                            'dpkg -l; pkg_info; rpm -qa; ' .
                            'equery list -i; lslpp -Lc; pkginfo -x; true' .
                            "\" > $hostFile 2>&1'";

                &error( "Oops, this happened:", $!, "while executing:", $cmd  )
                        if system $cmd and $! ne 'File exists' ;

                $db{'sshUpdate'}{$host} = 1;
                $db{'hosts'} = &loadHost( $hostFile, $db{'hosts'} );
        }

        return \%db;
}

# adds an host to the update-pool
sub addHost {
        my $host      = $_[0];
        my %sshUpdate = %{ $_[1] };
        my $cmd;

        # generate ssh private key?
        unless( -f "$ENV{HOME}/.ssh/id_rsa" or -f "$ENV{HOME}/.ssh/id_dsa" ) {
                &info(  'Looks like you don\'t have a private key file yet.',
                        'Let\'s generate one!' );
                $cmd = 'ssh-keygen -t dsa';
                &error( "Oops, this happened:", $!, "while executing:", $cmd  )
                        if system $cmd;
        }

        &info( "enabling ssh update for '$host' ..." );
        my $sshHost =  $host;
        $sshHost =~ s/\:/\ -p\ /;
        $cmd =  "/bin/sh -c 'echo command=\\\"" .
                "dpkg -l\\; pkg_info\\; rpm -qa\\; " .
                "equery list -i\\; lslpp -Lc\\; pkginfo -x\\; true\\\" " .
                "`/bin/cat $ENV{'HOME'}/.ssh/id_?sa.pub` | " .
                "ssh -T $sshHost \"/bin/cat >> .ssh/authorized_keys2\"'";
        &error( "Oops, this happened:", $!, "while executing:", $cmd  )
                if system $cmd;

        $sshUpdate{$host} = 1;
        return \%sshUpdate;
}

# updates feeds and checks for advisories
sub checkFeeds {
        my %db = %{ $_[0] };
        my( %newItems, %matches );
        &info( 'checking advisories ...' );

        foreach my $feed ( keys %{ $db{'feeds'} } ) {
                &debug( "fetching feed '$feed' ..." );
                foreach my $item ( split /\<item[^\>]*\>/i,
                                   ( get $feed or 'XSS' ) ) {
                        # cleanup
                        $item =~ s/\r//g;
                        $item =~ s/\<(?:link|title)\>([^\<]+)
                                   \<\/(?:link|title)\>/$1\n/xg;
                        $item =~ s/\<[^\>]*\>//g;
                        $item =~ s/\&lt\;[^\&]+\&gt\;//g;
                        $item =~ s/\&\w{2,4}\;//g;
                        $item =~ s/[\=\-\_]{3,}//g;
                        $item =~ s/\n\s+/\n/g;
                        $item =~ s/\n\s*\n/\n/g;
                        $item =~ s/\+/\ /g;
                        $item = "\n$item" unless $item =~ /^\n/;

                        next if $db{'items'}{$item};
                        next if $item =~ # nobody cares about those xss bugs...
                                /(?:^|\s)(?:XSS|Cross.Site.Scripting|Ajax)
                                 (?:$|\s|\-|\:|\.|\;)/ix;
                        $newItems{$item} = 1;
                        $db{'items'}{$item} = time;
                }
        }

        &debug( 'removing old items ...' );
        foreach my $item ( keys %{ $db{'items'} } ) {
                delete $db{'items'}{$item}
                        if $db{'items'}{$item} < ( time - 7776000 );
        }

        &debug( 'matching feed items to host packages ...' );
        foreach my $item ( keys %newItems ) {
                foreach my $host ( keys %{ $db{'hosts'} } ) {
                        my %packages = %{ $db{'hosts'}{$host} };
                        foreach my $package ( keys %packages ) {
                                my $version = $packages{$package};
                                $matches{$package}{$item}{$host} = 1
                                        if &match( $package, $version, $item );
                        }
                }
        }

        if( scalar keys %matches ) {
                &debug( 'generating report ...' );
                my( $summary, $text );

                foreach my $pkg ( keys %matches ) {
                        my %items  = %{ $matches{$pkg} };
                        my( %hosts, $fItem );
                        foreach my $item ( keys %items ) {
                                $fItem = $item if ( ! $fItem and length $item > 42 );
                                foreach my $host ( keys %{ $items{$item} } ) {
                                        $hosts{$host} = 1;
                                }
                        }
                        $summary  .= "- $pkg (" . ( scalar keys %hosts ) .")\n";
                        $text     .= "\n\n####\n##\t$pkg$fItem\nAffected hosts:\n";
                        foreach my $host ( keys %hosts ) {
                                $text .= sprintf "%-36s%-36s\n", $host,
                                         "$pkg-$db{'hosts'}{$host}{$pkg}";
                        }
                }
                
                print <<MESG;
####
##      Abstract
Advchk compared recent security advisories against a list of known software.
The following packages installed on your systems are very likely to be
vulnerable against some digital attack and require further investigations.

$summary
$text
MESG
        }

       return \%db; 
}

# matches software against feed items
sub match {
        my( $package, $version, $item ) = @_;
        return 0 unless ( $package and $version and $item );
        return 0 unless $item =~ /[\s\-\_\.\!\:]\Q$package\E[\s\-\_\.\!\:]/i;

        my $count = 3;
        $count++ if $version =~ /.{1,4}\./;
        $version = substr $version, 0, $count;
        return 0 unless $item =~ /\Q$version\E/i;

        return 1;
}

# reads a host file
sub loadHost {
        my $hostFile = $_[0];
        my %hosts;
        %hosts = %{ $_[1] } if $_[1];
        my $host;
        if( $hostFile =~ /^(?:.*\/)?(.+)\.list$/i ) {
                $host = $1;
        }
        &error( "Could not extract hostname out of host file '$hostFile'!",
                'Strict naming convention: "$HOSTNAME.list"' )
                unless $host;

        unless ( -f $hostFile ) {
                if( $hosts{$host} ) {
                        delete $hosts{$host};
                        &info( "deleted host '$host' from database" );
                } else {
                        &alert(  "Can't remove host '$host':",
                                 'Host not in database.'
                        );
                }
                return %hosts;
        }

        &info( "loading host file '$hostFile' ..." );
        open( hostFile, $hostFile )
                or &error( "Can't load host file '$hostFile':", $! );
        delete $hosts{$host};
        while( <hostFile> ) {
                chomp;
                next unless $_;
                my $line = $_;

                if( $line =~ /^\w\w\s+([^\s]{2,})\s+([\d\-\.]+\w*)[^\s]*
                              \s+[^\s]+\s+.+$/x ) {
                        $hosts{$host}{$1} = $2;
                        &debug( "added DPKG     package '$1' version '$2'" );
                } elsif( $line =~ /^([\w\d\+\-\.]{2,})\-([\d\-\.]+\w*)[^\s]*
                                   \s+[^\s]+\s+.+$/x ) {
                        $hosts{$host}{$1} = $2;
                        &debug( "added PKG_INFO package '$1' version '$2'" );
                } elsif( $line =~ /^[^\/]+\/([\w\d\+\-\.]{2,})\-([\d\-\.]+\w*).*$/x ) {
                        $hosts{$host}{$1} = $2;
                        &debug( "added PORTAGE  package '$1' version '$2'" );
                } elsif( $line =~ /^([\w\d\+\-\.]{2,})\:
                                   [\w\d\+\-\.]{2,}\:([\d\-\.]+\w*).*\:.*$/x ) {
	                $hosts{$host}{$1} = $2;
                        &debug( "added LPP      package '$1' version '$2'" );
                } elsif( $line =~ /^([\w\d\+\-\.]{2,})\-([\d\-\.]+\w*).*$/x ) {
                        $hosts{$host}{$1} = $2;
                        &debug( "added RPM      package '$1' version '$2'" );
                } elsif( $line =~ /^([\w\d\+\-\.]{2,})\s+\w+.*$/x ) {
                        my $name   = $1;
                        my $line2  = <hostFile>;
                        if( $line2 =~ /\s+\s+\([\w\d\+\-\.]{2,}\)\s+
                                      ([\d\-\.]+\w*).*$/x ) {
                                $hosts{$host}{$name} = $1;
                                &debug( "added PKGINFO  package '$name' version '$1'" );
                        } else {
                                &debug( 'Could not make sense of these lines:',
                                        $line, $line2 );
                        }
                } else {
                        &debug( 'Could not make sense of this line:', $line );
                }
        }
        close hostFile;

        &error( "Could not detect packages in '$hostFile' => $host not in db!" )
                unless $hosts{$host};

        return \%hosts;
}

# writes the database file
sub storeDb {
        my $dbFile = $_[0];
        my %db     = %{ $_[1] };

        &error( "Database file '$dbFile' does not exist." )
                unless ( $dbFile and -f $dbFile );

        &debug( "saving database to file '$dbFile' ..." );
        eval{
                store( \[ $db{'hosts'}, $db{'feeds'}, $db{'items'}, $db{'sshUpdate'} ], $dbFile )
                        if scalar keys %db > 0;
        }
        or &error( "Can't store database: $!\n" );
}

# reads the database file
sub loadDb {
        my $dbFile = $_[0];
        my %db;

        unless( $dbFile ) {
                foreach my $path( '/etc', '/usr/local/etc', '/var', '.',
                                  "$ENV{'HOME'}/.advchk" ) {
                        $dbFile = $path.'/advchk.db' if -f $path.'/advchk.db';
                }
                # create db file
                unless( $dbFile ) {
                        $dbFile = "$ENV{'HOME'}/.advchk/advchk.db";
                        mkdir "$ENV{'HOME'}/.advchk"
                                unless -d "ENV{'HOME'}/.advchk";
                        my $touch;
                        $touch = '/bin/touch'          if -f '/bin/touch';
                        $touch = '/usr/bin/touch'      if -f '/usr/bin/touch';
                        $touch = '/usr/loal/bin/touch' if -f '/usr/local/bin/touch';
                        &error( "Oops, this happened:", $!,
                                "while executing:", "$touch $dbFile"  )
                                if system "$touch $dbFile";

                }
        }
        &error( "Database file '$dbFile' does not exist." )
                unless ( $dbFile and -f $dbFile );

        &debug( "loading database from file '$dbFile' ..." );
        eval{
                ( $db{'hosts'}, $db{'feeds'}, $db{'items'}, $db{'sshUpdate'} )
                        = @{ ${ retrieve( $dbFile ) } };
        };

        $Conf{'dbFile'} = $dbFile; # yeah, its dirty...
        return \%db;
}
