I also like the idea of keeping the pool tree size down. Also I think
this will help in installing packages whose names begin with numbers.
I've attached a patch that exports Tree_Mkdir() and uses the approach
proposed by Magnus Holmgren to create the minimal pool tree.
--- debpool_released/share/DebPool/Dirs.pm 2007-12-03 14:10:49.000000000 -0500
+++ debpool/share/DebPool/Dirs.pm 2007-12-05 02:04:29.000000000 -0500
@@ -60,6 +60,7 @@
@EXPORT_OK = qw(
&Archfile
&Create_Tree
+ &Tree_Mkdir
&Monitor_Incoming
&PoolBasePath
&PoolDir
@@ -69,7 +70,7 @@
);
%EXPORT_TAGS = (
- 'functions' => [qw(&Archfile &Create_Tree &Monitor_Incoming
+ 'functions' => [qw(&Archfile &Create_Tree &Tree_Mkdir &Monitor_Incoming
&PoolBasePath &PoolDir &Scan_Changes &Scan_All
&Strip_Subsection)],
'vars' => [qw()],
@@ -198,19 +199,10 @@
my($section);
foreach $section (@{$Options{'sections'}}) {
+ next if $section =~ m/\s*\/debian-installer/;
if (!Tree_Mkdir("$pool_dir/$section", $pool_dir_mode)) {
return 0;
}
-
- my($letter);
- foreach $letter ('a' .. 'z') {
- if (!Tree_Mkdir("$pool_dir/$section/$letter", $pool_dir_mode)) {
- return 0;
- }
- if (!Tree_Mkdir("$pool_dir/$section/lib$letter", $pool_dir_mode)) {
- return 0;
- }
- }
}
return 1;
--- debpool_released/share/DebPool/Packages.pm 2007-12-03 14:10:49.000000000 -0500
+++ debpool/share/DebPool/Packages.pm 2007-12-05 02:12:24.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,23 +630,27 @@
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));
+ my($pkg_pool_subdir) = join('/',
+ ($pool_dir, PoolDir($pkg_name, $guess_section)));
+ my($pkg_dir) = join('/', ($pkg_pool_subdir, $pkg_name));
- # Make sure the package directory exists (and is a directory!)
+ # Create the directory or error out
- if (! -e $pkg_dir) {
- if (!mkdir($pkg_dir)) {
- $Error = "Failed to mkdir '$pkg_dir': $!";
- return 0;
- }
- if (!chmod($Options{'pool_dir_mode'}, $pkg_dir)) {
- $Error = "Failed to chmod '$pkg_dir': $!";
- return 0;
- }
- } elsif (! -d $pkg_dir) {
- $Error = "Target '$pkg_dir' is not a directory.";
+ if (!Tree_Mkdir($pkg_pool_subdir, $Options{'pool_dir_mode'})) {
+ return 0;
+ }
+ if (!Tree_Mkdir($pkg_dir, $Options{'pool_dir_mode'})) {
return 0;
}
@@ -661,19 +671,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 +732,9 @@
$chg_hashref->{'Files'});
$ComponentDB{$distribution}->{$pkg_name} = $component;
}
+ if ( $section eq 'debian-installer' ) {
+ $component .= '/debian-installer';
+ }
return 1;
}
@@ -820,6 +836,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 +896,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 +909,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 +1008,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 +1080,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 +1143,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";
