#!/usr/bin/perl -w # # make_disc_trees # # From the list of packages we have, lay out the CD trees use strict; use Digest::MD5; use Digest::SHA; use File::stat; use File::Find; use File::Path qw(make_path remove_tree); use File::Basename; use Compress::Zlib; use File::Slurp; my %pkginfo; my ($basedir, $mirror, $tdir, $codename, $archlist, $mkisofs, $maxcds, $maxisos, $maxjigdos, $extranonfree, $nonfree, $contrib, $use_local); my $mkisofs_base_opts = ""; my $mkisofs_opts = ""; my $mkisofs_dirs = ""; my (@arches, @arches_nosrc, @overflowlist, @pkgs_added, @nonfree_components); my (@exclude_packages, @unexclude_packages, @excluded_package_list); my %firmware_package; my $current_checksum_type = ""; my %descriptions; undef @pkgs_added; undef @exclude_packages; undef @unexclude_packages; undef @excluded_package_list; $basedir = shift; $mirror = shift; $tdir = shift; $codename = shift; $archlist = shift; $mkisofs = shift; $mkisofs_base_opts = shift; require "$basedir/tools/link.pl"; my $iso_blksize = 2048; my $log_opened = 0; my $old_split = $/; my $security = read_env('SECURITY', $mirror); my $localdebs = read_env('LOCALDEBS', $mirror); my $symlink_farm = read_env('SYMLINK', 0); my $link_verbose = read_env('VERBOSE', 0); my $link_copy = read_env('COPYLINK', 0); my $backports_list = read_env('BACKPORTS', ""); my $backports = 1; if ($backports_list =~ /^$/) { $backports = 0;; } my $disktype = read_env('DISKTYPE', ""); if ($disktype =~ /^$/) { die "make_disc_trees.pl: DISKTYPE not set, aborting\n"; } # MAXCDS is the hard limit on the MAXIMUM number of images to # make. MAXJIGDOS and MAXISOS can only make this number smaller; we # will use the higher of those 2 numbers as the last image to go to, # if they're set $maxcds = read_env('MAXCDS', 9999); $maxisos = read_env('MAXISOS', 9999); if ($maxisos =~ 'ALL' || $maxisos =~ 'all') { $maxisos = 9999; } $maxjigdos = read_env('MAXJIGDOS', 9999); if ($maxjigdos =~ 'ALL' || $maxjigdos =~ 'all') { $maxjigdos = 9999; } if ($maxisos > $maxjigdos) { $maxjigdos = $maxisos; } if ($maxjigdos > $maxisos) { $maxisos = $maxjigdos; } if ($maxisos < $maxcds) { $maxcds = $maxisos; } $extranonfree = read_env('EXTRANONFREE', 0); @nonfree_components = split /\ /, read_env('NONFREE_COMPONENTS', 'non-free'); $nonfree = read_env('NONFREE', 0); $contrib = read_env('CONTRIB', 0); $use_local = read_env('LOCAL', 0); my $list = "$tdir/list"; my $bdir = "$tdir/$codename"; my $log = "$bdir/make_disc_tree.log"; open(LOG, ">> $log") or die ("Can't open logfile $log for writing: $!\n"); # Print out the details of genisoimage/xorriso etc. my $mkisofs_version = `$mkisofs -version`; print "$mkisofs -version says:\n$mkisofs_version\n"; print LOG "$mkisofs -version says:\n$mkisofs_version\n"; foreach my $arch (split(' ', $archlist)) { push(@arches, $arch); if (! ($arch eq "source")) { push(@arches_nosrc, $arch); } # Pre-cache all the package information that we need load_packages_cache($arch); } load_all_descriptions(0); if ($backports) { load_all_descriptions(1); } my $disknum = 1; my $max_done = 0; my $size_check = ""; # Constants used for space calculations my $MiB = 1048576; my $MB = 1000000; my $GB = 1000000000; my $blocksize = 2048; my ($maxdiskblocks, $diskdesc); my $cddir; my $size_swap_check; my $hfs_extra = 0; my $hfs_mult = 1; # And count how many packages added since the last size check was done # - the estimation code is getting very accurate, so let's reduce the # number of times we fork mkisofs my $count_since_last_check = 0; my $size_check_period = 10; my $pkgs_this_cd = 0; my $pkgs_done = 0; my $size = 0; my $guess_size = 0; my @overflowpkg; my $mkisofs_check = "$mkisofs $mkisofs_base_opts -r -print-size -quiet"; my $debootstrap_script = read_env('DEBOOTSTRAP_SCRIPT', ""); chdir $bdir; # Size calculation is slightly complicated: # # 1. At the start, ask mkisofs for a size so far (including all the # stuff in the initial tree like docs and boot stuff # # 2. After that, add_packages will tell us the sizes of the files it # has added. This will not include directories / metadata so is # only a rough guess, but it's a _cheap_ guess # # 3. Once we get >90% of the max size we've been configured with, # start asking mkisofs after each package addition. This will # be slow, but we want to be exact at the end $cddir = "$bdir/CD$disknum"; get_disc_size(); # Space calculation for extra HFS crap if ($archlist =~ /m68k/ || $archlist =~ /powerpc/) { $hfs_mult = 1.2; $hfs_extra = int($maxdiskblocks * 8 / $blocksize); print LOG "arches require HFS hybrid, multiplying sizes by $hfs_mult and marking $hfs_extra blocks for HFS use\n"; } print "Starting to lay out packages into images:\n"; # Read in the list of packages that we're expecting to include if (-e "$bdir/firmware-packages") { open(FWLIST, "$bdir/firmware-packages") or die "Unable to read firmware-packages file!\n"; while (defined (my $pkg = )) { chomp $pkg; $firmware_package{$pkg} = 1; } close(FWLIST); } open(INLIST, "$bdir/packages") or die "No packages file!\n"; while (defined (my $pkg = )) { chomp $pkg; $cddir = "$bdir/CD$disknum"; my $opt; if (! -d $cddir) { if ($disknum > $maxcds) { print LOG "Disk $disknum is beyond the configured MAXCDS of $maxcds; exiting now...\n"; $max_done = 1; last; } print LOG "Starting new disc $disknum at " . `date` . "\n"; start_disc(); print LOG " Specified size: $diskdesc, $maxdiskblocks 2K-blocks maximum\n"; print " Placing packages into image $disknum\n"; if ( -e "$bdir/$disknum.mkisofs_opts" ) { open(OPTS, "<$bdir/$disknum.mkisofs_opts"); while (defined($opt = )) { chomp $opt; $mkisofs_opts = "$mkisofs_opts $opt"; } close(OPTS); } else { $mkisofs_opts = ""; } if ($disknum <= $maxjigdos) { # Set things to /dev/null - we're only doing a # sizing run here $mkisofs_opts = "$mkisofs_opts -o /dev/null"; } if ( -e "$bdir/$disknum.mkisofs_dirs" ) { open(OPTS, "<$bdir/$disknum.mkisofs_dirs"); while (defined($opt = )) { chomp $opt; $mkisofs_dirs = "$mkisofs_dirs $opt"; } close(OPTS); } else { $mkisofs_dirs = ""; } $size_check = "$mkisofs_check $mkisofs_opts $mkisofs_dirs"; $size=`$size_check $cddir`; chomp $size; $size += $hfs_extra; print LOG "CD $disknum: size is $size before starting to add packages\n"; $pkgs_this_cd = 0; # If we have some unexcludes for this disc and have already # previously excluded some packages, check now if the two # lists intersect and we should re-include some packages if (scalar @unexclude_packages && scalar @excluded_package_list) { foreach my $reinclude_pkg (@excluded_package_list) { my ($arch, $component, $pkgname, $pkgsize) = split /:/, $reinclude_pkg; foreach my $entry (@unexclude_packages) { if (($pkgname =~ /^\Q$entry\E$/m)) { print LOG "Re-including $reinclude_pkg due to match on \"\^$entry\$\"\n"; $guess_size = int($hfs_mult * add_packages($cddir, $reinclude_pkg)); $size += $guess_size; print LOG "CD $disknum: GUESS_TOTAL is $size after adding $reinclude_pkg\n"; $pkgs_this_cd++; $pkgs_done++; push (@pkgs_added, $entry); } } } } while (scalar @overflowlist) { my $overflowpkg = pop @overflowlist; print LOG "Adding a package that failed on the last disc: $overflowpkg\n"; $guess_size = int($hfs_mult * add_packages($cddir, $overflowpkg)); $size += $guess_size; print LOG "CD $disknum: GUESS_TOTAL is $size after adding $overflowpkg\n"; $pkgs_this_cd++; $pkgs_done++; push (@pkgs_added, $overflowpkg); } } # end of creating new CD dir if (should_exclude_package($pkg)) { push(@excluded_package_list, $pkg); } elsif (should_start_extra_nonfree($pkg)) { print LOG "Starting on extra non-free image(s)\n"; finish_disc($cddir, ""); # And reset, to start the next disc $size = 0; $disknum++; undef(@pkgs_added); # Put this package first on the next disc push (@overflowlist, $pkg); } else { $guess_size = int($hfs_mult * add_packages($cddir, $pkg)); $size += $guess_size; push (@pkgs_added, $pkg); print LOG "CD $disknum: GUESS_TOTAL is $size after adding $pkg\n"; if (($size > $maxdiskblocks) || (($size > $size_swap_check) && ($count_since_last_check > $size_check_period))) { $count_since_last_check = 0; # Recompress files as needed before the size check find (\&recompress, "$cddir/dists"); print LOG "Running $size_check $cddir\n"; $size = `$size_check $cddir`; chomp $size; print LOG "CD $disknum: Real current size is $size blocks after adding $pkg\n"; } if ($size > $maxdiskblocks) { while ($size > $maxdiskblocks) { $pkg = pop(@pkgs_added); print LOG "CD $disknum over-full ($size > $maxdiskblocks). Rollback!\n"; $guess_size = int($hfs_mult * add_packages("--rollback", $cddir, $pkg)); # Recompress files as needed before the size check find (\&recompress, "$cddir/dists"); $size=`$size_check $cddir`; chomp $size; print LOG "CD $disknum: Real current size is $size blocks after rolling back $pkg\n"; # Put this package first on the next disc push (@overflowlist, $pkg); } # Special-case for source-only discs where we don't care # about the ordering. If we're doing a source-only build # and we've overflowed, allow us to carry on down the list # for a while to fill more space. Stop when we've skipped # 5 packages (arbitrary choice of number!) #613751 if (!($archlist eq "source") or (scalar @overflowlist >= 5)) { finish_disc($cddir, ""); # And reset, to start the next disc $size = 0; $disknum++; undef(@pkgs_added); } else { print LOG "SOURCE DISC: continuing on to see if anything else will fit, " . scalar @overflowlist . " packages on the overflow list at this point\n"; } } else { $pkgs_this_cd++; $pkgs_done++; $count_since_last_check++; } } } close(INLIST); if ($max_done == 0) { finish_disc($cddir, " (not)"); } print LOG "Finished: $pkgs_done packages placed\n"; print "Finished: $pkgs_done packages placed\n"; system("date >> $log"); close(LOG); ############################################# # # Local helper functions # ############################################# # Load up information about all the packages sub load_packages_cache { my $arch = shift; my @pkglist; my @tmplist; my ($p); my $num_pkgs = 0; $ENV{'LC_ALL'} = 'C'; # Required since apt is now translated $ENV{'ARCH'} = $arch; open(INLIST, "$bdir/packages.$arch") or die "No packages file $bdir/packages.$arch for $arch!\n"; while (defined (my $pkg = )) { chomp $pkg; my ($junk, $component, $pkgname, $pkgsize) = split /:/, $pkg; push @tmplist, $pkgname; } close INLIST; print "Reading in package information for $arch:\n"; print LOG "Reading in package information for $arch:\n"; $/ = ''; # Browse by paragraph @pkglist = (grep (!/\/$codename-backports$/, @tmplist)); while (@pkglist) { my (@pkg) = splice(@pkglist,0,200); if ($arch eq "source") { open (LIST, "$basedir/tools/apt-selection cache showsrc @pkg |") || die "Can't fork : $!\n"; } else { open (LIST, "$basedir/tools/apt-selection cache show @pkg |") || die "Can't fork : $!\n"; } while (defined($_ = )) { m/^Package: (\S+)/m and $p = $1; push @{$pkginfo{$arch}{$p}}, $_; $num_pkgs++; } close LIST; print LOG "load_packages_cache: Read details of $num_pkgs packages for $arch\n"; } print " Done: Read details of $num_pkgs packages for $arch\n"; if ($backports) { $num_pkgs = 0; @pkglist = (grep (/\/$codename-backports$/, @tmplist)); while (@pkglist) { my (@pkg) = splice(@pkglist,0,200); if ($arch eq "source") { open (LIST, "USE_BP=1 $basedir/tools/apt-selection cache showsrc @pkg |") || die "Can't fork : $!\n"; } else { open (LIST, "USE_BP=1 $basedir/tools/apt-selection cache show @pkg |") || die "Can't fork : $!\n"; } while (defined($_ = )) { m/^Package: (\S+)/m and $p = $1; push @{$pkginfo{$arch}{"$p/$codename-backports"}}, $_; $num_pkgs++; } close LIST; print LOG "load_packages_cache: Read details of $num_pkgs packages for $arch backports\n"; } print " Done: Read details of $num_pkgs packages for $arch backports\n"; } $/ = $old_split; # Browse by line again } sub load_all_descriptions { my $use_backports = shift; if (! ($archlist eq "source")) { load_descriptions("main", $use_backports); if ($contrib) { load_descriptions("contrib", $use_backports); } if ($nonfree || $extranonfree) { foreach my $component (@nonfree_components) { load_descriptions($component, $use_backports); } } if ($use_local) { load_descriptions("local", $use_backports); } } } # Load all the translated descriptions we can find sub load_descriptions { my $suite = shift; my $use_backports = shift; my $lang; my $dh; my ($p); my $num_total = 0; my $num_files = 0; my $dir = "$mirror/dists/$codename/$suite/i18n"; if ($use_backports) { $dir = "$mirror/dists/$codename-backports/$suite/i18n"; } if ($suite =~ /local/) { $dir = "$localdebs/dists/$codename/$suite/i18n"; if ($use_backports) { $dir = "$localdebs/dists/$codename-backports/$suite/i18n"; } } my @files; if ($use_backports) { $suite = "$suite backports"; } if (-d $dir) { print "Reading in translated package descriptions for $suite:\n"; print LOG "Reading in translated package descriptions for $suite:\n"; opendir($dh, $dir) || die "can't opendir $dir: $!\n"; @files = readdir($dh); $/ = ''; # Browse by paragraph foreach my $file (@files) { if ($file =~ /Translation-(.*).bz2/) { my $num_descs = 0; $lang = $1; open(BZ, "bzip2 -cd $dir/$file |") || die "can't open description file $dir/$file for reading: $!\n"; $num_files++; print LOG " Parsing $file\n"; while (defined($_ = )) { m/^Package: (\S+)/m and $p = $1; if ($use_backports) { $p = "$p/$codename-backports"; } $descriptions{"$lang"}{$p}{"data"} = $_; $descriptions{"$lang"}{$p}{"used"} = 0; $num_descs++; $num_total++; } close(BZ); print LOG " $num_descs descriptions\n"; } } $/ = $old_split; # Browse by line again print " Done: read $num_total entries for $num_files languages\n"; print LOG " Done: read $num_total entries for $num_files languages\n"; } else { print "WARNING: no translated descriptions found for $codename/$suite\n"; } } sub should_start_extra_nonfree { my $pkg = shift; my ($arch, $component, $pkgname, $pkgsize) = split /:/, $pkg; if ($extranonfree) { foreach my $nf_comp (@nonfree_components) { if ($component eq $nf_comp) { $extranonfree = 0; # Flag that we don't need to start new next time! return 1; } } } return 0; } sub should_exclude_package { my $pkg = shift; my ($arch, $component, $pkgname, $pkgsize) = split /:/, $pkg; my $should_exclude = 0; foreach my $entry (@exclude_packages) { if (($pkgname =~ /^\Q$entry\E$/m)) { print LOG "Excluding $pkg due to match on \"\^$entry\$\"\n"; $should_exclude++; } } if ($should_exclude) { # Double-check that we're not being asked to include *and* # exclude the package at the same time. If so, complain and # bail out foreach my $entry (@unexclude_packages) { if (($pkgname =~ /^\Q$entry\E$/m)) { print LOG "But ALSO asked to unexclude $pkg due to match on \"\^$entry\$\"\n"; print LOG "Make your mind up! Bailing out...\n"; die "Incompatible exclude/unexclude entries for $pkg...\n"; } } return 1; } return 0; } sub check_base_installable { my $arch = shift; my $cddir = shift; my $ok = 0; my (%on_disc, %exclude); my $packages_file = "$cddir/dists/$codename/main/binary-$arch/Packages"; my $p; my $db_error = 0; my $error_string = ""; open (PLIST, $packages_file) || die "Can't open Packages file $packages_file : $!\n"; while (defined($p = )) { chomp $p; $p =~ m/^Package: (\S+)/ and $on_disc{$1} = $1; } close PLIST; $packages_file = "$cddir/dists/$codename/local/binary-$arch/Packages"; if (open (PLIST, $packages_file)) { while (defined($p = )) { chomp $p; $p =~ m/^Package: (\S+)/ and $on_disc{$1} = $1; } close PLIST; } if (defined($ENV{'BASE_EXCLUDE'})) { open (ELIST, $ENV{'BASE_EXCLUDE'}) || die "Can't open base_exclude file $ENV{'BASE_EXCLUDE'} : $!\n"; while (defined($p = )) { chomp $p; $exclude{$p} = $p; } close ELIST; } open (DLIST, "debootstrap --arch $arch --print-debs $codename $tdir/debootstrap_tmp file:$mirror $debootstrap_script 2>/dev/null | tr ' ' '\n' |") || die "Can't fork debootstrap : $!\n"; while (defined($p = )) { if ($p =~ m/^E:/) { $db_error = 1; } chomp $p; if ($db_error) { $error_string = "$error_string $p"; } else { if (length $p > 1) { if (!defined($on_disc{$p})) { if (defined($exclude{$p})) { print LOG "Missing debootstrap-required $p but included in $ENV{'BASE_EXCLUDE'}\n"; } else { $ok++; print LOG "Missing debootstrap-required $p\n"; } } } } } close DLIST; if ($db_error) { print LOG "Debootstrap reported error: $error_string\n"; die "Debootstrap reported error: $error_string\n"; } remove_tree("$tdir/debootstrap_tmp"); return $ok; } # If missing, create an empty local Packages file for an architecture. # Only create an uncompressed Packages file; the call to recompress will # create the compressed version. sub add_missing_Packages { my ($filename); $filename = $File::Find::name; if ((-d "$_") && ($filename =~ m/\/main\/binary-[^\/]*$/)) { if (-f "$_/Packages") { if (! -d "../local/$_/") { mkdir "../local/$_/" || die "Error creating directory local/$_: $!\n"; } if ( ! -f "../local/$_/Packages" ) { open(LPFILE, ">../local/$_/Packages") or die "Error creating local/$_/Packages: $!\n"; close LPFILE; print " Created empty Packages file for local/$_\n"; } } } } sub checksum_file { my $filename = shift; my $alg = shift; my ($checksum, $st); open(CHECKFILE, $filename) or die "Can't open '$filename': $!\n"; binmode(CHECKFILE); if ($alg eq "md5") { $checksum = Digest::MD5->new->addfile(*CHECKFILE)->hexdigest; } elsif ($alg =~ /^sha\d+$/) { $checksum = Digest::SHA->new($alg)->addfile(*CHECKFILE)->hexdigest; } else { die "checksum_file: unknown alorithm $alg!\n"; } close(CHECKFILE); $st = stat($filename) || die "Stat error on '$filename': $!\n"; return ($checksum, $st->size); } sub remove_uncompressed { my ($filename); $filename = $File::Find::name; if ($filename =~ m/\/.*\/(Packages|Sources)$/o || $filename =~ m/\/.*\/i18n\/(Translation-[_a-zA-Z]+)$/o) { unlink($_) or die "Failed to remove $_: $!\n"; } } sub recompress { # Recompress various files my ($filename); $filename = $File::Find::name; # Packages and Sources files; workaround for bug #402482 if ($filename =~ m/\/.*\/(Packages|Sources)$/o) { system("rm -f $_.gz"); system("pigz -9nmc < $_ >$_.gz"); } # Translation files need to be compressed in .gz format on CD? if ($filename =~ m/\/.*\/i18n\/(Translation.*)$/o && ! ($filename =~ m/\/.*\/i18n\/(Translation.*gz)$/o)) { system("rm -f $_.gz"); system("pigz -9nmc < $_ >$_.gz"); system("rm -f $_"); } } sub find_and_checksum_files_for_release { my ($checksum, $size, $filename); $filename = $File::Find::name; if ($filename =~ m/\/.*\/(Packages|Sources|Release|Translation)/o) { $filename =~ s/^\.\///g; ($checksum, $size) = checksum_file($_, $current_checksum_type); printf RELEASE " %s %8d %s\n", $checksum, $size, $filename; } } sub checksum_files_for_release { # ICK: no way to pass arguments to the # find_and_checksum_files_for_release() function that I can see, # so using a global here... print RELEASE "MD5Sum:\n"; $current_checksum_type = "md5"; find (\&find_and_checksum_files_for_release, "."); print RELEASE "SHA1:\n"; $current_checksum_type = "sha1"; find (\&find_and_checksum_files_for_release, "."); print RELEASE "SHA256:\n"; $current_checksum_type = "sha256"; find (\&find_and_checksum_files_for_release, "."); print RELEASE "SHA512:\n"; $current_checksum_type = "sha512"; find (\&find_and_checksum_files_for_release, "."); } sub md5_files_for_md5sum { my ($md5, $size, $filename); $filename = $File::Find::name; if (-f $_) { ($md5, $size) = checksum_file($_, "md5"); printf MD5LIST "%s %s\n", $md5, $filename; } } sub get_disc_size { my $hook; my $error = 0; my $reserved = 0; my $chosen_disk = $disktype; my $disk_size_hack = ""; if (defined($ENV{'RESERVED_BLOCKS_HOOK'})) { $hook = $ENV{'RESERVED_BLOCKS_HOOK'}; print " Calling reserved_blocks hook: $hook\n"; $reserved = `$hook $tdir $mirror $disknum $cddir \"$archlist\"`; chomp $reserved; if ($reserved eq "") { $reserved = 0; } print " Reserving $reserved blocks on CD $disknum\n"; } # See if we've been asked to switch sizes for the whole set $disk_size_hack = read_env('FORCE_CD_SIZE', ""); if ($disk_size_hack) { print LOG "HACK HACK HACK: FORCE_CD_SIZE found:\n"; print LOG " forcing use of a $disk_size_hack disk instead of $chosen_disk\n"; $chosen_disk = $disk_size_hack; } # If we're asked to do a specific size for *this* disknum, over-ride again $disk_size_hack = read_env("FORCE_CD_SIZE$disknum", ""); if ($disk_size_hack) { print LOG "HACK HACK HACK: FORCE_CD_SIZE$disknum found:\n"; print LOG " forcing use of a $disk_size_hack disk instead of $chosen_disk\n"; $chosen_disk = $disk_size_hack; } # Calculate the maximum number of 2K blocks in the output images if ($chosen_disk eq "BC") { $maxdiskblocks = int(680 * $MB / $blocksize) - $reserved; $diskdesc = "businesscard"; } elsif ($chosen_disk eq "NETINST") { $maxdiskblocks = int(680 * $MB / $blocksize) - $reserved; $diskdesc = "netinst"; } elsif ($chosen_disk =~ /CD$/) { $maxdiskblocks = int(680 * $MB / $blocksize) - $reserved; $diskdesc = "650MiB CD"; } elsif ($chosen_disk eq "CD700") { $maxdiskblocks = int(737 * $MB / $blocksize) - $reserved; $diskdesc = "700MiB CD"; } elsif ($chosen_disk eq "DVD") { $maxdiskblocks = int(4700 * $MB / $blocksize) - $reserved; $diskdesc = "4.7GB DVD"; } elsif ($chosen_disk eq "DLDVD") { $maxdiskblocks = int(8500 * $MB / $blocksize) - $reserved; $diskdesc = "8.5GB DVD"; } elsif ($chosen_disk eq "BD") { # Leave some space for potential formatting/spares on BD $maxdiskblocks = int(24000 * $MB / $blocksize) - $reserved; $diskdesc = "25GB BD"; } elsif ($chosen_disk eq "DLBD") { # Leave some space for potential formatting/spares on BD $maxdiskblocks = int(48000 * $MB / $blocksize) - $reserved; $diskdesc = "50GB DLBD"; } elsif ($chosen_disk =~ /STICK(\d+)GB/) { $maxdiskblocks = int($1 * $GB / $blocksize) - $reserved; $diskdesc = "$1GB STICK"; } elsif ($chosen_disk eq "CUSTOM") { $maxdiskblocks = $ENV{'CUSTOMSIZE'} - $reserved || die "Need to specify a custom size for the CUSTOM disktype\n"; $diskdesc = "User-supplied size"; } else { die "make_disc_trees.pl: Unknown disk type \"$chosen_disk\" specified; ABORT\n"; } $ENV{'MAXDISKBLOCKS'} = $maxdiskblocks; $ENV{'DISKDESC'} = $diskdesc; # How full should we let the disc get before we stop estimating and # start running mkisofs? $size_swap_check = $maxdiskblocks - (40 * $MB / $blocksize); } sub start_disc { my $error = 0; $error = system("$basedir/tools/start_new_disc $basedir $mirror $tdir $codename \"$archlist\" $disknum"); if ($error != 0) { die " Failed to start disc $disknum, error $error\n"; } get_disc_size(); print "Starting new \"$archlist\" $disktype $disknum at $basedir/$codename/CD$disknum\n"; print " Specified size for this image: $diskdesc, $maxdiskblocks 2K-blocks maximum\n"; # Grab all the early stuff, apart from dirs that will change later print " Starting the md5sum.txt file\n"; chdir $cddir; system("find . -type f | grep -v -e ^\./\.disk -e ^\./dists | xargs md5sum >> md5sum.txt"); chdir $bdir; $mkisofs_opts = ""; $mkisofs_dirs = ""; @exclude_packages = (); @unexclude_packages = (); # Change of interface here - exclude/unexclude files are now a # colon-separated list if (defined ($ENV{"EXCLUDE"})) { add_excludes_from_files($ENV{"EXCLUDE"}, "exclude", \@exclude_packages) } if (defined ($ENV{"EXCLUDE$disknum"})) { add_excludes_from_files($ENV{"EXCLUDE$disknum"}, "exclude", \@exclude_packages) } if (defined ($ENV{"UNEXCLUDE$disknum"})) { add_excludes_from_files($ENV{"UNEXCLUDE$disknum"}, "unexclude", \@unexclude_packages) } } sub add_excludes_from_files { my $files_list = shift; my $verb = shift; my $listref = shift; foreach my $entry (split(':', $files_list)) { my $excl_file = $ENV{"TASKDIR"} . "/" . $entry; parse_exclude_file($excl_file, $verb, $listref) } } sub parse_exclude_file { my $excl_file = shift; my $verb = shift; my $listref = shift; my @list = @$listref; print " Adding packages to $verb list from $excl_file\n"; print LOG "Adding packages to $verb list from $excl_file\n"; open (EXCLUDE_FILE, "< $excl_file") || die "Can't open exclude file $excl_file: $!\n"; while (defined (my $excl_pkg = )) { chomp $excl_pkg; push(@exclude_packages, $excl_pkg); print LOG " $excl_pkg\n"; } close (EXCLUDE_FILE); } sub finish_disc { my $cddir = shift; my $not = shift; my $archok = 0; my $ok = 0; my $bytes = 0; my $ctx; my $hook; my $error = 0; if (defined($ENV{'DISC_FINISH_HOOK'})) { $hook = $ENV{'DISC_FINISH_HOOK'}; print " Calling disc_finish hook: $hook\n"; $error = system("$hook $tdir $mirror $disknum $cddir \"$archlist\""); $error == 0 || die "DISC_FINISH_HOOK failed with error $error\n"; } if (($disknum == 1) && !($archlist eq "source") && !($disktype eq "BC")) { foreach my $arch (@arches_nosrc) { print " Checking base is installable for $arch\n"; $archok = check_base_installable($arch, $cddir); if ($archok > 0) { print " $arch is missing $archok files needed for debootstrap, look in $log for the list\n"; } $ok += $archok; } if ($ok == 0) { open(my $fh, ">>", "$cddir/.disk/base_installable"); close($fh); print " Found all files needed for debootstrap for all binary arches\n"; } else { print " $ok files missing for debootstrap, not creating base_installable\n"; if ($disktype eq "BC") { print " This is expected - building a BC\n"; } } } chdir $cddir; # If we have a local packages directory, ensure we have a Packages file # for all included architectures as otherwise the Release file will be # invalid. This can happen if we do have local udebs but no local # regular packages, or multiple architectures with not all of them # having local packages. if (-d "./dists/$codename/local") { find (\&add_missing_Packages, "./dists/$codename/main/"); } else { # Otherwise ensure not to pass --components=main,local to # debootstrap: my $base_components = ".disk/base_components"; if (-f $base_components) { my @components = read_file($base_components); if (grep { $_ eq "local\n" } @components) { print " Removing local from base_components (no such component under $codename)\n"; write_file($base_components, grep { $_ ne "local\n" } @components); } } } print " Finishing off the Release file\n"; my @codenames = ("$codename"); if ($backports) { push @codenames, "$codename-backports"; } foreach my $tmpcode (@codenames) { chdir "dists/$tmpcode"; open(RELEASE, ">>Release") or die "Failed to open Release file: $!\n"; find (\&recompress, "."); checksum_files_for_release(); close(RELEASE); find (\&remove_uncompressed, "."); chdir("../.."); } print " Finishing off md5sum.txt\n"; # Just md5 the bits we won't have seen already open(MD5LIST, ">>md5sum.txt") or die "Failed to open md5sum.txt file: $!\n"; foreach my $dir ("./.disk", "./dists", "./firmware/dep11") { if (-d $dir) { find (\&md5_files_for_md5sum, $dir); } } close(MD5LIST); # And sort; it should make things faster for people checking # the md5sums, as ISO9660 dirs are sorted alphabetically system("LANG=C sort -uk2 md5sum.txt | grep -v \./md5sum.txt > md5sum.txt.tmp"); rename("md5sum.txt.tmp", "md5sum.txt"); chdir $bdir; if (defined($ENV{'DISC_END_HOOK'})) { $hook = $ENV{'DISC_END_HOOK'}; print " Calling disc_end hook: $hook\n"; $error = system("$hook $tdir $mirror $disknum $cddir \"$archlist\""); $error == 0 || die "DISC_END_HOOK failed with error $error\n"; } $size = `$size_check $cddir`; chomp $size; $bytes = $size * $blocksize; print LOG "CD $disknum$not filled with $pkgs_this_cd packages, $size blocks, $bytes bytes\n"; print " CD $disknum$not filled with $pkgs_this_cd packages, $size blocks, $bytes bytes\n"; system("date >> $log"); } # start of add_packages sub msg_ap { my $level = shift; if (!$log_opened) { open(AP_LOG, ">> $tdir/$codename/add_packages.log") || die "Can't write in $tdir/add_packages.log!\n"; $log_opened = 1; } print AP_LOG @_; } sub size_in_blocks { my $size_in_bytes = shift; return (1 + int(($size_in_bytes + $iso_blksize - 1) / $iso_blksize)); } # From a package name and section, work out the directory where its # corresponding Packages file should live sub Packages_dir { my $dir = shift; my $file = shift; my $section = shift; my $in_backports = shift; my ($pdir, $component); if ($file =~ /\/main\//) { $component = "main"; } elsif ($file =~ /\/contrib\//) { $component = "contrib"; } elsif ($file =~ /\/non-free\//) { $component = "non-free"; } elsif ($file =~ /\/non-free-firmware\//) { $component = "non-free-firmware"; } else { $component = "local"; } $pdir = "$dir/dists/$codename/$component"; if ($in_backports) { $pdir = "$dir/dists/$codename-backports/$component"; } if ($section and $section eq "debian-installer") { # Don't attempt to put d-i components into backports, as d-i # won't look for them there. # # Also, merge local udebs into main, as d-i uses a single # Packages file anyway: my $dstcomponent = $component ne 'local' ? $component : 'main'; $pdir = "$dir/dists/$codename/$dstcomponent/debian-installer"; } return $pdir; } # Dump the apt-cached data into a Packages file; make the parent dir # for the Packages file if necesssary sub add_Packages_entry { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my ($p, $file, $section, $pdir, $pkgfile, $gz, $st1, $st2, $size1, $size2); my $blocks_added = 0; my $old_blocks = 0; my $new_blocks = 0; m/^Package: (\S+)/m and $p = $1; m/^Section: (\S+)/m and $section = $1; if ($arch eq "source") { m/^Directory: (\S+)/mi and $file = $1; if (!defined($file)) { die "Can't parse source file information out of $_\n"; } $pdir = Packages_dir($dir, $file, $section, $in_backports) . "/source"; $pkgfile = "$pdir/Sources"; } else { m/^Filename: (\S+)/mi and $file = $1; if (!defined($file)) { die "Can't parse binary file information out of $_\n"; } $pdir = Packages_dir($dir, $file, $section, $in_backports) . "/binary-$arch"; $pkgfile = "$pdir/Packages"; } msg_ap(0, " Adding $p to $pkgfile(.gz)\n"); if (! -d $pdir) { make_path($pdir); $blocks_added++; } if (-e $pkgfile) { $st1 = stat("$pkgfile"); $old_blocks = size_in_blocks($st1->size); } if (-e "$pkgfile.gz") { $st1 = stat("$pkgfile.gz"); $old_blocks += size_in_blocks($st1->size); } open(PFILE, ">>$pkgfile"); print PFILE $_; close(PFILE); $gz = gzopen("$pkgfile.gz", "ab9") or die "Failed to open $pkgfile.gz: $gzerrno\n"; $gz->gzwrite($_) or die "Failed to write $pkgfile.gz: $gzerrno\n"; $gz->gzclose(); $st1 = stat("$pkgfile"); $st2 = stat("$pkgfile.gz"); $size1 = $st1->size; $size2 = $st2->size; $new_blocks += size_in_blocks($st1->size); $new_blocks += size_in_blocks($st2->size); $blocks_added += ($new_blocks - $old_blocks); msg_ap(0, " now $size1 / $size2 bytes, $blocks_added blocks added\n"); return $blocks_added; } # Write out translated description(s) for a package sub add_trans_desc_entry { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my ($p, $file, $section, $idir, $pkgfile, $gz, $st); my $size = 0; my $blocks_added = 0; my $old_blocks = 0; my $new_blocks = 0; m/^Package: (\S+)/m and $p = $1; m/^Section: (\S+)/m and $section = $1; m/^Filename: (\S+)/mi and $file = $1; $idir = Packages_dir($dir, $file, $section, $in_backports) . "/i18n"; if (! -d $idir) { make_path($idir); $blocks_added++; } foreach my $lang (keys %descriptions) { # Do we have a translation for this language? if (defined $descriptions{$lang}{$p}{"data"}) { my $trans_file = "$idir/Translation-$lang"; msg_ap(0, " Adding $p to $trans_file(.gz)\n"); if ($descriptions{$lang}{$p}{"used"}) { msg_ap(0, " - not, already included\n"); } else { # Keeping files in .gz format is far too expensive in # terms of de-compressing and re-compressing all the # time. Store uncompressed and only compress when we're # finished. Analysis of typical text suggests that gzip # will give roughly a factor of 2 compresssion here, so # use that estimate. For accuracy, we may end up # compressing *anyway* just before doing a size check; if # so, we'll need to uncompress again on entry here. if (-f "$trans_file.gz") { system("rm -f $trans_file"); system("gunzip $trans_file.gz"); } if (-f $trans_file) { $st = stat("$trans_file") || die "unable to stat $trans_file\n"; $old_blocks += size_in_blocks($st->size / 2); } # Add the new description open(IFILE, ">> $trans_file"); print IFILE $descriptions{$lang}{$p}{"data"}; $descriptions{$lang}{$p}{"used"} = 1; close(IFILE); $st = stat("$trans_file") || die "unable to stat $trans_file\n"; $size += int($st->size / 2); $new_blocks += size_in_blocks($st->size / 2); } } } $blocks_added += ($new_blocks - $old_blocks); if ($blocks_added != 0) { msg_ap(0, " now $size bytes, $blocks_added blocks added\n"); } return $blocks_added; } sub add_md5_entry { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my ($pdir, $file, $md5, $st, $size, $p); my $md5file = "$dir/md5sum.txt"; my $blocks_added = 0; my $old_blocks = 0; my $new_blocks = 0; if ($in_backports) { m/^Package: (\S+)/mi and $p = "$1/$codename-backports"; } else { m/^Package: (\S+)/mi and $p = $1; } if (-e $md5file) { $st = stat("$md5file"); $old_blocks = size_in_blocks($st->size); } open(MD5FILE, ">>$md5file"); if ($arch eq "source") { m/^Directory: (\S+)/mi and $pdir = $1; # Explicitly use the md5 lines in the Sources stanza, hence the xdigit(32) here while (/^ ([[:xdigit:]]{32}) (\d+) (\S+)/msg) { print MD5FILE "$1 ./$pdir/$3\n"; } } else { m/^Filename: (\S+)/m and $file = $1; m/^MD5sum: (\S+)/m and print MD5FILE "$1 ./$file\n"; } close(MD5FILE); msg_ap(0, " Adding $p to $md5file\n"); $st = stat("$md5file"); $size = $st->size; $new_blocks = size_in_blocks($st->size); $blocks_added = $new_blocks - $old_blocks; msg_ap(0, " now $size bytes, added $blocks_added blocks\n"); return $blocks_added; } # Add sym-links and pattern files for firmware packages sub add_firmware_stuff { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my ($p, $file, $section, $component, $dep11_dir); my $blocks_added = 0; my @args = ("$basedir/tools/generate_firmware_patterns", "--output-dir", "$dir/firmware/dep11"); m/^Package: (\S+)/m and $p = $1; m/^Section: (\S+)/m and $section = $1; m/^Filename: (\S+)/mi and $file = $1; my $base_file = basename($file); if ($file =~ /\/main\//) { $component = "main"; } elsif ($file =~ /\/contrib\//) { $component = "contrib"; } elsif ($file =~ /\/non-free\//) { $component = "non-free"; } elsif ($file =~ /\/non-free-firmware\//) { $component = "non-free-firmware"; } else { $component = "local"; } $dep11_dir = "$mirror/dists/$codename/$component/dep11"; if ($in_backports) { $dep11_dir = "$mirror/dists/$codename-backports/$component/dep11"; } if (! -d "$dir/firmware") { mkdir "$dir/firmware" or die "mkdir $dir/firmware failed $!\n"; mkdir "$dir/firmware/dep11" or die "mkdir $dir/firmware/dep11 failed $!\n"; $blocks_added += 2; # In case anyone wonders about those files: write_file("$dir/firmware/dep11/README.txt", "These files help Debian Installer detect helpful firmware packages (via hw-detect).\n") or die "unable to create $dir/firmware/dep11/README.txt"; $blocks_added += get_file_blocks("$dir/firmware/dep11/README.txt"); } msg_ap(0, "Link fw package $p into /firmware\n"); $blocks_added += good_link("$dir/firmware/../$file", "$dir/firmware/$base_file"); msg_ap(0, "Link ../$file $dir/firmware/.\n"); # Cope with maybe having the patterns file already # (e.g. multi-arch), in which case we'll replace it here if (-f "$dir/firmware/dep11/$p.patterns") { $blocks_added -= get_file_blocks("$dir/firmware/dep11/$p.patterns"); $blocks_added -= get_file_blocks("$dir/firmware/dep11/$p.component"); } msg_ap(0, "(Maybe) generate fw pattern file $dir/firmware/dep11/$p.patterns\n"); push(@args, "--package", "$p"); push(@args, "$dep11_dir/Components-$arch.yml.gz"); system(@args) == 0 or die "generate_firmware_patterns failed: $?"; if (-f "$dir/firmware/dep11/$p.patterns") { $blocks_added += get_file_blocks("$dir/firmware/dep11/$p.patterns"); # Make sure apt-setup can be configured appropriately: write_file("$dir/firmware/dep11/$p.component", $component) or die "unable to create $dir/firmware/dep11/$p.component"; $blocks_added += get_file_blocks("$dir/firmware/dep11/$p.component"); } # Find the current size of the firmware Contents file my $contents_blocks_old = 0; my $cont_file = "$dir/firmware/Contents-firmware"; if (-f "$cont_file") { $contents_blocks_old = get_file_blocks("$cont_file"); } # Add new contents stuff, and count it open(OFILE, ">> $cont_file"); open(DPKGC, "dpkg --contents $dir/firmware/$base_file |") or die "Can't find contents of $dir/firmware/$base_file: $!"; while (defined(my $line = )) { chomp $line; # XXX: Keep in line with make-firmware-image! if ($line =~ m,^[-|l]\S+\s+\S+\s+\d+\s+\S+\s+\S+\s+./(\S+/firmware/\S+),) { printf OFILE "%-55s %s %s\n", "/$1", $base_file, $component; } } close DPKGC; close OFILE; my $contents_blocks_new = get_file_blocks($cont_file); $blocks_added += $contents_blocks_new - $contents_blocks_old; return $blocks_added; } # Roll back the results of add_Packages_entry() sub remove_Packages_entry { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my ($p, $file, $section, $pdir, $pkgfile, $tmp_pkgfile, $match, $gz, $st1, $st2, $size1, $size2); my $blocks_removed = 0; my $old_blocks = 0; my $new_blocks = 0; m/^Package: (\S+)/m and $p = $1; m/^Section: (\S+)/m and $section = $1; if ($arch eq "source") { m/^Directory: (\S+)/mi and $file = $1; $pdir = Packages_dir($dir, $file, $section, $in_backports) . "/source"; $pkgfile = "$pdir/Sources"; } else { m/^Filename: (\S+)/mi and $file = $1; $pdir = Packages_dir($dir, $file, $section, $in_backports) . "/binary-$arch"; $pkgfile = "$pdir/Packages"; } if (-e $pkgfile) { $st1 = stat("$pkgfile"); $old_blocks += size_in_blocks($st1->size); } if (-e "$pkgfile.gz") { $st2 = stat("$pkgfile.gz"); $old_blocks += size_in_blocks($st2->size); } $tmp_pkgfile = "$pkgfile" . ".rollback"; msg_ap(0, " Removing $p from $pkgfile(.gz)\n"); open(IFILE, "<$pkgfile"); open(OFILE, ">>$tmp_pkgfile"); $gz = gzopen("$pkgfile.gz", "wb9"); $/ = ''; # Browse by paragraph while (defined($match = )) { if (! ($match =~ /^Package: \Q$p\E$/m)) { print OFILE $match; $gz->gzwrite($match) or die "Failed to write $pkgfile.gz: $gzerrno\n"; } } $/ = $old_split; # Browse by line again $gz->gzclose(); close(IFILE); close(OFILE); rename $tmp_pkgfile, $pkgfile; $st1 = stat("$pkgfile"); $st2 = stat("$pkgfile.gz"); $size1 = $st1->size; $size2 = $st2->size; $new_blocks += size_in_blocks($st1->size); $new_blocks += size_in_blocks($st2->size); $blocks_removed += ($old_blocks - $new_blocks); msg_ap(0, " now $size1 / $size2 bytes, $blocks_removed blocks removed\n"); return $blocks_removed; } # Roll back the result of add_trans_desc_entry() sub remove_trans_desc_entry { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my ($p, $file, $section, $idir, $gz, $match, $st); my $size = 0; my $blocks_added = 0; my $old_blocks = 0; my $new_blocks = 0; m/^Package: (\S+)/m and $p = $1; m/^Section: (\S+)/m and $section = $1; m/^Filename: (\S+)/mi and $file = $1; $idir = Packages_dir($dir, $file, $section, $in_backports) . "/i18n"; $/ = ''; # Browse by paragraph foreach my $lang (keys %descriptions) { # Do we have a translation for this language? if (defined $descriptions{$lang}{$p}{"data"}) { my $trans_file = "$idir/Translation-$lang"; my $tmp_tfile = "$trans_file" . ".rollback"; my $entries_remaining = 0; msg_ap(0, " Removing $p from $trans_file(.gz)\n"); # Keeping files in .gz format is expensive - see comment # in add_trans_desc_entry() above. if (-f "$trans_file.gz") { system("rm -f $trans_file"); system("gunzip $trans_file.gz"); } $st = stat("$trans_file") || die "unable to stat $trans_file\n"; $old_blocks += size_in_blocks($st->size / 2); # Remove the description open(IFILE, "< $trans_file") || die "unable to open $trans_file\n"; open(OFILE, ">> $tmp_tfile"); while (defined($match = )) { if (! ($match =~ /^Package: \Q$p\E$/m)) { print OFILE $match; $entries_remaining++; } } close(IFILE); close(OFILE); $descriptions{$lang}{$p}{"used"} = 0; # If we still have any entries in the new file, # keep it. Otherwise, just delete it if ($entries_remaining) { rename $tmp_tfile, $trans_file; $st = stat("$trans_file") || die "unable to stat $trans_file\n"; $size += int($st->size / 3); $new_blocks += size_in_blocks($st->size / 3); } else { unlink($tmp_tfile); unlink($trans_file); } } } $/ = $old_split; # Browse by line again $blocks_added += ($new_blocks - $old_blocks); msg_ap(0, " now $size bytes, $blocks_added blocks added\n"); return $blocks_added; } sub remove_md5_entry { my $dir = shift; my $arch = shift; my $in_backports = shift; local $_ = shift; my $md5file = "$dir/md5sum.txt"; my $tmp_md5file = "$dir/md5sum.txt.tmp"; my @fileslist; my ($pdir, $file, $md5, $match, $present, $st, $size, $p); my $blocks_removed = 0; my $old_blocks = 0; my $new_blocks = 0; $/ = $old_split; # Browse by line again m/^Package: (\S+)/mi and $p = $1; if ($arch eq "source") { m/^Directory: (\S+)/mi and $pdir = $1; # Explicitly use the md5 lines in the Sources stanza, hence the xdigit(32) here while (/^ ([[:xdigit:]]{32}) (\d+) (\S+)/msg) { push(@fileslist, "$1 ./$pdir/$3"); } } else { m/^Filename: (\S+)/m and $file = $1; m/^MD5Sum: (\S+)/mi and push(@fileslist, "$1 ./$file"); } if (-e $md5file) { $st = stat("$md5file"); $old_blocks = size_in_blocks($st->size); } open(IFILE, "<$md5file"); open(OFILE, ">>$tmp_md5file"); while (defined($match = )) { $present = 0; foreach my $entry (@fileslist) { if (($match =~ /\Q$entry\E$/m)) { $present++; } } if (!$present) { print OFILE $match; } } close(IFILE); close(OFILE); $/ = ''; # Browse by paragraph again rename $tmp_md5file, $md5file; msg_ap(0, " Removing $p from md5sum.txt\n"); $st = stat("$dir/md5sum.txt"); $size = $st->size; $new_blocks = size_in_blocks($st->size); $blocks_removed = $old_blocks - $new_blocks; msg_ap(0, " now $size bytes, $blocks_removed blocks removed\n"); $/ = $old_split; # Browse by line again return $blocks_removed; } sub remove_firmware_stuff { my $dir = shift; my $arch = shift; my $in_backports = shift; my ($p, $file); local $_ = shift; my $blocks_removed = 0; m/^Package: (\S+)/mi and $p = $1; m/^Filename: (\S+)/mi and $file = $1; my $base_file = basename($file); msg_ap(0, "Remove symlink for fw package $p in /firmware\n"); unlink("$dir/firmware/$base_file"); if (-f "$dir/firmware/dep11/$p.patterns") { $blocks_removed += get_file_blocks("$dir/firmware/dep11/$p.patterns"); msg_ap(0, "Remove $dir/firmware/dep11/$p.patterns\n"); unlink("$dir/firmware/dep11/$p.patterns"); $blocks_removed += get_file_blocks("$dir/firmware/dep11/$p.component"); msg_ap(0, "Remove $dir/firmware/dep11/$p.component\n"); unlink("$dir/firmware/dep11/$p.component"); } # Find the current size of the firmware Contents file, and grep # out from the current data my $contents_blocks_old = 0; my $cont_file = "$dir/firmware/Contents-firmware"; open(OFILE, "> $cont_file.1"); if (-f $cont_file) { $contents_blocks_old = get_file_blocks($cont_file); open(IFILE, "< $cont_file"); while (defined(my $line = )) { chomp $line; if ($line !~ /\b$base_file$/) { print OFILE "$line\n"; } } close IFILE; } close OFILE; rename "$cont_file.1", "$cont_file"; my $contents_blocks_new = get_file_blocks($cont_file); $blocks_removed += $contents_blocks_new - $contents_blocks_old; return $blocks_removed; } sub get_file_blocks { my $realfile = shift; my $st; $st = stat($realfile) or die "unable to stat file $realfile: $!\n"; return size_in_blocks($st->size); } sub add_packages { my ($p, @files, $d, $realfile, $source, $section, $name, $pkgfile, $pdir); my $dir; my $total_blocks = 0; my $rollback = 0; my $option = shift; if ($option =~ /--rollback/) { $rollback = 1; $dir = shift; } else { $dir = $option; } if (! -d $dir) { die "add_packages: $dir is not a directory ..."; } my $pkg = shift; my ($arch, $component, $pkgname, $pkgsize) = split /:/, $pkg; if ("$arch" eq "" or "$pkgname" eq "" or "$pkgname" eq "") { die "inconsistent data passed to add_packages: $pkg\n"; } msg_ap(0, "Looking at $pkg: arch $arch, package $pkgname, rollback $rollback\n"); foreach my $package_info (@{$pkginfo{$arch}{$pkgname}}) { my $in_backports = 0; if ($pkgname =~ /\/$codename-backports/) { $in_backports = 1; } undef @files; $source = $mirror; if ($arch eq "source") { if ($package_info =~ m/^Directory: (\S+)/m) { $pdir = $1; } if ($pdir =~ m:updates/:) { $source = $security; } # Explicitly use the md5 lines in the Sources stanza, hence the xdigit(32) here while ($package_info =~ /^ ([[:xdigit:]]{32}) (\d+) (\S+)/msg) { push(@files, "$pdir/$3"); } } else { if ($package_info =~ m/^Filename: (\S+)/mi) { push(@files, $1); } if ($1 =~ m:updates/:) { $source = $security; } } if ($rollback) { # Remove the Packages entry/entries for the specified package $total_blocks -= remove_Packages_entry($dir, $arch, $in_backports, $package_info); $total_blocks -= remove_md5_entry($dir, $arch, $in_backports, $package_info); if (!($arch eq "source")) { $total_blocks -= remove_trans_desc_entry($dir, $arch, $in_backports, $package_info); } if ($firmware_package{$pkgname}) { $total_blocks -= remove_firmware_stuff($dir, $arch, $in_backports, $package_info); } foreach my $file (@files) { my $missing = 0; # Count how big the file is we're removing, for checking if the disc is full if (! -e "$source/$file") { msg_ap(0, "Can't find $file in the main archive, trying local\n"); if (-e "$localdebs/$file") { $source = $localdebs; } else { die "$file not found under either $source or $localdebs\n"; } } $realfile = real_file ("$source/$file"); $total_blocks -= get_file_blocks($realfile); # Remove the link unlink ("$dir/$file") || msg_ap(0, "Couldn't delete file $dir/$file\n"); msg_ap(0, " Rollback: removed $dir/$file\n"); } # Try to remove the directory; will silently fail if there # are still files there, which is OK. rmdir ($dir); } else { $total_blocks += add_Packages_entry($dir, $arch, $in_backports, $package_info); $total_blocks += add_md5_entry($dir, $arch, $in_backports, $package_info); if (!($arch eq "source")) { $total_blocks += add_trans_desc_entry($dir, $arch, $in_backports, $package_info); } foreach my $file (@files) { # And put the file in the CD tree (with a (hard) link) if (! -e "$source/$file") { msg_ap(0, "Can't find $file in the main archive, trying local\n"); if (-e "$localdebs/$file") { $source = $localdebs; } else { die "$file not found under either $source or $localdebs\n"; } } $realfile = real_file ("$source/$file"); if (! -e "$dir/$file") { # Count how big the file is, for checking if the # disc is full. ONLY do this if the file is not # already linked in - consider binary-all packages # on a multi-arch disc $total_blocks += get_file_blocks($realfile); $total_blocks += good_link ($realfile, "$dir/$file"); msg_ap(0, " Linked $dir/$file\n"); if ($firmware_package{$pkgname}) { $total_blocks += add_firmware_stuff($dir, $arch, $in_backports, $package_info); } } else { msg_ap(0, " $dir/$file already linked in\n"); } } } } # close LIST or die "Something went wrong with apt-cache : $@ ($!)\n"; msg_ap(0, " size $total_blocks\n"); $/ = $old_split; # Return to line-orientation return $total_blocks; }