use Config;
use Sys::Hostname;
use File::Copy;
+use Digest::MD5;
setlocale(&POSIX::LC_ALL, "C");
($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 = "";
# 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>) {
init_mail($file);
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 (
# 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);
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; "
#}
} ## 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
#
} 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 $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 "
#
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($)
#
projects / dak.git / blobdiff