#! /usr/bin/perl
#
# Buildd.pm: library for buildd and friends
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Copyright © 2005 Ryan Murray <rmurray@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;

use strict;
use warnings;
use POSIX;
use FileHandle;
use Sbuild::LogBase;

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

@Buildd::EXPORT = qw(unset_env lock_file unlock_file send_mail
  ll_send_mail exitstatus isin);

$Buildd::lock_interval = 15;
$Buildd::max_lock_trys = 120;
($Buildd::progname = $0) =~ s,.*/,,;
my @pwinfo = getpwuid($>);
$Buildd::username = $pwinfo[0];
$Buildd::gecos    = $pwinfo[6];
$Buildd::gecos =~ s/,.*$//;
$Buildd::hostname = `/bin/hostname -f`;
$Buildd::hostname =~ /^(\S+)$/;
$Buildd::hostname = $1;    # untaint

sub isin ($@);
sub unset_env ();
sub lock_file ($;$);
sub unlock_file ($);
sub send_mail ($$$;$);
sub ll_send_mail ($$);
sub exitstatus ($);

sub isin ($@) {
	my $val = shift;
	return grep($_ eq $val, @_);
}

sub unset_env () {
	# unset any locale variables (sorted to match output from locale(1))
	delete $ENV{'LANG'};
	delete $ENV{'LANGUAGE'};
	delete $ENV{'LC_CTYPE'};
	delete $ENV{'LC_NUMERIC'};
	delete $ENV{'LC_TIME'};
	delete $ENV{'LC_COLLATE'};
	delete $ENV{'LC_MONETARY'};
	delete $ENV{'LC_MESSAGES'};
	delete $ENV{'LC_PAPER'};
	delete $ENV{'LC_NAME'};
	delete $ENV{'LC_ADDRESS'};
	delete $ENV{'LC_TELEPHONE'};
	delete $ENV{'LC_MEASUREMENT'};
	delete $ENV{'LC_IDENTIFICATION'};
	delete $ENV{'LC_ALL'};
	# other unneeded variables that might be set
	delete $ENV{'DISPLAY'};
	delete $ENV{'TERM'};
	delete $ENV{'XDG_RUNTIME_DIR'};
	delete $ENV{'XDG_SEAT'};
	delete $ENV{'XDG_SESSION_COOKIE'};
	delete $ENV{'XDG_SESSION_ID'};
	delete $ENV{'XDG_VTNR'};
}

sub lock_file ($;$) {
	my $file     = shift;
	my $nowait   = shift;
	my $lockfile = "$file.lock";
	my $try      = 0;
	my $username = (getpwuid($<))[0] || $ENV{'LOGNAME'} || $ENV{'USER'};

	if (!defined($nowait)) {
		$nowait = 0;
	}

  repeat:
	if (!sysopen(F, $lockfile, O_WRONLY | O_CREAT | O_TRUNC | O_EXCL, 0644)) {
		if ($! == EEXIST) {
			# lock file exists, wait
			goto repeat if !open(F, "<$lockfile");
			my $line = <F>;
			close(F);
			# If this goes wrong it would be a spinlock and the world will
			# end.
			goto repeat if !defined($line);
			if ($line !~ /^(\d+)\s+([\w\d.-]+)$/) {
				warn "Bad lock file contents ($lockfile) -- still trying\n";
			} else {
				my ($pid, $user) = ($1, $2);
				my $cnt = kill(0, $pid);
				if ($cnt == 0 && $! == ESRCH) {
					# process doesn't exist anymore, remove stale lock
					warn "Removing stale lock file $lockfile "
					  . " (pid $pid, user $user)\n";
					unlink($lockfile);
					goto repeat;
				} elsif ($cnt >= 1 and $nowait == 1) {
					# process exists.
					return 0;
				}
			}
			if (++$try > $Buildd::max_lock_trys) {
				warn "Lockfile $lockfile still present after "
				  . "$Buildd::max_lock_trys * $Buildd::lock_interval "
				  . " seconds -- giving up\n";
				return 0;
			}
			sleep $Buildd::lock_interval;
			goto repeat;
		}
		die "$Buildd::progname: Can't create lock file $lockfile: $!\n";
	}
	F->print("$$ $username\n");
	F->close();
	return 1;
}

sub unlock_file ($) {
	my $file     = shift;
	my $lockfile = "$file.lock";

	unlink($lockfile);
}

sub send_mail ($$$;$) {
	my $addr        = shift;
	my $subject     = shift;
	my $text        = shift;
	my $add_headers = shift;

	return ll_send_mail($addr,
			"To: $addr\n"
		  . "Subject: $subject\n"
		  . "From: $Buildd::gecos "
		  . "<$Buildd::username\@$Buildd::hostname>\n"
		  . ($add_headers ? $add_headers : "")
		  . "\n$text\n");
}

sub ll_send_mail ($$) {
	my $to   = shift;
	my $text = shift;
	local (*MAIL);

	# TODO: Don't log to STDERR: Implement as class method using
	# standard pipe interface using normal log streams.

	$text =~ s/^\.$/../mg;
	local $SIG{'PIPE'} = 'IGNORE';
	if (!open(MAIL, "|/usr/sbin/sendmail -oem '$to'")) {
		print STDERR "Could not open pipe to /usr/sbin/sendmail: $!\n";
		return 0;
	}
	print MAIL $text;
	if (!close(MAIL)) {
		print STDERR "sendmail failed (exit status ", exitstatus($?), ")\n";
		return 0;
	}
	return 1;
}

sub exitstatus ($) {
	my $stat = shift;

	return ($stat >> 8) . "/" . ($stat % 256);
}

1;
