X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=tools%2Fdebianqueued-0.9%2Fdebianqueued;h=776fffea3f79f09723476c390a0cfd9f2f5bcb18;hb=5814e84874cf5fb0566c157173315faa376915fd;hp=fd422e77664a13ec4fbc1bd8be06cfcbb0abeb02;hpb=ec257c02a5d62fd27844c70814acd9616b24b4c8;p=dak.git diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued index fd422e77..776fffea 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 = ""; @@ -387,7 +390,7 @@ while (1) { # 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++ ) @@ -487,7 +490,7 @@ sub check_dir() { 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>) { init_mail($file); @@ -498,6 +501,15 @@ sub check_dir() { write_status_file() if $conf::statusdelay; finish_mail(); } ## end foreach $file (<*.commands>) + foreach $file (<*.dak-commands>) { + 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 ( @@ -671,7 +683,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; @@ -694,7 +706,7 @@ sub process_changes($\@) { $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); @@ -711,12 +723,19 @@ sub process_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 () { 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) { @@ -731,7 +750,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( @@ -762,6 +781,12 @@ outer_loop: while () { @$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; " @@ -1104,6 +1129,55 @@ outer_loop: while () { #} } ## 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 # @@ -1336,7 +1410,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" ); @@ -1637,6 +1711,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 " @@ -2132,14 +2213,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($) # @@ -2322,9 +2401,6 @@ sub send_mail($$$) { my $subject = shift; my $text = shift; -# security is special - $addr = 'team@security.debian.org'; - my $package = keys %main::packages ? join( ' ', keys %main::packages ) : "";