#!/usr/bin/perl

use Getopt::Std;
use File::Basename;
use Errno qw(ESRCH ENOENT);
use Algorithm::Diff::Cheap;
use strict;
use warnings;
use File::Temp qw(tempfile);
use Sys::Hostname qw(hostname);
use File::ShLock;

sub usage() {
    exec(perldoc => -F  => $0)
        or die "Cannot exec 'perldoc -F $0': $!";
}

our($opt_a, $opt_b, $opt_B, $opt_c, $opt_C, $opt_d, $opt_D, $opt_f, $opt_F, $opt_g, $opt_h,
    $opt_l, $opt_L, $opt_m, $opt_M, $opt_n, $opt_N, $opt_p, $opt_S, $opt_s, $opt_v, $opt_k);
BEGIN {
    &getopts("a:b:B:c:C:d:D:f:F:g:hl:Lm:M:nN:pS:s:vk:");

    usage if $opt_h or @ARGV != 1;
}

my $debug    = $opt_n;
my $appendkey= $opt_a;
my $context  = defined($opt_C) ? $opt_C : 3;
my $faktor   = defined($opt_c) ? $opt_c : 10;
my $block    = defined($opt_B) ? $opt_B : 1;
my $groesse  = defined($opt_s) ? $opt_s : 30;
my $mailfail = defined($opt_m) ? $opt_m : $debug ? "" : "autoupdate-failed\@noris.net";
my $maildone = defined($opt_M) ? $opt_M : $debug ? "" : "autoupdate\@noris.net";
my $printdiff = defined($opt_p) ? $opt_p : 0;
my $sender   = $opt_f || "root\@noris.net";
my $sendname = $opt_F || "Auto-Update";
my $gen      = $opt_g || "";
my $done     = $opt_d || "";
my $lock     = $opt_l || "";
my $errlock  = $opt_L;
my $backup   = $opt_b || "";
my $subject  = $opt_S || "";
my $verbose  = $opt_v;
my $keep_stat= defined($opt_k) ? $opt_k : 1;
my $notiz    = $opt_N ? "Notiz: $opt_N\n\n" : '';

$appendkey = 'changed-file ' . hostname() unless defined $appendkey;
$appendkey = undef if defined $appendkey && !length($appendkey);
my $AppendKeyHeader = defined $appendkey ? "X-noris-Ticket-AppendKey: $appendkey\n" : '';

$|=1 if $opt_v;

if ($opt_D) {
    chdir $opt_D or die "$0: chdir '$opt_D' $!\n";
}

my($errh,$errf) = tempfile();
my($difh,$diff) = tempfile();
my $datei = $ARGV[0];
my @datei_stat = stat($datei);
my $tmpf  = "$datei.$$";
my $lockf;

END {
    unlink $tmpf;
    unlink $errf;
    unlink $diff;
}

my $pid = 0;

sub do_error($;$) {
    my ($msg,$ret) = @_;
	$ret=2 unless defined $ret;

    my $hostname = qx/hostname -f/;
    chomp $hostname;

    print STDERR "Fehler: $msg.\n" if -t STDERR and not $debug;
    open( MSG,
        ($mailfail && !$debug) ? "|/usr/sbin/sendmail -f $sender $mailfail" : ">&STDERR" );
    my $subj =
      ( $subject ne "" ) ? "Fehler: $subject" : "Fehler beim Updaten von $datei";
    print MSG <<END unless $debug;
From: $sendname <$sender>
Subject: $subj
To: $mailfail
X-noris-CI-IP: $hostname
Content-type: text/plain; charset=UTF-8
$AppendKeyHeader
${notiz}Beim Updaten von $datei ist ein Fehler aufgetreten:
END
	print MSG "$msg\n";
    if ( -s $errf ) {
		seek($errh,0,0);
        print MSG <<END;

Problem:
END
        while (<$errh>) {
            print MSG;
        }
        close($errh);
    }
    if ( -s $diff ) {
		seek($difh,0,0);
        print MSG <<END;

Diff:
END
        if ($printdiff) {
            while (<$difh>) {
                s/([^\0-\177])/sprintf '\\x%02X', ord $1/eg;
                print MSG;
            }
        }
        else {
            print MSG <<_;

Diff wird nicht ausgegeben!
Wenn du das doch noch willst, musst du die Option '-p' angeben!
_
        }
        close($difh);
    }
    close MSG;
    undef $lock;
    exit $ret;
}

if ( $lock ne "" ) {
    $lock = new File::ShLock($lock);
    unless ( ref $lock ) {
        do_error($lock) if $errlock;
        exit $lock;
    }
}

if ( $backup ne "" and -f "$datei.$backup" ) {
    unlink("$datei.$backup")
      or do_error "Konnte alte Backupdatei '$datei.$backup' nicht entfernen: $!";
}

# Drei Fälle:
# 1- lese von Programm
# 2- lese von STDIN o.ä.
# 3- lese von Datei (d.h STDIN ist seek-bar)
# 4- lese von neuer Datei, geschrieben bei -1- bis -3-

my ($ssame,$sold,$snew) = (0,0,0); # file length
my ($lsame,$lold,$lnew) = (0,0,0); # file lines
my ($iold,$inew) = (0,0);
my $chg = 0;
my %chg;

sub rep() {
	return unless $verbose;
	return if $chg++%100;
	my $lin = "\r";
	while(my($a,$b)=each %chg) {
		$lin .= " $a $b";
	}
	$lin .= " < $iold > $inew";
	print $lin;
}

my $incase;
sub setup_fd {
	my $fd1 = undef;
	my $fd2 = undef;
	if(not defined $incase) {
		if($gen ne "") {
		    $incase = 1;
		} else {
			$! = 0;
			seek(STDIN,0,0);
			$incase = ($! ? 2 : 3);
		}
	}
	if($incase == 1) {
	    $pid = open( $fd1, "-|" );
	    if ( !defined $pid ) {
			die "Cannot fork: $!\n";
			undef $lock;
			exit 1;
	    }
	    elsif ( $pid == 0 ) {
			open( STDERR, ">>$errf" );
			exec($gen);
			die "Kein Generator '$gen': $!\n";
	    }
	} elsif($incase == 2) {
        open( $fd1, "<&STDIN" );
	} elsif($incase == 3) {
        open( $fd1, "<&STDIN" );
		seek( $fd1,0,0 );
	} elsif($incase == 4) {
        open( $fd1, "<", $tmpf );
		seek( $fd1,0,0 );
	}
	my($rd1,$rd2);
	if($incase < 4) {
		$incase = 4;
		my $newf;
		open($newf, ">",$tmpf)
		  or do_error("Konnte $tmpf nicht öffnen: $!");
		if ($keep_stat && @datei_stat) {
			chmod( $datei_stat[2], $tmpf );
			chown( $datei_stat[4], $datei_stat[5], $tmpf );
		}
		$rd1 = sub {
			$inew++; rep();
			my $r = <$fd1>;
			if(defined $r and $r ne "") {
				print $newf $r;
			} else {
				close($newf)
				  or do_error("Konnte $tmpf nicht schließen: $!");
				close($fd1)
				  or do_error("'$gen' ($datei) hat einen Fehler gemeldet? $?");
			}
			$r;
		};
	} else {
		$rd1 = sub {
			$inew++; rep();
			scalar <$fd1>;
		};
	}

	if(open( $fd2, "$datei" )) {
		$rd2 = sub {
			$iold++; rep();
			scalar <$fd2>;
		};
	} else {
		$rd2 = undef;
	}
	($rd1,$rd2);
}

my($r1,$r2) = setup_fd();
if(not defined $r2) {
	# Datei gibbet nich. Trotzdem lesen, weil stdin kopiert werden muss.
	while(defined (my $s = &$r1())) {
		$snew += length($s);
		$lnew ++;
	}
} else {
	my $di = Algorithm::Diff::Cheap->new($r2,$r1, Blocksize=>$block);
	my @context;
	my $did_context = undef;
	open(DIFF, ">$diff" );

	while(my($k,$s) = $di->Next()) {
		$chg{$k}++;
		rep();
		if($k ne " ") {
			print DIFF "@@@ -".(1+$lsame+$lold)." +".(1+$lsame+$lnew)."\n" unless defined $did_context;
			print DIFF " ",join(" ",@context) if @context;
			print DIFF "$k$s";
			$did_context = 0;
			@context = ();
		} elsif(not defined $did_context) {
			# Remember the last few lines before the next chunk
			shift @context if @context >= $context;
			push(@context, $s);
		} elsif(@context < $context) {
			# Remember lines after the current chunk
			push(@context, $s);
		} else {
			# Print the lines after the current chunk
			print DIFF " ",join(" ",@context) if @context;
			@context = ();
			$did_context = undef;
		}
		if($k eq " ") {
			$ssame += length($s);
			$lsame ++;
		} elsif($k eq "-") {
			$sold += length($s);
			$lold ++;
		} elsif($k eq "+") {
			$snew += length($s);
			$lnew ++;
		} else {
			# ???
		}
	}
	close(DIFF) or do_error("Schreiben des diff schlug fehl: $!");
}
print "\r" if $verbose;

if ($snew+$ssame != -s $tmpf) {
	system("cat $tmpf");
    do_error("Die Datei $tmpf ist ".(-s $tmpf)." Bytes lang,\n"
		. "obwohl ".($ssame+$snew)." geschrieben wurden!");
}

if ( not $lold and not $lnew  and @datei_stat) {
    print STDERR "Keine Unterschiede.\n" if -t STDERR;
    undef $lock;
    exit 0;
}

do_error( "Die neue $datei ist nur "
      . ( -s $tmpf )
      . "\nstatt min. $groesse Bytes lang" )
  if -s $tmpf < $groesse;

my($lfakt,$sfakt);
$lfakt = ($lsame+1)/($lold/2+$lnew/2+1);
$sfakt = ($ssame+1)/($sold/2+$snew/2+1);

if( -f $datei ) {
	do_error("Zu viele Unterschiede zu $datei ($lfakt: $lsame -$lold +$lnew)",1)
		if $lfakt < $faktor;
	do_error("Zu viele Unterschiede zu $datei ($sfakt: $ssame -$sold +$snew)",1)
		if $sfakt < $faktor;
	do_error("Update OK ($lfakt: $lsame -$lold +$lnew / $sfakt: $ssame -$sold +$snew)",0) if $debug;
} else {
    open( ERR, ">$diff" );
    print ERR "*** $datei wurde neu angelegt ($lnew / $snew).\n";
    close ERR;
    print STDERR "Neu angelegt ($lnew / $snew).\n" if -t STDERR;
}

if ( $backup ne "" ) {
    link( $datei, "$datei.$backup" )
      or do_error("Link auf Backup $datei.$backup schlug fehl: $!");
}
rename( $tmpf, $datei )
  or do_error("Umbenennen der neuen $datei schlug fehl: $!");

if ( $backup ne "" and $done ne "" ) {
    $pid = fork();
    if ( !defined $pid ) {
        die "Cannot fork: $!\n";
        undef $lock;
        exit 1;
    }
    elsif ( $pid == 0 ) {
        open( STDERR, ">>$errf" );
        exec($done);
        die "Keine Completor '$done': $!\n";
    }
    wait;
    if ( $? or -s $errf ) {
        rename( "$datei.$backup", $datei )
          or do_error("Entfernen der neuen Datei nach Fehler schlug fehl: $!");
        do_error("Fehler ($?) in '$done'");
    }
}

if ( $maildone ne "" ) {
    open( MSG, "|/usr/sbin/sendmail -f $sender $maildone" );
    my $subj = ( $subject ne "" ) ? $subject : "Update: $datei";
    my $hostname = qx/hostname -f/;
    chomp $hostname;
    print MSG <<END;
From: $sendname <$sender>
Subject: $subj
To: $maildone
X-noris-CI-IP: $hostname
Content-type: text/plain; charset=UTF-8
$AppendKeyHeader
${notiz}Der Update von $datei war erfolgreich.
END
    if ( open( CHG, $diff ) ) {
        print MSG <<END;

Änderungen:
END
        while (<CHG>) {
            s/([^\0-\177])/sprintf '\\x%02X', ord $1/eg;
            print MSG $_;
        }
        close CHG;
    }
    close MSG;
}
print STDERR "Update erfolgreich ($lsame -$lold +$lnew / $ssame -$sold +$snew).\n" if -t STDERR;

unlink $diff or die "Could not unlink diff: $!\n";
unlink $errf or die "Could not unlink errf: $1\n";

if ( $done ne "" and $backup eq "" ) {
    exec($done) or
    do_error "Update von $datei: Konnte '$done' nicht starten: $!";
}

undef $lock;
exit 0;

__END__
=encoding UTF-8

=head1 Name

changed-file -- generiert eine Datei neu

=head1 Zusammenfassung

	changed-file
       [ -b BAK (Extension für die alte Dateiversion; Default: löschen) ]
       [ -B # (Blockgröße bei mehrzeiligem Input; Default: 1) ]
       [ -c # (Bruchteil der Datei, der sich geändert haben darf) ]
       [ -C # (Kontextgröße im diff-Output; Default: 3) ]
       [ -d WHAT (Programm, gestartet nachdem alles OK; Default: nix) ]
       [ -D dir (wechsle in dieses Verzeichnis) ]
       [ -f BLA (Absender der Mail, Mailadresse) ]
       [ -F BLA (Absender der Mail, Fullname) ]
       [ -g WHAT (Generatorprogramm; Default: Lesen von stdin) ]
       [ -l Name (Name der Lockdatei in /var/lock; Default: kein Lock) ]
       [ -L (Fehlermeldung, wenn das Lock existiert; Default: tue nichts) ]
       [ -m BLA (Mail an diese Adresse, wenn Probleme) ]
       [ -M BLA (Mail an diese Adresse, wenn OK) ]
       [ -n (tue nichts) ]
       [ -N NOTIZ ]
       [ -p (schicke Diff mit) ]
       [ -s # (minimale Dateigröße (Input neue Datei)) ]
       [ -S BLA (Subject der Mails) ]
       [ -k (User, Gruppe und Rechte behalten) ]
       [ -a BLA (AppendKey-Header; mit '' deaktivieren; Default: changed-file HOSTNAME) ]
       Datei

=head1 Beschreibung

Dieses Programm generiert eine Datei neu. Dabei werden Fehler im
generierenden Programm berücksichtigt, eine maximale Anzahl
von Änderungen festgeschrieben, und optional eine Mail versendet.

=head2 Optionen

=over 4

=item C<-b Extension>

Die alte Version der Datei wird unter dieser Extension aufgehoben.

Default: Kein Aufheben.

=item C<-B Blockgröße>

Der neue platzsparende diff-Algorithmus schlägt bei der ersten
Übereinstimmung zu, anstatt die kleinstmögliche Änderung zu suchen.
Das ist ungünstig für Dateien, die Begrenzungszeilen
(geschweifte Klammer o.ä.) enthalten. Mit dieser Option kann man angeben,
wieviele Zeilen als Einheit betrachtet werden sollen.

Default: 1 (keine Bockung).

=item C<-c Anteil>

Anteil der Datei, der sich ändern darf. Genauer: Anzahl der
Änderungen in Relation zur originalen Dateilänge. Neue Einträge
werden hierbei nur zur Hälfte berücksichtigt.

Bei Angabe von 0 sind alle Änderungen zulässig.

Default: 10.

=item C<-C Kontext>

Anteil der Zeilen vor und nach jeder Änderung, die mit ausgegeben werden
sollen.

Default: 3.

=item C<-d Programm>

Dieses Programm wird nach einem erfolgreichen Update ausgeführt.

Ist die Option C<-b> ebenfalls angegeben, führen Fehler in diesem 
Programm dazu, daß die alte Datei restauriert wird. Ansonsten wird
dieses Programm direkt ausgeführt und Exitstatus+stderr werden B<nicht>
berücksichtigt.

=item C<-D Verzeichnis>

Wechsle als allererstes in dieses Verzeichnis.

=item C<-f Adresse>

Absender der Mail.

Default: C<root@noris.net>.

=item C<-F Fullname>

Fullname des Absenders.

Default: C<Autoupdate>.

=item C<-g Programm>

Das die Datei generierende Programm.

Eine Fehlermeldung wird erzeugt, wenn das Programm einen Exitstatus != 0
liefert oder auf stderr schreibt.

Default: Lesen von I<stdin>.

B<Vorsicht>: Wenn von I<stdin> gelesen wird, können Fehler im
Generatorprogramm nicht berücksichtigt werden.

=item C<-h>

Kurzhilfe.

=item C<-k>

Übernehme User, Gruppe und Dateirechte von der Originaldatei

=item C<-l Name>

Eine Lockdatei, die gegen mehrfaches Generieren derselben Datei
schützt, wird in C</var/lock> angelegt.

=item C<-L>

Wenn das Lock existiert, wird eine Fehlermeldung gemailt.

Default: C<changed-file> wird ohne Fehler beendet.

=item C<-m Adresse>

Zieladresse für Mails, die einen Fehler bei der Generierung der Datei anzeigen.

Default: C<autoupdate-failed@noris.net>.

=item C<-M Adresse>

Zieladresse für Mails, die eine erfolgreiche Generierung der Datei anzeigen.

Default: C<autoupdate@noris.net>.

=item C<-n>

Tue nichts; es wird keine Mail generiert und die Zieldatei wird nicht
verändert.

=item C<-N Notiz>

Gibt die Notiz im Body der verschickten Mails mit aus.
Sinnvoll, um einfacher den entsprechenden cron-job ausfindig zu machen.

=item C<-p>

Gibt das Diff zwischen alter und neuer Datei mit in die E-Mail.
Dabei werden nicht-ASCII-Zeichen escaped, z.B. als C<\xC3>, da
C<changed-file> nicht wissen kann, in welcher Zeichenkodierung
die Daten vorliegen.

=item C<-s Bytes>

Minimale Größe der neu angelegten Datei in Bytes. Default: 30.

=item C<-S Subject>

Subject der gesendeten Mail.

=item C<-a BLA>

X-noris-Ticket-AppendKey Header der gesendeten E-Mail.

Wenn ein alternativer Wert im Header gewünscht ist, dann kann dieser mit der
o.g. Option angepasst werden. Sollte kein Header gewünscht sein, muss die
C<-a> Option mit leerem String angegeben werden.

Default: C<changed-file $hostname>

=item C<Datei> ...

Die zu ersetzende Datei.

=back

=cut

