use Net::FTP;
use Socket qw( PF_INET AF_INET SOCK_STREAM );
use Config;
+use Sys::Hostname;
+use File::Copy;
+use Digest::MD5;
+
+setlocale(&POSIX::LC_ALL, "C");
# ---------------------------------------------------------------------------
# configuration
$junk = $conf::ar;
$junk = $conf::gzip;
$junk = $conf::cp;
+$junk = $conf::check_md5sum;
#$junk = $conf::ls;
$junk = $conf::chmod;
$junk = @conf::maintainer_mail;
$junk = @conf::targetdir_delayed;
$junk = $conf::mail ||= '/usr/sbin/sendmail';
+$junk = $conf::overridemail;
$conf::target = "localhost" if $conf::upload_method eq "copy";
package main;
( $main::progname = $0 ) =~ s,.*/,,;
+($main::hostname, undef, undef, undef, undef) = gethostbyname(hostname());
+
my %packages = ();
+my $re_file_safe_prefix = qr/\A([a-zA-Z0-9][a-zA-Z0-9_.:~+-]*)/s;
+my $re_file_safe = qr/$re_file_safe_prefix\z/s;
# extract -r and -k args
$main::arg = "";
# test for another instance of the queued already running
my ( $pid, $delayed_dirs, $adelayedcore );
-if ( open( PIDFILE, "<$conf::pidfile" ) ) {
+if ( open( PIDFILE, "<", $conf::pidfile ) ) {
chomp( $pid = <PIDFILE> );
close(PIDFILE);
if ( !$pid ) {
POSIX::sigsuspend($sigset);
waitpid( $pid, WNOHANG );
if ( kill( 0, $pid ) ) {
- print "Daemon started in background (pid $pid)\n";
+ print "Daemon (on $main::hostname) started in background (pid $pid)\n";
exit 0;
} else {
exit 1;
do {
my $version;
- ( $version =
-'Release: 0.9 $Revision: 1.51 $ $Date: 1999/07/08 09:43:21 $ $Author: ftplinux $'
- ) =~ s/\$ ?//g;
+ ( $version = 'Release: 0.95' ) =~ s/\$ ?//g;
print "debianqueued $version\n";
};
sub check_incoming_writable();
sub rm(@);
sub md5sum($);
-sub is_debian_file($);
-sub get_maintainer($);
-sub debian_file_stem($);
sub msg($@);
sub debug(@);
sub init_mail(;$);
$SIG{"HUP"} = "IGNORE";
# open logfile, make it unbuffered
-open( LOG, ">>$conf::logfile" )
+open( LOG, ">>", $conf::logfile )
or die "Cannot open my logfile $conf::logfile: $!\n";
chmod( 0644, $conf::logfile )
or die "Cannot set modes of $conf::logfile: $!\n";
$SIG{"HUP"} = \&close_log;
# redirect stdin, ... to /dev/null
-open( STDIN, "</dev/null" )
+open( STDIN, "<", "/dev/null" )
or die "$main::progname: Can't redirect stdin to /dev/null: $!\n";
-open( STDOUT, ">&LOG" )
+open( STDOUT, ">&", \*LOG )
or die "$main::progname: Can't redirect stdout to $conf::logfile: $!\n";
-open( STDERR, ">&LOG" )
+open( STDERR, ">&", \*LOG )
or die "$main::progname: Can't redirect stderr to $conf::logfile: $!\n";
# ok, from this point usually no "die" anymore, stderr is gone!
-msg( "log", "daemon (pid $$) started\n" );
+msg( "log", "daemon (pid $$) (on $main::hostname) started\n" );
# initialize variables used by send_status before launching the status daemon
$main::dstat = "i";
}
# write the pid file
-open( PIDFILE, ">$conf::pidfile" )
+open( PIDFILE, ">", $conf::pidfile )
or msg( "log", "Can't open $conf::pidfile: $!\n" );
printf PIDFILE "%5d\n", $$;
close(PIDFILE);
# ping target only if there is the possibility that we'll contact it (but
# also don't wait too long).
- my @have_changes = <*.changes *.commands>;
+ my @have_changes = <*.changes *.commands *.dak-commands>;
for ( my $delayed_dirs = 0 ;
$delayed_dirs <= $conf::max_delayed ;
$delayed_dirs++ )
return
);
- # look for *.commands files but not in delayed queues
+ # look for *.commands and *.dak-commands files but not in delayed queues
if ( $adelay == -1 ) {
foreach $file (<*.commands>) {
+ next unless $file =~ /$re_file_safe/;
init_mail($file);
block_signals();
process_commands($file);
write_status_file() if $conf::statusdelay;
finish_mail();
} ## end foreach $file (<*.commands>)
+ foreach $file (<*.dak-commands>) {
+ next unless $file =~ /$re_file_safe/;
+ init_mail($file);
+ block_signals();
+ process_dak_commands($file);
+ unblock_signals();
+ $main::dstat = "c";
+ write_status_file() if $conf::statusdelay;
+ finish_mail();
+ }
} ## end if ( $adelay == -1 )
opendir( INC, "." )
or (
@changes = grep /\.changes$/, @files;
push( @keep_files, @changes ); # .changes files aren't stray
foreach $file (@changes) {
+ next unless $file =~ /$re_file_safe/;
init_mail($file);
# wrap in an eval to allow jumpbacks to here with die in case
my ( $maint, $pattern, @job_files );
if ( $file =~ /^junk-for-writable-test/
|| $file !~ m,$conf::valid_files,
+ || $file !~ /$re_file_safe/
|| $age >= $conf::stray_remove_timeout )
{
msg( "log",
"Deleted stray file ${main::current_incoming_short}/$file\n" )
if rm($file);
- } elsif (
- $age > $conf::no_changes_timeout
- && is_debian_file($file)
- &&
-
- # not already reported
- !( $stats[ST_MODE] & S_ISGID )
- && ( $pattern = debian_file_stem($file) )
- && ( @job_files = glob($pattern) )
- &&
-
- # If a .changes is in the list, it has the same stem as the
- # found file (probably a .orig.tar.gz). Don't report in this
- # case.
- !( grep( /\.changes$/, @job_files ) )
- )
- {
- $maint = get_maintainer($file);
-
- # Don't send a mail if this looks like the recompilation of a
- # package for a non-i386 arch. For those, the maintainer field is
- # useless :-(
- if ( !grep( /(\.dsc|_(i386|all)\.deb)$/, @job_files ) ) {
- msg( "log", "Found an upload without .changes and with no ",
- ".dsc file\n" );
- msg( "log",
- "Not sending a report, because probably ",
- "recompilation job\n" );
- } elsif ($maint) {
- init_mail();
- $main::mail_addr = $maint;
- $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
- $main::mail_subject =
- "Incomplete upload found in " . "Debian upload queue";
- msg(
- "mail",
- "Probably you are the uploader of the following "
- . "file(s) in\n"
- );
- msg( "mail", "the Debian upload queue directory:\n " );
- msg( "mail", join( "\n ", @job_files ), "\n" );
- msg(
- "mail",
- "This looks like an upload, but a .changes file "
- . "is missing, so the job\n"
- );
- msg( "mail", "cannot be processed.\n\n" );
- msg(
- "mail",
- "If no .changes file arrives within ",
- print_time( $conf::stray_remove_timeout - $age ),
- ", the files will be deleted.\n\n"
- );
- msg(
- "mail",
- "If you didn't upload those files, please just "
- . "ignore this message.\n"
- );
- finish_mail();
- msg(
- "log",
- "Sending problem report for an upload without a "
- . ".changes\n"
- );
- msg( "log", "Maintainer: $maint\n" );
- } else {
- msg(
- "log",
- "Found an upload without .changes, but can't "
- . "find a maintainer address\n"
- );
- } ## end else [ if ( !grep( /(\.dsc|_(i386|all)\.deb)$/...
- msg( "log", "Files: @job_files\n" );
-
- # remember we already have sent a mail regarding this file
- foreach (@job_files) {
- my @st = stat($_);
- next if !@st; # file may have disappeared in the meantime
- chmod +( $st[ST_MODE] |= S_ISGID ), $_;
- }
} else {
debug(
"found stray file ${main::current_incoming_short}/$file, deleting in ",
my (@filenames);
# parse the .changes file
- open( CHANGES, "<$changes" )
+ open( CHANGES, "<", $changes )
or die "$changes: $!\n";
outer_loop: while (<CHANGES>) {
if (/^Files:/i) {
# forbid shell meta chars in the name, we pass it to a
# subshell several times...
- $field[5] =~ /^([a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*)/;
+ $field[5] =~ /$re_file_safe/;
if ( $1 ne $field[5] ) {
msg( "log", "found suspicious filename $field[5]\n" );
next;
$pgplines, @files, @filenames, @changes_stats,
$failure_file, $retries, $last_retry, $upload_time,
$file, $do_report, $ls_l, $problems_reported,
- $errs, $pkgname, $signator
+ $errs, $pkgname, $signator, $extralines
);
local (*CHANGES);
local (*FAILS);
msg( "log", "processing ${main::current_incoming_short}/$changes\n" );
# parse the .changes file
- open( CHANGES, "<$changes" )
+ open( CHANGES, "<", $changes )
or die "Cannot open ${main::current_incoming_short}/$changes: $!\n";
$pgplines = 0;
+ $extralines = 0;
$main::mail_addr = "";
@files = ();
outer_loop: while (<CHANGES>) {
if (/^---+(BEGIN|END) PGP .*---+$/) {
++$pgplines;
- } elsif (/^Maintainer:\s*/i) {
+ next;
+ }
+ if ( $pgplines < 1 or $pgplines >= 3 ) {
+ $extralines++ if length $_ > 1;
+ next;
+ }
+ if (/^Maintainer:\s*/i) {
chomp( $main::mail_addr = $' );
$main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
} elsif (/^Source:\s*/i) {
# forbid shell meta chars in the name, we pass it to a
# subshell several times...
- $field[5] =~ /^([a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*)/;
+ $field[5] =~ /$re_file_safe/;
if ( $1 ne $field[5] ) {
msg( "log", "found suspicious filename $field[5]\n" );
msg(
@$keep_list = @filenames;
# some consistency checks
+ if ( $extralines ) {
+ msg( "log,mail",
+"$main::current_incoming_short/$changes contained lines outside the pgp signed "
+."part, cannot process\n" );
+ goto remove_only_changes;
+ } ## end if ( $extralines )
if ( !$main::mail_addr ) {
msg( "log,mail",
"$main::current_incoming_short/$changes doesn't contain a Maintainer: field; "
$failure_file = $changes . ".failures";
$retries = $last_retry = 0;
if ( -f $failure_file ) {
- open( FAILS, "<$failure_file" )
+ open( FAILS, "<", $failure_file )
or die "Cannot open $main::current_incoming_short/$failure_file: $!\n";
my $line = <FAILS>;
close(FAILS);
rm( $changes, @filenames, $failure_file );
} else {
$last_retry = time;
- if ( open( FAILS, ">$failure_file" ) ) {
+ if ( open( FAILS, ">", $failure_file ) ) {
print FAILS "$retries $last_retry\n";
close(FAILS);
chmod( 0600, $failure_file )
#}
} ## end sub process_changes($\@)
+#
+# process one .dak-commands file
+#
+sub process_dak_commands {
+ my $commands = shift;
+
+ msg("log", "processing ${main::current_incoming_short}/$commands\n");
+
+ # TODO: get mail address from signed contents
+ # and NOT implement a third parser for armored PGP...
+ $main::mail_addr = undef;
+
+ # check signature
+ my $signator = pgp_check($commands);
+ if (!$signator) {
+ msg("log,mail",
+ "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n");
+ msg("log,mail",
+ "Removing $main::current_incoming_short/$commands\n");
+ rm($commands);
+ return;
+ }
+ elsif ($signator eq 'LOCAL ERROR') {
+ debug("Can't check signature for $main::current_incoming_short/$commands -- don't process it for now");
+ return;
+ }
+ msg("log,mail", "(PGP/GnuPG signature by $signator)\n");
+
+ # check target
+ my @filenames = ($commands);
+ if (my $ls_l = is_on_target($commands, @filenames)) {
+ msg("log,mail", "$main::current_incoming_short/$commands is already present on target host:\n");
+ msg("log,mail", "$ls_l\n");
+ msg("log,mail", "Job $commands removed.\n");
+ rm($commands);
+ return;
+ }
+
+ if (!copy_to_target($commands)) {
+ msg("log,mail", "$commands couldn't be uploaded to target.\n");
+ msg("log,mail", "Giving up and removing it.\n");
+ rm($commands);
+ return;
+ }
+
+ rm($commands);
+ msg("mail", "$commands uploaded successfully to $conf::target\n");
+}
+
#
# process one .commands file
#
msg( "log", "processing $main::current_incoming_short/$commands\n" );
# parse the .commands file
- if ( !open( COMMANDS, "<$commands" ) ) {
+ if ( !open( COMMANDS, "<", $commands ) ) {
msg( "log", "Cannot open $main::current_incoming_short/$commands: $!\n" );
return;
}
$selecteddelayed = $1;
s,^DELAYED/[0-9]+-day/,,;
}
- if ( $origword eq "--searchdirs" ) {
+ if (m,(^|/)\*,) {
+ msg("mail,log", "$_: filename component cannot start with a wildcard\n");
+ } elsif ( $origword eq "--searchdirs" ) {
$selecteddelayed = -2;
} elsif (m,/,) {
msg(
if ( $afile =~ m/\.changes$/ ) {
utime undef, undef, ("$dir/$afile");
}
- if ( !rename "$dir/$afile", "$target_dir/$afile" ) {
- msg( "mail,log", "rename: $!\n" );
+ if ( !move("$dir/$afile", "$target_dir/$afile") ) {
+ msg( "mail,log", "move: $!\n" );
} else {
msg( "mail,log", "$afile moved to $target_delay-day\n" );
}
} elsif ( $conf::upload_method ne "copy" ) {
msg( "mail,log", "cancel not available\n" );
} elsif (
- $word[1] !~ m,^[a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*\.changes$, )
+ $word[1] !~ m,$re_file_safe_prefix.changes\z, )
{
msg( "mail,log",
"argument to cancel must be one .changes filename without path\n" );
my @thesefiles = ( $achanges =~ m,.*/([^/]*), );
push( @thesefiles, get_filelist_from_known_good_changes($achanges) );
for my $afile (@thesefiles) {
- if ( !rename "$dir/$afile", "$target_dir/$afile" ) {
- msg( "log", "rename: $!\n" );
+ if ( !move("$dir/$afile", "$target_dir/$afile") ) {
+ msg( "log", "move: $!\n" );
} else {
msg( "log", "$afile moved to $target_dir\n" );
}
# check md5sums or sizes on target against our own
my $have_md5sums = 1;
- if ( $conf::upload_method eq "ssh" ) {
- ( $msgs, $stat ) = ssh_cmd("md5sum @files");
- goto err if $stat;
- @md5sum = split( "\n", $msgs );
- } elsif ( $conf::upload_method eq "ftp" ) {
- my ( $rv, $err, $file );
- foreach $file (@files) {
- ( $rv, $err ) = ftp_cmd( "quot", "site", "md5sum", $file );
- if ($err) {
- next if ftp_code() == 550; # file not found
- if ( ftp_code() == 500 ) { # unimplemented
- $have_md5sums = 0;
- goto get_sizes_instead;
- }
- $msgs = $err;
- goto err;
- } ## end if ($err)
- chomp( my $t = ftp_response() );
- push( @md5sum, $t );
- } ## end foreach $file (@files)
- if ( !$have_md5sums ) {
- get_sizes_instead:
+ if ($conf::check_md5sum) {
+ if ( $conf::upload_method eq "ssh" ) {
+ ( $msgs, $stat ) = ssh_cmd("md5sum @files");
+ goto err if $stat;
+ @md5sum = split( "\n", $msgs );
+ } elsif ( $conf::upload_method eq "ftp" ) {
+ my ( $rv, $err, $file );
foreach $file (@files) {
- ( $rv, $err ) = ftp_cmd( "size", $file );
+ ( $rv, $err ) = ftp_cmd( "quot", "site", "md5sum", $file );
if ($err) {
next if ftp_code() == 550; # file not found
+ if ( ftp_code() == 500 ) { # unimplemented
+ $have_md5sums = 0;
+ goto get_sizes_instead;
+ }
$msgs = $err;
goto err;
- }
- push( @md5sum, "$rv $file" );
+ } ## end if ($err)
+ chomp( my $t = ftp_response() );
+ push( @md5sum, $t );
} ## end foreach $file (@files)
- } ## end if ( !$have_md5sums )
- } else {
- ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
- goto err if $stat;
- @md5sum = split( "\n", $msgs );
- }
+ if ( !$have_md5sums ) {
+ get_sizes_instead:
+ foreach $file (@files) {
+ ( $rv, $err ) = ftp_cmd( "size", $file );
+ if ($err) {
+ next if ftp_code() == 550; # file not found
+ $msgs = $err;
+ goto err;
+ }
+ push( @md5sum, "$rv $file" );
+ } ## end foreach $file (@files)
+ } ## end if ( !$have_md5sums )
+ } else {
+ ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
+ goto err if $stat;
+ @md5sum = split( "\n", $msgs );
+ }
- @expected_files = @files;
- foreach (@md5sum) {
- chomp;
- ( $sum, $name ) = split;
- next if !grep { $_ eq $name } @files; # a file we didn't upload??
- next if $sum eq "md5sum:"; # looks like an error message
- if ( ( $have_md5sums && $sum ne md5sum($name) )
- || ( !$have_md5sums && $sum != ( -s $name ) ) )
- {
- msg(
- "log,mail",
- "Upload of $name to $conf::target failed ",
- "(" . ( $have_md5sums ? "md5sum" : "size" ) . " mismatch)\n"
- );
+ @expected_files = @files;
+ foreach (@md5sum) {
+ chomp;
+ ( $sum, $name ) = split;
+ next if !grep { $_ eq $name } @files; # a file we didn't upload??
+ next if $sum eq "md5sum:"; # looks like an error message
+ if ( ( $have_md5sums && $sum ne md5sum($name) )
+ || ( !$have_md5sums && $sum != ( -s $name ) ) )
+ {
+ msg(
+ "log,mail",
+ "Upload of $name to $conf::target failed ",
+ "(" . ( $have_md5sums ? "md5sum" : "size" ) . " mismatch)\n"
+ );
+ goto err;
+ } ## end if ( ( $have_md5sums &&...
+
+ # seen that file, remove it from expect list
+ @expected_files = map { $_ eq $name ? () : $_ } @expected_files;
+ } ## end foreach (@md5sum)
+ if (@expected_files) {
+ msg( "log,mail", "Failed to upload the files\n" );
+ msg( "log,mail", " ", join( ", ", @expected_files ), "\n" );
+ msg( "log,mail", "(Not present on target after upload)\n" );
goto err;
- } ## end if ( ( $have_md5sums &&...
-
- # seen that file, remove it from expect list
- @expected_files = map { $_ eq $name ? () : $_ } @expected_files;
- } ## end foreach (@md5sum)
- if (@expected_files) {
- msg( "log,mail", "Failed to upload the files\n" );
- msg( "log,mail", " ", join( ", ", @expected_files ), "\n" );
- msg( "log,mail", "(Not present on target after upload)\n" );
- goto err;
- } ## end if (@expected_files)
+ } ## end if (@expected_files)
+ } ## end if ($conf::check_md5sum)
if ($conf::chmod_on_target) {
my $stat;
local (*PIPE);
+ if ($file =~ /$re_file_safe/) {
+ $file = $1;
+ } else {
+ msg( "log", "Tainted filename, skipping: $file\n" );
+ return "LOCAL ERROR";
+ }
+
$stat = 1;
if ( -x $conf::gpg ) {
debug( "executing $conf::gpg --no-options --batch "
# open the FIFO for writing; this blocks until someone (probably ftpd)
# opens it for reading
- open( STATFIFO, ">$conf::statusfile" )
+ open( STATFIFO, ">", $conf::statusfile )
or die "Cannot open $conf::statusfile\n";
select(STATFIFO);
return if !$conf::statusfile;
- open( STATFILE, ">$conf::statusfile" )
+ open( STATFILE, ">", $conf::statusfile )
or ( msg( "log", "Could not open $conf::statusfile: $!\n" ), return );
my $oldsel = select(STATFILE);
Net::FTP->new(
$conf::target,
Debug => $conf::ftpdebug,
- Timeout => $conf::ftptimeout
+ Timeout => $conf::ftptimeout,
+ Passive => 1,
)
)
)
my $file = "junk-for-writable-test-" . format_time();
$file =~ s/[ :.]/-/g;
local (*F);
- open( F, ">$file" );
+ open( F, ">", $file );
close(F);
my $rv;
( $rv, $msg ) = ftp_cmd( "put", $file );
#
sub md5sum($) {
my $file = shift;
- my $line;
-
- chomp( $line = `$conf::md5sum $file` );
- debug( "md5sum($file): ",
- $? ? "exit status $?"
- : $line =~ /^(\S+)/ ? $1
- : "match failed" );
- return $? ? "" : $line =~ /^(\S+)/ ? $1 : "";
-} ## end sub md5sum($)
-
-#
-# check if a file probably belongs to a Debian upload
-#
-sub is_debian_file($) {
- my $file = shift;
- return $file =~ /\.(deb|dsc|(diff|tar)\.gz)$/
- && $file !~ /\.orig\.tar\.gz/;
-}
-
-#
-# try to extract maintainer email address from some a non-.changes file
-# return "" if not possible
-#
-sub get_maintainer($) {
- my $file = shift;
- my $maintainer = "";
- local (*F);
-
- if ( $file =~ /\.diff\.gz$/ ) {
-
- # parse a diff
- open( F, "$conf::gzip -dc '$file' 2>/dev/null |" ) or return "";
- while (<F>) {
-
- # look for header line of a file */debian/control
- last if m,^\+\+\+\s+[^/]+/debian/control(\s+|$),;
- }
- while (<F>) {
- last if /^---/; # end of control file patch, no Maintainer: found
- # inside control file patch look for Maintainer: field
- $maintainer = $1, last if /^\+Maintainer:\s*(.*)$/i;
- }
- while (<F>) { } # read to end of file to avoid broken pipe
- close(F) or return "";
- } elsif ( $file =~ /\.(deb|dsc|tar\.gz)$/ ) {
- if ( $file =~ /\.deb$/ && $conf::ar ) {
-
- # extract control.tar.gz from .deb with ar, then let tar extract
- # the control file itself
- open( F,
- "($conf::ar p '$file' control.tar.gz | "
- . "$conf::tar -xOf - "
- . "--use-compress-program $conf::gzip "
- . "control) 2>/dev/null |"
- ) or return "";
- } elsif ( $file =~ /\.dsc$/ ) {
-
- # just do a plain grep
- debug("get_maint: .dsc, no cmd");
- open( F, "<$file" ) or return "";
- } elsif ( $file =~ /\.tar\.gz$/ ) {
-
- # let tar extract a file */debian/control
- open( F,
- "$conf::tar -xOf '$file' "
- . "--use-compress-program $conf::gzip "
- . "\\*/debian/control 2>&1 |"
- ) or return "";
- } else {
- return "";
- }
- while (<F>) {
- $maintainer = $1, last if /^Maintainer:\s*(.*)$/i;
- }
- close(F) or return "";
- } ## end elsif ( $file =~ /\.(deb|dsc|tar\.gz)$/)
-
- return $maintainer;
-} ## end sub get_maintainer($)
-
-#
-# return a pattern that matches all files that probably belong to one job
-#
-sub debian_file_stem($) {
- my $file = shift;
- my ( $pkg, $version );
+ my $md5 = Digest::MD5->new;
- # strip file suffix
- $file =~ s,\.(deb|dsc|changes|(orig\.)?tar\.gz|diff\.gz)$,,;
+ open my $fh, "<", $file or return "";
+ $md5->addfile($fh);
+ close $fh;
- # if not is *_* (name_version), can't derive a stem and return just
- # the file's name
- return $file if !( $file =~ /^([^_]+)_([^_]+)/ );
- ( $pkg, $version ) = ( $1, $2 );
-
- # strip Debian revision from version
- $version =~ s/^(.*)-[\d.+-]+$/$1/;
-
- return "${pkg}_${version}*";
-} ## end sub debian_file_stem($)
+ return $md5->hexdigest;
+} ## end sub md5sum($)
#
# output a messages to several destinations
$Email::Send::Sendmail::SENDMAIL = $conf::mail;
}
+ if ($conf::overridemail) {
+ $addr = $conf::overridemail;
+ }
+
my $date = sprintf "%s",
strftime( "%a, %d %b %Y %T %z", ( localtime(time) ) );
my $message = <<__MESSAGE__;
To: $addr
-From: Archive Administrator <dak\@ftp-master.debian.org>
+From: Debian FTP Masters <ftpmaster\@ftp-master.debian.org>
Subject: $subject
Date: $date
X-Debian: DAK
+X-DAK: DAK
__MESSAGE__
if ( length $package ) {
}
$message .= "\n$text";
- $message .= "\nGreetings,\n\n\tYour Debian queue daemon\n";
+ $message .= "\nGreetings,\n\n\tYour Debian queue daemon (running on host $main::hostname)\n";
my $mail = Email::Send->new;
for (qw[Sendmail SMTP]) {
close(STDOUT);
close(STDERR);
- open( LOG, ">>$conf::logfile" )
+ open( LOG, ">>", $conf::logfile )
or die "Cannot open my logfile $conf::logfile: $!\n";
chmod( 0644, $conf::logfile )
or msg( "log", "Cannot set modes of $conf::logfile: $!\n" );
select( ( select(LOG), $| = 1 )[0] );
- open( STDOUT, ">&LOG" )
+ open( STDOUT, ">&", \*LOG )
or msg( "log",
"$main::progname: Can't redirect stdout to " . "$conf::logfile: $!\n" );
- open( STDERR, ">&LOG" )
+ open( STDERR, ">&", \*LOG )
or msg( "log",
"$main::progname: Can't redirect stderr to " . "$conf::logfile: $!\n" );
msg( "log", "Restart after SIGHUP\n" );