$junk = $conf::max_upload_retries;
$junk = $conf::upload_delay_1;
$junk = $conf::upload_delay_2;
-$junk = $conf::ar;
-$junk = $conf::gzip;
-$junk = $conf::cp;
$junk = $conf::check_md5sum;
#$junk = $conf::ls;
-$junk = $conf::chmod;
$junk = $conf::ftpdebug;
$junk = $conf::ftptimeout;
-$junk = $conf::no_changes_timeout;
$junk = @conf::nonus_packages;
$junk = @conf::test_binaries;
$junk = @conf::maintainer_mail;
# 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 ) {
# check if all programs exist
my $prg;
foreach $prg ( $conf::gpg, $conf::ssh, $conf::scp, $conf::ssh_agent,
- $conf::ssh_add, $conf::md5sum, $conf::mail, $conf::mkfifo )
+ $conf::ssh_add, $conf::mail, $conf::mkfifo )
{
die "Required program $prg doesn't exist or isn't executable\n"
if !-x $prg;
sub ftp_error();
sub ssh_cmd($);
sub scp_cmd(@);
-sub local_cmd($;$);
sub check_alive(;$);
sub check_incoming_writable();
sub rm(@);
sub md5sum($);
-sub is_debian_file($);
-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!
}
# 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);
# 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);
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);
@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",
my (@filenames);
# parse the .changes file
- open( CHANGES, "<$changes" )
+ open( CHANGES, "<", $changes )
or die "$changes: $!\n";
outer_loop: while (<CHANGES>) {
if (/^Files:/i) {
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;
$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 )
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;
}
goto err if !$rv;
}
} else {
- ( $msgs, $stat ) =
- local_cmd( "$conf::cp @files $main::current_targetdir", 'NOCD' );
- goto err if $stat;
+ for my $file (@files) {
+ eval { File::Copy::copy($file, $main::current_targetdir) };
+ if ($@) {
+ $stat = 1;
+ $msgs = $@;
+ goto err;
+ }
+ }
}
# check md5sums or sizes on target against our own
} ## end foreach $file (@files)
} ## end if ( !$have_md5sums )
} else {
- ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
- goto err if $stat;
- @md5sum = split( "\n", $msgs );
+ for my $file (@files) {
+ my $md5 = eval { md5sum("$main::current_targetdir/$file") };
+ if ($@) {
+ $msgs = $@;
+ goto err;
+ }
+ push @md5sum, "$md5 $file" if $md5;
+ }
}
@expected_files = @files;
goto err if !$rv;
} ## end foreach $file (@files)
} else {
- ( $msgs, $stat ) = local_cmd("$conf::chmod 644 @files");
- goto err if $stat;
+ for my $file (@files) {
+ unless (chmod 0644, "$main::current_targetdir/$file") {
+ $msgs = "Could not chmod $file: $!";
+ goto err;
+ }
+ }
}
} ## end if ($conf::chmod_on_target)
# If "permission denied" was among the errors, test if the incoming is
# writable at all.
- if ( $msgs =~ /(permission denied|read-?only file)/i ) {
+ if ( $msgs && $msgs =~ /(permission denied|read-?only file)/i ) {
if ( !check_incoming_writable() ) {
msg( "log,mail", "(The incoming directory seems to be ",
"unwritable.)\n" );
$stat = 1;
if ( -x $conf::gpg ) {
- debug( "executing $conf::gpg --no-options --batch "
- . "--no-default-keyring --always-trust "
- . "--keyring "
- . join( " --keyring ", @conf::keyrings )
- . " --verify '$file'" );
- if (
- !open( PIPE,
- "$conf::gpg --no-options --batch "
- . "--no-default-keyring --always-trust "
- . "--keyring "
- . join( " --keyring ", @conf::keyrings )
- . " --verify '$file'"
- . " 2>&1 |"
- )
- )
- {
- msg( "log", "Can't open pipe to $conf::gpg: $!\n" );
+ my @command = ("$conf::gpg", "--no-options", "--batch", "--no-tty",
+ "--trust-model", "always", "--no-default-keyring",
+ (map +("--keyring" => $_), @conf::keyrings),
+ "--verify", "-");
+ debug( "executing " . join(" ", @command) );
+
+ my $child = open(PIPE, "-|");
+ if (!defined($child)) {
+ msg("log", "Can't open pipe to $conf::gpg: $!\n");
return "LOCAL ERROR";
- } ## end if ( !open( PIPE, "$conf::gpg --no-options --batch "...
+ }
+ if ($child == 0) {
+ unless (open(STDERR, ">&", \*STDOUT)) {
+ print "Could not redirect STDERR.";
+ exit(-1);
+ }
+ unless (open(STDIN, "<", $file)) {
+ print "Could not open $file: $!";
+ exit(-1);
+ }
+ { exec(@command) }; # BLOCK avoids warning about likely unreachable code
+ print "Could not exec gpg: $!";
+ exit(-1);
+ }
+
$output .= $_ while (<PIPE>);
close(PIPE);
$stat = $?;
# 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);
return ( $msg, $stat );
} ## end sub scp_cmd(@)
-sub local_cmd($;$) {
- my $cmd = shift;
- my $nocd = shift;
- my ( $msg, $stat );
-
- my $ecmd = ( $nocd ? "" : "cd $main::current_targetdir; " ) . $cmd;
- debug("executing $ecmd");
- $msg = `($ecmd) 2>&1`;
- $stat = $?;
- return ( $msg, $stat );
-
-} ## end sub local_cmd($;$)
-
#
# check if target is alive (code stolen from Net::Ping.pm)
#
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 );
unlink $file;
ftp_cmd( "delete", $file );
} elsif ( $conf::upload_method eq "copy" ) {
- ( $msg, $stat ) =
- local_cmd( "rm -f $testfile; touch $testfile; " . "rm -f $testfile" );
+ unless(POSIX::access($main::current_targetdir, &POSIX::W_OK)) {
+ $msg = "No write access: $!";
+ $stat = 1;
+ }
}
chomp($msg);
debug("exit status: $stat, output was: $msg");
#
sub md5sum($) {
my $file = shift;
+ my $md5 = Digest::MD5->new;
open my $fh, "<", $file or return "";
- my $md5 = $md5->addfile($fh);
+ $md5->addfile($fh);
close $fh;
return $md5->hexdigest;
} ## 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/;
-}
-
-#
-# return a pattern that matches all files that probably belong to one job
-#
-sub debian_file_stem($) {
- my $file = shift;
- my ( $pkg, $version );
-
- # strip file suffix
- $file =~ s,\.(deb|dsc|changes|(orig\.)?tar\.gz|diff\.gz)$,,;
-
- # 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($)
-
#
# output a messages to several destinations
#
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" );
projects / dak.git / blobdiff