#!/usr/bin/perl
#    Big Sister network monitor
#    Copyright (C) 1997-2002  Thomas Aeby
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

#=============================================================================
#
$BigSister::common::Usage	  = "[-D level] [-q] [-s] [-n] [-f] [install|list|remove] [module1] [module2] ...

Options:

  -q   quiet: only print fatal messages, never ask questions
  -s   ignore missing signatures/checksums ('force')
  -n   do not try to load missing modules from the Big Sister web server
  -f   force installing even with dependencies not met";
#
#=============================================================================
@BigSister::common::options = ( "s", "q", "n", "f" );
use lib "."; use lib "uxmon"; use lib "platforms"; use lib "tools"; 		#inslib
use BigSister::common;
proginit();

use FileHandle;
use File::stat;
use strict;
use Tar;
use CheckSig;
use HTTPDownload;

my $dl = $BigSister::common::dl;
my $quiet = $BigSister::common::opt_q;
my $ignore_sigs = $BigSister::common::opt_s;
my $noweb = $BigSister::common::opt_n;
my $force = $BigSister::common::opt_f;

my @tmp = ();
my $pid = $$;

# make sure END {} is executed on signal too
$SIG{"INT"} = $SIG{"HUP"} = $SIG{"QUIT"} = sub {
    exit(1);
};

my $tmpdir = "$BigSister::common::fs{'tmp'}/module.$$";
mkdir( $tmpdir, 0700 );
push( @tmp, $tmpdir );

my $mode = @ARGV?"install":"list";
if( grep( $ARGV[0] eq $_, "install", "list", "remove" ) ) {
    $mode = shift;
}

my $dir = "$BigSister::common::fs{'etc'}/moduleinfo";
( -d $dir ) || mkdir( $dir, 0755 );

if( $mode eq "list" ) {
    list_modules();
}
elsif( $mode eq "install" ) {
    foreach my $module( @ARGV ) {
	install_module( $module ) || exit(1);
    }
}
elsif( $mode eq "remove" ) {
    foreach my $module( @ARGV ) {
	remove_module( $module ) || exit(1);
    }
}
exit(0);



sub list_modules {
    my $modules = 0;
    foreach my $info (@{installed_modules()}) {
	my( $name, $version, $descr ) = ( $info->{"module"}, $info->{"version"}, $info->{"descr"} );
	$version = "N/A" unless( $version );
	print sprintf( "%-15s (%5s) %s\n", $name, $version, $descr );
	$modules++;
    }
    close DIR;
    print "no modules installed\n" unless( $modules );
}



sub installed_modules {
    my @modules = ();
    my $dir = "$BigSister::common::fs{'etc'}/moduleinfo";
    opendir( DIR, $dir );
    foreach my $module (readdir( DIR )) {
	next unless( $module =~ /\.info$/ );
	my $info = read_moduleinfo( "$dir/$module" );
	next unless( $info && %$info );
	push( @modules, $info );
    }
    return \@modules;
}



sub fatal {
    my( $message ) = @_;

    print STDERR "$message\n";
    exit(1);
}


sub remove_module {
    my( $module ) = @_;

    my $modules = installed_modules();
    my @match = grep( $_->{"module"} eq $module, @$modules );
    unless( @match ) {
	fatal( "module $module is not installed" );
    }
    my @depend = ();
    foreach my $next (@$modules) {
	my @depends = split( /[\s\t]+/, $next->{"depends"} );
	foreach my $depend (@depends) {
	    my $short = $depend;
	    $short =~ s/\(.*\)//;
	    if( $short eq $module ) {
		push( @depend, $next );
		last;
	    }
	}
    }
    if( @depend ) {
	 print STDERR "\nthe following modules depend on $module to be installed:\n\n";
	 foreach my $module (@depend) {
	     print "  ".($module->{"module"})."\n";
	 }
	 unless( $quiet ) {
	     print "\n";
	     $| = 1;
	     print "Remove anyway? (y/n) ";
	     my $answer = <STDIN>;
	     ($answer =~ /^y/i) || fatal( "removal aborted" );
	 }
	 else {
	     fatal( "removal aborted" );
	 }
    }

    my $list = filelist();
    my @failed = ();
    while( my( $file, $filemodule ) = each %$list ) {
	next unless( $filemodule eq $module );
	if( (-e $file) && !unlink( $file )) {
	    push( @failed, $file );
	}
	else {
	    delete $list->{$file};
	}
    }
    write_filelist($list);
    if( @failed ) {
	print STDERR "\nthe following files could not be removed:\n\n";
	print STDERR "".(join( "\n", @failed ))."\n";
	fatal( "module $module not completely removed" );
    }
    unlink( "$BigSister::common::fs{'etc'}/moduleinfo/$module.info" ) || fatal( "cannot remove module info file" );
    print "removed $module\n" unless( $quiet );
}




sub install_module {
    my( $file ) = @_;

    unless( $file =~ /\.mod$/ ) {
	$file .= ".mod";
    }
    unless( -f $file ) {
	unless( $noweb ) {
	    $file = retrieve_module( $file );
	}
	fatal( "file $file not found" ) unless( -f $file );
    }
    my $sig = new CheckSig( $file );
    my $md5 = $sig->md5ok();
    my $gpg = $sig->gpgok();
    ((defined $md5) && ! $md5) && fatal( "invalid MD5 checksum ($file)" );
    ((defined $gpg) && ! $gpg) && fatal( "invalid GPG signature ($file)" );
    unless( ($md5 && $gpg) || $ignore_sigs ) {
	if( $quiet ) {
	    $md5 || fatal( "cannot verify MD5 checksum" );
	    $gpg || fatal( "cannot verify GPG signature" );
	}
	else {
	    $md5 || print "cannot verify MD5 checksum\n";
	    $gpg || print "cannot verify GPG checksum\n";
	    $| = 1;
	    print "Install $file, anyway (y/n) ";
	    my $answer = <STDIN>;
	    ( $answer =~ /^y/i ) || fatal( "installation aborted" );
	}
    }

    my $module = $file;
    $module =~ s/\.mod$//;
    $module =~ s#.*/##;
    my $moduledir = "$tmpdir/$module";
    (Tar::untar( $file, $tmpdir ) && (-d $moduledir)) || fatal( "invalid module file - cannot unpack $file" );

    lock_mod();
    my $info = read_moduleinfo( "$moduledir/module.info" );
    unless( $info && ($info->{"module"} eq "$module") ) {
	fatal( "the module seems to be invalid (missing or invalid module.info file)" );
    }
    my @depends = split( /[\s\t]+/, $info->{"depends"} );
    my $installed = installed_modules();
    foreach my $depend (@depends) {
	my $name = $depend;
	my $version = 0;
	if( $name =~ /\((.*)\)$/ ) {
	   $version = $1;
	   $name = $`;
	}
	unless( grep( ($_->{"module"} eq $name) && (($version <= $info->{"version"}) || ! $version), @$installed ) ) {
	    print STDERR "module $name, version >= $version, is needed by $module\n" if( $force );
	    fatal( "module $name, version >= $version, is needed by $module" ) unless( $force );
	}
    }

    my $filelist = filelist();
    my $dirlist = dirlist( $moduledir );
    my @targetlist = ();
    my @conflicts = ();
    foreach my $file (@$dirlist) {
	my $target;
        ( $file eq "tests.cfg" ) && ($target = "$BigSister::common::fs{'etc'}/testdef/$module.cfg");
        ( $file eq "bsmon.cfg" ) && ($target = "$BigSister::common::fs{'etc'}/mondef/$module.cfg");
        ( $file eq "graphtemplates" ) && ($target = "$BigSister::common::fs{'etc'}/graphdef/$module.cfg");
	( $file =~ /^Requester\// ) && ($target = "$BigSister::common::fs{'uxmon'}/$file");
	( $file =~ /^(Reader|Monitor|Statusmon)\// ) && ($target = "$BigSister::common::fs{'bin'}/$file");
	( $file =~ /^(bin|etc|adm)\/(.*)$/ ) && ($target = qq(BigSister::common::fs{"$1"}/$2));
	( $file eq "README" ) && ($target = "$BigSister::common::fs{'etc'}/moduleinfo/$module.readme");
	( $file eq "README.html" ) && ($target = "$BigSister::common::fs{'etc'}/moduleinfo/$module.html");
	next unless $target;
	push( @targetlist, [ $file, $target ] );
	if( -f $target ) {
	    my $mod = $filelist->{$target};
	    if( $mod ne $module ) {
		push( @conflicts, [ $target, $mod ] );
	    }
	}
    }
    if( @conflicts ) {
	print STDERR "\nthe following files conflict with already installed files:\n";
	foreach my $conflict (@conflicts) {
	    print "  ".($conflict->[0])." ".(($conflict->[1])?("(".$conflict->[1].")"):"")."\n";
	}
	unless( $quiet ) {
	    $| = 1;
	    print "\nInstall anyway? (y/n) ";
	    my $answer = <STDIN>;
	    fatal( "installation aborted" ) unless( $answer =~ /^y/i );
	}
    }

    foreach my $target (@targetlist) {
	my $source = $target->[0];
	my $destination = $target->[1];
	$filelist->{$destination} = $module;
	copy( $source, "$moduledir/$source", $destination );
    }

    write_filelist( $filelist );

    copy( "module.info", "$moduledir/module.info", "$BigSister::common::fs{'etc'}/moduleinfo/$module.info" );

    print "module $module installed successfully\n" unless( $quiet );
}



sub copy {
    my( $name, $source, $destination ) = @_;
    push( @tmp, "$destination.$$" );
    open( IN, "<$source" ) || fatal( "failed to copy $name: $!" );
    binmode IN;
    open( OUT, ">$destination.$$" ) || fatal( "failed to create $destination: $!" );
    binmode OUT;
    print OUT <IN>;
    (close( IN ) && close( OUT )) || fatal( "error while copying $name: $!" );
    my $dir = $destination;
    $dir =~ s#/[^/]+$##;
    my $dirstat = stat( $dir );
    $dirstat || fatal( "cannot stat directory $dir" );
    chown( $dirstat->uid, $dirstat->gid, "$destination.$$" );
    my $filestat = stat( $source );
    $filestat || fatal( "cannot stat file $name" );
    chmod( $filestat->mode, "$destination.$$" );
    rename( "$destination.$$", "$destination" ) || fatal( "failed to replace $destination" );
}



sub dirlist {
    my( $dir, $prefix, $depth ) = @_;

    ($depth = 1) unless( $depth );
    return() if( $depth > 10 );
    opendir( DIR, "$dir" ) || return();
    my @list = readdir( DIR );
    close DIR;
    my @result = ();
    foreach my $file (@list) {
	next if( $file =~ /^\.*$/ );
	next if( $file eq "CVS" );
	if( (-d "$dir/$file") && ! -l "$dir/$file" ) {
	    push( @result, @{dirlist( "$dir/$file", $prefix?"$prefix/$file":$file, $depth + 1 )} );
	}
	else {
	    push( @result, $prefix?"$prefix/$file":$file );
	}
    }
    return( \@result );
}

	    

sub filelist {
    my $file = "$BigSister::common::fs{'etc'}/moduleinfo/files";
    ( -f $file ) || return();
    my %list;
    open( LIST, "<$file" ) || fatal( "cannot read installed files list" ); 
    while( <LIST> ) {
	chomp;
	/^(.*)[\s\t]+(.*)$/ || next;
	$list{$1} = $2;
    }
    close LIST;
    return \%list;
}



sub write_filelist {
    my( $list ) = @_;

    my $file = "$BigSister::common::fs{'etc'}/moduleinfo/files";
    push( @tmp, "$file.$$" );
    open( OUT, ">$file.$$" ) || fatal( "cannot write file list: $!" );
    while( my( $file, $module ) = each %$list ) {
	print OUT "$file\t$module\n" || fatal( "file list write failure: $!" );
    }
    close( OUT ) || fatal( "file list write failure: $!" );
    my $stat = stat( $file );
    if( $stat ) {
	chown( $stat->uid, $stat->gid, "$file.$$" );
	chmod( $stat->mode, "$file.$$" );
    }
    else {
	my $dir = $file;
	$dir =~ s#/([^/]+)$##;
	if( $stat = stat( $dir ) ) {
	    chown( $stat->uid, $stat->gid, "$file.$$" );
	}
    }
    rename( "$file.$$", $file ) || fatal( "cannot replace file list: $!" );
}



sub retrieve_module {
    my( $module ) = @_;

    my $file = "$tmpdir/$module";
    my $url = "http://software.graeff.com/bigsis-modules";
    print "trying to retrieve $module from $url ...\n" unless( $quiet );
    unless( HTTPDownload::download( "$url/$module", $file ) ) {
	fatal( "module not found" );
    }
    unless( HTTPDownload::download( "$url/$module.md5", "$file.md5" ) ) {
	print STDERR "WARNING: cannot retrieve MD5 checksum\n" unless( $quiet );
    }
    unless( HTTPDownload::download( "$url/$module.sig", "$file.sig" ) ) {
	print STDERR "WARNING: cannot retrieve GPG signature\n" unless( $quiet );
    }
    return $file;
}




sub read_moduleinfo {
    my( $file ) = @_;

    open( IN, "<$file" ) || return undef;
    my $info = {};
    while( <IN> ) {
	if( /^(.*?)[\s\t]*=[\s\t]*(.*)/ ) {
	    $info->{$1} = $2;
	}
    }
    close IN;
    return $info;
}



sub lock_mod {
    my $lock = "$BigSister::common::fs{'var'}/module.lock";
    my $locktmp = "$lock.$$";
    push( @tmp, $locktmp );
    my $timeout = time + 5;
    eval {
	while( 1 ) {
	    if( open( LOCK, "<$lock" ) ) {
		my $info = <LOCK>;
		close LOCK;
		chomp $info;
		$info =~ /^(.*) (.*)/;
		last if( ($1 == $$) && (time - $2 < 240) );
		if( time - $2 < 240 ) {
		    die "someone else is currently manipulating modules" if( time > $timeout );
		    sleep 1;
		    next;
		}
	    }
	    open( LOCK, ">$locktmp" ) || die "unable to lock: $!: $locktmp";
	    print LOCK "$$ ".time."\n" || die "I/O error: $!";
	    close LOCK || die "I/O error: $!";
	    rename( $locktmp, $lock ) || die "I/O error: $!";
	    sleep 1;
	}
    };
    if( $@ ) {
	print STDERR "unable to lock modules: $@\n";
	exit(1);
    }
    push( @tmp, $lock );
}




sub tree_remove {
    my( $dir, $depth ) = @_;
    
    ($depth = 1) unless( $depth );
    return if( $depth > 10 );
    opendir( DIR, $dir ) || return;
    my @files = readdir( DIR );
    closedir( DIR );
    foreach my $file (@files) {
	next if( $file =~ /^\.*$/ );
	if( (-d "$dir/$file") && ! -l "$dir/$file" ) {
	    tree_remove( "$dir/$file", $depth+1 );
	    rmdir( "$dir/$file" );
	}
	else {
	    unlink( "$dir/$file" );
	}
    }
}



END {
    if( $$ == $pid ) {
	if( $tmpdir ) {
	    tree_remove( $tmpdir );
	}
	my $retries = 5;
	while( @tmp && $retries ) {
	    for( my $i=$#tmp; $i>=0; $i-- ) {
		my $file = $tmp[$i];
		unlink( $file );
		( -d $file ) && rmdir( $file );
		( -e $file ) || splice( @tmp, $i, 1 );
	    }
	    $retries--;
	}
    };
}
