Apparently I had a misunderstanding of what a binary only upload was.
I thought it was only when the orig.tar.gz information was left out.
Here's yet another patch that will really address the binary only
upload issue. For the record, I've tested this by uploading packages
with the orig tarball, packages without the orig tarball but with the
source information (diff.gz and .dsc files), binary only uploads, and
source only uploads. They all upload and generate the Packages/Sources
files correctly as well as generating the .package/.source files
correctly.
--- debpool_released/bin/debpool        2007-12-03 14:10:49.000000000 -0500
+++ debpool/bin/debpool 2007-12-04 15:18:23.000000000 -0500
@@ -206,11 +206,14 @@
         }
     }

-    my($dsc_data) = Parse_DSC("$Options{'incoming_dir'}/$dscfile");
-    if ($with_source && !defined($dsc_data)) {
-        Log_Message("Failure parsing dsc file '$dscfile': " .
+    my($dsc_data);
+    if ($with_source) {
+        $dsc_data = Parse_DSC("$Options{'incoming_dir'}/$dscfile");
+        if ($with_source && !defined($dsc_data)) {
+            Log_Message("Failure parsing dsc file '$dscfile': " .
                     $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR);
-        next;
+            next;
+        }
     }

     my($package) = $changes_data->{'Source'};
--- debpool_released/share/DebPool/Packages.pm	2007-12-03 14:10:49.000000000 -0500
+++ debpool/share/DebPool/Packages.pm	2007-12-04 15:18:03.000000000 -0500
@@ -488,7 +488,7 @@
 
     for $count (0..$#dsc) {
         if ($found) {
-            if ($dsc[$count] =~ m/^\s*$/) { # Blank line
+            if ($dsc[$count] =~ m/^(\s*$|\S)/) { # End of Files entry
                 $found = 0; # No longer in Files
             } elsif ($dsc[$count] =~ m/\s*([[:xdigit:]]+)\s+(\d+)\s+(\S+)/) {
                 my($md5, $size, $file) = ($1, $2, $3);
@@ -567,31 +567,37 @@
                 ($Options{'pool_dir'}, PoolDir($source, $section), $source));
             my($version) = Get_Version($distribution, $source, 'meta');
             my($target) = "$pool/${source}_" . Strip_Epoch($version);
-            $target .= '.package';
+            $target .= "_$arch\.package";
 
-            if (!open(PKG, '<', "$target")) {
-                my($msg) = "Skipping package entry for all packages from ";
-                $msg .= "${source}: couldn't open '$target' for reading: $!";
+            # Check if package for arch is installed and write entries if
+            # found
+            my($check_changes) = "$Options{'installed_dir'}/${source}_";
+            $check_changes .= Strip_Epoch($version) . "_$arch\.changes";
+            if (-e $check_changes) {
+                if (!open(PKG, '<', "$target")) {
+                    my($msg) = "Skipping package entry for all packages from ";
+                    $msg .= "${source}: couldn't open '$target' for reading: $!";
 
-                Log_Message($msg, LOG_GENERAL, LOG_ERROR);
-                next;
-            }
+                    Log_Message($msg, LOG_GENERAL, LOG_ERROR);
+                    next;
+                }
 
-            # Playing around with the record separator ($/) to make this
-            # easier.
+                # Playing around with the record separator ($/) to make this
+                # easier.
 
-            my($backup_RS) = $/;
-            $/ = "";
+                my($backup_RS) = $/;
+                $/ = "";
 
-            my(@entries) = <PKG>;
-            close(PKG);
+                my(@entries) = <PKG>;
+                close(PKG);
 
-            $/ = $backup_RS;
+                $/ = $backup_RS;
 
-            # Pare it down to the relevant entries, and print those out.
+                # Pare it down to the relevant entries, and print those out.
 
-            @entries = grep(/\nArchitecture: ($arch|all)\n/, @entries);
-            print $tmpfile_handle @entries;
+                @entries = grep(/\nArchitecture: ($arch|all)\n/, @entries);
+                print $tmpfile_handle @entries;
+            }
         }
     }
 
@@ -624,6 +630,16 @@
     my($pkg_name) = $chg_hashref->{'Source'};
     my($pkg_ver) = $chg_hashref->{'Version'};
 
+    # determine arch for packages being installed based on set archs from
+    # options
+    my($options_archs);
+    my($pkg_arch);
+    foreach $options_archs (@{$Options{'archs'}}) {
+        if ($changes =~ m/.*\Q_${options_archs}.changes\E/) {
+              $pkg_arch = $options_archs;
+        }
+    }
+
     my($guess_section) = Guess_Section($chg_hashref);
     my($pkg_dir) = join('/',
         ($pool_dir, PoolDir($pkg_name, $guess_section), $pkg_name));
@@ -661,19 +677,22 @@
 
     # Generate and install .package and .source metadata files.
 
-    my($pkg_file) = Generate_Package($chg_hashref);
+    my($target);
+    if ($pkg_arch ne 'source') { #Don't generate for source only uploads
+        my($pkg_file) = Generate_Package($chg_hashref);
 
-    if (!defined($pkg_file)) {
-        $Error = "Failed to generate .package file: $Error";
-        return undef;
-    }
+        if (!defined($pkg_file)) {
+            $Error = "Failed to generate .package file: $Error";
+            return undef;
+        }
 
-    my($target) = "$pkg_dir/${pkg_name}_" . Strip_Epoch($pkg_ver) . '.package';
+        $target = "$pkg_dir/${pkg_name}_" . Strip_Epoch($pkg_ver) . "_$pkg_arch" . '.package';
 
-    if (!Move_File($pkg_file, $target, $Options{'pool_file_mode'})) {
-        $Error = "Failed to move '$pkg_file' to '$target': ";
-        $Error .= $DebPool::Util::Error;
-        return 0;
+        if (!Move_File($pkg_file, $target, $Options{'pool_file_mode'})) {
+            $Error = "Failed to move '$pkg_file' to '$target': ";
+            $Error .= $DebPool::Util::Error;
+            return 0;
+        }
     }
 
     if (defined($dsc) && defined($dsc_hashref)) {
@@ -719,6 +738,9 @@
             $chg_hashref->{'Files'});
         $ComponentDB{$distribution}->{$pkg_name} = $component;
     }
+    if ( $section eq 'debian-installer' ) {
+        $component .= '/debian-installer';
+    }
 
     return 1;
 }
@@ -820,6 +842,14 @@
 
     my($package, $changes_hashref) = @_;
 
+    my($with_source) = undef; # Checking for binary only upload
+    my($temp);
+    for $temp (@{$changes_hashref->{'Architecture'}}) {
+        if ('source' eq $temp) {
+            $with_source = 1;
+        }
+    }
+
     my($installed_dir) = $Options{'installed_dir'};
     my($pool_dir) = $Options{'pool_dir'};
 
@@ -872,7 +902,7 @@
             $bin_package = $1;
             $version = $2;
             $deb = 1;
-        } elsif ($file =~ m/^([^_]+)_([^_]+)\.package$/) { # package metadata
+        } elsif ($file =~ m/^([^_]+)_([^_]+)_.+\.package$/) { # package metadata
             $bin_package = $1;
             $version = $2;
         } elsif ($file =~ m/^([^_]+)_([^_]+)\.source$/) { # source metadata
@@ -885,7 +915,10 @@
         }
 
         # Skip it if we recognize it as a valid version.
-
+        # Also skip src files if doing a binary only upload
+        if (!$with_source) {
+            $src = 0;
+        }
         my($matched) = 0;
         my($dist);
         foreach $dist (@{$Options{'realdists'}}) {
@@ -981,8 +1014,7 @@
             # without the epoch" -- it is more or less arbitrary, as long
             # as it is a well-formed version number).
 
-            my($filepat) = "${package}_.*_${arch}\\.deb";
-            $filepat =~ s/\+/\\\+/;
+            my($filepat) = qr/^\Q${package}_\E.*\Q_${arch}.\Eu?deb/;
 
             my($section) = Guess_Section($changes_data);
             my($pool) = join('/', (PoolDir($source, $section), $source));
@@ -1054,9 +1086,9 @@
             print $tmpfile_handle "MD5sum: $files[$marker]->{'MD5Sum'}\n";
         
             print $tmpfile_handle "Description: $info->{'Description'}";
-        }
 
-        print $tmpfile_handle "\n";
+            print $tmpfile_handle "\n";
+        }
     }
 
     # All done
@@ -1117,7 +1149,8 @@
     print $tmpfile_handle 'Architecture: ';
     print $tmpfile_handle join(' ', @{$dsc_data->{'Architecture'}}) . "\n";
 
-    print $tmpfile_handle "Standards-Version: $dsc_data->{'Standards-Version'}\n";
+    print $tmpfile_handle "Standards-Version: $dsc_data->{'Standards-Version'}\n"
+      if  exists $dsc_data->{'Standards-Version'};
     print $tmpfile_handle "Format: $dsc_data->{'Format'}\n";
     print $tmpfile_handle "Directory: " .  join('/',
         (PoolBasePath(), PoolDir($source, $section), $source)) . "\n";

Reply via email to