debianqueued: use Digest::MD5 instead of external md5sum binary

[dak.git] / tools / debianqueued-0.9 / debianqueued

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index 3e6400f827f15da5ee4084a7c04e945ac149027d..776fffea3f79f09723476c390a0cfd9f2f5bcb18 100755 (executable)
--- 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 = "";
@@ -680,7 +683,7 @@ outer_loop: while (<CHANGES>) {
 
         # 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;
@@ -747,7 +750,7 @@ outer_loop: while (<CHANGES>) {
 
         # 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(
@@ -1132,6 +1135,8 @@ outer_loop: while (<CHANGES>) {
 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;
@@ -1405,7 +1410,7 @@ outer_loop: while (<COMMANDS>) {
       } 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" );
@@ -1706,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 "
@@ -2201,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($)
 
 #