# buildd-watcher:
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Copyright © 2009 Roger Leigh <rleigh@debian.org>
#
# 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, see
# <http://www.gnu.org/licenses/>.
#
#######################################################################

package Buildd::Watcher;

use strict;
use warnings;
use Buildd       qw(send_mail lock_file unlock_file unset_env);
use Buildd::Conf qw();
use Buildd::Base;

use POSIX qw(ESRCH LONG_MAX);
use Cwd;

sub ST_MTIME () { 9 }

BEGIN {
	use Exporter ();
	our (@ISA, @EXPORT);

	@ISA = qw(Exporter Buildd::Base);

	@EXPORT = qw();
}

sub new {
	my $class = shift;
	my $conf  = shift;

	my $self = $class->SUPER::new($conf);
	bless($self, $class);

	$self->set('Fudge', 1 / 24 / 6);    # 10 minutes in units of a day
	$self->set(
		'Graph Maxval',
		{
			'builds-per-day'     => 100,
			'uploads-per-day'    => 100,
			'failed-per-day'     => 50,
			'dep-wait-per-day'   => 50,
			'give-back-per-day'  => 50,
			'time-per-build'     => 10 * 60 * 60,
			'build-time-percent' => 1,
			'idle-time-percent'  => 1
		});

	$self->open_log();

	return $self;
}

sub run {
	my $self = shift;

	unset_env();
	chdir($self->get_conf('HOME'));

	# check if another watcher is still running
	my $watcher_pid;
	if (open(PID, "<watcher-running")) {
		$watcher_pid = <PID>;
		close(PID);
		$watcher_pid =~ /^\s*(\d+)/;
		$watcher_pid = $1;
		if (!$watcher_pid || (kill(0, $watcher_pid) == 0 && $! == ESRCH)) {
			$self->log(
				"Ignoring stale watcher-running file (pid $watcher_pid).\n");
		} else {
			$self->log("Another buildd-watcher is still running "
				  . "(pid $watcher_pid) -- exiting.\n");
			return 0;
		}
	}
	open(F, ">watcher-running.new")
	  or die "Can't create watcher-running.new: $!\n";
	printf F "%5d\n", $$;
	close(F);
	rename("watcher-running.new", "watcher-running")
	  or die "Can't rename watcher-running.new: $!\n";

	# check if buildd is still running, restart it if needed.
	my $restart = 0;
	my $daemon_pid;
	if (open(PID, "<" . $self->get_conf('PIDFILE'))) {
		$daemon_pid = <PID>;
		close(PID);
		$daemon_pid =~ /^\s*(\d+)/;
		$daemon_pid = $1;
		if (!$daemon_pid || (kill(0, $daemon_pid) == 0 && $! == ESRCH)) {
			$self->log(
				"pid file exists, but process $daemon_pid doesn't exist.\n");
			$restart = 1;
		}
	} else {
		$self->log("daemon not running (no pid file).\n");
		$restart = 1;
	}

   # do dir-purges that buildd-mail can't do (is running as nobody, so no sudo)
	lock_file("build/PURGE");
	my @to_purge = ();
	if (open(F, "<build/PURGE")) {
		@to_purge = <F>;
		close(F);
		unlink("build/PURGE");
		chomp(@to_purge);
	}
	unlock_file("build/PURGE");

	foreach (@to_purge) {
		next if !-d $_;
		system(qw(sudo rm -rf --), $_);
		$self->log("Purged $_\n");
	}

	# cut down mail-errormails file
	my $now = time;
	my @em  = ();
	if (open(F, "<mail-errormails")) {
		chomp(@em = <F>);
		close(F);
	}
	shift @em
	  while @em && ($now - $em[0]) > $self->get_conf('ERROR_MAIL_WINDOW');
	if (@em) {
		open(F, ">mail-errormails");
		print F join("\n", @em), "\n";
		close(F);
	} else {
		unlink("mail-errormails");
	}

	# check for old stuff in build and upload dirs
	my %warnfile;
	my $file;
	my $dev;
	my $ino;
	foreach $file (<upload/*>) {
		($dev, $ino) = lstat $file;
		$warnfile{"$dev:$ino"} = $file
		  if -M $file >= $self->get_conf('WARNING_AGE');
	}
	# TODO: Glob is incompatible with modern sbuild, which doesn't use
	# separate user directories.
	my $username = $self->get_conf('USERNAME');
	foreach $file (<build/chroot-*/build/$username/*>) {
		($dev, $ino) = lstat $file;
		if (!-d _ && !-l _) {
			$warnfile{"$dev:$ino"} = $file
			  if -C _ >= $self->get_conf('WARNING_AGE');
		} else {
			my $warnage = $self->get_conf('WARNING_AGE');
			my $changed_files
			  = `find $file -ctime -$warnage -print 2>/dev/null`;
			$warnfile{"$dev:$ino"} = $file if !$changed_files;
		}
	}
	foreach $file (<build/*>) {
		next if $file =~ m#^build/chroot-[^/]+$#;
		($dev, $ino) = lstat $file;
		if (!-d _ && !-l _) {
			$warnfile{"$dev:$ino"} = $file
			  if -C _ >= $self->get_conf('WARNING_AGE');
		} else {
			my $warnage = $self->get_conf('WARNING_AGE');
			my $changed_files
			  = `find $file -ctime -$warnage -print 2>/dev/null`;
			$warnfile{"$dev:$ino"} = $file if !$changed_files;
		}
	}
	my $nowarnpattern = $self->get_conf('NO_WARN_PATTERN');
	my @warnings      = grep(!/$nowarnpattern/, sort values %warnfile);
	if (@warnings) {
		my %reported;
		my @do_warn;
		if (open(W, "<reported-old-files")) {
			while (<W>) {
				next if !/^(\S+)\s+(\d+)$/;
				$reported{$1} = $2;
			}
			close(W);
		}

		foreach (@warnings) {
			if (!exists($reported{$_})
				|| ($now - $reported{$_})
				>= $self->get_conf('WARNING_AGE') * 24 * 60 * 60) {
				push(@do_warn, $_);
				$reported{$_} = $now;
			}
		}

		my $old_umask = umask 007;
		open(W, ">reported-old-files")
		  or die "Can't create/write reported-old-files: $!\n";
		foreach (keys %reported) {
			print W "$_ $reported{$_}\n" if -e $_ || -l $_;
		}
		close(W);
		umask $old_umask;

		send_mail(
			$self->get_conf('ADMIN_MAIL'),
			"buildd-watcher found some old files",
			"buildd-watcher has found some old files or directories in\n"
			  . "~buildd/upload and/or ~buildd/build. Those are:\n\n  "
			  . join("\n  ", @do_warn) . "\n\n"
			  . "Please have a look at them and remove them if "
			  . "they're obsolete.\n"
		) if @do_warn;
	}

	# archive old package/build log files
	$self->archive_logs("logs", "*", "old-logs/plog",
		$self->get_conf('PKG_LOG_KEEP'));
	$self->archive_logs("build", "build-*.log", "old-logs/blog",
		$self->get_conf('BUILD_LOG_KEEP'));

	# rotate daemon's log file
	if (  !-f "old-logs/daemon-stamp"
		|| -M "old-logs/daemon-stamp"
		> $self->get_conf('DAEMON_LOG_ROTATE') - $self->get('Fudge')) {

		$self->log("Rotating daemon log file\n");
		system(qw(touch old-logs/daemon-stamp));

		my $d = $self->format_time(time);
		if (-f $self->get_conf('DAEMON_LOG_FILE') . ".old") {
			system(qw(mv --), $self->get_conf('DAEMON_LOG_FILE') . '.old',
				"old-logs/daemon-$d.log");
			system(qw(gzip -9), "old-logs/daemon-$d.log");
		}

		rename(
			$self->get_conf('DAEMON_LOG_FILE'),
			$self->get_conf('DAEMON_LOG_FILE') . ".old"
		);
		my $old_umask = umask 0007;
		system(qw(touch --), $self->get_conf('DAEMON_LOG_FILE'));
		umask $old_umask;
		kill(1, $daemon_pid) if $daemon_pid;
		$self->reopen_log();

		if ($self->get_conf('DAEMON_LOG_SEND')) {
			my $text;
			open(F, "<" . $self->get_conf('DAEMON_LOG_FILE') . ".old");
			{ local ($/); undef $/; $text = <F>; }
			close(F);
			send_mail($self->get_conf('ADMIN_MAIL'),
				"Build Daemon Log $d", $text);
		}
	}
	$self->archive_logs("old-logs", "daemon-*.log.gz", "old-logs/dlog",
		$self->get_conf('DAEMON_LOG_KEEP'));

	# make buildd statistics
	if (  !-f "stats/Stamp"
		|| -M "stats/Stamp"
		> $self->get_conf('STATISTICS_PERIOD') - $self->get('Fudge')) {

		$self->log("Making buildd statistics\n");
		lock_file("stats");
		my $lasttime = 0;
		if (open(F, "<stats/Stamp")) {
			chomp($lasttime = <F>);
			close(F);
		}
		my $now = time;

		$self->make_statistics($lasttime, $now);

		open(F, ">stats/Stamp");
		print F "$now\n";
		close(F);
		unlock_file("stats");

		my $text;
		open(F, "<stats/Summary");
		{ local ($/); undef $/; $text = <F>; }
		close(F);
		send_mail($self->get_conf('STATISTICS_MAIL'),
			"Build Daemon Statistics", $text);
	}

	if ($restart) {
		if (-f "NO-DAEMON-PLEASE") {
			$self->log("NO-DAEMON-PLEASE exists, not starting daemon\n");
		} else {
			$self->close_log();
			unlink("watcher-running");
			exec "buildd";
		}
	}

	unlink("watcher-running");
	return 0;
}

sub archive_logs ($$$$) {
	my $self    = shift;
	my $dir     = shift;
	my $pattern = shift;
	my $destpat = shift;
	my $minage  = shift;

	my ($olddir, $file, @todo, $oldest, $newest, $oldt, $newt);

	return
	  if -f "$destpat-stamp"
	  && -M "$destpat-stamp" < $minage - $self->get('Fudge');
	$self->log("Archiving logs in $dir:\n");
	system(qw(touch --), "$destpat-stamp");

	$olddir = cwd;
	chdir($dir);

	$oldest = LONG_MAX;
	$newest = 0;
	foreach $file (glob($pattern)) {
		if (-M $file >= $minage) {
			push(@todo, $file);
			my $modtime = (stat(_))[ST_MTIME];
			$oldest = $modtime if $oldest > $modtime;
			$newest = $modtime if $newest < $modtime;
		}
	}
	if (@todo) {
		$oldt = $self->format_time($oldest);
		$newt = $self->format_time($newest);
		$file = $self->get_conf('HOME') . "/$destpat-$oldt-$newt.tar";

		system(qw(tar cf), $file, '--', @todo);
		system(qw(gzip -9 --), $file);

		if ($dir eq "logs") {
			local (*F);
			my $index
			  = $self->get_conf('HOME') . "/$destpat-$oldt-$newt.index";
			if (open(F, ">$index")) {
				print F join("\n", @todo), "\n";
				close(F);
			}
		}

		unlink(@todo);
		$self->log("Archived ", scalar(@todo), " files from $oldt to $newt\n");
	} else {
		$self->log("No files to archive\n");
	}

	chdir($olddir);
}

sub make_statistics ($$) {
	my $self       = shift;
	my $start_time = shift;
	my $end_time   = shift;

	my @svars = qw(taken builds uploads failed dep-wait no-build
	  give-back idle-time build-time remove-time
	  install-download-time);
	my (
		$s_taken,       $s_builds,    $s_uploads,
		$s_failed,      $s_dep_wait,  $s_no_build,
		$s_give_back,   $s_idle_time, $s_build_time,
		$s_remove_time, $s_install_download_time
	);
	local (*F, *G, *OUT);

	my $var;
	foreach $var (@svars) {
		my $svar = "s_$var";
		$svar =~ s/-/_/g;
		eval "\$$svar = 0;";
		if (-f "stats/$var") {
			if (!open(F, "<stats/$var")) {
				$self->log("can't open stats/$var: $!\n");
				next;
			}
			my $n = 0;
			while (<F>) {
				chomp;
				$n += $_;
			}
			close(F);
			eval "\$$svar = $n;";
			unlink("stats/$var");
		}
	}

	my $total_time = $end_time - $start_time;
	my $days       = $total_time / (24 * 60 * 60);

	if (!open(OUT, ">stats/Summary")) {
		$self->log("Can't create stats/Summary: $!\n");
		return;
	}

	printf OUT "Build daemon statistics from %s to %s (%3.2f days):\n\n",
	  $self->format_time($start_time), $self->format_time($end_time), $days;

	print OUT "           #packages  % of taken  pkgs/day\n";
	print OUT "-------------------------------------------\n";
	printf OUT "taken    : %5d                  %7.2f\n",
	  $s_taken, $s_taken / $days;
	printf OUT "builds   : %5d       %7.2f%%   %7.2f\n",
	  $s_builds, $s_taken ? $s_builds * 100 / $s_taken : 0, $s_builds / $days;
	printf OUT "uploaded : %5d       %7.2f%%   %7.2f\n",
	  $s_uploads, $s_taken ? $s_uploads * 100 / $s_taken : 0,
	  $s_uploads / $days;
	printf OUT "failed   : %5d       %7.2f%%   %7.2f\n",
	  $s_failed, $s_taken ? $s_failed * 100 / $s_taken : 0, $s_failed / $days;
	printf OUT "dep-wait : %5d       %7.2f%%   %7.2f\n",
	  $s_dep_wait, $s_taken ? $s_dep_wait * 100 / $s_taken : 0,
	  $s_dep_wait / $days;
	printf OUT "give-back: %5d       %7.2f%%   %7.2f\n",
	  $s_give_back, $s_taken ? $s_give_back * 100 / $s_taken : 0,
	  $s_give_back / $days;
	printf OUT "no-build : %5d       %7.2f%%   %7.2f\n",
	  $s_no_build, $s_taken ? $s_no_build * 100 / $s_taken : 0,
	  $s_no_build / $days;
	print OUT "\n";

	print OUT "          time          % of total\n";
	print OUT "----------------------------------\n";
	printf OUT "building: %s  %7.2f%%\n",
	  $self->print_time($s_build_time), $s_build_time * 100 / $total_time;
	printf OUT "install : %s  %7.2f%%\n",
	  $self->print_time($s_install_download_time),
	  $s_install_download_time * 100 / $total_time;
	printf OUT "removing: %s  %7.2f%%\n",
	  $self->print_time($s_remove_time), $s_remove_time * 100 / $total_time;
	printf OUT "idle    : %s  %7.2f%%\n",
	  $self->print_time($s_idle_time), $s_idle_time * 100 / $total_time;
	printf OUT "total   : %s\n", $self->print_time($total_time);
	print OUT "\n";

	my $proc
	  = $s_uploads + $s_failed + $s_dep_wait + $s_no_build + $s_give_back;
	printf OUT "processed package (upl+fail+dep+nob): %7d\n", $proc;
	printf OUT "slipped (proc-taken)                : %7d\n", $proc - $s_taken;
	printf OUT "builds/taken package                : %7.2f\n",
	  $s_builds / $s_taken
	  if $s_taken;
	printf OUT "avg. time/taken package             : %s\n",
	  $self->print_time($s_build_time / $s_taken)
	  if $s_taken;
	printf OUT "avg. time/processed package         : %s\n",
	  $self->print_time($s_build_time / $proc)
	  if $proc;
	printf OUT "avg. time/build                     : %s\n",
	  $self->print_time($s_build_time / $s_builds)
	  if $s_builds;
	print OUT "\n";

	my $date = $self->format_date(time);
	$self->print_graph($s_builds / $days,         $date, "builds-per-day");
	$self->print_graph($s_uploads / $days,        $date, "uploads-per-day");
	$self->print_graph($s_failed / $days,         $date, "failed-per-day");
	$self->print_graph($s_dep_wait / $days,       $date, "dep-wait-per-day");
	$self->print_graph($s_give_back / $days,      $date, "give-back-per-day");
	$self->print_graph($s_build_time / $s_builds, $date, "time-per-build")
	  if $s_builds;
	$self->print_graph($s_build_time / $total_time,
		$date, "build-time-percent");
	$self->print_graph($s_idle_time / $total_time, $date, "idle-time-percent");

	my $g;
	my $graph_maxval = $self->get('Graph Maxval');

	foreach $g (keys %{$graph_maxval}) {
		next if !open(G, "<stats/graphs/$g");

		print OUT "$g (max. $graph_maxval->{$g}):\n\n";
		while (<G>) {
			print OUT $_;
		}
		close(G);
		print OUT "\n";
	}

	close(OUT);
}

sub print_time ($) {
	my $self = shift;
	my $t    = shift;

	my $str = sprintf "%02d:%02d:%02d", int($t / 3600), int(($t % 3600) / 60),
	  int($t % 60);
	$str = " " x (10 - length($str)) . $str;

	return $str;
}

sub print_graph ($$$) {
	my $self  = shift;
	my $val   = shift;
	my $date  = shift;
	my $graph = shift;

	my $width = 72;
	local (*G);

	my $graph_maxval = $self->get('Graph Maxval');
	if (!exists $graph_maxval->{$graph}) {
		$self->log("Unknown graph $graph\n");
		return;
	}
	if (!open(G, ">>stats/graphs/$graph")) {
		$self->log("Can't create stats/graphs/$graph: $!\n");
		return;
	}
	$val = int($val * $width / $graph_maxval->{$graph} + 0.5);
	my $str = $val > $width ? "*" x ($width - 1) . "+" : "*" x $val;
	$date = substr($date, 0, 6);
	$date .= " " x (6 - length($date));
	print G "$date $str\n";
	close(G);
}

sub format_time ($) {
	my $self = shift;
	my $t    = shift;

	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = localtime($t);

	return sprintf "%04d%02d%02d-%02d%02d",
	  $year + 1900, $mon + 1, $mday, $hour, $min;
}

sub format_date ($) {
	my $self = shift;
	my $t    = shift;

	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = localtime($t);

	return sprintf "%02d%02d%02d", $year % 100, $mon + 1, $mday;
}

1;
