#!/usr/bin/perl

use 5.010;
use Getopt::Std;
use strict;
use warnings;
use File::Temp qw(tempfile tmpnam);
use Sys::Hostname qw(hostname);
use File::ShLock;
use List::Util qw(max);

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;
}

if (defined $opt_B) {
   warn "Die Option -B wird nicht mehr unterstützt (musste im Rahmen von\n"
      . "https://jira.office.noris.de/browse/NNIS-676 ausgebaut werden)\n" ;
}

my $debug    = $opt_n;
my $appendkey= $opt_a;
my $context  = $opt_C // 3;
my $faktor   = defined($opt_c) ? $opt_c : 10;
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 $diff = tmpnam();
my ( $errh, $errf ) = tempfile();
my $datei = $ARGV[0];
my @datei_stat = stat($datei);

# Kann hier nicht tempfile() nehmen, weil die Temp-Datei dann häufig
# in einer anderen Partition liegt als $datei, und damit ein rename()
# nicht klappen wird
my $newf = "$datei.$$";

my $lockf;

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

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;
    my $MSG;
    if ($mailfail && !$debug) {
        open $MSG, "|/usr/sbin/sendmail -f $sender $mailfail"
    }
    else {
        $MSG = \*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 ) {
        print $MSG <<END;

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

Diff wird nicht ausgegeben!
Wenn du das doch noch willst, musst du die Option '-p' angeben!
_
        }
    }
    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;

my $read_fh;
if ( $gen ) {
    my $pid = open my $pipe, '-|';
    if ( !defined $pid ) {
        die "Cannot fork: $!";
    }
    elsif ( $pid == 0 ) {
        open STDERR, '>>', $errf;
        exec $gen;
        die "Kein Generator '$gen': $!";
    }
    else {
        $read_fh = $pipe;
    }
}
else {
    $read_fh = \*STDIN;
}

open my $newh, '>', $newf
or die "Cannot open '$newf' for writing: $!";
while (my $line = <$read_fh>) {
    print $newh $line
        or die "Cannot write $newf: $!";
}
close $read_fh;
close $newh
    or die "Cannot write $newf: $!";

my $has_diff = 0;
system('touch', $datei) unless -e $datei;

my $command = "diff -U$context '$newf' '$datei' > $diff";
system $command;
if ($? == -1) {
    do_error(qq[Kann "$command" nicht ausführen: $!])
}
elsif ($? & 127) {
    do_error(sprintf '"%s" ist mit Signal %d gestorben', $command, $? & 127);
}
elsif ($?) {
    $has_diff = 1;
}

if ( ! $has_diff ) {
    print STDERR "Keine Unterschiede.\n" if -t STDERR;
    undef $lock;
    exit 0;
}

open my $difh, '<', $diff
    or die "Kann Diff-Tempfile $diff nicht lesen: $!";

while (<$difh>) {
    next if $. == 1 || $. == 2;
    if (/^\+/) {
        $lnew++;
        $snew += length($_) - 1;
    }
    elsif (/^-/) {
        $lold++;
        $sold += length($_) - 1;
    }
}
close $difh;

$ssame = (-s $datei) - $sold;
$lsame = count_lines($datei)- $lold;

do_error( "Die neue $datei ist nur "
      . ( -s $newf )
      . "\nstatt min. $groesse Bytes lang" )
  if -s $newf < $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 $faktor != 0 && $lfakt < $faktor;
    do_error("Zu viele Unterschiede zu $datei ($sfakt: $ssame -$sold +$snew)",1)
        if $faktor != 0 && $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( $newf, $datei )
  or do_error("Umbenennen der neuen $datei schlug fehl: $!");

if ( $backup ne "" and $done ne "" ) {
    my $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: $!\n";

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

sub count_lines {
    my $filename = shift;
    # aus perlfaq5
    my $lines = 0;
    my $buffer;
    open my $fh , '<:raw', $filename or die "Can't open $filename: $!";
    while( sysread $fh, $buffer, 4096 ) {
        $lines += ( $buffer =~ tr/\n// );
    }
    close $fh;
    return $lines;
}

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) ]
       [ -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<-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

# vim: expandtab
