#!/usr/bin/perl -Tw

use strict;

use Fcntl qw(:DEFAULT :flock);
use FileHandle;
use IPC::Open3;
use POSIX ":sys_wait_h";
use Text::Diff;

$ENV{'PATH'} = '/bin:/usr/bin';

setpriority(0, $$, 20);
#exit(0);

my @mirror_set = (
# [...]
	{
		set => 'debian',
		src => 'ftp.de.debian.org::debian-all',
		dest => '/srv/ftp/pub/linux/debian',
		excl => [map {("binary-$_/", "*_$_*", "installer-$_/", "Contents-$_*")}
			qw(alpha arm hppa hurd-i386 m68k mips mipsel s390)],
		opts => [qw()],
		post => [qq(date -u > /srv/ftp/pub/linux/debian/project/trace/ftp.uni-kl.de)],
	},
# [...]
	{
		set => 'fedora',
		#src => 'fedora.tu-chemnitz.de::fedora-enchilada',
		#src => 'fedora-archives.ibiblio.org::fedora-enchilada',
		#src => 'uniklde@mirrors.nl.eu.kernel.org::t2fedora-enchilada',
		src => 'uniklde@mirrors.se.eu.kernel.org::t2fedora-enchilada',
		pass => '...',
		dest => '/srv/ftp/pub/linux/fedora',
		excl => [qw(/linux/core /linux/development /linux/extras /linux/releases/test /linux/updates/testing)],
		opts => [qw(--hard-links)],
		post => [qq(/home/ftpadm/fedora/report_mirror -c /home/ftpadm/fedora/report_mirror.conf)],
	},
# [...]
	{
		set => 'gentoo',
		src => 'ftp.join.uni-muenster.de::gentoo',
		dest => '/srv/ftp/pub/linux/gentoo',
		excl => [qw(releases/historical/)],
		opts => [qw()],
		post => [qq(date -u > /srv/ftp/pub/linux/gentoo/last-update)],
	},
	{
		set => 'gentoo',
		src => 'ftp.join.uni-muenster.de::gentoo-portage',
		dest => '/srv/ftp/pub/linux/gentoo-portage',
		excl => [qw()],
		opts => [qw()],
		post => [qq(date -u > /srv/ftp/pub/linux/gentoo-portage/last-update)],
	},
# [...]
	{
		set => 'kernel',
		#src => 'ftp.leo.org::Linux/linux/kernel/',
		#src => 'ftp.uni-oldenburg.de::kernel.org/linux/kernel/',
		src => 'rhlx01.fht-esslingen.de::linux-kernel/pub/linux/kernel/',
		dest => '/srv/ftp/pub/linux/kernel',
		excl => [qw(*.gz *.gz.sign)],
		opts => [qw()],
		post => [qq(date -u > /srv/ftp/pub/linux/kernel/last-update)],
	},
# [...]
);

my $script = "/home/ftpadm/mirror-scripte/mirror-master";

my $lock_file_1 = "/home/ftpadm/mirror-scripte/LOCK";
my $lock_file_2 = "/home/ftpadm/mirror-scripte/LOCK:crit";

# Set this to where you want logging to go.
my $log_file = "/home/ftpadm/mirror-scripte/log";
my $out_file = "/home/ftpadm/mirror-scripte/STDOUT";
my $err_file = "/home/ftpadm/mirror-scripte/STDERR";
my $debug_file = "/home/ftpadm/mirror-scripte/debug-log";

# motd cache
my $motd_files = "/home/ftpadm/mirror-scripte/motd";

# Umask for log and lock files
my $umask = 0022;

# hard sync timeout (in seconds)
#my $hard_timeout = 7200; #  2 hours
my $hard_timeout = 72000; # 20 hours

# rsync and common options
my @rsync = (qw(/usr/bin/rsync -rltp -v --hard-links --whole-file
	--delete --delete-excluded --delete-after --ignore-errors
	--delay-updates --numeric-ids
	--max-delete 3000
	), '-f', 'R .~tmp~/');
# --timeout=900

#push @rsync, '-n' if ($DEBUG);

my @sets = map {$_." ".time} @ARGV;

sub mail_notify($$$) {
	my ($mail, $subj, $body) = @_;
	
	open(MAIL, "|/usr/sbin/sendmail ".$mail);
	print MAIL <<EOF;
Subject: FTP $subj

$body
EOF
	close(MAIL);
}

sub admin_notify($$) {
	mail_notify('root', shift, shift);
}

###
### end of config..
###

sub do_rsync($$) {
	my ($mirror, $schedtime) = @_;
	my (@cmd, $cmd, $rv);
	
	if (exists $mirror->{pass}) {
		$ENV{RSYNC_PASSWORD} = $mirror->{pass};
	} else {
		delete $ENV{RSYNC_PASSWORD};
	}
	$mirror->{src} =~ m/^(.*?)::?(.*)$/;
	my ($server, $module) = ($1, $2);
	
	@cmd = (@rsync, ( map {('--exclude', $_)} (@{$mirror->{excl}}) ),
		@{$mirror->{opts}}, $mirror->{src}, $mirror->{dest});
	$cmd = join(" ",@cmd);
	
	my $starttime = time;
	my $pid;
	open(chld_IN, "<", "/dev/null");
	open(chld_OUT, ">", $out_file);
	open(chld_ERR, ">", $err_file);
	$pid = open3("<&chld_IN", ">&chld_OUT", ">&chld_ERR", @cmd);
	close(chld_IN);
	close(chld_OUT);
	close(chld_ERR);
	
	while (time < $starttime + $hard_timeout) {
		$rv = waitpid($pid, WNOHANG);
		last if ($rv > 0);
		sleep(3);
	}
	unless ($rv > 0) {
		kill 15, $pid;
		sleep(3);
		$rv = waitpid($pid, WNOHANG);
	}
	unless ($rv > 0) {
		kill 9, $pid;
		sleep(3);
		$rv = waitpid($pid, WNOHANG);
	}
	$rv = $?;
	
	my $stoptime = time;
	
	open(chld_OUT, "<", $out_file);
	open(chld_ERR, "<", $err_file);
	my $stdout = join('',<chld_OUT>);
	my $stderr = join('',<chld_ERR>);
	close(chld_OUT);
	close(chld_ERR);
	
	my $exit = ( $rv & 0xFF ? 'signal ' . ($rv & 0xFF) : 'status ' . ($rv >> 8));
	my $body = <<EOF;
Rsync command:
$cmd

rsync exited with
$exit

error output:
$stderr

standard output:
$stdout

EOF
	
	# @ERROR: max connections (40) reached - try again later
	if ($stderr =~ m/\@ERROR: max connections \((\d+)\) reached --? try again later/) {
		open(AT, '| at now + 30 minute');
		printf AT "%s %s\n", $script, $mirror->{set};
		close(AT);
		admin_notify("$server full ($1), rescheduled", $body);
		return;
	}
	
	# status 23
	# rsync error: some files could not be transferred (code 23) at main.c(1166)
	($rv, $stderr) = (0, '') if ($rv == (23 << 8));
	
	# status 25
	# rsync error: the --max-delete limit stopped deletions (code 25) at main.c(1166)
	($rv, $stderr) = (0, '') if ($rv == (25 << 8));
	
	system(@{$mirror->{post}}) if ($rv == 0);
	
	if ($rv != 0 || $stderr ne '') {
		admin_notify("rsync from $server failed", $body);
		# try the rest anyway
		#return;
	}
	
	my $motd_file = $motd_files."-".$server;
	if ($stdout =~ m/^(.*?)receiving file list /s) {
		my $motd = $1;
		my $diff = diff((-e $motd_file ? $motd_file : \""), \$motd, { STYLE => "Unified" });
		if (defined($diff) and ($diff ne '')) {
			admin_notify("MOTD update on $server", $diff);
			
			open(MOTD, '>', $motd_file);
			print MOTD $motd;
			close(MOTD);
		}
	}
	
	if ($stdout =~ m{^sent (\S+) bytes  received (\S+) bytes  (\S+) bytes/sec$}m) {
		my ($send, $recv, $speed) = ($1, $2, $3);
		my $elapsed = $stoptime-$starttime;
		if (($recv > 1*1024*1024 && $speed < 50_000. && $elapsed > 900)||($elapsed > 3600)) {
			my $hour = int($elapsed / 3600);
			my $min = int($elapsed / 60 % 60);
			admin_notify("$server: ".sprintf("%.0fkb/s %.0fMb %sh%sm", $speed/1024., $recv/1024./1024., $hour, $min,), $body);
		}
		
		printf LOGFILE "%s %s %s %s %s %s %s\n", $server, $module, $recv, $stoptime-$starttime, $speed, $starttime, $schedtime;
	}
}

sub do_rsync_all(@) {
	my (@sets) = @_;
	my ($rv, $set_name);
	
	my @mirror_subset = grep {$set_name = $_->{set}; grep {$_ =~ m/^$set_name( |$)/} @sets} @mirror_set;
	
	foreach my $nr (0..$#mirror_subset) {
		my $last;
		printf LOGFILE "# $$ queue: %s\n",
			join ' ',
			map {my @res = defined($last) && $last eq $_ ? () : ($_); $last=$_; @res}
			map {$mirror_subset[$_]->{set}} $nr..$#mirror_subset;
		do_rsync($mirror_subset[$nr],
			(split / +/, (sort {$a cmp $b} grep {m/$mirror_subset[$nr]->{set}( |$)/} @sets)[0])[1]);
	}
}

#
# Avoid email sender getting SIGPIPE
#
sub drain_input() {
	my ($drain);
	while (read(STDIN,$drain,65536)) { }
}

if ( -p STDIN ) {
	drain_input();
}

#
# Set umask, and redirect output to the log file
#
umask($umask);
open(LOGFILE, '>>', $log_file) or die "Can not open log_file $log_file: $!";
#open(STDERR, '>&', \*LOGFILE);
#open(STDOUT, '>&', \*LOGFILE);
select LOGFILE; $| = 1;                 # Make unbuffered
select STDERR; $| = 1;
select STDOUT; $| = 1;

#
# Enter critical section
#
open(CRITICAL, '>', $lock_file_2) || die "$0: Cannot open lock file $lock_file_2\n";
if ( flock(CRITICAL, LOCK_EX) == -1 ) {
	die "$0: Cannot lock $lock_file_2\n";
}

open(ENV, '>>', $debug_file) || die "$0: Cannot open lock file $debug_file\n";
print ENV "=======================\n";
print ENV "cmdline: ", join(" ", map {"<".$_.">"} @ARGV), "\n";
print ENV map {sprintf "%s=%s\n", $_, $ENV{$_}} sort keys %ENV;
close(ENV);

#
# Check to see if someone else is already doing this
#
open(ROCK, '+>>', $lock_file_1) || die "$0: Cannot open lock file $lock_file_1\n";
autoflush ROCK 1;
if ( !flock(ROCK, LOCK_EX|LOCK_NB) ) {
	#
	# rsync process already active. Mark that they have
	# to start over.
	#
	print ROCK join("\n", @sets), "\n";
	flock(ROCK, LOCK_UN);
	close(ROCK);
	flock(CRITICAL, LOCK_UN);
	close(CRITICAL);
	exit 0;
}

#
# No other rsync process.  We're "it".  Note check at end if another
# poll request came in.
#
do {
	seek ROCK, 0, 0;
	truncate ROCK, 0;
	flock(CRITICAL, LOCK_UN); # Drop critical section lock
	
	do_rsync_all(@sets);
	
	flock(CRITICAL, LOCK_EX); # Get critical section lock
	seek ROCK, 0, 0;
	@sets = map {chomp; $_} <ROCK>;
} while ( @sets );

flock(ROCK, LOCK_UN);
close(ROCK);
flock(CRITICAL, LOCK_UN);
close(CRITICAL);

exit 0;