X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=tools%2Fdebianqueued-0.9%2Fdebianqueued;h=b783ef3a902c5e8c68ec452f31cbf1c13024d436;hb=9fdf31a902a9d3288282f4b0ad6a24ae28a82cc8;hp=45f1242781fe7bc54948fa66a19ad215957b2e22;hpb=4102d0b25732a3fc964e2d3537605c344337c4bb;p=dak.git diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued index 45f12427..b783ef3a 100755 --- a/tools/debianqueued-0.9/debianqueued +++ b/tools/debianqueued-0.9/debianqueued @@ -23,6 +23,7 @@ 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"); @@ -69,6 +70,8 @@ package main; ($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 = ""; @@ -79,7 +82,7 @@ if ( @ARGV == 1 && $ARGV[0] =~ /^-[rk]$/ ) { # 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 = ); close(PIDFILE); if ( !$pid ) { @@ -237,7 +240,6 @@ sub check_incoming_writable(); sub rm(@); sub md5sum($); sub is_debian_file($); -sub get_maintainer($); sub debian_file_stem($); sub msg($@); sub debug(@); @@ -316,7 +318,7 @@ chdir($conf::incoming) $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"; @@ -326,11 +328,11 @@ sleep(1); $SIG{"HUP"} = \&close_log; # redirect stdin, ... to /dev/null -open( STDIN, "&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! @@ -358,7 +360,7 @@ END { } # 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); @@ -567,86 +569,6 @@ sub check_dir() { 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 ", @@ -669,7 +591,7 @@ sub get_filelist_from_known_good_changes($) { my (@filenames); # parse the .changes file - open( CHANGES, "<$changes" ) + open( CHANGES, "<", $changes ) or die "$changes: $!\n"; outer_loop: while () { if (/^Files:/i) { @@ -680,7 +602,7 @@ outer_loop: while () { # 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; @@ -717,7 +639,7 @@ sub process_changes($\@) { 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; @@ -747,7 +669,7 @@ outer_loop: while () { # 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( @@ -868,7 +790,7 @@ outer_loop: while () { $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 = ; close(FAILS); @@ -1065,7 +987,7 @@ outer_loop: while () { 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 ) @@ -1191,7 +1113,7 @@ sub process_commands($) { 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; } @@ -1407,7 +1329,7 @@ outer_loop: while () { } 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" ); @@ -1708,6 +1630,13 @@ sub pgp_check($) { 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 " @@ -1801,7 +1730,7 @@ sub fork_statusd() { # 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); @@ -1847,7 +1776,7 @@ sub write_status_file() { 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); @@ -2154,7 +2083,7 @@ sub check_incoming_writable() { 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 ); @@ -2203,14 +2132,12 @@ sub rm(@) { # 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 : ""; + + open my $fh, "<", $file or return ""; + my $md5 = $md5->addfile($fh); + close $fh; + + return $md5->hexdigest; } ## end sub md5sum($) # @@ -2222,67 +2149,6 @@ sub is_debian_file($) { && $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 () { - - # look for header line of a file */debian/control - last if m,^\+\+\+\s+[^/]+/debian/control(\s+|$),; - } - while () { - 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 () { } # 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 () { - $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 # @@ -2504,16 +2370,16 @@ sub close_log($) { 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" );