#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;

BEGIN {
        unshift(@INC,($ENV{'POPHOME'}||'@POPHOME@').'/lib')
			unless $ENV{'KUNDE_NO_PERLPATH'};
      }

select(STDERR); $|=1; select(STDOUT);

use Cf qw($LOGDIR);
use Symbol;
use File::Basename qw(basename dirname);
use File::Path qw(mkpath);
use Compress::Zlib;
use Dbase::Globals qw(get_kunde get_person find_descr);
use Dbase::Help qw(unixtime Do DoFn DoTrans DoTransFail);
use Acct;
use IO::Pipe;
use MIME::Base64;

sub Usage() {
    die <<END;
Usage: $0 -- accountet Daten in $LOGDIR/incoming
          -o KEY  nur Dateien mit KEY accounten
          -s HOST nur Dateien von diesem Host accounten
          -k DIR  accountete Logs in dieses Verzeichnis (bzw.
                  Unterverzeichnis YYYY-MM-DD) verschieben
          -z      Dateien dabei mit gzip komprimieren,
                  sofern sie das noch nicht sind
          -j      wie oben, jedoch Kompression mit bzip2
          -v      aktuelle Aktion mitschreiben
          -q      nicht erkannte Dateien nicht anzeigen
          -t      Test: quelle=test, Logging in \$LOGDIR/test
          -r      Re-Feed: Dateinamen auf $ARGV; -o BLA setzen!

Accountingskript, füttert Accountingdaten in Datenbank und Logdateien.
END
  exit 1;
}

use Getopt::Std;
use vars qw( $opt_h $opt_j $opt_k $opt_o $opt_q $opt_r $opt_s $opt_t $opt_v $opt_z );
getopts('hjk:o:qr:s:tvz') or Usage;
die "Die Optionen -j und -z schließen sich aus.\n" if $opt_j && $opt_z;
Usage if $opt_h;
Usage if $opt_r ? not @ARGV : @ARGV;
my %opt;
my $limited = defined($opt_o)+defined($opt_s);
if($opt_o) {
	foreach my $o(split(/,/,$opt_o)) {
		if($o =~ /(.+)=(.+)/) {
			$opt{$1} = $2;
		} else {
			$opt{$o} = $opt_r ? 1 : undef;
		}
	}
}
if($opt_r) {
    if($opt{'timestamp'} =~ /-/) {
	$opt{'timestamp'} = unixtime($opt{'timestamp'});
    }
}

## CODE ##

if($opt_t) {
	my $log = $LOGDIR;
	$log .= "/test";
	$ENV{'LOGDIR'} = $log;
	# ja, das geht so -- die Cf::*-Variablen sind read-only
}
chdir $LOGDIR unless $opt_r;

my $min_ts;
sub sel($$;@);
sub sel($$;@) {
	my($file,$level,%attr) = @_;
	$level++;
	my $base = basename($file);
	if(-f $file) {
		return unless -s _;
		my $fbase = basename(dirname($file));
		delete $attr{$fbase};
		if($base =~ /^(\d+)(?:\.(gz|bz2))?$/) {
			if(defined $2) {
				$attr{'gzip'} = 1 if $2 eq "gz";
				$attr{'bzip2'} = 1 if $2 eq "bz2";
			}

			$min_ts = $1 if not defined $min_ts or $min_ts > $1;
			$attr{'filename'} = $file;
			$attr{'timestamp'} = $1;
			$attr{'file'} = $fbase;
			return { %attr };
		}
	} elsif(-d $file) {
		$0="acct scan $file";
		my $fh = new IO::Handle;
		my $fn;
		my @res;
		opendir($fh,$file) or return ();
		if($base =~ /(.+?)_(.+)/) {
			$attr{$1}=$2;
		} elsif($base =~ /(.+?)_$/) {
			$attr{$1}++;
		} elsif($level == 2) {
			$attr{'host'} = $base;
		} else {
			$attr{$base}++;
		}
		while(defined($fn = readdir $fh)) {
			next if $fn =~ /^\./;
			push @res,sel("$file/$fn",$level,%attr);
		}
		closedir($fh);
		return @res;
	}
	();
}

###

my $reader;
my $file;

sub do_start(@) {
	my(%arg) = @_;
	my $cust;
	if($cust = $file->{'kunde'}) {
		$cust = get_kunde $cust or die "Kunde '$file->{'kunde'}' nicht bekannt\n";
		$arg{'kunde'} = $cust;
	}
	if($file->{'person'}) {
		my $id = get_person($file->{'person'});
		die "Person '$file->{'person'}' nicht bekannt\n" unless $id;
		$id = DoFn("select kunde from person where id=$id");
		die "Person '$file->{'person'}' hat Kunde #$id, nicht '$file->{'kunde'}'\n"
			if defined $cust and $id != $cust;
		$arg{'kunde'} = $id;
	}
	$arg{'timestamp'} = $file->{'timestamp'} unless defined $arg{'timestamp'};
	$arg{'verbose'} = $opt_v;
	if($opt_r) {
		$arg{'do_logging'} = 0;
		$arg{'do_tarife'} = 0;
		$arg{'do_same_customer'} = 0;
		$arg{'redo'} = 1;
	}
	$arg{'quelle'} = $file->{'quelle'} if $file->{'quelle'};
	$arg{'quelle'} = "test" if $opt_t and $arg{'quelle'} !~ /^test/;
#
#	$arg{'zip'}=1 unless exists $arg{'zip'};
#
	Acct->new(%arg);
}

sub get_line($;$) {
	my($acct,$len) = @_;
	my $line;
	while(1) {
		$line = &$reader($len);
		return undef if not defined $line or $line eq "";
		return $line unless $acct->line($line,$len);
	}
}

my @acct;

sub do_end($) {
	my($acct) = @_;
	#$acct->finish();
	$acct->database();
	push(@acct,$acct);

	undef;
}

### Ende Setupkram

sub run($$) {
	my($what);
	($what,$file) = @_;
	my $res;
	print STDERR "EXEC $what\n" if $opt_v;
	DoTrans {
		eval { require "acct/$what"; };
		$res = $@;
		return if $res;
		@acct = ();
		$res = eval { no strict 'refs'; &{"acct_$what"}($file); };
		$res = $@ if $@;
		DoTransFail() if $res;
	};
	return $res if $res;

	# Ab hier sind die Daten in der Datenbank. Damit sind Schreibfehler
	# auf Logdateien etc. kein Abbruchgrund mehr.

	foreach my $ac(@acct) {
		eval {
			$ac->finish();
		};
		if($@) { # Fehler? Sollte nicht passieren!
			print STDERR "Problem: $@: $file->{'filename'}\n";
		} else {
			$ac->{'no_cache'} = 0;
		}
	};
	return $res;
}

my ($err,$err2);
my $fd;
my @file;
if($opt_r) {
    @file = ();
    foreach my $arg(@ARGV) {
    	push(@file,{ logging => 0, %opt, filename => $arg });
    }
} else {
    print STDERR "Scanning...\n" if $opt_v;
    @file = $opt_s ? sel("incoming/$opt_s",1) : sel("incoming",0);

	Do("REPLACE INTO nextid SET name='acct_ts', id=$min_ts")
		if not $limited and defined $min_ts;

    print STDERR "Sorting...\n" if $opt_v; $0="acct sorting ".(0+@file);
    @file = sort {
			    $b->{'timestamp'} <=> $a->{'timestamp'} or
			    $b->{'filename'} cmp $a->{'filename'}
		    } @file;
}

file: while(1) {
	$file = pop @file;
	last unless $file;
	$0="acct ".$file->{'filename'};
	$err=$opt_q?"-":"Datei uebersprungen";
	$err2="";
	$fd = undef;
	my $sz = ($file->{'filename'} eq "-") ? "?" : -s $file->{'filename'};
	unless($opt_r) {
		foreach my $o(keys %opt) {
			my $oo = $o;
			if($o =~ s/^\!//) {
				if(defined $opt{$oo}) {
					next file if defined $file->{$o} and $file->{$o} eq $opt{$oo};
				} else {
					next file if exists $file->{$o};
				}
			} else {
				if(defined $opt{$oo}) {
					next file unless defined $file->{$o} and $file->{$o} eq $opt{$oo};
				} else {
					next file unless exists $file->{$o};
				}
			}
		}
		unless($sz) { ## can happen if busy
			$err = "-";
			next;
		}
	}
	$err="";
	print STDERR "Datei($sz):",join(" ",map {"$_=$file->{$_}"} keys %$file),"\n" if $opt_v;

	$reader = sub {
		if($file->{'filename'} eq "-") {
			$fd = new IO::File "<&STDIN";
		} else {
			$fd = new IO::File $file->{'filename'},"r";
		}
		unless($fd) {
			$err2 = "Cannot open file: $!";
			return;
		}
		if($file->{'mime'}) {
			my $fi = $fd;
			$fd = new IO::Pipe;
			my $pid = fork();
			die "No fork: $!" unless defined $pid;
			if($pid == 0) {
				$0 = "MIME Decode $file->{'filename'}";
				eval {
					$fd->writer;
					while(<$fi>) {
						chop;
						if(/^From /) {
							$/="\n\n"; $_ = <$fi>; $/="\n";
						} else {
							print $fd decode_base64($_);
						}
					}
				};
				exit 0;
			}
			$fi->close;
			$fd->reader;
		}

		if($file->{'gzip'}) {
			my $fd2 = new IO::Pipe;
			my $pid=fork();
			die "no Fork: $!\n" unless defined $pid;
			if($pid == 0) {
				open(STDIN,"<&".$fd->fileno);

				$fd2->writer;
				open(STDOUT,">&".$fd2->fileno);

				{ exec("gzip","-cdq"); }
				# in eigenem Block, um Warnung wegen der folgenden
				# Statements unterdrücken, falls kein gzip

				kill(15,getppid());
				_exit(1);
			}
			$fd2->reader;
			$fd->close; $fd = $fd2; $fd2 = undef;
		} elsif($file->{'bzip'} or $file->{'bzip2'}) {
			my $fd2 = new IO::Pipe;
			my $pid=fork();
			die "no Fork: $!\n" unless defined $pid;
			if($pid == 0) {
				open(STDIN,"<&".$fd->fileno);

				$fd2->writer;
				open(STDOUT,">&".$fd2->fileno);

				{ exec("bzip2","-cd"); }
				# in eigenem Block, um Warnung wegen der folgenden
				# Statements unterdrücken, falls kein bzip2

				kill(15,getppid());
				_exit(1);
			}
			$fd2->reader;
			$fd->close; $fd = $fd2; $fd2 = undef;
		}
		if($opt_r) {
			$reader = sub($) { 
				my($len) = @_;
				my $res;
				if($len) {
					return undef unless read($fd,$res,$len) == $len;
				} else {
					$res = scalar <$fd>;
					$res =~ s/^R // if defined $res;
				}
				$res;
			};
		} else {
			$reader = sub($) {
				my($len) = @_;
				if($len) {
					my $res;
					return undef unless read($fd,$res,$len) == $len;
					$res;
				} else {
					scalar <$fd>
				}
			};
		}
		goto &$reader;
	};

	if ($opt_r) {
		$err=run($opt_r, $file);
		next;
	}
	if ($file->{'file'} eq "ip.multi") {
		$err=run("ip_multi", $file);
		next;
	}
	if ($file->{'file'} eq "router") {
		$err=run("router", $file);
		next;
	}
	if ($file->{'file'} eq "mainlog") {
		$err=run("exim", $file);
		next;
	}
	if ($file->{'file'} eq "brick") {
		$err = run("brick", $file);
		next;
	}
	if (defined $file->{type} and $file->{type} eq 'radius') {
		$err = run radius => $file;
		next;
	}
	if (defined $file->{dienst}) {
		if ($file->{dienst} eq 'sms' ) {
			$err = run(sms=>$file);
			next;
		}
		if ($file->{dienst} eq 'ipass' ) {
			$err = run(ipass=>$file);
			next;
		}
		if (defined $file->{'type'}) {
			if (($file->{'kunde'} or $file->{'person'}) and $file->{'dienst'} eq "www" and $file->{'type'} eq "access") {
				$err = run("www", $file);
				next;
			}
			if($file->{'dienst'} eq "cache" and $file->{'type'} eq "access" and $file->{'file'} eq "squid") {
				$err = run("cache", $file);
				next;
			}
			if($file->{'dienst'} eq "ftp" and $file->{'type'} eq "xfer") {
				$err = run("ftp", $file);
				next;
			}
		}
	}
} continue {
	$fd->close if defined $fd;
	$fd = undef;
	wait if $file->{gzip} || $file->{bzip} || $file->{bzip2}; ## no zombies please

	$err = $err2 if defined $err2 and $err2 ne "";
	if(not defined $err) {
		print STDERR "Done: $file->{'filename'}         \n" if $opt_v;
		if(not defined $opt_r) {
			if ( defined $opt_k ) {
				my $ymd = do {
					my($d,$m,$y) = ( localtime $file->{'timestamp'} )[3,4,5];
					sprintf '%d-%02d-%02d', $y+1900, $m+1, $d;
				};
				( my $dest = $file->{filename} ) =~ s#^incoming/##;
				mkpath( dirname( $dest = "$opt_k/$ymd/$dest" ) );
				rename $file->{filename}, $dest
				  or die "Could not rename $file->{filename} to $dest: $!\n";
				unless ( $file->{gzip} || $file->{bzip} || $file->{bzip2} ) {
					if ($opt_z) {
						local $0 = "gzip $dest";
						system gzip => -9 => $dest;
					}
					elsif ($opt_j) {
						local $0 = "bzip2 $dest";
						system bzip2 => $dest;
					}
				}
			}
			else {
				unlink($file->{filename}) or die "Could not unlink $file->{filename}: $!\n";
			}
		}
	} else {
		# print "Problem mit $file->{'filename'}. ".($err?$err:$!)."\n";
		print STDERR "... busy: ",join(" ",map {"$_=$file->{$_}"} keys %$file),"\n" if $err =~ /^Busy\b/mi and $opt_v;
		redo file if $err eq "-" or $err eq "" and $opt_q or $err =~ /^Busy\b/mi;
		chomp $err;
		print STDERR ($err||"Datentyp nicht bekannt").": ",join(" ",map {"$_=$file->{$_}"} keys %$file),"\n";
	}
}

__END__


=head1 Name

acctrun -- accountet Logdateien

=head1 Zusammenfassung

	acctrun 
          -o KEY  nur Dateien mit KEY accounten
          -s HOST nur Daten dieses Hosts accounten
          -k DIR  accountete Logs in dieses Verzeichnis (bzw.
                  Unterverzeichnis YYYY-MM-DD) verschieben
          -z      Dateien dabei mit gzip komprimieren,
                  sofern sie das noch nicht sind
          -j      wie oben, jedoch Kompression mit bzip2
          -v      aktuelle Aktion mitschreiben
          -q      nicht erkannte Dateien nicht anzeigen
          -t      Testing?
          -r      Re-Feed

=head1 Beschreibung

C<acctrun> liest Logdateien, findet raus was wann woher wohin, und schreibt
die gefundenen Infos sowohl in diverse Logdateien als auch in die Datenbank.

=head2 Optionen

=over 4

=item C<-o KEY>

Accountet nur Daten mit den gegebenen Optionen. 

=item C<-s NAME>

Accountet nur Daten von Host NAME.

=item C<-k DIR>

Verschiebt erfolgreich accountete Log-Dateien in DIR/YYYY-MM-DD/,
anstatt sie zu löschen.

=item C<-z>

Packt noch ungepackte Dateien dabei mit gzip (vgl. RT#250307).

=item C<-j>

Packt noch ungepackte Dateien alternativ mit bzip2 (vgl. RT#250307).

=item C<-v>

Schreibt aktuelle Aktionen mit.

=item C<-q>

Schreibt nicht erkannte Dateien B<nicht> mit.

=item C<-h>

Kurzhilfe.

=back

=head1 Daten

=head1 ToDo

Das Ganze ist noch ein wenig zu unmodular.

=cut

