X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=tools%2Fdebianqueued-0.9%2Fdebianqueued;h=fb91ff8be4b578b77726850f496ae4381ca33043;hb=dcafe1e024c63a54db7aa2630772992b41e80af5;hp=d5937abbf410989f3ce8d3672f3380301caa0b20;hpb=0d7358071631adb4b1765220921175436e3f963f;p=dak.git diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued index d5937abb..fb91ff8b 100755 --- a/tools/debianqueued-0.9/debianqueued +++ b/tools/debianqueued-0.9/debianqueued @@ -14,6 +14,7 @@ # require 5.002; +no lib '.'; use strict; use POSIX; use POSIX qw( strftime sys_stat_h sys_wait_h signal_h ); @@ -26,6 +27,7 @@ use File::Copy; use Digest::MD5; setlocale(&POSIX::LC_ALL, "C"); +$ENV{"LC_ALL"} = "C"; # --------------------------------------------------------------------------- # configuration @@ -629,17 +631,34 @@ sub process_changes($\@) { format_status_str( $main::current_changes, "$main::current_incoming_short/$changes" ); $main::dstat = "c"; + $main::mail_addr = ""; write_status_file() if $conf::statusdelay; @$keep_list = (); msg( "log", "processing ${main::current_incoming_short}/$changes\n" ); + # run PGP on the file to check the signature + if ( !( $signator = pgp_check($changes) ) ) { + msg( + "log,mail", + "$main::current_incoming_short/$changes has bad PGP/GnuPG signature!\n" + ); + goto remove_only_changes; + } elsif ( $signator eq "LOCAL ERROR" ) { + + # An error has appened when starting pgp... Don't process the file, + # but also don't delete it + debug( +"Can't PGP/GnuPG check $main::current_incoming_short/$changes -- don't process it for now" + ); + return; + } ## end elsif ( $signator eq "LOCAL ERROR") + # parse the .changes file 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 .*---+$/) { @@ -795,39 +814,6 @@ outer_loop: while () { push( @$keep_list, $failure_file ); } ## end if ( -f $failure_file ) - # run PGP on the file to check the signature - if ( !( $signator = pgp_check($changes) ) ) { - msg( - "log,mail", - "$main::current_incoming_short/$changes has bad PGP/GnuPG signature!\n" - ); - msg( "log", "(uploader $main::mail_addr)\n" ); - remove_only_changes: - msg( - "log,mail", -"Removing $main::current_incoming_short/$changes, but keeping its associated ", - "files for now.\n" - ); - rm($changes); - - # Set SGID bit on associated files, so that the test for Debian files - # without a .changes doesn't consider them. - foreach (@filenames) { - my @st = stat($_); - next if !@st; # file may have disappeared in the meantime - chmod +( $st[ST_MODE] |= S_ISGID ), $_; - } - return; - } elsif ( $signator eq "LOCAL ERROR" ) { - - # An error has appened when starting pgp... Don't process the file, - # but also don't delete it - debug( -"Can't PGP/GnuPG check $main::current_incoming_short/$changes -- don't process it for now" - ); - return; - } ## end elsif ( $signator eq "LOCAL ERROR") - die "Cannot stat ${main::current_incoming_short}/$changes (??): $!\n" if !( @changes_stats = stat($changes) ); @@ -935,9 +921,7 @@ outer_loop: while () { return; } ## end if ( $retries > 0 && (... - if ( $conf::upload_method eq "ftp" ) { - return if !ftp_open(); - } + return if !ftp_open(); # check if the job is already present on target # (moved to here, to avoid bothering target as long as there are errors in @@ -1014,6 +998,17 @@ outer_loop: while () { msg( "log", "$changes processed successfully (uploader $main::mail_addr)\n" ); + return; + + remove_only_changes: + msg( + "log,mail", + "Removing $main::current_incoming_short/$changes, but keeping its " + . "associated files for now.\n" + ); + rm($changes); + return; + # Check for files that have the same stem as the .changes (and weren't # mentioned there) and delete them. It happens often enough that people # upload a .orig.tar.gz where it isn't needed and also not in the @@ -1072,6 +1067,8 @@ sub process_dak_commands { } msg("log,mail", "(PGP/GnuPG signature by $signator)\n"); + return if !ftp_open(); + # check target my @filenames = ($commands); if (my $ls_l = is_on_target($commands, @filenames)) { @@ -1100,21 +1097,39 @@ sub process_commands($) { my $commands = shift; my ( @cmds, $cmd, $pgplines, $signator ); local (*COMMANDS); - my ( @files, $file, @removed, $target_delay ); + my ($file, @removed, $target_delay ); format_status_str( $main::current_changes, $commands ); $main::dstat = "c"; + $main::mail_addr = ""; write_status_file() if $conf::statusdelay; msg( "log", "processing $main::current_incoming_short/$commands\n" ); + # run PGP on the file to check the signature + if ( !( $signator = pgp_check($commands) ) ) { + msg( + "log,mail", + "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n" + ); + goto remove; + } elsif ( $signator eq "LOCAL ERROR" ) { + + # An error has appened when starting pgp... Don't process the file, + # but also don't delete it + debug( +"Can't PGP/GnuPG check $main::current_incoming_short/$commands -- don't process it for now" + ); + return; + } ## end elsif ( $signator eq "LOCAL ERROR") + msg( "log", "(PGP/GnuPG signature by $signator)\n" ); + # parse the .commands file if ( !open( COMMANDS, "<", $commands ) ) { msg( "log", "Cannot open $main::current_incoming_short/$commands: $!\n" ); return; } $pgplines = 0; - $main::mail_addr = ""; @cmds = (); outer_loop: while () { if (/^---+(BEGIN|END) PGP .*---+$/) { @@ -1163,27 +1178,6 @@ outer_loop: while () { goto remove; } ## end if ( $pgplines < 3 ) - # run PGP on the file to check the signature - if ( !( $signator = pgp_check($commands) ) ) { - msg( - "log,mail", - "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n" - ); - remove: - msg( "log,mail", "Removing $main::current_incoming_short/$commands\n" ); - rm($commands); - return; - } elsif ( $signator eq "LOCAL ERROR" ) { - - # An error has appened when starting pgp... Don't process the file, - # but also don't delete it - debug( -"Can't PGP/GnuPG check $main::current_incoming_short/$commands -- don't process it for now" - ); - return; - } ## end elsif ( $signator eq "LOCAL ERROR") - msg( "log", "(PGP/GnuPG signature by $signator)\n" ); - # now process commands msg( "mail", @@ -1196,6 +1190,7 @@ outer_loop: while () { next if @word < 1; if ( $word[0] eq "rm" ) { + my @files = (); foreach ( @word[ 1 .. $#word ] ) { my $origword = $_; if (m,^DELAYED/([0-9]+)-day/,) { @@ -1364,6 +1359,12 @@ outer_loop: while () { rm($commands); msg( "log", "-- End of $main::current_incoming_short/$commands processing\n" ); + return; + + remove: + msg("log,mail", "Removing $main::current_incoming_short/$commands\n"); + rm($commands); + return; } ## end sub process_commands($) sub age_delayed_queues() { @@ -1637,8 +1638,9 @@ sub pgp_check($) { my $output = ""; my $signator; my $found = 0; - my $stat; + my $stat = 1; local (*PIPE); + local $_; if ($file =~ /$re_file_safe/) { $file = $1; @@ -1647,7 +1649,41 @@ sub pgp_check($) { return "LOCAL ERROR"; } - $stat = 1; + # check the file has only one clear-signed section + my $fh; + unless (open $fh, "<", $file) { + msg("log,mail", "Could not open $file\n"); + return ""; + } + unless (<$fh> eq "-----BEGIN PGP SIGNED MESSAGE-----\n") { + msg("log,mail", "$file: does not start with a clearsigned message\n"); + return ""; + } + my $pgplines = 1; + while (<$fh>) { + if (/\A- /) { + msg("log,mail", "$file: dash-escaped messages are not accepted\n"); + return ""; + } + elsif ($_ eq "-----BEGIN PGP SIGNATURE-----\n" + || $_ eq "-----END PGP SIGNATURE-----\n") { + $pgplines++; + } + elsif (/\A--/) { + msg("log,mail", "$file: unexpected OpenPGP armor\n"); + return ""; + } + elsif ($pgplines > 3 && /\S/) { + msg("log,mail", "$file: found text after end of signature\n"); + return ""; + } + } + if ($pgplines != 3) { + msg("log,mail", "$file: doesn't seem to be a valid clearsigned OpenPGP message\n"); + return ""; + } + close $fh; + if ( -x $conf::gpg ) { my @command = ("$conf::gpg", "--no-options", "--batch", "--no-tty", "--trust-model", "always", "--no-default-keyring", @@ -1899,6 +1935,7 @@ sub send_status() { # open FTP connection to target host if not already open # sub ftp_open() { + return 1 unless $conf::upload_method eq "ftp"; if ($main::FTP_chan) { @@ -2238,11 +2275,7 @@ sub send_mail($$$) { my $package = keys %main::packages ? join( ' ', keys %main::packages ) : ""; - use Email::Send; - - unless ( defined($Email::Send::Sendmail::SENDMAIL) ) { - $Email::Send::Sendmail::SENDMAIL = $conf::mail; - } + use Email::Sender::Simple; if ($conf::overridemail) { $addr = $conf::overridemail; @@ -2257,6 +2290,8 @@ Subject: $subject Date: $date X-Debian: DAK X-DAK: DAK +Precedence: bulk +Auto-Submitted: auto-generated __MESSAGE__ if ( length $package ) { @@ -2266,17 +2301,7 @@ __MESSAGE__ $message .= "\n$text"; $message .= "\nGreetings,\n\n\tYour Debian queue daemon (running on host $main::hostname)\n"; - my $mail = Email::Send->new; - for (qw[Sendmail SMTP]) { - $mail->mailer($_) and last if $mail->mailer_available($_); - } - - my $ret = $mail->send($message); - if ( $ret && $ret !~ /Message sent|success/ ) { - return 0; - } - - return 1; + return Email::Sender::Simple->try_to_send($message); } ## end sub send_mail($$$) #