Adding upstream version 0.85.6.upstream/0.85.6

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

12 files changed, 4773 insertions, 0 deletions

diff --git a/lib/Buildd.pm b/lib/Buildd.pm
new file mode 100644
index 0000000..9b90e07
--- /dev/null
+++ b/lib/Buildd.pm
@@ -0,0 +1,192 @@
+#! /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;
diff --git a/lib/Buildd/Base.pm b/lib/Buildd/Base.pm
new file mode 100644
index 0000000..c7240c0
--- /dev/null
+++ b/lib/Buildd/Base.pm
@@ -0,0 +1,190 @@
+# Buildd common base functionality
+# 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::Base;
+
+use strict;
+use warnings;
+
+use IO::File;
+use Buildd qw(lock_file unlock_file);
+use Buildd::Client qw();
+
+use Sbuild::Base;
+use Sbuild qw($devnull);
+
+BEGIN {
+    use Exporter ();
+    our (@ISA, @EXPORT);
+
+    @ISA = qw(Exporter Sbuild::Base);
+
+    @EXPORT = qw();
+}
+
+sub new {
+    my $class = shift;
+    my $conf = shift;
+
+    my $self = $class->SUPER::new($conf);
+    bless($self, $class);
+
+    $self->set('PID', $$);
+
+    $self->open_log();
+
+    return $self;
+}
+
+sub open_log ($) {
+    my $self = shift;
+
+    my $logfile = $self->get_conf('DAEMON_LOG_FILE');
+
+    my $log = IO::File->new("$logfile", O_CREAT|O_WRONLY|O_APPEND, 0640)
+	or die "$0: Cannot open logfile $logfile: $!\n";
+    $log->autoflush(1);
+
+    # Since we are a daemon, fully detach from terminal by reopening
+    # stdout and stderr to redirect to the log file.  Note messages
+    # should be printed using log(), not printing directly to the
+    # filehandle.  This is a fallback only.
+    open(STDOUT, '>&', $log) or warn "Can't redirect stderr\n";
+    open(STDERR, '>&', $log) or warn "Can't redirect stderr\n";
+
+    $self->set('Log Stream', $log);
+
+    return $log;
+}
+
+sub close_log ($) {
+    my $self = shift;
+
+    # We can't close stdout and stderr, so redirect to /dev/null.
+    open(STDOUT, '>&', $devnull) or warn "Can't redirect stderr\n";
+    open(STDERR, '>&', $devnull) or warn "Can't redirect stderr\n";
+
+    my $log = $self->get('Log Stream');
+    $self->set('Log Stream', undef);
+
+    return $log->close();
+}
+
+sub reopen_log ($) {
+    my $self = shift;
+
+    my $log = $self->get('Log Stream');
+
+    if ($self->close_log()) {
+	$log = $self->open_log();
+    }
+
+    return $log;
+}
+
+sub write_stats ($$$) {
+    my $self = shift;
+    my ($cat, $val) = @_;
+
+    local( *F );
+
+    my $home = $self->get_conf('HOME');
+
+    lock_file( "$home/stats" );
+    open( F, ">>$home/stats/$cat" );
+    print F "$val\n";
+    close( F );
+    unlock_file( "$home/stats" );
+}
+
+sub get_db_handle ($$) {
+    my $self = shift;
+    my $dist_config = shift;
+
+    my $db = Buildd::Client->new($dist_config);
+    $db->set('Log Stream', $self->get('Log Stream'));
+    return $db;
+}
+
+sub get_dist_config_by_name ($$) {
+    my $self = shift;
+    my $dist_name = shift;
+
+    my $dist_config;
+    for my $dist_config_entry (@{$self->get_conf('DISTRIBUTIONS')}) {
+        if ($dist_config_entry->get('DIST_NAME') eq $dist_name) {
+            $dist_config = $dist_config_entry;
+        }
+    }
+
+    if (!$dist_config) {
+        $self->set('Mail Short Error',
+                $self->get('Mail Short Error') .
+                "No configuration found for dist $dist_name\n");
+        $self->set('Mail Error',
+                $self->get('Mail Error') .
+                "Answer could not be processed, as dist=$dist_name does not match any of\n".
+                "the entries in the buildd configuration.\n");
+    }
+
+    return $dist_config;
+}
+
+sub get_arch_dist_config_by_name ($$) {
+    my $self = shift;
+    my $arch_name = shift;
+    my $dist_name = shift;
+
+    my $arch_config, my $dist_config;
+    for my $dist_config_entry (@{$self->get_conf('DISTRIBUTIONS')}) {
+        if ($dist_config_entry->get('BUILT_ARCHITECTURE') eq $arch_name &&
+            $dist_config_entry->get('DIST_NAME') eq $dist_name) {
+            $dist_config = $dist_config_entry;
+        }
+    }
+
+    if (!$dist_config) {
+        $self->set('Mail Short Error',
+                $self->get('Mail Short Error') .
+                "No configuration found for arch=$arch_name, dist=$dist_name\n");
+        $self->set('Mail Error',
+                $self->get('Mail Error') .
+                "Answer could not be processed, as arch=$arch_name, dist=$dist_name".
+                "does not match any of the entries in the buildd configuration.\n");
+    }
+
+    return $dist_config;
+}
+
+sub log {
+	my $self = shift;
+
+	my $timestamp = localtime;
+	# omit weekday and year for brevity
+	$timestamp =~ s/^\w+\s(.*)\s\d+$/$1/;
+	my $prefix = "$timestamp $Buildd::progname\[" .
+	    $self->get('PID') . "\]: ";
+
+	for my $line (split(/\n/, join("", @_))) {
+		Sbuild::Base::log($self, $prefix, $line, "\n");
+	}
+}
+
+1;
diff --git a/lib/Buildd/Client.pm b/lib/Buildd/Client.pm
new file mode 100644
index 0000000..14a9104
--- /dev/null
+++ b/lib/Buildd/Client.pm
@@ -0,0 +1,135 @@
+#
+# Client.pm: client library for wanna-build
+# Copyright © 2005      Ryan Murray <rmurray@debian.org>
+# Copyright © 2005-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::Client;
+
+use strict;
+use warnings;
+
+use Sbuild qw($devnull);
+use Sbuild::ChrootRoot;
+use Cwd;
+
+BEGIN {
+    use Exporter ();
+    our (@ISA, @EXPORT);
+
+    @ISA = qw(Exporter Sbuild::Base);
+
+    @EXPORT = qw();
+}
+
+sub new {
+    my $class = shift;
+    my $conf = shift;
+
+    my $self = $class->SUPER::new($conf);
+    bless($self, $class);
+
+    $self->set('SETUP', 0);
+
+    return $self;
+}
+
+sub setup {
+    my $self = shift;
+
+    if (!$self->get('SETUP')) {
+	my $host = Sbuild::ChrootRoot->new($self->get('Config'));
+	$host->begin_session();
+	$host->set('Log Stream', $self->get('Log Stream'));
+	$self->set('Host', $host);
+	$self->set('SETUP', 1);
+    }
+}
+
+sub get_query {
+    my $self = shift;
+
+    my @command = (@{$self->get_conf('WANNA_BUILD_SSH_CMD')}, 'wanna-build');
+    if ($self->get_conf('WANNA_BUILD_DB_NAME')) {
+	push(@command, "--database=" . $self->get_conf('WANNA_BUILD_DB_NAME'));
+    } else {
+        if ($self->get_conf('BUILT_ARCHITECTURE')) {
+            push(@command, "--arch=" . $self->get_conf('BUILT_ARCHITECTURE'));
+        }
+        if ($self->get_conf('DIST_NAME')) {
+            push(@command, "--dist=" . $self->get_conf('DIST_NAME'));
+        }
+    }
+    push(@command, "--user=" . $self->get_conf('WANNA_BUILD_DB_USER'))
+	if $self->get_conf('WANNA_BUILD_DB_USER');
+    push(@command, @_);
+
+    return @command;
+}
+
+sub run_query {
+    my $self = shift;
+
+    my @command = $self->get_query(@_);
+
+    $self->setup();
+
+    my $pipe = $self->get('Host')->run_command(
+	{ COMMAND => [@command],
+	  USER => $self->get_conf('USERNAME'),
+	  PRIORITY => 0,
+	});
+}
+
+sub pipe_query {
+    my $self = shift;
+
+    my @command = $self->get_query(@_);
+
+    $self->setup();
+
+    my $pipe = $self->get('Host')->pipe_command(
+	{ COMMAND => [@command],
+	  USER => $self->get_conf('USERNAME'),
+	  PRIORITY => 0,
+          DIR => getcwd(),
+          STREAMERR => \*STDOUT,
+	});
+
+    return $pipe;
+}
+
+sub pipe_query_out {
+    my $self = shift;
+
+    my @command = $self->get_query(@_);
+
+    $self->setup();
+
+    my $pipe = $self->get('Host')->pipe_command(
+	{ COMMAND => [@command],
+	  USER => $self->get_conf('USERNAME'),
+	  PIPE => 'out',
+	  STREAMOUT => $devnull,
+	  PRIORITY => 0,
+	});
+
+    return $pipe;
+}
+
+1;
diff --git a/lib/Buildd/ClientConf.pm b/lib/Buildd/ClientConf.pm
new file mode 100644
index 0000000..e38eb7c
--- /dev/null
+++ b/lib/Buildd/ClientConf.pm
@@ -0,0 +1,177 @@
+#
+# ClientConf.pm: configuration library for wanna-build clients
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2005 Ryan Murray <rmurray@debian.org>
+# Copyright © 2006-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::ClientConf;
+
+use strict;
+use warnings;
+
+use Sbuild::Sysconfig;
+use File::Spec;
+
+BEGIN {
+    use Exporter ();
+    our (@ISA, @EXPORT);
+
+    @ISA = qw(Exporter);
+
+    @EXPORT = qw(setup);
+}
+
+sub setup ($) {
+    my $conf = shift;
+
+    my $validate_program = sub {
+	my $conf = shift;
+	my $entry = shift;
+	my $key = $entry->{'NAME'};
+	my $program = $conf->get($key);
+
+	die "$key binary is not defined"
+	    if !defined($program) || !$program;
+
+	# Emulate execvp behaviour by searching the binary in the PATH.
+	my @paths = split(/:/, $ENV{'PATH'});
+	# Also consider the empty path for absolute locations.
+	push (@paths, '');
+	my $found = 0;
+	foreach my $path (@paths) {
+	    $found = 1 if (-x File::Spec->catfile($path, $program));
+	}
+
+	die "$key binary '$program' does not exist or is not executable"
+	    if !$found;
+    };
+
+    my $validate_ssh = sub {
+	my $conf = shift;
+	my $entry = shift;
+
+# TODO: Provide self, config and entry contexts, which functions to
+# get at needed data.  Provide generic configuration functions.
+#
+	$validate_program->($conf, $conf->{'KEYS'}->{'SSH'});
+
+	my $ssh = $conf->get('SSH');
+	my $sshuser = $conf->get('WANNA_BUILD_SSH_USER');
+	my $sshhost = $conf->get('WANNA_BUILD_SSH_HOST');
+	my @sshoptions = @{$conf->get('WANNA_BUILD_SSH_OPTIONS')};
+	my $sshsocket = $conf->get('WANNA_BUILD_SSH_SOCKET');
+
+	my @command = ();
+
+	if ($sshhost) {
+	    push (@command, $ssh);
+	    push (@command, '-l', $sshuser) if $sshuser;
+	    push (@command, '-S', $sshsocket) if $sshsocket;
+	    push (@command, @sshoptions) if @sshoptions;
+	    push (@command, $sshhost);
+	}
+
+	$conf->set('WANNA_BUILD_SSH_CMD', \@command);
+    };
+
+    our $HOME = $conf->get('HOME');
+    my $arch = $conf->get('ARCH');
+
+    my %db_keys = (
+	'SSH'					=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'ssh',
+	    GROUP => 'Programs',
+	    DEFAULT => 'ssh',
+	    CHECK => $validate_ssh,
+	    HELP => 'Path to ssh binary'
+	},
+	'WANNA_BUILD_SSH_CMD'			=> {
+	    TYPE => 'STRING',
+	    GROUP => '__INTERNAL',
+	    DEFAULT => '',
+	    HELP => 'Command to run wanna-build (set automatically from the other wanna-build options)'
+	},
+	'WANNA_BUILD_SSH_USER'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'wanna_build_ssh_user',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => '',
+	    CHECK => $validate_ssh,
+	    HELP => 'Username for SSH connection'
+	},
+	'WANNA_BUILD_SSH_HOST'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'wanna_build_ssh_host',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => '',
+	    CHECK => $validate_ssh,
+	    HELP => 'Host for SSH connection'
+	},
+	'WANNA_BUILD_SSH_SOCKET'		=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'wanna_build_ssh_socket',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => '',
+	    CHECK => $validate_ssh,
+	    HELP => 'Socket for SSH connection'
+	},
+	'WANNA_BUILD_SSH_OPTIONS'		=> {
+	    TYPE => 'ARRAY:STRING',
+	    VARNAME => 'wanna_build_ssh_options',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => [],
+	    CHECK => $validate_ssh,
+	    HELP => 'SSH options.  Note this is an array reference.'
+	},
+	'WANNA_BUILD_DB_NAME'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'wanna_build_db_name',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => undef,
+	    HELP => 'Database name'
+	},
+	'WANNA_BUILD_DB_USER'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'wanna_build_db_user',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => $conf->get('USERNAME'),
+	    # arch:all packages must not differ depending on which user is
+	    # building the source package, so don't show the default for
+	    # example config and man page generation
+	    IGNORE_DEFAULT => 1,
+	    HELP => 'Database user'
+	},
+	'BUILT_ARCHITECTURE'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'wanna_build_built_architecture',
+	    GROUP => 'wanna-build client',
+	    DEFAULT => $arch,
+	    # the $native_arch is different depending on the machine where
+	    # sbuild is built but arch:all packages must not differ depending on
+	    # the architecture they are built on, so don't show the default for
+	    # example config and man page generation
+	    IGNORE_DEFAULT => 1,
+	    HELP => 'Architecture for database'
+	});
+
+    $conf->set_allowed_keys(\%db_keys);
+}
+
+1;
diff --git a/lib/Buildd/Conf.pm b/lib/Buildd/Conf.pm
new file mode 100644
index 0000000..3dca902
--- /dev/null
+++ b/lib/Buildd/Conf.pm
@@ -0,0 +1,628 @@
+#
+# Conf.pm: configuration library for buildd
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2005 Ryan Murray <rmurray@debian.org>
+# Copyright © 2006-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::Conf;
+
+use strict;
+use warnings;
+
+use Buildd::DistConf qw();
+use Buildd::UploadQueueConf qw();
+use Sbuild::ConfBase;
+use Sbuild::Sysconfig;
+use Buildd::ClientConf qw();
+
+BEGIN {
+    use Exporter ();
+    our (@ISA, @EXPORT);
+
+    @ISA = qw(Exporter);
+
+    @EXPORT = qw($reread_config new setup read);
+}
+
+our $reread_config = 0;
+
+sub setup ($);
+sub read ($);
+
+sub new {
+    my $conf = Sbuild::ConfBase->new(@_);
+    Buildd::Conf::setup($conf);
+    Buildd::Conf::read($conf);
+
+    return $conf;
+}
+
+sub setup ($) {
+    my $conf = shift;
+
+    my $validate_program = sub {
+	my $conf = shift;
+	my $entry = shift;
+	my $key = $entry->{'NAME'};
+	my $program = $conf->get($key);
+
+	die "$key binary is not defined"
+	    if !defined($program) || !$program;
+
+	# Emulate execvp behaviour by searching the binary in the PATH.
+	my @paths = split(/:/, $conf->get('PATH'));
+	# Also consider the empty path for absolute locations.
+	push (@paths, '');
+	my $found = 0;
+	foreach my $path (@paths) {
+	    $found = 1 if (-x File::Spec->catfile($path, $program));
+	}
+
+	die "$key binary '$program' does not exist or is not executable"
+	    if !$found;
+    };
+
+    my $validate_directory = sub {
+	my $conf = shift;
+	my $entry = shift;
+	my $key = $entry->{'NAME'};
+	my $directory = $conf->get($key);
+
+	die "$key directory is not defined"
+	    if !defined($directory) || !$directory;
+
+	die "$key directory '$directory' does not exist"
+	    if !-d $directory;
+    };
+
+    our $HOME = $conf->get('HOME');
+    $main::HOME = $HOME; # TODO: Remove once Buildd.pm uses $conf
+    my $arch = $conf->get('ARCH');
+
+    my %buildd_keys = (
+	'ADMIN_MAIL'				=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'admin_mail',
+	    GROUP => 'Mail',
+	    DEFAULT => 'root',
+	    HELP => 'email address for admin'
+	},
+	'APT_GET'				=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'apt_get',
+	    GROUP => 'Programs',
+	    CHECK => $validate_program,
+	    DEFAULT => 'apt-get',
+	    HELP => 'Path to apt-get binary'
+	},
+	'DPKG_FILE_SUFFIX'	=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'dpkg_file_suffix',
+	    GROUP => 'Programs',
+	    DEFAULT => '',
+	    HELP => 'Value for the sbuild dpkg-file-suffix option, to be passed on to sbuild',
+	},
+	'BUILD_LOG_KEEP'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'build_log_keep',
+	    GROUP => 'Watcher',
+	    DEFAULT => 2,
+	    HELP => 'Number of days until build logs are archived'
+	},
+	'DAEMON_LOG_FILE'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'daemon_log_file',
+	    GROUP => 'Daemon',
+	    IGNORE_DEFAULT => 1, # Don't dump the current home
+	    DEFAULT => "$HOME/daemon.log",
+	    HELP => 'Main buildd daemon log file'
+	},
+	'DAEMON_LOG_KEEP'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'daemon_log_keep',
+	    GROUP => 'Watcher',
+	    DEFAULT => 7,
+	    HELP => 'Number of days until old daemon logs are archived in a .tar.gz file'
+	},
+	'DAEMON_LOG_ROTATE'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'daemon_log_rotate',
+	    GROUP => 'Watcher',
+	    DEFAULT => 1,
+	    HELP => 'Number how many days until daemon logs are rotated (one is kept as daemon.log.old, others are moved to old-logs and gzipped)'
+	},
+	'DAEMON_LOG_SEND'			=> {
+	    TYPE => 'BOOL',
+	    VARNAME => 'daemon_log_send',
+	    GROUP => 'Watcher',
+	    DEFAULT => 1,
+	    HELP => 'email rotated daemon logs to the admin?'
+	},
+	'DELAY_AFTER_GIVE_BACK'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'delay_after_give_back',
+	    GROUP => 'Daemon',
+	    DEFAULT => 8 * 60, # 8 hours
+	    HELP => 'Time to avoid packages that have automatically been given back by sbuild (in minutes)'
+	},
+	'ERROR_MAIL_WINDOW'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'error_mail_window',
+	    GROUP => 'Mail',
+	    DEFAULT => 8*60*60,
+	    HELP => 'If more than five error mails are received within the specified time (in seconds), do not forward (to avoid possible mail loops)'
+	},
+	'IDLE_SLEEP_TIME'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'idle_sleep_time',
+	    GROUP => 'Daemon',
+	    DEFAULT => 5*60,
+	    HELP => 'Time to sleep when idle (in seconds) between wanna-build --list=needs-build calls)'
+	},
+	'LOG_QUEUED_MESSAGES'			=> {
+	    TYPE => 'BOOL',
+	    VARNAME => 'log_queued_messages',
+	    GROUP => 'Mail',
+	    DEFAULT => 0,
+	    HELP => 'Log success messages from upload queue daemon?'
+	},
+	'MAX_SBUILD_FAILS'				=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'max_sbuild_fails',
+	    GROUP => 'Daemon',
+	    DEFAULT => 2,
+	    HELP => 'Maximum number of times sbuild can fail before sleeping'
+	},
+	'MIN_FREE_SPACE'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'min_free_space',
+	    GROUP => 'Daemon',
+	    DEFAULT => 50*1024,
+	    HELP => 'Minimum free space (in KiB) on build filesystem'
+	},
+	'NICE_LEVEL'				=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'nice_level',
+	    GROUP => 'Build options',
+	    DEFAULT => 10,
+	    HELP => 'Nice level to run sbuild.  Dedicated build daemons should not be niced.'
+	},
+	'NO_DETACH'				=> {
+	    TYPE => 'BOOL',
+	    VARNAME => 'no_detach',
+	    GROUP => 'Daemon',
+	    DEFAULT => 0,
+	    HELP => 'Disable becoming a daemon, for debugging purposes.  Set to 1 to stop daemonising, otherwise set to 0 to become a daemon.'
+	},
+	'NO_WARN_PATTERN'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'no_warn_pattern',
+	    GROUP => 'Watcher',
+	    DEFAULT => '^build/(SKIP|REDO|SBUILD-GIVEN-BACK|buildd\.pid|[^/]*.ssh|chroot-[^/]*|current-[^/]*)$',
+	    HELP => 'Don\'t complain about old files if they match the regexp.'
+	},
+	'PIDFILE'                               => {
+	    TYPE => 'STRING',
+	    VARNAME => 'pidfile',
+	    GROUP => 'Daemon',
+# Set once running as a system service.
+#          DEFAULT => "${Sbuild::Sysconfig::paths{'LOCALSTATEDIR'}/run/buildd.pid"
+	    IGNORE_DEFAULT => 1, # Don't dump the current home
+	    DEFAULT => "$HOME/build/buildd.pid",
+	    HELP => 'PID file to identify running daemon.'
+	},
+	'PKG_LOG_KEEP'				=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'pkg_log_keep',
+	    GROUP => 'Watcher',
+	    DEFAULT => 7,
+	    HELP => 'Number of days until to package logs are archived'
+	},
+	'SHOULD_BUILD_MSGS'			=> {
+	    TYPE => 'BOOL',
+	    VARNAME => 'should_build_msgs',
+	    GROUP => 'Daemon',
+	    DEFAULT => 1,
+	    HELP => 'Should buildd send "Should I build" messages?'
+	},
+	'STATISTICS_MAIL'			=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'statistics_mail',
+	    GROUP => 'Watcher',
+	    DEFAULT => 'root',
+	    HELP => 'email address for statistics summaries'
+	},
+	'STATISTICS_PERIOD'			=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'statistics_period',
+	    GROUP => 'Watcher',
+	    DEFAULT => 7,
+	    HELP => 'Period for statistic summaries (days)'
+	},
+	'SUDO'					=> {
+	    TYPE => 'STRING',
+	    VARNAME => 'sudo',
+	    GROUP => 'Programs',
+	    CHECK => $validate_program,
+	    DEFAULT => 'sudo',
+	    HELP => 'Path to sudo binary'
+	},
+	'WARNING_AGE'				=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'warning_age',
+	    GROUP => 'Watcher',
+	    DEFAULT => 7,
+	    HELP => 'Age (in days) after which a warning is issued for files in upload and dirs in build'
+	},
+	'CONFIG_TIME'				=> {
+	    TYPE => 'NUMERIC',
+	    VARNAME => 'config_time',
+	    GROUP => '__INTERNAL',
+	    DEFAULT => {},
+	    HELP => 'Time configuration was last read'
+	},
+	'DISTRIBUTIONS'                         => {
+	    TYPE => 'ARRAY:HASH:SCALAR',
+	    VARNAME => 'distributions',
+	    GROUP => 'Build options',
+	    DEFAULT => [],
+	    IGNORE_DEFAULT => 1, # Don't dump class to config
+	    HELP => 'List of distributions that buildd should take packages from',
+	    EXAMPLE =>
+'$distributions = [
+	{
+		# name of the suite to build (also used to query wanna-build)
+		dist_name => ["unstable", "testing"],
+
+		# architecture to be built (will be passed to sbuild and can be
+		# used to compute wanna_build_db_name)
+		built_architecture => undef,
+
+		# host on which wanna-build is run
+		wanna_build_ssh_host => "buildd.debian.org",
+
+		# user as who we are going to connect to the host running wanna-build
+		wanna_build_ssh_user => "buildd_arch",
+
+		# SSH control socket path for ssh -S option
+		wanna_build_ssh_socket => "",
+
+		# Additional SSH options used when connecting
+		wanna_build_ssh_options => [],
+
+		# database used for wanna-build
+		wanna_build_db_name => "arch/build-db",
+
+		# Username to use for wanna-build.
+		wanna_build_db_user => $Buildd::username,
+
+		# Local queue directory where binaries are stored before uploaded
+		# by dupload. You need to configure this directory in
+		# @upload_queues to get packages uploaded from there.
+		dupload_local_queue_dir => "upload",
+
+		# list of packages which shouldn\'t be picked up by buildd
+		no_auto_build => [],
+
+		# list of packages which should only be taken if there absolutely
+		# nothing else to do (probably packages included in no_auto_build
+		# because they take too long)
+		weak_no_auto_build => [],
+
+		# regex used to filter out unwanted packages:
+		#no_build_regex => "^(contrib/|non-free/)?non-US/",
+
+		# regex used to filter packages to build:
+		#build_regex => "",
+
+		# mail addr of buildd admin handling packages from this distribution
+		logs_mailed_to => $admin_mail,
+
+		# schroot name (or alias) of the chrooted environment to use for
+		# building (will be passed to sbuild). sbuild\'s default is
+		# the first of $distribution-$arch-sbuild, $distribution-sbuild,
+		# $distribution-$arch and $distribution.
+		sbuild_chroot => undef,
+
+	}
+];'
+	},
+	'UPLOAD_QUEUES'                         => {
+	    TYPE => 'ARRAY:HASH:SCALAR',
+	    VARNAME => 'upload_queues',
+	    GROUP => 'Uploader',
+	    DEFAULT => [],
+	    IGNORE_DEFAULT => 1, # Don't dump class to config
+	    HELP => 'Package upload queues',
+	    EXAMPLE =>
+'$upload_queues = [
+	{
+		# Local queue directory where binaries are stored before uploaded
+		# by dupload.
+		dupload_local_queue_dir => "upload",
+
+		# Upload site for buildd-upload to pass to dupload(1); see
+		# /etc/dupload.conf for possible values.
+		dupload_archive_name => "anonymous-ftp-master",
+	},
+
+	{
+		# Local queue directory where binaries are stored before uploaded
+		# by dupload.
+		dupload_local_queue_dir => "upload-security",
+
+		# Upload site for buildd-upload to pass to dupload(1); see
+		# /etc/dupload.conf for possible values.
+		dupload_archive_name => "security",
+	}
+];'
+	});
+
+    $conf->set_allowed_keys(\%buildd_keys);
+    Buildd::ClientConf::setup($conf);
+}
+
+sub read ($) {
+    my $conf = shift;
+
+    my $HOME = $conf->get('HOME');
+
+    my $global = $Sbuild::Sysconfig::paths{'BUILDD_CONF'};
+    my $user = "$HOME/.builddrc";
+    my %config_time = ();
+    my $user_time = 0;
+
+    my $reread = 0;
+
+    sub ST_MTIME () { 9 }
+
+    my @config_files = ($global, $user);
+
+    $reread = 1 if $reread_config;
+
+    foreach (@config_files) {
+	if (-r $_) {
+	    $config_time{$_} = 0;
+	    my @stat = stat($_);
+	    if (!defined($conf->get('CONFIG_TIME')->{$_}) ||
+		$conf->get('CONFIG_TIME')->{$_} < $stat[ST_MTIME]) {
+		$config_time{$_} = $stat[ST_MTIME];
+		$reread = 1;
+	    }
+	}
+    }
+
+    # For compatibility only.  Non-scalars are deprecated.
+    my $deprecated_init = <<END;
+# Variables are undefined, so config will default to DEFAULT if unset.
+my \$defaults;
+my \@distributions;
+undef \@distributions;
+my \@upload_queues;
+undef \@upload_queues;
+
+#legacy fields:
+my \@weak_no_auto_build;
+undef \@weak_no_auto_build;
+my \$build_regex = undef; # Should this be user settable?
+my \@no_auto_build;
+undef \@no_auto_build;
+my \$no_build_regex = undef;
+my \@take_from_dists;
+undef \@take_from_dists;
+my \$sshcmd = undef;
+my \$sshsocket = undef;
+my \$wanna_build_user = undef;
+my \$wanna_build_dbbase = undef;
+END
+
+    my $deprecated_setup = '';
+
+    my $custom_setup = <<END;
+if (\$sshcmd && \$sshcmd =~ /^\\s*(\\S+)\\s+(.+)/) {
+    my \$rest = \$2;
+    \$conf->set('SSH', \$1);
+
+    #Try to pry the user out:
+    if (\$rest =~ /(-l\\s*(\\S+))\\s+/) {
+	\$wanna_build_ssh_user = \$2;
+	#purge this from the rest:
+	\$rest =~ s/\\Q\$1//;
+    } elsif (\$rest =~ /\\s+(\\S+)\@/) {
+	\$wanna_build_ssh_user = \$1;
+	\$rest =~ s/\\Q\$1\\E\@//;
+    }
+
+    #Hope that the last argument is the host:
+    if (\$rest =~ /\\s+(\\S+)\\s*\$/) {
+	\$wanna_build_ssh_host = \$1;
+	\$rest =~ s/\\Q\$1//;
+    }
+
+    #rest should be options:
+    if (\$rest !~ /\\s*/) {
+	\$wanna_build_ssh_options = [split \$rest];
+    }
+}
+
+if (\$sshsocket) {
+    \$wanna_build_ssh_socket = \$sshsocket;
+}
+
+if (\$wanna_build_user) {
+    \$wanna_build_db_user = \$wanna_build_user;
+}
+
+if (\$wanna_build_dbbase) {
+    \$wanna_build_db_name = \$wanna_build_dbbase;
+}
+
+#Convert old config, if needed:
+my \@distributions_info;
+if (\@take_from_dists) {
+    for my \$dist (\@take_from_dists) {
+	my \%entry;
+
+	\$entry{DIST_NAME} = \$dist;
+	\$entry{SSH} = \$ssh;
+
+	if (\$dist =~ /security/) {
+	    \$entry{DUPLOAD_LOCAL_QUEUE_DIR} = 'upload-security';
+	}
+	if (\$build_regex) {
+	    \$entry{BUILD_REGEX} = \$build_regex;
+	}
+	if (\$no_build_regex) {
+	    \$entry{NO_BUILD_REGEX} = \$build_regex;
+	}
+	if (\@no_auto_build) {
+	    \$entry{NO_AUTO_BUILD} = \\\@no_auto_build;
+	}
+	if (\@weak_no_auto_build) {
+	    \$entry{WEAK_NO_AUTO_BUILD} = \\\@weak_no_auto_build;
+	}
+
+	\$entry{WANNA_BUILD_DB_NAME} = \$wanna_build_db_name;
+	\$entry{WANNA_BUILD_DB_USER} = \$wanna_build_db_user;
+	\$entry{WANNA_BUILD_SSH_HOST} = \$wanna_build_ssh_host;
+	\$entry{WANNA_BUILD_SSH_USER} = \$wanna_build_ssh_user;
+	\$entry{WANNA_BUILD_SSH_SOCKET} = \$wanna_build_ssh_socket;
+	\$entry{WANNA_BUILD_SSH_OPTIONS} = \$wanna_build_ssh_options;
+                \$entry{WANNA_BUILD_API} = 0;
+
+	my \$dist_config = Buildd::DistConf::new_hash(CHECK=>$conf->{'CHECK'},
+						      HASH=>\\\%entry);
+
+	push \@distributions_info, \$dist_config;
+    }
+} else {
+    my \@dists = ();
+    push \@dists, \@{\$distributions} if defined \$distributions;
+
+    if (\@distributions) {
+	warn 'W: \@distributions is deprecated; please use the array reference \$distributions[]\n';
+	push \@dists, \@distributions;
+    }
+
+    for my \$raw_entry (\@dists) {
+	my \%entry;
+	my \@dist_names;
+
+	#Find out for which distributions this entry is intended:
+	for my \$key (keys \%\$raw_entry) {
+	    if (uc(\$key) eq "DIST_NAME") {
+		if (ref(\$raw_entry->{\$key}) eq "ARRAY") {
+		    push \@dist_names, \@{\$raw_entry->{\$key}};
+		} else {
+		    push \@dist_names, \$raw_entry->{\$key};
+		}
+	    }
+	}
+
+	for my \$key (keys \%\$raw_entry) {
+	    if (uc(\$key) ne "DIST_NAME") {
+		\$entry{uc(\$key)} = \$raw_entry->{\$key};
+	    }
+	}
+
+                for my \$key (keys \%\$defaults) {
+                    if (uc(\$key) ne "DIST_NAME" && not defined \$entry{uc(\$key)}) {
+                        \$entry{uc(\$key)} = \$defaults->{\$key};
+                    }
+                }
+
+                \$entry{WANNA_BUILD_API} //= 1;
+
+
+	#We need this to pass this to Buildd::Client:
+                \$entry{SSH} = \$ssh;
+
+	#Make one entry per distribution, it's easier later on:
+	for my \$dist (\@dist_names) {
+	    \$entry{'DIST_NAME'} = \$dist;
+                    my \$dist_config = Buildd::DistConf::new_hash(HASH=>\\\%entry);
+                    push \@distributions_info, \$dist_config;
+	}
+    }
+}
+
+\$conf->set('DISTRIBUTIONS', \\\@distributions_info);
+
+my \@queues = ();
+push \@queues, \@{\$upload_queues} if defined \$upload_queues;
+
+if (\@upload_queues) {
+    warn 'W: \@upload_queues is deprecated; please use the array reference \$upload_queues[]\n';
+    push \@queues, \@upload_queues;
+}
+
+if (\@queues) {
+    my \@upload_queue_configs;
+    for my \$raw_entry (\@queues) {
+	my \%entry;
+	for my \$key (keys \%\$raw_entry) {
+	    \$entry{uc(\$key)} = \$raw_entry->{\$key};
+	}
+
+	my \$queue_config = Buildd::UploadQueueConf::new_hash(CHECK=>$conf->{'CHECK'},
+							      HASH=>\\\%entry);
+
+	push \@upload_queue_configs, \$queue_config;
+    }
+    \$conf->set('UPLOAD_QUEUES', \\\@upload_queue_configs);
+} else {
+    push \@{\$conf->get('UPLOAD_QUEUES')},
+	Buildd::UploadQueueConf::new_hash(CHECK=>$conf->{'CHECK'},
+					  HASH=>
+	    {
+		DUPLOAD_LOCAL_QUEUE_DIR => 'upload',
+		DUPLOAD_ARCHIVE_NAME    => 'anonymous-ftp-master'
+	    }
+	),
+	Buildd::UploadQueueConf::new_hash(CHECK=>$conf->{'CHECK'},
+					  HASH=>
+	    {
+		DUPLOAD_LOCAL_QUEUE_DIR => 'upload-security',
+		DUPLOAD_ARCHIVE_NAME    => 'security'
+	    }
+	);
+}
+
+# Set here to allow user to override.
+if (-t STDIN && -t STDOUT && \$conf->get('NO_DETACH')) {
+    \$conf->_set_default('VERBOSE', 1);
+} else {
+    \$conf->_set_default('VERBOSE', 0);
+}
+END
+
+    $conf->read(\@config_files, $deprecated_init, $deprecated_setup,
+		$custom_setup);
+
+    # Update times
+    if ($reread) {
+	foreach (@config_files) {
+	    if (-r $_) {
+		$conf->get('CONFIG_TIME')->{$_} = $config_time{$_};
+	    }
+	}
+    }
+}
+
+1;
diff --git a/lib/Buildd/Daemon.pm b/lib/Buildd/Daemon.pm
new file mode 100644
index 0000000..dc07254
--- /dev/null
+++ b/lib/Buildd/Daemon.pm
@@ -0,0 +1,998 @@
+# buildd: daemon to automatically build packages
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2009 Roger Leigh <rleigh@debian.org>
+# 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::Daemon;
+
+use strict;
+use warnings;
+
+use POSIX;
+use Buildd qw(isin lock_file unlock_file send_mail exitstatus);
+use Buildd::Conf qw();
+use Buildd::Base;
+use Sbuild qw($devnull df);
+use Sbuild::Sysconfig;
+use Sbuild::ChrootRoot;
+use Buildd::Client;
+use Cwd;
+
+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('Daemon', 0);
+
+    return $self;
+}
+
+sub ST_MTIME () { 9 }
+
+sub run {
+    my $self = shift;
+
+    my $host = Sbuild::ChrootRoot->new($self->get('Config'));
+    $host->set('Log Stream', $self->get('Log Stream'));
+    $self->set('Host', $host);
+    $host->begin_session() or die "Can't begin session\n";
+
+    my $my_binary = $0;
+    $my_binary = cwd . "/" . $my_binary if $my_binary !~ m,^/,;
+    $self->set('MY_BINARY', $my_binary);
+
+    my @bin_stats = stat( $my_binary );
+    die "Cannot stat $my_binary: $!\n" if !@bin_stats;
+    $self->set('MY_BINARY_TIME', $bin_stats[ST_MTIME]);
+
+    chdir( $self->get_conf('HOME') . "/build" )
+	or die "Can't cd to " . $self->get_conf('HOME') . "/build: $!\n";
+
+    open( STDIN, "</dev/null" )
+	or die "$0: can't redirect stdin to /dev/null: $!\n";
+
+    if (open( PID, "<" . $self->get_conf('PIDFILE') )) {
+	my $pid = <PID>;
+	close( PID );
+	$pid =~ /^[[:space:]]*(\d+)/; $pid = $1;
+	if (!$pid || (kill( 0, $pid ) == 0 && $! == ESRCH)) {
+	    warn "Removing stale pid file (process $pid dead)\n";
+	}
+	else {
+	    die "Another buildd (pid $pid) is already running.\n";
+	}
+    }
+
+    if (!@{$self->get_conf('DISTRIBUTIONS')}) {
+	die "distribution list is empty, aborting.";
+    }
+
+    if (!$self->get_conf('NO_DETACH')) {
+	defined(my $pid = fork) or die "can't fork: $!\n";
+	exit if $pid; # parent exits
+	setsid or die "can't start a new session: $!\n";
+    }
+
+    $self->set('PID', $$); # Needed for cleanup
+    $self->set('Daemon', 1);
+
+    open( PID, ">" . $self->get_conf('PIDFILE') )
+	or die "can't create " . $self->get_conf('PIDFILE') . ": $!\n";
+    printf PID "%5d\n", $self->get('PID');
+    close( PID );
+
+    $self->log("Daemon started. (pid=$$)\n");
+
+    undef $ENV{'DISPLAY'};
+
+# the main loop
+  MAINLOOP:
+    while( 1 ) {
+	$self->check_restart();
+
+        my ( $dist_config, $pkg_ver) = get_next_REDO($self);
+        $self->do_build( $dist_config, $pkg_ver) if $pkg_ver;
+        next MAINLOOP if $pkg_ver;
+
+        ( $dist_config, $pkg_ver) = get_next_WANNABUILD($self);
+        $self->do_build( $dist_config, $pkg_ver) if $pkg_ver;
+        next MAINLOOP if $pkg_ver;
+
+	# sleep a little bit if there was nothing to do this time
+	    $self->log("Nothing to do -- sleeping " .
+		       $self->get_conf('IDLE_SLEEP_TIME') . " seconds\n");
+	    my $idle_start_time = time;
+	    sleep( $self->get_conf('IDLE_SLEEP_TIME') );
+	    my $idle_end_time = time;
+	    $self->write_stats("idle-time", $idle_end_time - $idle_start_time);
+    }
+
+    return 0;
+}
+
+sub get_next_WANNABUILD {
+    my $self = shift;
+	foreach my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) {
+	    $self->check_ssh_master($dist_config);
+	    my $dist_name = $dist_config->get('DIST_NAME');
+	    my %givenback = $self->read_givenback();
+		my $db = $self->get_db_handle($dist_config);
+	    my $pipe = $db->pipe_query(
+                ($dist_config->get('WANNA_BUILD_API') ? '--api '.$dist_config->get('WANNA_BUILD_API') : ''),
+		'--list=needs-build',
+                ($dist_config->get('WANNA_BUILD_MIN_AGE') ? '--min-age '.$dist_config->get('WANNA_BUILD_MIN_AGE') : ''),
+                );
+	    if (!$pipe) {
+		$self->log("Can't spawn wanna-build --list=needs-build: $!\n");
+		next MAINLOOP;
+	    }
+
+	    my($pkg_ver, $total, $nonex, $lowprio_pkg_ver);
+	    while( <$pipe> ) {
+		my $socket = $dist_config->get('WANNA_BUILD_SSH_SOCKET');
+		if ($socket &&
+		    (/^Couldn't connect to $socket: Connection refused[\r]?$/ ||
+		     /^Control socket connect\($socket\): Connection refused[\r]?$/)) {
+		    unlink($socket);
+		    $self->check_ssh_master($dist_config);
+                    next;
+		}
+		elsif (/^Total (\d+) package/) {
+		    $total = $1;
+		    next;
+		}
+		elsif (/^Database for \S+ doesn.t exist/) {
+		    $nonex = 1;
+		}
+		next if $nonex;
+		next if defined($pkg_ver); #we only want one!
+		my @line = (split( /\s+/, $_));
+		my $pv = $line[0];
+		my $no_build_regex = $dist_config->get('NO_BUILD_REGEX');
+		my $build_regex = $dist_config->get('BUILD_REGEX');
+		next if $no_build_regex && $pv =~ m,$no_build_regex,;
+		next if $build_regex && $pv !~ m,$build_regex,;
+		$pv =~ s,^.*/,,;
+		my $p;
+		($p = $pv) =~ s/_.*$//;
+		next if isin( $p, @{$dist_config->get('NO_AUTO_BUILD')} );
+		next if $givenback{$pv};
+		if (isin( $p, @{$dist_config->get('WEAK_NO_AUTO_BUILD')} )) {
+		    # only consider the first lowprio item if there are
+		    # multiple ones
+		    next if defined($lowprio_pkg_ver);
+		    $lowprio_pkg_ver = $pv;
+		    next;
+		}
+		$pkg_ver = $pv;
+	    }
+	    close( $pipe );
+	    next if $nonex;
+	    if ($?) {
+		$self->log("wanna-build --list=needs-build --dist=${dist_name} failed; status ",
+			   exitstatus($?), "\n");
+		next;
+	    }
+	    $self->log("${dist_name}: total $total packages to build.\n") if defined($total);
+
+	    # Build weak_no_auto packages before the next dist
+	    if (!defined($pkg_ver) && defined($lowprio_pkg_ver)) {
+		$pkg_ver = $lowprio_pkg_ver;
+	    }
+
+	    next if !defined($pkg_ver);
+	    my $todo = $self->do_wanna_build( $dist_config, $pkg_ver );
+	    last if !$todo;
+	    return ( $dist_config, $todo );
+	}
+}
+
+sub get_next_REDO {
+    my $self = shift;
+    my ( $dist_config, $pkg_ver);
+    foreach my $current_dist_config (@{$self->get_conf('DISTRIBUTIONS')}) {
+	$pkg_ver = $self->get_from_REDO( $current_dist_config );
+        $dist_config = $current_dist_config;
+        last if defined($pkg_ver);
+    }
+    return ( $dist_config, $pkg_ver);
+}
+
+
+sub get_from_REDO {
+    my $self = shift;
+    my $wanted_dist_config = shift;
+    my $ret = undef;
+    local( *F );
+
+    lock_file( "REDO" );
+    goto end if ! -f "REDO";
+    if (!open( F, "<REDO" )) {
+	$self->log("File REDO exists, but can't open it: $!\n");
+	goto end;
+    }
+    my @lines = <F>;
+    close( F );
+
+    $self->block_signals();
+    if (!open( F, ">REDO" )) {
+	$self->log("Can't open REDO for writing: $!\n",
+		   "Raw contents:\n@lines\n");
+	goto end;
+    }
+    foreach (@lines) {
+	if (!/^(\S+)\s+(\S+)(?:\s*|\s+(\d+)\s+(\S.*))?$/) {
+	    $self->log("Ignoring/deleting bad line in REDO: $_");
+	    next;
+	}
+	my($pkg, $dist, $binNMUver, $changelog) = ($1, $2, $3, $4);
+	if ($dist eq $wanted_dist_config->get('DIST_NAME') && !defined($ret)) {
+            $ret = {'pv' => $pkg };
+	    if (defined $binNMUver) {
+		$ret->{'changelog'} = $changelog;
+		$ret->{'binNMU'} = $binNMUver;
+	    }
+	} else {
+	    print F $_;
+	}
+    }
+    close( F );
+
+  end:
+    unlock_file( "REDO" );
+    $self->unblock_signals();
+    return $ret;
+}
+
+sub add_given_back ($$) {
+    my $self = shift;
+    my $pkg_ver = shift;
+
+    local( *F );
+    lock_file("SBUILD-GIVEN-BACK", 0);
+
+    if (open( F, ">>SBUILD-GIVEN-BACK" )) {
+	print F $pkg_ver . " " . time() . "\n";
+	close( F );
+    } else {
+	$self->log("Can't open SBUILD-GIVEN-BACK: $!\n");
+    }
+
+    unlock_file("SBUILD-GIVEN-BACK");
+}
+
+sub read_givenback {
+    my $self = shift;
+
+    my %gb;
+    my $now = time;
+    local( *F );
+
+    lock_file( "SBUILD-GIVEN-BACK" );
+
+    if (open( F, "<SBUILD-GIVEN-BACK" )) {
+	%gb = map { split } <F>;
+	close( F );
+    }
+
+    if (open( F, ">SBUILD-GIVEN-BACK" )) {
+	foreach (keys %gb) {
+	    if ($now - $gb{$_} > $self->get_conf('DELAY_AFTER_GIVE_BACK') *60) {
+		delete $gb{$_};
+	    }
+	    else {
+		print F "$_ $gb{$_}\n";
+	    }
+	}
+	close( F );
+    }
+    else {
+	$self->log("Can't open SBUILD-GIVEN-BACK: $!\n");
+    }
+
+  unlock:
+    unlock_file( "SBUILD-GIVEN-BACK" );
+    return %gb;
+}
+
+sub do_wanna_build {
+    my $self = shift;
+
+    my $dist_config = shift;
+    my $pkgver = shift;
+    my @output = ();
+    my $ret = undef;
+    my $n = 0;
+
+    $self->block_signals();
+
+    my $db = $self->get_db_handle($dist_config);
+    if ($dist_config->get('WANNA_BUILD_API') >= 1) {
+        use YAML::Tiny;
+        my $pipe = $db->pipe_query(
+	'--api '.$dist_config->get('WANNA_BUILD_API'),
+       	$pkgver);
+        unless ($pipe) {
+            $self->unblock_signals();
+            $self->log("Can't spawn wanna-build: $!\n");
+            return undef;
+        }
+        local $/ = undef;
+        my $yaml = <$pipe>;
+        $yaml =~ s,^update transactions:.*$,,m; # get rid of simulate output in case simulate is specified above
+        $self->log($yaml);
+        $yaml = YAML::Tiny->read_string($yaml);
+        $yaml = $yaml->[0];
+        foreach my $pkgv (@$yaml) {
+            my $pkg = (keys %$pkgv)[0];
+            my $pkgd;
+            foreach my $k (@{$pkgv->{$pkg}}) {
+                foreach my $l (keys %$k) {
+                    $pkgd->{$l} = $k->{$l};
+                }
+            };
+            if ($pkgd->{'status'} ne 'ok') {
+                $self->log("Can't take $pkg: $pkgd->{'status'}\n");
+                next;
+            }
+            $ret = { 'pv' => $pkgver };
+            # fix SHOULD_BUILD_MSGS
+#              if ($self->get_conf('SHOULD_BUILD_MSGS')) {
+#                  $self->handle_prevfailed( $dist_config, grep( /^\Q$pkg\E_/, @_ ) );
+#              } else {
+#                  push( @output, grep( /^\Q$pkg\E_/, @_ ) );
+            my $fields = { 'changelog' => 'extra-changelog',
+			   'binNMU' => 'binNMU',
+			   'extra-depends' => 'extra-depends',
+			   'extra-conflicts' => 'extra-conflicts',
+			   'build_dep_resolver' => 'build_dep_resolver',
+			   'arch_all' => 'arch_all',
+			   'mail_logs' => 'mail_logs',
+			 };
+            for my $f (keys %$fields) {
+                $ret->{$f} = $pkgd->{$fields->{$f}} if $pkgd->{$fields->{$f}};
+            }
+            last;
+        }
+        close( $pipe );
+        $self->unblock_signals();
+        $self->write_stats("taken", $n) if $n;
+        return $ret;
+    }
+    my $pipe = $db->pipe_query(
+	'-v',
+       	$pkgver);
+    if ($pipe) {
+	while( <$pipe> ) {
+	    next if /^wanna-build Revision/;
+	    if (/^(\S+):\s*ok/) {
+                $ret = { 'pv' => $pkgver };
+		++$n;
+	    }
+	    elsif (/^(\S+):.*NOT OK/) {
+		my $pkg = $1;
+		my $nextline = <$pipe>;
+		chomp( $nextline );
+		$nextline =~ s/^\s+//;
+		$self->log("Can't take $pkg: $nextline\n");
+	    }
+	    elsif (/^(\S+):.*previous version failed/i) {
+		my $pkg = $1;
+		++$n;
+		if ($self->get_conf('SHOULD_BUILD_MSGS')) {
+		    $self->handle_prevfailed( $dist_config, $pkgver );
+		} else {
+                    $ret = { 'pv' => $pkgver };
+		}
+		# skip until ok line
+		while( <$pipe> ) {
+		    last if /^\Q$pkg\E:\s*ok/;
+		}
+	    }
+	    elsif (/^(\S+):.*needs binary NMU (\d+)/) {
+		my $pkg = $1;
+		my $binNMUver = $2;
+		chop (my $changelog = <$pipe>);
+		my $newpkg;
+		++$n;
+
+		push( @output, grep( /^\Q$pkg\E_/, @_ ) );
+                $ret = { 'pv' => $pkgver };
+                $ret->{'changelog'} = $changelog;
+                $ret->{'binNMU'} = $binNMUver;
+		# skip until ok line
+		while( <$pipe> ) {
+		    last if /^\Q$pkg\E:\s*aok/;
+		}
+	    }
+	}
+	close( $pipe );
+	$self->unblock_signals();
+	$self->write_stats("taken", $n) if $n;
+	return $ret;
+    }
+    else {
+	$self->unblock_signals();
+	$self->log("Can't spawn wanna-build: $!\n");
+	return undef;
+    }
+}
+
+sub should_skip {
+    my $self = shift;
+    my $pkgv = shift;
+
+    my $found = 0;
+
+    $self->lock_file("SKIP", 0);
+    goto unlock if !open( F, "SKIP" );
+    my @pkgs = <F>;
+    close(F);
+
+    if (!open( F, ">SKIP" )) {
+	$self->log("Can't open SKIP for writing: $!\n",
+		   "Would write: @pkgs\nminus $pkgv\n");
+	goto unlock;
+    }
+    foreach (@pkgs) {
+	if (/^\Q$pkgv\E$/) {
+	    ++$found;
+	    $self->log("$pkgv found in SKIP file -- skipping building it\n");
+	}
+	else {
+	    print F $_;
+	}
+    }
+    close( F );
+  unlock:
+    $self->unlock_file("SKIP");
+    return $found;
+}
+
+sub do_build {
+    my $self = shift;
+    my $dist_config = shift;
+    my $todo = shift;
+    # $todo = { 'pv' => $pkg_ver, 'changelog' => $binNMUlog->{$pkg_ver}, 'binNMU' => $binNMUver; };
+
+    # If the package to build is in SKIP, then skip.
+    if ($self->should_skip($todo->{'pv'})) {
+	return;
+    }
+
+    my $free_space;
+
+    while (($free_space = df(".")) < $self->get_conf('MIN_FREE_SPACE')) {
+	$self->log("Delaying build, because free space is low ($free_space KB)\n");
+	my $idle_start_time = time;
+	sleep( 10*60 );
+	my $idle_end_time = time;
+	$self->write_stats("idle-time", $idle_end_time - $idle_start_time);
+    }
+
+    $self->log("Starting build (dist=" . $dist_config->get('DIST_NAME') . ") of "
+        .($todo->{'binNMU'} ? "!".$todo->{'binNMU'}."!" : "")
+        ."$todo->{'pv'}\n");
+    $self->write_stats("builds", 1);
+
+    my @sbuild_args = ();
+    if ($self->get_conf('NICE_LEVEL') != 0) {
+	@sbuild_args = ( 'nice', '-n', $self->get_conf('NICE_LEVEL') );
+    }
+
+    push @sbuild_args, 'sbuild',
+			'--apt-update',
+			'--no-apt-upgrade',
+			'--no-apt-distupgrade',
+			'--no-run-lintian',
+			'--batch',
+			"--stats-dir=" . $self->get_conf('HOME') . "/stats",
+			"--dist=" . $dist_config->get('DIST_NAME');
+
+    push @sbuild_args, "--sbuild-mode=buildd";
+    push @sbuild_args, "--mailfrom=".$dist_config->get('MAILFROM') if $dist_config->get('MAILFROM');
+    push @sbuild_args, "--maintainer=".$dist_config->get('MAINTAINER_NAME') if $dist_config->get('MAINTAINER_NAME');
+    push @sbuild_args, "--dpkg-file-suffix=".$self->get_conf('DPKG_FILE_SUFFIX') if $self->get_conf('DPKG_FILE_SUFFIX');
+
+    if ($dist_config->get('SIGN_WITH')) {
+	push @sbuild_args, '--keyid=' . $dist_config->get('SIGN_WITH');
+    }
+
+    #multi-archive-buildd keeps the mailto configuration in the builddrc, so
+    #this needs to be passed over to sbuild. If the buildd config doesn't have
+    #it, we hope that the address is configured in .sbuildrc and the right one:
+    if ($dist_config->get('LOGS_MAILED_TO')) {
+	push @sbuild_args, '--mail-log-to=' . $dist_config->get('LOGS_MAILED_TO');
+    } elsif ($dist_config->get('LOGS_MAIL_ALSO') || $todo->{'mail_logs'}) {
+        push @sbuild_args, '--mail-log-to=' . join (',', grep { $_ } ($dist_config->get('LOGS_MAIL_ALSO'), $todo->{'mail_logs'}));
+    }
+    #Some distributions (bpo, experimental) require a more complex dep resolver.
+    #Ask sbuild to use another build-dep resolver if the config says so:
+    if ($dist_config->get('BUILD_DEP_RESOLVER') || $todo->{'build_dep_resolver'}) {
+	push @sbuild_args, '--build-dep-resolver=' . ($dist_config->get('BUILD_DEP_RESOLVER') || $todo->{'build_dep_resolver'});
+    }
+    if ($dist_config->get('BUILT_ARCHITECTURE')) {
+        if ($dist_config->get('BUILT_ARCHITECTURE') eq 'all') {
+	    push ( @sbuild_args, "--arch-all", "--no-arch-any" );
+        } else {
+            push ( @sbuild_args, "--no-arch-all", "--arch-any", "--arch=" . $dist_config->get('BUILT_ARCHITECTURE') );
+	}
+    }
+    push ( @sbuild_args, "--chroot=" . $dist_config->get('SBUILD_CHROOT') )
+	if $dist_config->get('SBUILD_CHROOT');
+
+
+    push ( @sbuild_args, "--binNMU=$todo->{'binNMU'}") if $todo->{'binNMU'};
+    push ( @sbuild_args, "--make-binNMU=$todo->{'changelog'}") if $todo->{'changelog'};
+    push ( @sbuild_args, "--add-conflicts=$todo->{'extra-conflicts'}") if $todo->{'extra-conflicts'};
+    push ( @sbuild_args, "--add-depends=$todo->{'extra-depends'}") if $todo->{'extra-depends'};
+    push @sbuild_args, $todo->{'pv'};
+    $self->log("command line: @sbuild_args\n");
+
+    $main::sbuild_pid = open(SBUILD_OUT, "-|");
+
+    #We're childish, so call sbuild:
+    if ($main::sbuild_pid == 0) {
+	{ exec (@sbuild_args) };
+	$self->log("Cannot execute sbuild: $!\n");
+	exit(64);
+    }
+
+    if (!defined $main::sbuild_pid) {
+	$self->log("Cannot fork for sbuild: $!\n");
+	goto failed;
+    }
+
+    #We want to collect the first few lines of sbuild output:
+    my ($sbuild_output_line_count, @sbuild_output_buffer) = (0, ());
+    while (<SBUILD_OUT>) {
+	#5 lines are enough:
+	if (++$sbuild_output_line_count < 5) {
+	    push @sbuild_output_buffer, $_;
+	}
+    }
+
+    #We got enough output, now just wait for sbuild to die:
+    my $rc;
+    while (($rc = wait) != $main::sbuild_pid) {
+	if ($rc == -1) {
+	    last if $! == ECHILD;
+	    next if $! == EINTR;
+	    $self->log("wait for sbuild: $!; continuing to wait\n");
+	} elsif ($rc != $main::sbuild_pid) {
+	    $self->log("wait for sbuild: returned unexpected pid $rc\n");
+	}
+    }
+    my $sbuild_exit_code = $?;
+    undef $main::sbuild_pid;
+    close(SBUILD_OUT);
+
+    #Process sbuild's results:
+    my $db = $self->get_db_handle($dist_config);
+    my $failed = 1;
+    my $giveback = 1;
+
+    if (WIFEXITED($sbuild_exit_code)) {
+	my $status = WEXITSTATUS($sbuild_exit_code);
+
+	if ($status == 0) {
+	    $failed = 0;
+	    $giveback = 0;
+	    $self->log("sbuild of $todo->{'pv'} succeeded -- marking as built in wanna-build\n");
+	    $db->run_query('--built', '--dist=' . $dist_config->get('DIST_NAME'), $todo->{'pv'});
+
+	    if ($dist_config->get('SIGN_WITH') && $dist_config->get('BUILT_ARCHITECTURE')) {
+		# XXX: Check if signature is present.
+		$self->move_to_upload($dist_config, $todo->{'pv'}, $todo->{'binNMU'});
+	    }
+	} elsif ($status ==  2) {
+	    $giveback = 0;
+	    $self->log("sbuild of $todo->{'pv'} failed with status $status (build failed) -- marking as attempted in wanna-build\n");
+	    $db->run_query('--attempted', '--dist=' . $dist_config->get('DIST_NAME'), $todo->{'pv'});
+	    $self->write_stats("failed", 1);
+	} else {
+	    $self->log("sbuild of $todo->{'pv'} failed with status $status (local problem) -- giving back\n");
+	}
+    } elsif (WIFSIGNALED($sbuild_exit_code)) {
+	my $sig = WTERMSIG($sbuild_exit_code);
+	$self->log("sbuild of $todo->{'pv'} failed with signal $sig (local problem) -- giving back\n");
+    } else {
+	$self->log("sbuild of $todo->{'pv'} failed with unknown reason (local problem) -- giving back\n");
+    }
+
+    if ($giveback) {
+	$db->run_query('--give-back', '--dist=' . $dist_config->get('DIST_NAME'), $todo->{'pv'});
+	$self->add_given_back($todo->{'pv'});
+	$self->write_stats("give-back", 1);
+    }
+
+    # Check if we encountered some local error to stop further building
+    if ($giveback) {
+	if (!defined $main::sbuild_fails) {
+	    $main::sbuild_fails = 0;
+	}
+
+	$main::sbuild_fails++;
+
+	if ($main::sbuild_fails > $self->get_conf('MAX_SBUILD_FAILS')) {
+	    $self->log("sbuild now failed $main::sbuild_fails times in ".
+		       "a row; going to sleep\n");
+	    send_mail( $self->get_conf('ADMIN_MAIL'),
+		       "Repeated mess with sbuild",
+		       <<EOF );
+The execution of sbuild now failed for $main::sbuild_fails times.
+These are the first $sbuild_output_line_count lines of the last failed sbuild call:
+@sbuild_output_buffer
+
+The daemon is going to sleep for 1 hour, or can be restarted with SIGUSR2.
+EOF
+            my $oldsig;
+	    eval <<'EOF';
+$oldsig = $SIG{'USR2'};
+$SIG{'USR2'} = sub ($) { die "signal\n" };
+my $idle_start_time = time;
+sleep( 60*60 );
+my $idle_end_time = time;
+$SIG{'USR2'} = $oldsig;
+$self->write_stats("idle-time", $idle_end_time - $idle_start_time);
+EOF
+	    $main::sbuild_fails = 0;
+	}
+    }
+    else {
+	# Either a build success or an attempted build will cause the
+	# counter to reset.
+	$main::sbuild_fails = 0;
+    }
+    $self->log("Build finished.\n");
+}
+
+sub move_to_upload {
+    my $self = shift;
+    my $dist_config = shift;
+    my $pv = shift;
+    my $binNMUver = shift;
+
+    my $arch = $dist_config->get('BUILT_ARCHITECTURE');
+    my $upload_dir = $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR');
+    my $file_suffix = $self->get_conf('DPKG_FILE_SUFFIX');
+
+    if ($binNMUver) {
+        $pv .= '+b' . $binNMUver;
+    }
+
+    my $pkg_noepoch = $pv;
+    $pkg_noepoch =~ s/_\d*:/_/;
+
+    my $changes_name = $pkg_noepoch . '_' . $arch . $file_suffix . '.changes';
+    my $upload_path = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR') . '/' . $pkg_noepoch . '_' . $arch . '.upload';
+
+    $self->log("$pv is autosigned, moving to '$upload_dir'\n");
+    if ( -f $upload_path ) {
+        unlink( $upload_path );
+        $self->log("'$upload_path' removed.\n");
+    }
+    system(qw(dcmd mv --),
+        sprintf('%s/build/%s', $self->get_conf('HOME'), $changes_name),
+        sprintf('%s/%s/', $self->get_conf('HOME'), $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR'))
+    );
+    $self->log("$pv moved to '$upload_dir'\n");
+}
+
+sub handle_prevfailed {
+    my $self = shift;
+    my $dist_config = shift;
+    my $pkgv = shift;
+
+    my $dist_name = $dist_config->get('DIST_NAME');
+    my( $pkg, $fail_msg, $changelog);
+
+    $self->log("$pkgv previously failed -- asking admin first\n");
+    ($pkg = $pkgv) =~ s/_.*$//;
+
+    my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query(
+	'--info',
+       	$pkg);
+    if (!$pipe) {
+	$self->log("Can't run wanna-build: $!\n");
+	return;
+    }
+
+    $fail_msg = "";
+    while (<$pipe>) {
+      $fail_msg .= $_;
+    }
+
+    close($pipe);
+    if ($?) {
+	$self->log("wanna-build exited with error $?\n");
+	return;
+    }
+
+    send_mail( $self->get_conf('ADMIN_MAIL'),
+	       "Should I build $pkgv (dist=${dist_name})?",
+	       "The package $pkg failed to build in a previous version. ".
+	       "The fail\n".
+	       "messages are:\n\n$fail_msg\n".
+	       "Should buildd try to build the new version, or should it ".
+	       "fail with the\n".
+	       "same messages again.? Please answer with 'build' (or 'ok'), ".
+	       "or 'fail'.\n" );
+}
+
+sub get_changelog {
+    # This method is currently broken.  It makes some assumptions about source
+    # layout that are no longer true.  Furthermore it tries fetching through
+    # the host instead of creating a session (which is necessary for snapshot-
+    # based chroots) and work in the chroot.
+
+    my $self = shift;
+    my $dist_config = shift;
+    my $pkg = shift;
+
+    my $dist_name = $dist_config->get('DIST_NAME');
+    my $changelog = "";
+    my $analyze = "";
+    my $chroot_apt_options;
+    my $file;
+    my $retried = 0;
+
+    $pkg =~ /^([\w\d.+-]+)_([\w\d:.~+-]+)/;
+    my ($n, $v) = ($1, $2);
+    (my $v_ne = $v) =~ s/^\d+://;
+    my $pkg_ne = "${n}_${v_ne}";
+
+retry:
+    my @schroot = ($self->get_conf('SCHROOT'), '-c',
+		   $dist_name . '-' . $self->get_conf('ARCH') . '-sbuild', '--');
+    my @schroot_root = ($self->get_conf('SCHROOT'), '-c',
+			$dist_name . '-' . $self->get_conf('ARCH') . '-sbuild',
+			'-u', 'root', '--');
+    my $apt_get = $self->get_conf('APT_GET');
+
+    my $pipe = $self->get('Host')->pipe_command(
+	{ COMMAND => [@schroot,
+		      "$apt_get", '-q', '-d',
+		      '--diff-only', 'source', "$n=$v"],
+	  USER => $self->get_conf('USERNAME'),
+	  PRIORITY => 0,
+	});
+    if (!$pipe) {
+	$self->log("Can't run schroot: $!\n");
+	return;
+    }
+
+    my $msg = "";
+    while (<$pipe>) {
+      $msg .= $_;
+    }
+
+    close($pipe);
+
+    if ($? == 0 && $msg !~ /get 0B/) {
+	$analyze = "diff";
+	$file = "${n}_${v_ne}.diff.gz";
+    }
+
+    if (!$analyze) {
+	my $pipe2 = $self->get('Host')->pipe_command(
+	    { COMMAND => [@schroot,
+			  "$apt_get", '-q', '-d',
+			  '--tar-only', 'source', "$n=$v"],
+	      USER => $self->get_conf('USERNAME'),
+	      PRIORITY => 0,
+	    });
+	if (!$pipe2) {
+	    $self->log("Can't run schroot: $!\n");
+	    return;
+	}
+
+	my $msg = <$pipe2>;
+
+	close($pipe2);
+
+	if ($? == 0 && $msg !~ /get 0B/) {
+	    $analyze = "tar";
+	    $file = "${n}_${v_ne}.tar.gz";
+	}
+    }
+
+    if (!$analyze && !$retried) {
+	$self->get('Host')->run_command(
+	    { COMMAND => [@schroot_root,
+			  $apt_get, '-qq',
+			  'update'],
+	      USER => $self->get_conf('USERNAME'),
+	      PRIORITY => 0,
+	      STREAMOUT => $devnull
+	    });
+
+	$retried = 1;
+	goto retry;
+    }
+
+    return "ERROR: cannot find any source" if !$analyze;
+
+    if ($analyze eq "diff") {
+	if (!open( F, "gzip -dc '$file' 2>/dev/null |" )) {
+	    return "ERROR: Cannot spawn gzip to zcat $file: $!";
+	}
+	while( <F> ) {
+	    # look for header line of a file */debian/changelog
+	    last if m,^\+\+\+\s+[^/]+/debian/changelog(\s+|$),;
+	}
+	while( <F> ) {
+	    last if /^---/; # end of control changelog patch
+	    next if /^\@\@/;
+	    $changelog .= "$1\n" if /^\+(.*)$/;
+	    last if /^\+\s+--\s+/;
+	}
+	while( <F> ) { } # read to end of file to avoid broken pipe
+	close( F );
+	if ($?) {
+	    return "ERROR: error status ".exitstatus($?)." from gzip on $file";
+	}
+	unlink( $file );
+    }
+    elsif ($analyze eq "tar") {
+	if (!open( F, "tar -xzOf '$file' '*/debian/changelog' ".
+		   "2>/dev/null |" )) {
+	    return "ERROR: Cannot spawn tar for $file: $!";
+	}
+	while( <F> ) {
+	    $changelog .= $_;
+	    last if /^\s+--\s+/;
+	}
+	while( <F> ) { } # read to end of file to avoid broken pipe
+	close( F );
+	if ($?) {
+	    return "ERROR: error status ".exitstatus($?)." from tar on $file";
+	}
+	unlink( $file );
+    }
+
+    return $changelog;
+}
+
+sub check_restart {
+    my $self = shift;
+    my @stats = stat( $self->get('MY_BINARY') );
+
+    if (@stats && $self->get('MY_BINARY_TIME') != $stats[ST_MTIME]) {
+	$self->log("My binary has been updated -- restarting myself (pid=$$)\n");
+	unlink( $self->get_conf('PIDFILE') );
+	kill ( 15, $main::ssh_pid ) if $main::ssh_pid;
+	exec $self->get('MY_BINARY');
+    }
+
+    if ( -f $self->get_conf('HOME') . "/EXIT-DAEMON-PLEASE" ) {
+	unlink($self->get_conf('HOME') . "/EXIT-DAEMON-PLEASE");
+	$self->shutdown("NONE (flag file exit)");
+    }
+}
+
+sub block_signals {
+    my $self = shift;
+
+    POSIX::sigprocmask( SIG_BLOCK, $main::block_sigset );
+}
+
+sub unblock_signals {
+    my $self = shift;
+
+    POSIX::sigprocmask( SIG_UNBLOCK, $main::block_sigset );
+}
+
+sub check_ssh_master {
+    my $self = shift;
+    my $dist_config = shift;
+
+    my $ssh_socket = $dist_config->get('WANNA_BUILD_SSH_SOCKET');
+
+    return 1 if (!$ssh_socket);
+    return 1 if ( -S $ssh_socket );
+
+    my $ssh_master_pids = {};
+    if ($self->get('SSH_MASTER_PIDS')) {
+	$ssh_master_pids = $self->get('SSH_MASTER_PIDS');
+    } else {
+	$self->set('SSH_MASTER_PIDS', $ssh_master_pids);
+    }
+
+    if ($ssh_master_pids->{$ssh_socket})
+    {
+	my $wpid = waitpid ( $ssh_master_pids->{$ssh_socket}, WNOHANG );
+	return 1 if ($wpid != -1 and $wpid != $ssh_master_pids->{$ssh_socket});
+    }
+
+    my $new_master_pid = fork;
+
+    #We are in the newly forked child:
+    if (defined($new_master_pid) && $new_master_pid == 0) {
+	exec (@{$dist_config->get('WANNA_BUILD_SSH_CMD')}, "-MN");
+    }
+
+    #We are the parent:
+    if (!defined $new_master_pid) {
+	$self->log("Cannot fork for ssh master: $!\n");
+	return 0;
+    }
+
+    $ssh_master_pids->{$ssh_socket} = $new_master_pid;
+
+    while ( ! -S $ssh_socket )
+    {
+	sleep 1;
+	my $wpid = waitpid ( $new_master_pid, WNOHANG );
+	return 0 if ($wpid == -1 or $wpid == $new_master_pid);
+    }
+    return 1;
+}
+
+sub shutdown {
+    my $self = shift;
+    my $signame = shift;
+
+    $self->log("buildd ($$) received SIG$signame -- shutting down\n");
+
+    if ($self->get('SSH_MASTER_PIDS')) {
+	my $ssh_master_pids = $self->get('SSH_MASTER_PIDS');
+	for my $ssh_socket (keys %{$ssh_master_pids}) {
+	    my $master_pid = $ssh_master_pids->{$ssh_socket};
+	    kill ( 15, $master_pid );
+	    delete ( $ssh_master_pids->{$ssh_socket} );
+	}
+    }
+
+    if (defined $main::sbuild_pid) {
+	$self->log("Killing sbuild (pid=$main::sbuild_pid)\n");
+	kill( 15, $main::sbuild_pid );
+	$self->log("Waiting max. 2 minutes for sbuild to finish\n");
+	$SIG{'ALRM'} = sub ($) { die "timeout\n"; };
+	alarm( 120 );
+	eval "waitpid( $main::sbuild_pid, 0 )";
+	alarm( 0 );
+	if ($@) {
+	    $self->log("sbuild did not die!");
+	}
+	else {
+	    $self->log("sbuild died normally");
+	}
+	unlink( "SBUILD-REDO-DUMPED" );
+    }
+    unlink( $self->get('Config')->get('PIDFILE') );
+    $self->log("exiting now\n");
+    $self->close_log();
+    exit 1;
+}
+
+1;
diff --git a/lib/Buildd/DistConf.pm b/lib/Buildd/DistConf.pm
new file mode 100644
index 0000000..6edffba
--- /dev/null
+++ b/lib/Buildd/DistConf.pm
@@ -0,0 +1,159 @@
+#
+# Conf.pm: configuration library for buildd
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2005 Ryan Murray <rmurray@debian.org>
+# Copyright © 2006-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::DistConf;
+
+use strict;
+use warnings;
+
+use Sbuild::ConfBase;
+use Sbuild::Sysconfig;
+use Buildd::ClientConf qw();
+
+BEGIN {
+    use Exporter ();
+    our (@ISA, @EXPORT);
+
+    @ISA = qw(Exporter);
+
+    @EXPORT = qw(new_hash setup read_hash);
+}
+
+sub new_hash (@);
+sub setup ($);
+sub read_hash ($$);
+
+sub new_hash (@) {
+    my %opts = @_;
+
+    my $queue_config = Sbuild::ConfBase->new(%opts);
+
+    Buildd::DistConf::setup($queue_config);
+    Buildd::DistConf::read_hash($queue_config, $opts{'HASH'});
+
+    return $queue_config;
+}
+
+sub setup ($) {
+    my $conf = shift;
+
+    my $validate_directory_in_home = sub {
+	my $conf = shift;
+	my $entry = shift;
+	my $key = $entry->{'NAME'};
+	my $directory = $conf->get($key);
+	my $home_directory = $conf->get('HOME');
+
+	die "$key directory is not defined"
+	    if !defined($directory) || !$directory;
+
+	die "$key directory '$home_directory/$directory' does not exist"
+	    if !-d $home_directory . "/" . $directory;
+    };
+
+    my $arch = $conf->get('ARCH');
+
+    my %buildd_dist_keys = (
+	'DIST_NAME'				=> {
+	    DEFAULT => 'unstable'
+	},
+	'BUILT_ARCHITECTURE'			=> {
+	    DEFAULT => undef,
+	},
+	'SBUILD_CHROOT'                         => {
+	    DEFAULT => undef,
+	},
+	'WANNA_BUILD_SSH_HOST'			=> {
+	    DEFAULT => 'buildd.debian.org'
+	},
+	'WANNA_BUILD_SSH_USER'			=> {
+	    DEFAULT => 'buildd_' . $arch
+	},
+	'WANNA_BUILD_SSH_SOCKET'		=> {
+	    DEFAULT => undef
+	},
+	'WANNA_BUILD_SSH_OPTIONS'		=> {
+	    DEFAULT => []
+	},
+	'WANNA_BUILD_DB_NAME'			=> {
+	    DEFAULT => undef,
+	},
+	'WANNA_BUILD_DB_USER'			=> {
+	    DEFAULT => $Buildd::username
+	},
+	'WANNA_BUILD_API'			=> {
+	    DEFAULT => undef,
+	},
+	'WANNA_BUILD_MIN_AGE'			=> {
+	    DEFAULT => undef,
+	},
+	'DUPLOAD_LOCAL_QUEUE_DIR'		=> {
+	    CHECK => $validate_directory_in_home,
+	    DEFAULT => 'upload'
+	},
+	'NO_AUTO_BUILD'				=> {
+	    DEFAULT => []
+	},
+	'WEAK_NO_AUTO_BUILD'			=> {
+	    DEFAULT => []
+	},
+	'NO_BUILD_REGEX'			=> {
+	    DEFAULT => undef
+	},
+	'BUILD_REGEX'				=> {
+	    DEFAULT => undef
+	},
+	'LOGS_MAILED_TO'			=> {
+	    DEFAULT => undef
+	},
+	'LOGS_MAIL_ALSO'			=> {
+	    DEFAULT => undef
+	},
+	'BUILD_DEP_RESOLVER'			=> {
+	    DEFAULT => undef
+	},
+	'SIGN_WITH'				=> {
+	    DEFAULT => undef
+	},
+	'MAINTAINER_NAME'			=> {
+	    DEFAULT => undef
+	},
+	'MAILFROM'				=> {
+	    DEFAULT => undef
+	},
+        );
+
+    $conf->set_allowed_keys(\%buildd_dist_keys);
+
+    Buildd::ClientConf::setup($conf);
+}
+
+sub read_hash($$) {
+    my $conf = shift;
+    my $data = shift;
+
+    for my $key (keys %$data) {
+	$conf->set($key, $data->{$key});
+    }
+}
+
+1;
diff --git a/lib/Buildd/Mail.pm b/lib/Buildd/Mail.pm
new file mode 100644
index 0000000..09f43ec
--- /dev/null
+++ b/lib/Buildd/Mail.pm
@@ -0,0 +1,1354 @@
+# buildd-mail: mail answer processor for buildd
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2009 Roger Leigh <rleigh@debian.org>
+# 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::Mail;
+
+use strict;
+use warnings;
+
+use Buildd qw(ll_send_mail lock_file unlock_file send_mail exitstatus);
+use Buildd::Conf qw();
+use Buildd::Base;
+use Sbuild qw(binNMU_version $devnull);
+use Sbuild::ChrootRoot;
+use Buildd::Client;
+use POSIX;
+use File::Basename;
+use MIME::QuotedPrint;
+use MIME::Base64;
+use Encode;
+
+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('Mail Error', undef);
+    $self->set('Mail Short Error', undef);
+    $self->set('Mail Header', {});
+    $self->set('Mail Body Text', '');
+
+    $self->open_log();
+
+    return $self;
+}
+
+sub run {
+    my $self = shift;
+
+    chdir($self->get_conf('HOME'));
+
+    $self->set('Mail Error', undef);
+    $self->set('Mail Short Error', undef);
+    $self->set('Mail Header', {});
+    $self->set('Mail Body Text', '');
+
+    $self->process_mail();
+
+    return 0;
+}
+
+
+sub process_mail () {
+    my $self = shift;
+
+# Note: Mail Header (to|from|subject|message-id|date) are mandatory.
+# Check for these and bail out if not present.
+    my $header_text = "";
+    my $lastheader = "";
+
+    $self->set('Mail Header', {});
+
+    $self->set('Mail Error', '');
+    $self->set('Mail Short Error', '');
+    $self->set('Mail Header', {});
+    $self->set('Mail Body Text', '');
+
+    while( <STDIN> ) {
+	$header_text .= $_;
+	last if /^$/;
+
+	if (/^\s/ && $lastheader) {
+	    $_ =~ s/^\s+//;
+	    $_ = "$lastheader $_";
+	}
+
+	if (/^From (\S+)/) {
+	    ;
+	}
+	if (/^([\w\d-]+):\s*(.*)\s*$/) {
+	    my $hname;
+	    ($hname = $1) =~ y/A-Z/a-z/;
+	    $self->get('Mail Header')->{$hname} = $2;
+	    $lastheader = $_;
+	    chomp( $lastheader );
+	}
+	else {
+	    $lastheader = "";
+	}
+    }
+    while( <STDIN> ) {
+	last if !/^\s*$/;
+    }
+
+    $self->set('Mail Body Text',
+	       $self->get('Mail Body Text') . $_)
+	if defined($_);
+
+    if (!eof)
+    {
+	local($/);
+	undef $/;
+	$self->set('Mail Body Text',
+		   $self->get('Mail Body Text') . <STDIN>);
+    }
+
+    if ($self->get('Mail Header')->{'from'} =~ /mail\s+delivery\s+(sub)?system|mailer.\s*daemon/i) {
+	# is an error mail from a mailer daemon
+	# To avoid mail loops if this error resulted from a mail we sent
+	# outselves, we break the loop by not forwarding this mail after the 5th
+	# error mail within 8 hours or so.
+	my $n = $self->add_error_mail();
+	if ($n > 5) {
+	    $self->log("Too much error mails ($n) within ",
+		       int($self->get_conf('ERROR_MAIL_WINDOW')/(60*60)), " hours\n",
+		       "Not forwarding mail from ".$self->get('Mail Header')->{'from'}."\n",
+		       "Subject: " . $self->get('Mail Header')->{'subject'} . "\n");
+	    return;
+	}
+    }
+
+    goto forward_mail if !$self->get('Mail Header')->{'subject'};
+    my $subject = $self->get('Mail Header')->{'subject'};
+    Encode::from_to($subject, "MIME-Header", "utf-8");
+
+    if ($subject =~ /^Re: Log for \S+ build of (\S+)(?: on [\w-]+)? \(dist=(\S+)\)/i) {
+	# reply to a build log
+	my( $package, $dist_name ) = ( $1, $2 );
+
+	my $dist_config = $self->get_dist_config_by_name($dist_name);
+	return if (!$dist_config); #get_dist_config sets the error mail
+
+	my $text = $self->get('Mail Body Text');
+	$text =~ /^(\S+)/;
+	$self->set('Mail Body Text', $text);
+	if (defined($self->get('Mail Header')->{'content-transfer-encoding'})) {
+	    # Decode the mail if necessary.
+	    if ($self->get('Mail Header')->{'content-transfer-encoding'} =~ /quoted-printable/) {
+		$self->set('Mail Body Text',
+			   decode_qp($self->get('Mail Body Text')));
+	    } elsif ($self->get('Mail Header')->{'content-transfer-encoding'} =~ /base64/) {
+		$self->set('Mail Body Text',
+			   decode_base64($self->get('Mail Body Text')));
+	    }
+	}
+	my $keyword = $1;
+	my $from = $self->get('Mail Header')->{'from'};
+	$from = $1 if $from =~ /<(.+)>/;
+	$self->log("Log reply from $from\n");
+	my %newv;
+
+	if ($keyword =~ /^not-for-us/) {
+	    $self->no_build( $package, $dist_config );
+	    $self->purge_pkg( $package, $dist_config );
+	}
+	elsif ($keyword =~ /^up(l(oad)?)?-rem/) {
+	    $self->remove_from_upload( $package, $dist_config );
+	}
+	elsif ($self->check_is_outdated( $dist_config, $package )) {
+	    # Error has been set already -> no action here
+	}
+	elsif ($keyword =~ /^fail/) {
+	    my $text = $self->get('Mail Body Text');
+	    $text =~ s/^fail.*\n(\s*\n)*//;
+	    $text =~ s/\n+$/\n/;
+	    $self->set_to_failed( $package, $dist_config, $text );
+	    $self->purge_pkg( $package, $dist_config );
+	}
+	elsif ($keyword =~ /^ret/) {
+	    if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) {
+		# Error already set
+	    }
+	    else {
+		$self->append_to_REDO( $package, $dist_config );
+	    }
+	}
+	elsif ($keyword =~ /^d(ep(endency)?)?-(ret|w)/) {
+	    if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) {
+		# Error already set
+	    }
+	    else {
+		$self->get('Mail Body Text') =~ /^\S+\s+(.*)$/m;
+		my $deps = $1;
+		$self->set_to_depwait( $package, $dist_config, $deps );
+		$self->purge_pkg( $package, $dist_config );
+	    }
+	}
+	elsif ($keyword =~ /^man/) {
+	    if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) {
+		# Error already set
+	    }
+	    else {
+		# no action
+		$self->log("$package($dist_name) will be finished manually\n");
+	    }
+	}
+	elsif ($keyword =~ /^newv/) {
+	    # build a newer version instead
+	    $self->get('Mail Body Text') =~ /^newv\S*\s+(\S+)/;
+	    my $newv = $1;
+	    if ($newv =~ /_/) {
+		$self->log("Removing unneeded package name from $newv\n");
+		$newv =~ s/^.*_//;
+		$self->log("Result: $newv\n");
+	    }
+	    my $pkgname;
+	    ($pkgname = $package) =~ s/_.*$//;
+	    $self->redo_new_version( $dist_config, $package, "${pkgname}_${newv}" );
+	    $self->purge_pkg( $package, $dist_config );
+	}
+	elsif ($keyword =~ /^(give|back)/) {
+	    $self->get('Mail Body Text') =~ /^(give|back) ([-0-9]+)/;
+	    my $pri = $1;
+	    if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) {
+		# Error already set
+	    }
+	    else {
+		$self->give_back( $package, $dist_config );
+		$self->purge_pkg( $package, $dist_config );
+	    }
+	}
+	elsif ($keyword =~ /^purge/) {
+	    $self->purge_pkg( $package, $dist_config );
+	}
+	elsif ($self->get('Mail Body Text') =~ /^---+\s*BEGIN PGP SIGNED MESSAGE/) {
+	    if ($self->prepare_for_upload( $package,
+					   $self->get('Mail Body Text') )) {
+		$self->purge_pkg( $package, $dist_config );
+	    }
+	}
+	elsif ($self->get('Mail Body Text') =~ /^--/ &&
+	       $self->get('Mail Header')->{'content-type'} =~ m,multipart/signed,) {
+	    my ($prot)  = ($self->get('Mail Header')->{'content-type'} =~ m,protocol="([^"]*)",);
+	    my ($bound) = ($self->get('Mail Header')->{'content-type'} =~ m,boundary="([^"]*)",);
+	    my $text = $self->get('Mail Body Text');
+	    $text =~ s,^--\Q$bound\E\nContent-Type: text/plain; charset=us-ascii\n\n,-----BEGIN PGP SIGNED MESSAGE-----\n\n,;
+	    $text =~ s,--\Q$bound\E\nContent-Type: application/pgp-signature\n\n,,;
+	    $text =~ s,\n\n--\Q$bound\E--\n,,;
+	    $self->set('Mail Body Text', $text);
+	    if ($self->prepare_for_upload($package,
+					  $self->get('Mail Body Text'))) {
+		$self->purge_pkg( $package, $dist_config );
+	    }
+	}
+	else {
+	    $self->set('Mail Short Error',
+		       $self->get('Mail Short Error') .
+		       "Bad keyword in answer $keyword\n");
+	    $self->set('Mail Error',
+		       $self->get('Mail Error') .
+		       "Answer not understood (expected retry, failed, manual,\n".
+		       "dep-wait, giveback, not-for-us, purge, upload-rem,\n".
+		       "newvers, or a signed changes file)\n");
+	}
+    }
+    elsif ($subject =~ /^Re: Should I build (\S+) \(dist=(\S+)\)/i) {
+	# reply whether a prev-failed package should be built
+	my( $package, $dist_name ) = ( $1, $2 );
+
+	my $dist_config = $self->get_dist_config_by_name($dist_name);
+	return if (!$dist_config); #get_dist_config sets the error mail
+
+	$self->get('Mail Body Text') =~ /^(\S+)/;
+	my $keyword = $1;
+	$self->log("Should-build reply for $package($dist_name)\n");
+	if ($self->check_is_outdated( $dist_config, $package )) {
+	    # Error has been set already -> no action here
+	}
+	elsif (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) {
+	    # Error already set
+	}
+	elsif ($keyword =~ /^(build|ok)/) {
+	    $self->append_to_REDO( $package, $dist_config );
+	}
+	elsif ($keyword =~ /^fail/) {
+	    my $text = $self->get_fail_msg( $package, $dist_config );
+	    $self->set_to_failed( $package, $dist_config, $text );
+	}
+	elsif ($keyword =~ /^(not|no-b)/) {
+	    $self->no_build( $package, $dist_config );
+	}
+	elsif ($keyword =~ /^(give|back)/) {
+	    $self->give_back( $package, $dist_config );
+	}
+	else {
+	    $self->set('Mail Short Error',
+		       $self->get('Mail Short Error') .
+		       "Bad keyword in answer $keyword\n");
+	    $self->set('Mail Error',
+		       $self->get('Mail Error') .
+		       "Answer not understood (expected build, ok, fail, ".
+		       "give-back, or no-build)\n");
+	}
+    }
+    elsif ($subject =~ /^Processing of (\S+)/) {
+	my $job = $1;
+	# mail from Erlangen queue daemon: forward all non-success messages
+	my $text = $self->get('Mail Body Text');
+	goto forward_mail if $text !~ /uploaded successfully/mi;
+	$self->log("$job processed by upload queue\n")
+	    if $self->get_conf('LOG_QUEUED_MESSAGES');
+    }
+    elsif ($subject =~ /^([-+~\.\w]+\.changes) (INSTALL|ACCEPT)ED/) {
+	# success mail from dinstall
+	my $changes_f = $1;
+	my( @to_remove, $upload_f, $pkgv );
+	my @upload_dirs = $self->find_upload_dirs_for_changes_file($changes_f);
+
+	if ((scalar @upload_dirs) < 1) {
+	    $self->log("Can't identify upload directory for $changes_f!\n");
+	    return 0;
+	} elsif ((scalar @upload_dirs) > 1) {
+	    $self->log("Found more than one upload directory for $changes_f - not deleting binaries!\n");
+	    return 0;
+	}
+	my $upload_dir = $upload_dirs[0];
+
+	if (-f "$upload_dir/$changes_f" && open( F, "<$upload_dir/$changes_f" )) {
+	    local($/); undef $/;
+	    my $changetext = <F>;
+	    close( F );
+	    push( @to_remove, $self->get_files_from_changes( $changetext ) );
+	} else {
+	    foreach (split( "\n", $self->get('Mail Body Text'))) {
+		if (/^(\[-+~\.\w]+\.(u?deb))$/) {
+		    my $f = $1;
+		    push( @to_remove, $f ) if !grep { $_ eq $f } @to_remove;
+		}
+	    }
+	}
+	($upload_f = $changes_f) =~ s/\.changes$/\.upload/;
+	push( @to_remove, $changes_f, $upload_f );
+	($pkgv = $changes_f) =~ s/_(\S+)\.changes//;
+	$self->log("$pkgv has been installed; removing from upload dir:\n",
+		   "@to_remove\n");
+
+	my @dists;
+	if (open( F, "<$upload_dir/$changes_f" )) {
+	    my $changes_text;
+	    { local($/); undef $/; $changes_text = <F>; }
+	    close( F );
+	    @dists = $self->get_dists_from_changes( $changes_text );
+	} else {
+	    $self->log("Cannot get dists from $upload_dir/$changes_f: $! (assuming unstable)\n");
+	    @dists = ( "unstable" );
+	}
+
+FILE:	foreach (@to_remove) {
+    if (/\.deb$/) {
+	# first listed wins
+	foreach my $dist (@dists) {
+	    if ( -d $self->get_conf('HOME') . "/build/chroot-$dist" &&
+		 -w $self->get_conf('HOME') . "/build/chroot-$dist/var/cache/apt/archives/") {
+		# TODO: send all of to_remove to perl-apt if it's available, setting a try_mv list
+		# that only has build-depends in it.
+		# if that's too much cpu, have buildd use perl-apt if avail to export the
+		# build-depends list, which could then be read in at this point
+		if (system (qw(mv --), "$upload_dir/$_",
+		    $self->get_conf('HOME') .
+		    "/build/chroot-$dist/var/cache/apt/archives/")) {
+		    $self->log("Cannot move $upload_dir/$_ to cache dir\n");
+		} else {
+		    next FILE;
+		}
+	    }
+	}
+    }
+    unlink "$upload_dir/$_"
+	or $self->log("Can't remove $upload_dir/$_: $!\n");
+}
+    }
+    elsif ($subject =~ /^(\S+\.changes) is NEW$/) {
+	# "is new" mail from dinstall
+	my $changes_f = $1;
+	my $pkgv;
+	($pkgv = $changes_f) =~ s/_(\S+)\.changes//;
+	$self->log("$pkgv must be manually dinstall-ed -- delayed\n");
+    }
+    elsif ($subject =~ /^new version of (\S+) \(dist=(\S+)\)$/) {
+	# notice from wanna-build
+	my ($pkg, $dist_name) = ($1, $2);
+	my $dist_config = $self->get_dist_config_by_name($dist_name);
+	goto forward if $self->get('Mail Body Text') !~ /^in version (\S+)\.$/m;
+	my $pkgv = $pkg."_".$1;
+	$self->get('Mail Body Text') =~ /new source version (\S+)\./m;
+	my $newv = $1;
+	$self->log("Build of $pkgv ($dist_name) obsolete -- new version $newv\n");
+	$self->register_outdated( $dist_name, $pkgv, $pkg."_".$newv );
+
+	my @ds;
+	if (!(@ds = $self->check_building_any_dist( $pkgv ))) {
+	    if (!$self->remove_from_REDO( $pkgv )) {
+		$self->append_to_SKIP( $pkgv );
+	    }
+	    $self->purge_pkg( $pkgv, $dist_config );
+	}
+	else {
+	    $self->log("Not deleting, still building for @ds\n");
+	}
+    }
+    elsif ($self->get('Mail Body Text') =~ /^blacklist (\S+)\n$/) {
+	my $pattern = "\Q$1\E";
+	if (open( F, ">>mail-blacklist" )) {
+	    print F "$pattern\n";
+	    close( F );
+	    $self->log("Added $pattern to blacklist.\n");
+	}
+	else {
+	    $self->log("Can't open mail-blacklist for appending: $!\n");
+	}
+    }
+    else {
+	goto forward_mail;
+    }
+
+
+    if ($self->get('Mail Error')) {
+	$self->log("Error: ",
+		   $self->get('Mail Short Error') || $self->get('Mail Error'));
+	$self->reply("Your mail could not be processed:\n" .
+		     $self->get('Mail Error'));
+    }
+    return;
+
+forward_mail:
+    my $header = $self->get('Mail Header');
+    $self->log("Mail from $header->{'from'}\nSubject: $subject\n");
+    if ($self->is_blacklisted( $self->get('Mail Header')->{'from'} )) {
+	$self->log("Address is blacklisted, deleting mail.\n");
+    }
+    else {
+	$self->log("Not for me, forwarding to admin\n");
+	ll_send_mail( $self->get_conf('ADMIN_MAIL'),
+		      "To: $header->{'to'}\n".
+		      ($header->{'cc'} ? "Cc: $header->{'cc'}\n" : "").
+		      "From: $header->{'from'}\n".
+		      "Subject: $header->{'subject'}\n".
+		      "Date: $header->{'date'}\n".
+		      "Message-Id: $header->{'message-id'}\n".
+		      ($header->{'reply-to'} ? "Reply-To: $header->{'reply-to'}\n" : "").
+		      ($header->{'in-reply-to'} ? "In-Reply-To: $header->{'in-reply-to'}\n" : "").
+		      ($header->{'references'} ? "References: $header->{'references'}\n" : "").
+		      ($header->{'content-type'} ? "Content-Type: $header->{'content-type'}\n": "").
+		      "Resent-From: $Buildd::gecos <$Buildd::username\@$Buildd::hostname>\n".
+		      "Resent-To: " . $self->get_conf('ADMIN_MAIL') . "\n\n".
+		      $self->get('Mail Body Text') );
+    }
+}
+
+
+sub prepare_for_upload ($$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $changes = shift;
+
+    $changes =~ s/\n+$/\n/;
+
+    my( @files, @md5, @missing, @md5fail, $i );
+
+    my @to_dists = $self->get_dists_from_changes( $changes );
+    if (!@to_dists) { # probably not a valid changes
+
+	$self->set('Mail Short Error',
+		   $self->get('Mail Error'));
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Couldn't find a valid Distribution: line.\n");
+	return 0;
+    }
+
+    my $changes_filename_arch = $self->get_conf('ARCH');
+    #Try to extract the arch from the actual changes file (see #566398)
+    if ($changes =~ /^Architecture:\s*(.+)/m) {
+	my @arches = grep { $_ ne "all" } split /\s+/, $1;
+	if (@arches > 1) {
+	    $changes_filename_arch = "multi";
+	} else {
+	    $changes_filename_arch = $arches[0];
+	}
+    }
+
+    $changes =~ /^Files:\s*\n((^[ 	]+.*\n)*)/m;
+    foreach (split( "\n", $1 )) {
+	push( @md5, (split( /\s+/, $_ ))[1] );
+	push( @files, (split( /\s+/, $_ ))[5] );
+    }
+    if (!@files) { # probably not a valid changes
+	$self->set('Mail Short Error',
+		   $self->get('Mail Error'));
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "No files listed in changes.\n");
+	return 0;
+    }
+    my @wrong_dists = ();
+    foreach my $d (@to_dists) {
+	push( @wrong_dists, $d )
+	    if !$self->check_state(
+			$pkg,
+			$self->get_dist_config_by_name($d),
+		   	qw(Building Built Install-Wait Reupload-Wait Build-Attempted));
+    }
+    if (@wrong_dists) {
+	$self->set('Mail Short Error',
+		   $self->get('Mail Error'));
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Package $pkg has target distributions @wrong_dists\n".
+		   "for which it isn't registered as Building.\n".
+		   "Please fix this by either modifying the Distribution: ".
+		   "header or\n".
+		   "taking the package in those distributions, too.\n");
+	return 0;
+    }
+
+    for( $i = 0; $i < @files; ++$i ) {
+	if (! -f $self->get_conf('HOME') . "/build/$files[$i]") {
+	    push( @missing, $files[$i] ) ;
+	}
+	else {
+	    my $home = $self->get_conf('HOME');
+	    chomp( my $sum = `md5sum $home/build/$files[$i]` );
+	    push( @md5fail, $files[$i] ) if (split(/\s+/,$sum))[0] ne $md5[$i];
+	}
+    }
+    if (@missing) {
+	$self->set('Mail Short Error',
+		   $self->get('Mail Short Error') .
+		   "Missing files for move: @missing\n");
+    	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "While trying to move the built package $pkg to upload,\n".
+		   "the following files mentioned in the .changes were not found:\n".
+		   "@missing\n");
+	return 0;
+    }
+    if (@md5fail) {
+	$self->set('Mail Short Error',
+		   $self->get('Mail Short Error') .
+		   "md5 failure during move: @md5fail\n");
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "While trying to move the built package $pkg to upload,\n".
+		   "the following files had bad md5 checksums:\n".
+		   "@md5fail\n");
+	return 0;
+    }
+
+    my @upload_dirs = $self->get_upload_queue_dirs ( $changes );
+
+    my $pkg_noep = $pkg;
+    $pkg_noep =~ s/_\d*:/_/;
+    my $changes_name = $pkg_noep . "_" . $changes_filename_arch . ".changes";
+
+    for my $upload_dir (@upload_dirs) {
+    if (! -d $upload_dir &&!mkdir( $upload_dir, 0750 )) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Cannot create directory $upload_dir");
+	$self->log("Cannot create dir $upload_dir\n");
+	return 0;
+    }
+    }
+
+    my $errs = 0;
+    for my $upload_dir (@upload_dirs) {
+	lock_file( $upload_dir );
+	foreach (@files) {
+	    if (system('cp', '--', $self->get_conf('HOME')."/build/$_", "$upload_dir/$_")) {
+		$self->log("Cannot copy $_ to $upload_dir/\n");
+		++$errs;
+	    }
+	}
+
+	open( F, ">$upload_dir/$changes_name" );
+	print F $changes;
+	close( F );
+	unlock_file( $upload_dir );
+	$self->log("Moved $pkg to ", basename($upload_dir), "\n");
+    }
+
+    foreach (@files) {
+	if (!unlink($self->get_conf('HOME') . "/build/$_")) {
+	    $self->log("Cannot remove build/$_\n");
+	    ++$errs;
+	}
+    }
+
+    if ($errs) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Could not move all files to upload dir.");
+	return 0;
+    }
+
+    unlink( $self->get_conf('HOME') . "/build/$changes_name" )
+	or $self->log("Cannot remove " . $self->get_conf('HOME') . "/$changes_name: $!\n");
+}
+
+sub redo_new_version ($$$) {
+    my $self = shift;
+    my $dist_config = shift;
+    my $oldv = shift;
+    my $newv = shift;
+
+    my $err = 0;
+
+	my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query('-v', $newv);
+    if ($pipe) {
+	while(<$pipe>) {
+	    next if /^wanna-build Revision/ ||
+		/^\S+: Warning: Older version / ||
+		/^\S+: ok$/;
+	    $self->set('Mail Error',
+		       $self->get('Mail Error') . $_);
+	    $err = 1;
+	}
+	close($pipe);
+    } else {
+	$self->log("Can't spawn wanna-build: $!\n");
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Can't spawn wanna-build: $!\n");
+	return;
+    }
+    if ($err) {
+	$self->log("Can't take newer version $newv due to wanna-build errors\n");
+	return;
+    }
+    $self->log("Going to build $newv instead of $oldv\n");
+
+    $self->append_to_REDO( $newv, $dist_config );
+}
+
+sub purge_pkg ($$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    my $dir;
+    local( *F );
+
+    $self->remove_from_REDO( $pkg );
+
+    # remove .changes and .deb in build dir (if existing)
+    my $pkg_noep = $pkg;
+    $pkg_noep =~ s/_\d*:/_/;
+    my $changes = "${pkg_noep}_" . $self->get_conf('ARCH') . ".changes";
+    if (-f "build/$changes" && open( F, "<build/$changes" )) {
+	local($/); undef $/;
+	my $changetext = <F>;
+	close( F );
+	my @files = $self->get_files_from_changes( $changetext );
+	push( @files, $changes );
+	$self->log("Purging files: $changes\n");
+	unlink( map { "build/$_" } @files );
+    }
+
+    # schedule dir for purging
+    ($dir = $pkg_noep) =~ s/-[^-]*$//; # remove Debian revision
+    $dir =~ s/_/-/; # change _ to -
+    if (-d "build/chroot-$dist_name/build/$Buildd::username/$dir") {
+	$dir = "build/chroot-$dist_name/build/$Buildd::username/$dir";
+    }
+    else {
+	$dir = "build/$dir";
+    }
+    return if ! -d $dir;
+
+    lock_file( "build/PURGE" );
+    if (open( F, ">>build/PURGE" )) {
+	print F "$dir\n";
+	close( F );
+	$self->log("Scheduled $dir for purging\n");
+    }
+    else {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Can't open build/PURGE: $!\n");
+	$self->log("Can't open build/PURGE: $!\n");
+    }
+    unlock_file( "build/PURGE" );
+}
+
+sub remove_from_upload ($) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+
+    my($changes_f, $upload_f, $changes_text, @to_remove);
+    local( *F );
+
+    $self->log("Remove $pkg from upload dir\n");
+    my $pkg_noep = $pkg;
+    $pkg_noep =~ s/_\d*:/_/;
+    $changes_f = "${pkg_noep}_" . $self->get_conf('ARCH') . ".changes";
+
+    my $upload_dir = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR');
+
+    if (!-f "$upload_dir/$changes_f") {
+	$self->log("$changes_f does not exist\n");
+	return;
+    }
+    if (!open( F, "<$upload_dir/$changes_f" )) {
+	$self->log("Cannot open $upload_dir/$changes_f: $!\n");
+	return;
+    }
+    { local($/); undef $/; $changes_text = <F>; }
+    close( F );
+    @to_remove = $self->get_files_from_changes( $changes_text );
+
+    ($upload_f = $changes_f) =~ s/\.changes$/\.upload/;
+    push( @to_remove, $changes_f, $upload_f );
+
+    $self->log("Removing files:\n", "@to_remove\n");
+    foreach (@to_remove) {
+	unlink "$upload_dir/$_"
+	    or $self->log("Can't remove $upload_dir/$_: $!\n");
+    }
+}
+
+sub append_to_REDO ($$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    local( *F );
+
+    lock_file( "build/REDO" );
+
+    if (open( F, "build/REDO" )) {
+	my @pkgs = <F>;
+	close( F );
+	if (grep( /^\Q$pkg\E\s/, @pkgs )) {
+	    $self->log("$pkg is already in REDO -- not rescheduled\n");
+	    goto unlock;
+	}
+    }
+
+    if (open( F, ">>build/REDO" )) {
+	print F "$pkg $dist_name\n";
+	close( F );
+	$self->log("Scheduled $pkg for rebuild\n");
+    }
+    else {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Can't open build/REDO: $!\n");
+	$self->log("Can't open build/REDO: $!\n");
+    }
+
+  unlock:
+    unlock_file( "build/REDO" );
+}
+
+sub remove_from_REDO ($) {
+    my $self = shift;
+    my $pkg = shift;
+
+    local( *F );
+
+    lock_file( "build/REDO" );
+    goto unlock if !open( F, "<build/REDO" );
+    my @pkgs = <F>;
+    close( F );
+    if (!open( F, ">build/REDO" )) {
+	$self->log("Can't open REDO for writing: $!\n",
+		   "Would write: @pkgs\nminus $pkg\n");
+	goto unlock;
+    }
+    my $done = 0;
+    foreach (@pkgs) {
+	if (/^\Q$pkg\E\s/) {
+	    ++$done;
+	}
+	else {
+	    print F $_;
+	}
+    }
+    close( F );
+    $self->log("Deleted $pkg from REDO list.\n") if $done;
+  unlock:
+    unlock_file( "build/REDO" );
+    return $done;
+}
+
+sub append_to_SKIP ($) {
+    my $self = shift;
+    my $pkg = shift;
+
+    local( *F );
+
+    return if !open( F, "<build/build-progress" );
+    my @lines = <F>;
+    close( F );
+
+    if (grep( /^\s*\Q$pkg\E$/, @lines )) {
+	# pkg is in build-progress, but without a suffix (failed,
+	# successful, currently building), so it can be skipped
+	lock_file( "build/SKIP" );
+	if (open( F, ">>build/SKIP" )) {
+	    print F "$pkg\n";
+	    close( F );
+	    $self->log("Told sbuild to skip $pkg\n");
+	}
+	unlock_file( "build/SKIP" );
+    }
+}
+
+sub check_is_outdated ($$) {
+    my $self = shift;
+    my $dist_config = shift;
+    my $package = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    my %newv;
+    return 0 if !(%newv = $self->is_outdated( $dist_name, $package ));
+
+    my $have_changes = 1 if $self->get('Mail Body Text') =~ /^---+\s*BEGIN PGP SIGNED MESSAGE/;
+
+    # If we have a changes file, we can see which distributions that
+    # package is aimed to. Otherwise, we're out of luck because we can't see
+    # reliably anymore for which distribs the package was for. Let the user
+    # find out this...
+    #
+    # If the package is outdated in all dists we have to consider,
+    # send a plain error message. If only outdated in some of them, send a
+    # modified error that tells to send a restricted changes (with
+    # Distribution: only for those dists where it isn't outdated), or to do
+    # the action manually, because it would be (wrongly) propagated.
+    goto all_outdated if !$have_changes;
+
+    my @check_dists = ();
+    @check_dists = $self->get_dists_from_changes($self->get('Mail Body Text'));
+
+    my @not_outdated = ();
+    my @outdated = ();
+    foreach (@check_dists) {
+	if (!exists $newv{$_}) {
+	    push( @not_outdated, $_ );
+	}
+	else {
+	    push( @outdated, $_ );
+	}
+    }
+    return 0 if !@outdated;
+    if (@not_outdated) {
+	$self->set('Mail Short Error',
+		   $self->get('Mail Short Error') .
+		   "$package ($dist_name) partially outdated ".
+		   "(ok for @not_outdated)\n");
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Package $package ($dist_name) is partially outdated.\n".
+		   "The following new versions have appeared in the meantime:\n ".
+		   join( "\n ", map { "$_: $newv{$_}" } keys %newv )."\n\n".
+		   "Please send a .changes for the following distributions only:\n".
+		   " Distribution: ".join( " ", @not_outdated )."\n");
+    }
+    else {
+      all_outdated:
+	$self->set('Mail Short Error',
+		   $self->get('Mail Short Error') .
+		   "$package ($dist_name) outdated; new versions ".
+		   join( ", ", map { "$_:$newv{$_}" } keys %newv )."\n");
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Package $package ($dist_name) is outdated.\n".
+		   "The following new versions have appeared in the meantime:\n ".
+		   join( "\n ", map { "$_: $newv{$_}" } keys %newv )."\n");
+    }
+    return 1;
+}
+
+sub is_outdated ($$) {
+    my $self = shift;
+    my $dist_name = shift;
+    my $pkg = shift;
+
+    my %result = ();
+    local( *F );
+
+    lock_file( "outdated-packages" );
+    goto unlock if !open( F, "<outdated-packages" );
+    while( <F> ) {
+	my($oldpkg, $newpkg, $t, $d) = split( /\s+/, $_ );
+	$d ||= "unstable";
+	if ($oldpkg eq $pkg && $d eq $dist_name) {
+	    $result{$d} = $newpkg;
+	}
+    }
+    close( F );
+  unlock:
+    unlock_file( "outdated-packages" );
+    return %result;
+}
+
+sub register_outdated ($$$) {
+    my $self = shift;
+    my $dist = shift;
+    my $oldv = shift;
+    my $newv = shift;
+
+    my(@pkgs);
+    local( *F );
+
+    lock_file( "outdated-packages" );
+
+    if (open( F, "<outdated-packages" )) {
+	@pkgs = <F>;
+	close( F );
+    }
+
+    if (!open( F, ">outdated-packages" )) {
+	$self->log("Cannot open outdated-packages for writing: $!\n");
+	goto unlock;
+    }
+    my $now = time;
+    my @d = ();
+    foreach (@pkgs) {
+	my($oldpkg, $newpkg, $t, $d) = split( /\s+/, $_ );
+	$d ||= "unstable";
+	next if ($oldpkg eq $oldv && $d eq $dist) || ($now - $t) > 21*24*60*60;
+	print F $_;
+    }
+    print F "$oldv $newv $now $dist\n";
+    close( F );
+  unlock:
+    unlock_file( "outdated-packages" );
+}
+
+sub set_to_failed ($$$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $text = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    my $is_bugno = 0;
+
+    $text =~  s/^\.$/../mg;
+    $is_bugno = 1 if $text =~ /^\(see #\d+\)$/;
+    return if !$self->check_state( $pkg, $dist_config, $is_bugno ? "Failed" : qw(Built Building Build-Attempted BD-Uninstallable) );
+
+    my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query_out('--failed', $pkg);
+    if ($pipe) {
+	print $pipe "${text}.\n";
+	close($pipe);
+    }
+    if ($?) {
+	my $t = "wanna-build --failed failed with status ".exitstatus($?)."\n";
+	$self->log($t);
+	$self->set('Mail Error',
+		   $self->get('Mail Error') . $t);
+    } elsif ($is_bugno) {
+	$self->log("Bug# appended to fail message of $pkg ($dist_name)\n");
+    }
+    else {
+	$self->log("Set package $pkg ($dist_name) to Failed\n");
+	$self->write_stats("failed", 1);
+    }
+}
+
+sub set_to_depwait ($$$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $deps = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+	my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query_out('--dep-wait', $pkg);
+    if ($pipe) {
+	print $pipe "$deps\n";
+	close($pipe);
+    }
+    if ($?) {
+	my $t = "wanna-build --dep-wait failed with status ".exitstatus($?)."\n";
+	$self->log($t);
+	$self->set('Mail Error',
+		   $self->get('Mail Error') . $t);
+    }
+    else {
+	$self->log("Set package $pkg ($dist_name) to Dep-Wait\nDependencies: $deps\n");
+    }
+    $self->write_stats("dep-wait", 1);
+}
+
+sub give_back ($$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    my $answer;
+
+	my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query('--give-back', $pkg);
+    if ($pipe) {
+	$answer = <$pipe>;
+	close($pipe);
+    }
+    if ($?) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "wanna-build --give-back failed:\n$answer");
+    }
+    else {
+	$self->log("Given back package $pkg ($dist_name)\n");
+    }
+}
+
+sub no_build ($$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+    my $answer_cmd;
+
+    my $answer;
+
+    my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query('--no-build', $pkg);
+    if ($pipe) {
+	$answer = <$pipe>;
+	close($pipe);
+    }
+    if ($?) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "no-build failed:\n$answer");
+    }
+    else {
+	$self->log("Package $pkg ($dist_name) to set Not-For-Us\n");
+    }
+    $self->write_stats("no-build", 1);
+}
+
+sub get_fail_msg ($$) {
+    my $self = shift;
+    my $pkg = shift;
+    my $dist_config = shift;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    $pkg =~ s/_.*//;
+
+    my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query('--info', $pkg);
+    if ($pipe) {
+	my $msg = "";
+	while(<$pipe>) {
+	    if (/^\s*Old-Failed\s*:/) {
+		while(<$pipe>) {
+		    last if /^  \S+\s*/;
+		    $_ =~ s/^\s+//;
+		    if (/^----+\s+\S+\s+----+$/) {
+			last if $msg;
+		    }
+		    else {
+			$msg .= $_;
+		    }
+		}
+		last;
+	    }
+	}
+	close($pipe);
+	return $msg if $msg;
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Couldn't find Old-Failed in info for $pkg\n");
+	return "Same as previous version (couldn't extract the text)\n";
+    } else {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Couldn't start wanna-build --info: $!\n");
+	return "Same as previous version (couldn't extract the text)\n";
+    }
+}
+
+sub check_state ($@) {
+    my $self = shift;
+    my $mail_error = $self->get('Mail Error');
+    my $retval = $self->check_state_internal(@_);
+    # check if we should retry the call
+    if ($retval == -1) {
+	my $interval = int(rand(120));
+	$self->log("Retrying --info in $interval seconds...\n");
+	# reset error to old value
+	$self->set('Mail Error', $mail_error);
+	# 0..120s of sleep ought to be enough for retrying;
+	# for mail bursts, this should get us out of the
+	# crticial mass
+	sleep $interval;
+	$retval = $self->check_state_internal(@_);
+	# remap the -1 retry code to failure
+	if ($retval == -1) {
+	    return 0;
+	} else {
+	    return $retval;
+	}
+    }
+    return $retval;
+}
+
+sub check_state_internal ($$@) {
+    my $self = shift;
+    my $pkgv = shift;
+    my $dist_config = shift;
+    my @wanted_states = @_;
+    my $dist_name = $dist_config->get('DIST_NAME');
+
+    $pkgv =~ /^([^_]+)_(.+)/;
+    my ($pkg, $vers) = ($1, $2);
+
+    my $db = $self->get_db_handle($dist_config);
+    my $pipe = $db->pipe_query('--info', $pkg);
+    if (!$pipe) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Couldn't start wanna-build --info: $!\n");
+	$self->log("Couldn't start wanna-build --info: $!\n");
+	# let check_state() retry if needed
+	return -1;
+    }
+
+    my ($av, $as, $ab, $an);
+    while(<$pipe>) {
+	$av = $1 if /^\s*Version\s*:\s*(\S+)/;
+	$as = $1 if /^\s*State\s*:\s*(\S+)/;
+	$ab = $1 if /^\s*Builder\s*:\s*(\S+)/;
+	$an = $1 if /^\s*Binary-NMU-Version\s*:\s*(\d+)/;
+    }
+    close($pipe);
+
+    if ($?) {
+	my $t = "wanna-build --info failed with status ".exitstatus($?)."\n";
+	$self->log($t);
+	$self->set('Mail Error',
+		   $self->get('Mail Error') . $t);
+	return 0;
+    }
+
+    my $msg = "$pkgv($dist_name) check_state(@wanted_states): ";
+    $av = binNMU_version($av,$an,undef) if (defined $an);
+    if ($av ne $vers) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   $msg."version $av registered as $as\n");
+	return 0;
+    }
+    if (!Buildd::isin( $as, @wanted_states)) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   $msg."state is $as\n");
+	return 0;
+    }
+    if ($as eq "Building" && $ab ne $dist_config->get('WANNA_BUILD_DB_USER')) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   $msg."is building by $ab\n");
+	return 0;
+    }
+    return 1;
+}
+
+sub check_building_any_dist ($) {
+    my $self = shift;
+    my $pkgv = shift;
+
+    my @dists;
+
+    $pkgv =~ /^([^_]+)_(.+)/;
+    my ($pkg, $vers) = ($1, $2);
+
+    for my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) {
+	my $dist_name = $dist_config->get('DIST_NAME');
+
+	my $db = $self->get_db_handle($dist_config);
+	my $pipe = $db->pipe_query('--info', $pkg);
+    if (!$pipe) {
+	$self->set('Mail Error',
+		   $self->get('Mail Error') .
+		   "Couldn't start wanna-build --info: $!\n");
+	return 0;
+    }
+
+    my $text;
+    { local ($/); $text = <$pipe>; }
+    close($pipe);
+
+    while( $text =~ /^\Q$pkg\E\((\w+)\):(.*)\n((\s.*\n)*)/mg ) {
+	my ($dist, $rest, $info) = ($1, $2, $3);
+	next if $rest =~ /not registered/;
+	my ($av, $as, $ab);
+	$av = $1 if $info =~ /^\s*Version\s*:\s*(\S+)/mi;
+	$as = $1 if $info =~ /^\s*State\s*:\s*(\S+)/mi;
+	$ab = $1 if $info =~ /^\s*Builder\s*:\s*(\S+)/mi;
+	push( @dists, $dist )
+	    if $av eq $vers && $as eq "Building" &&
+	    $ab eq $self->get_conf('WANNA_BUILD_DB_USER');
+    }
+    }
+    return @dists;
+}
+
+sub get_files_from_changes ($) {
+    my $self = shift;
+    my $changes_text = shift;
+
+    my(@filelines, @files);
+
+    $changes_text =~ /^Files:\s*\n((^[ 	]+.*\n)*)/m;
+    @filelines = split( "\n", $1 );
+    foreach (@filelines) {
+	push( @files, (split( /\s+/, $_ ))[5] );
+    }
+    return @files;
+}
+
+sub get_dists_from_changes ($) {
+    my $self = shift;
+    my $changes_text = shift;
+
+    $changes_text =~ /^Distribution:\s*(.*)\s*$/mi;
+    return split( /\s+/, $1 );
+}
+
+sub get_upload_queue_dirs ($) {
+    my $self = shift;
+    my $changes_text = shift;
+
+    my %upload_dirs;
+    my @dists = $self->get_dists_from_changes( $changes_text );
+    for my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) {
+	my $upload_dir = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR');
+
+	if (grep { $dist_config->get('DIST_NAME') eq $_ } @dists) {
+	    $upload_dirs{$upload_dir} = 1;
+    }
+    }
+    return keys %upload_dirs;
+}
+
+sub find_upload_dirs_for_changes_file ($) {
+    my $self = shift;
+    my $changes_file_name = shift;
+
+    my %dirs;
+
+    for my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) {
+	my $upload_dir = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR');
+	if (-f "$upload_dir/$changes_file_name") {
+	    $dirs{$upload_dir} = 1;
+	}
+    }
+
+    return keys %dirs;
+}
+
+sub reply ($) {
+    my $self = shift;
+    my $text = shift;
+
+    my( $to, $subj, $quoting );
+
+    $to = $self->get('Mail Header')->{'reply-to'} ||
+	$self->get('Mail Header')->{'from'};
+    $subj = $self->get('Mail Header')->{'subject'};
+    $subj = "Re: $subj" if $subj !~ /^Re\S{0,2}:/;
+    ($quoting = $self->get('Mail Body Text')) =~ s/\n+$/\n/;
+    $quoting =~ s/^/> /mg;
+
+    send_mail( $to, $subj, "$text\n$quoting",
+	       "In-Reply-To: ". $self->get('Mail Header')->{'message-id'}. "\n" );
+}
+
+sub is_blacklisted ($) {
+    my $self = shift;
+    my $addr = shift;
+
+    local( *BL );
+
+    $addr = $1 if $addr =~ /<(.*)>/;
+    return 0 if !open( BL, "<mail-blacklist" );
+    while( <BL> ) {
+	chomp;
+	if ($addr =~ /$_$/) {
+	    close( BL );
+	    return 1;
+	}
+    }
+    close( BL );
+    return 0;
+}
+
+sub add_error_mail () {
+    my $self = shift;
+
+    local( *F );
+    my $now = time;
+    my @em = ();
+
+    if (open( F, "<mail-errormails" )) {
+	chomp( @em = <F> );
+	close( F );
+    }
+    push( @em, $now );
+    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" );
+    }
+
+    return scalar(@em);
+}
+
+1;
diff --git a/lib/Buildd/Makefile.am b/lib/Buildd/Makefile.am
new file mode 100644
index 0000000..5b5b930
--- /dev/null
+++ b/lib/Buildd/Makefile.am
@@ -0,0 +1,42 @@
+# sbuild Makefile template
+#
+#
+# Copyright © 2004-2009  Roger Leigh <rleigh@debian.org>
+#
+# sbuild 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 3 of the License, or
+# (at your option) any later version.
+#
+# sbuild 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/>.
+#
+#####################################################################
+
+include $(top_srcdir)/scripts/global.mk
+
+perlmodbuildddir = $(perlmoddir)/Buildd
+
+MODULES =			\
+	Base.pm			\
+	Client.pm		\
+	ClientConf.pm		\
+	Conf.pm			\
+	DistConf.pm 		\
+	UploadQueueConf.pm 	\
+	Daemon.pm		\
+	Mail.pm			\
+	Uploader.pm		\
+	Watcher.pm
+
+perlmodbuildd_DATA =	\
+	$(MODULES)
+
+EXTRA_DIST =		\
+	$(MODULES)
diff --git a/lib/Buildd/UploadQueueConf.pm b/lib/Buildd/UploadQueueConf.pm
new file mode 100644
index 0000000..d0fb1e0
--- /dev/null
+++ b/lib/Buildd/UploadQueueConf.pm
@@ -0,0 +1,96 @@
+#
+# Conf.pm: configuration library for buildd
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2005 Ryan Murray <rmurray@debian.org>
+# Copyright © 2006-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::UploadQueueConf;
+
+use strict;
+use warnings;
+
+use Sbuild::ConfBase;
+use Sbuild::Sysconfig;
+
+BEGIN {
+    use Exporter ();
+    our (@ISA, @EXPORT);
+
+    @ISA = qw(Exporter);
+
+    @EXPORT = qw(new_hash setup read_hash);
+}
+
+sub new_hash (@);
+sub setup ($);
+sub read_hash ($$);
+
+sub new_hash (@) {
+    my %opts = @_;
+
+    my $queue_config = Sbuild::ConfBase->new(%opts);
+
+    Buildd::UploadQueueConf::setup($queue_config);
+    Buildd::UploadQueueConf::read_hash($queue_config, $opts{'HASH'});
+
+    return $queue_config;
+}
+
+sub setup ($) {
+    my $conf = shift;
+
+    my $validate_directory_in_home = sub {
+	my $conf = shift;
+	my $entry = shift;
+	my $key = $entry->{'NAME'};
+	my $directory = $conf->get($key);
+	my $home_directory = $conf->get('HOME');
+
+	die "$key directory is not defined"
+	    if !defined($directory) || !$directory;
+
+	die "$key directory '$home_directory/$directory' does not exist"
+	    if !-d $home_directory . "/" . $directory;
+    };
+
+    my %dupload_queue_keys = (
+	'DUPLOAD_LOCAL_QUEUE_DIR'		=> {
+	    CHECK => $validate_directory_in_home,
+	    DEFAULT => 'upload'
+	},
+	'DUPLOAD_ARCHIVE_NAME'		=> {
+	    DEFAULT => 'anonymous-ftp-master'
+	},
+    );
+
+    $conf->set_allowed_keys(\%dupload_queue_keys);
+
+    Buildd::ClientConf::setup($conf);
+}
+
+sub read_hash ($$) {
+    my $conf = shift;
+    my $data = shift;
+
+    for my $key (keys %$data) {
+	$conf->set($key, $data->{$key});
+    }
+}
+
+1;
diff --git a/lib/Buildd/Uploader.pm b/lib/Buildd/Uploader.pm
new file mode 100644
index 0000000..302f5da
--- /dev/null
+++ b/lib/Buildd/Uploader.pm
@@ -0,0 +1,274 @@
+# buildd-uploader: upload finished packages for buildd
+# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
+# Copyright © 2009 Roger Leigh <rleigh@debian.org>
+# 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::Uploader;
+
+use strict;
+use warnings;
+
+use Buildd qw(lock_file unlock_file unset_env exitstatus send_mail);
+use Buildd::Base;
+use Buildd::Conf qw();
+
+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('Uploader Lock', undef);
+    $self->set('Uploaded Pkgs', {});
+
+    $self->open_log();
+
+    return $self;
+}
+
+sub run {
+    my $self = shift;
+
+    unset_env();
+
+    $self->set('Uploader Lock',
+	       lock_file("$main::HOME/buildd-uploader", 1));
+
+    if (!$self->get('Uploader Lock')) {
+	$self->log("exiting; another buildd-uploader is still running");
+	return 1;
+    }
+
+    for my $queue_config (@{$self->get_conf('UPLOAD_QUEUES')}) {
+	$self->upload(
+		$queue_config->get('DUPLOAD_LOCAL_QUEUE_DIR'),
+		$queue_config->get('DUPLOAD_ARCHIVE_NAME'));
+    }
+
+    my $uploaded_pkgs = $self->get('Uploaded Pkgs');
+
+    foreach my $archdist (keys %{$uploaded_pkgs}) {
+	$self->log("Set to Uploaded($archdist):$uploaded_pkgs->{$archdist}");
+    }
+
+    return 0;
+}
+
+sub uploaded ($@) {
+    my $self = shift;
+    my $pkg = shift;
+    my $arch_name = shift;
+    my $dist_name = shift;
+
+    my $msgs = "";
+
+    my $dist_config = $self->get_arch_dist_config_by_name($arch_name, $dist_name);
+    my $db = $self->get_db_handle($dist_config);
+
+    my $pipe = $db->pipe_query('--uploaded', $pkg);
+
+    if ($pipe) {
+        while(<$pipe>) {
+	    if (!/^(\S+): Propagating new state /) {
+		$msgs .= $_;
+	    }
+	}
+	close($pipe);
+	if ($msgs or $?) {
+	    $self->log($msgs) if $msgs;
+	    $self->log("wanna-build --uploaded failed with status ",
+			exitstatus($?), "\n" )
+		if $?;
+	} else {
+	    my $archdist_name = "$arch_name/$dist_name";
+	    $self->get('Uploaded Pkgs')->{$archdist_name} .= " $pkg";
+	}
+    } else {
+	$self->log("Can't spawn wanna-build --uploaded: $!\n");
+    }
+}
+
+sub upload ($$) {
+    my $self = shift;
+    my $udir = shift;
+    my $upload_to = shift;
+
+    chdir( "$main::HOME/$udir" ) || return;
+    lock_file( "$main::HOME/$udir" );
+
+    my( $f, $g, @before, @after );
+
+    foreach $f (<*.changes>) {
+	($g = $f) =~ s/\.changes$/\.upload/;
+	push( @before, $f ) if ! -f $g;
+    }
+
+    unlock_file( "$main::HOME/$udir" );
+
+    if (!@before) {
+	$self->log("Nothing to do for $udir\n");
+	return;
+    }
+
+    $self->log(scalar(@before), " jobs to upload in $udir: @before\n");
+
+    foreach $f (@before) {
+	($g = $f) =~ s/\.changes$/\.upload/;
+	my $logref = $self->do_dupload( $upload_to, $f );
+
+	if (defined $logref and scalar(@$logref) > 0) {
+	    my $line;
+
+	    foreach $line (@$logref) {
+		$self->log($line);
+	    }
+	}
+
+	if ( -f $g ) {
+	    if (!open( F, "<$f" )) {
+		$self->log("Cannot open $f: $!\n");
+		next;
+	    }
+	    my $text;
+	    { local($/); undef $/; $text = <F>; }
+	    close( F );
+	    if ($text !~ /^Architecture:\s*(.*)\s*$/m) {
+		$self->log("$f doesn't have a Architecture: field\n");
+		next;
+	    }
+	    my @archs = split( /\s+/, $1 );
+	    if ($text !~ /^Distribution:\s*(.*)\s*$/m) {
+		$self->log("$f doesn't have a Distribution: field\n");
+		next;
+	    }
+	    my @dists = split( /\s+/, $1 );
+	    my ($version,$source,$pkg);
+	    if ($text =~ /^Version:\s*(\S+)\s*$/m) {
+		$version = $1;
+	    }
+	    if ($text =~ /^Source:\s*(\S+)(?:\s+\(\S+\))?\s*$/m) {
+		$source = $1;
+	    }
+	    if (defined($version) and defined($source)) {
+		$pkg = "${source}_$version";
+	    } else {
+		($pkg = $f) =~ s/_\S+\.changes$//;
+	    }
+	    $self->uploaded($pkg, @archs, @dists);
+	} else {
+	    push (@after, $f);
+	}
+    }
+
+    if (@after) {
+	$self->log("The following jobs were not processed (successfully):\n" .
+		   "@after\n");
+    }
+    else {
+	$self->log("dupload successful.\n");
+    }
+    $self->write_stats("uploads", scalar(@before) - scalar(@after));
+}
+
+sub do_dupload ($@) {
+    my $self = shift;
+    my $upload_to = shift;
+
+    my @jobs = @_;
+    my @log;
+    local( *PIPE );
+    my( $current_job, $current_file, @failed, $errs );
+
+    if (!open( PIPE, "dupload -k --to $upload_to @jobs </dev/null 2>&1 |" )) {
+	return "Cannot spawn dupload: $!";
+    }
+
+    my $dup_log = "";
+    while( <PIPE> ) {
+	$dup_log .= $_;
+	chomp;
+	if (/^\[ job \S+ from (\S+\.changes)$/) {
+	    $current_job = $1;
+	}
+	elsif (/^warning: MD5sum mismatch for (\S+), skipping/i) {
+	    my $f = $1;
+	    push( @log, "dupload error: md5sum mismatch for $f\n" );
+	    $errs .= "md5sum mismatch on file $f ($current_job)\n";
+	    push( @failed, $current_job );
+	}
+	elsif (/^\[ Uploading job (\S+)$/) {
+	    $current_job = "$1.changes";
+	}
+	elsif (/dupload fatal error: Can't upload (\S+)/i ||
+	       /^\s(\S+).*scp: (.*)$/) {
+	    my($f, $e) = ($1, $2);
+	    push( @log, "dupload error: upload error for $f\n" );
+	    push( @log, "($e)\n" ) if $e;
+	    $errs .= "upload error on file $f ($current_job)\n";
+	    push( @failed, $current_job );
+	}
+	elsif (/Timeout at [\S]+ line [\d]+$/) {
+	    $errs .= "upload timeout on file $current_job\n";
+	    push( @failed, $current_job );
+	}
+	elsif (/^\s(\S+)\s+[\d.]+ kB /) {
+	    $current_file = $1;
+	}
+    }
+    close( PIPE );
+    if ($?) {
+	if (($? >> 8) == 141) {
+	    push( @log, "dupload error: SIGPIPE (broken connection)\n" );
+	    $errs .= "upload error (broken connection) during ".
+		"file $current_file ($current_job)\n";
+	    push( @failed, $current_job );
+	}
+	else {
+	    push( @log, "dupload exit status ". exitstatus($?)  );
+	    $errs .= "dupload exit status ".exitstatus($?)."\n";
+	    push( @failed, $current_job );
+	}
+    }
+
+    foreach (@failed) {
+	my $u = $_;
+	$u =~ s/\.changes$/\.upload/;
+	unlink( $u );
+	push( @log, "Removed $u due to upload errors.\n" );
+	$errs .= "Removed $u to reupload later.\n";
+    }
+
+    if ($errs) {
+	$errs .= "\nComplete output from dupload:\n\n$dup_log";
+	send_mail($self->get_conf('ADMIN_MAIL'), "dupload errors", $errs);
+    }
+    return \@log;
+}
+
+1;
diff --git a/lib/Buildd/Watcher.pm b/lib/Buildd/Watcher.pm
new file mode 100644
index 0000000..fd83d4e
--- /dev/null
+++ b/lib/Buildd/Watcher.pm
@@ -0,0 +1,528 @@
+# 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;