#! /usr/bin/perl # Copyright (c) 2005-2007 Marc Espie # $OpenBSD: pkg_merge,v 1.16 2010/06/09 11:57:21 espie Exp $ # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. use strict; use warnings; use OpenBSD::PackageLocator; use OpenBSD::PackageInfo; use OpenBSD::PackingList; use OpenBSD::Getopt; use OpenBSD::Error; use OpenBSD::Ustar; use OpenBSD::ArcCheck; use OpenBSD::Paths; use OpenBSD::State; use File::Copy; use File::Path; package OpenBSD::PackingElement; sub copy_over {} sub mark_tocopy {} sub make_alias {} package OpenBSD::PackingElement::FileBase; sub mark_tocopy { my ($self, $list) = @_; push(@$list, $self); } sub copy_over { my ($self, $wrarc, $prefix, $pkg) = @_; my $e = $pkg->{pkg}->next; if (!$e->check_name($self)) { die "Names don't match: ", $e->{name}, " ", $self->{name}; } $e->{name} = $prefix."/".$e->{name}; $e->copy_long($wrarc); } sub make_alias { my ($self, $wrarc, $prefix, $pkg, $alias) = @_; my $e = $pkg->{pkg}->next; if (!$e->check_name($self)) { die "Names don't match: ", $e->{name}, " ", $self->{name}; } $e->{name} = $prefix."/".$e->{name}; $e->alias($wrarc, "$prefix/$alias"); } package OpenBSD::PackingElement::SpecialFile; use File::Copy; sub mark_tocopy { my ($self, $list) = @_; push(@$list, $self); } sub copy_over { my ($self, $wrarc, $prefix, $pkg) = @_; if (defined $wrarc) { $wrarc->destdir($pkg->{dir}); my $e = $wrarc->prepare($self->{name}); $e->{name} = "$prefix/".$e->{name}; $e->write; } } package main; sub find_equal { my $list = shift; my $name = $list->[0]->{tocopy}->[0]->{name}; for my $pkg (@$list) { if ($pkg->{tocopy}->[0]->{name} ne $name) { return undef; } } return $name; } sub occurs_first_or_not { my ($name, $list) = @_; for my $pkg (@$list) { if ($pkg->{tocopy}->[0]->{name} eq $name) { next; } for my $i (@{$pkg->{tocopy}}) { if ($i->{name} eq $name) { return 0; } } } return 1; } sub occurs_first { my $list= shift; for my $pkg (@$list) { my $name = $pkg->{tocopy}->[0]->{name}; if (occurs_first_or_not($name, $list)) { return $name; } } return undef; } my $ui = OpenBSD::State->new("pkg_merge"); $ui->usage_is('[-v] -o result pkg pkg2 ...'); our ($opt_o, $opt_v); $ui->do_options(sub { getopts('o:v'); }); if (!defined $opt_o) { $ui->usage("Missing -o result"); } if (@ARGV<2) { $ui->usage("Can't merge less than two packages"); } my @tomerge; my $prefix = 'a'; my $allprefix = ''; open( my $outfh, "|-", OpenBSD::Paths->gzip, "-o", $opt_o); my $wrarc = OpenBSD::Ustar->new($outfh, "."); for my $pkgname (@ARGV) { my $true_package = OpenBSD::PackageLocator->find($pkgname); die "No such package $pkgname" unless $true_package; my $dir = $true_package->info; my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS); my $in = { plist => $plist, dir => $dir, prefix => $prefix, tocopy => [], pkg => $true_package }; my $e = OpenBSD::PackingElement::FCONTENTS->new(CONTENTS); $e->copy_over($wrarc, $prefix, $true_package); $plist->mark_tocopy($in->{tocopy}); push(@tomerge, $in); $prefix++; } my $total_files = 0; my $total_size = 0; # For now, we assume packing-lists contain the same items. while(1) { # kill empty lists my @n = (); for my $pkg (@tomerge) { if (@{$pkg->{tocopy}} > 0) { push(@n, $pkg); } } @tomerge = @n; if (@tomerge == 0) { last; } # determine which item we want to copy (by name) my $name; # easiest case: same name all around. $name = find_equal(\@tomerge); # second case: a name that occurs first in some lists, # and not in the others if (!defined $name) { $name = occurs_first(\@tomerge); } # else, try random if (!defined $name) { $name = $tomerge[0]->{tocopy}->[0]->{name}; } my $allprefix=''; my $ref; my @mergeable = (); # select the mergeable items for my $pkg (@tomerge) { if ($pkg->{tocopy}->[0]->{name} eq $name) { push(@mergeable, $pkg); } } my $all_copies = 0; while (@mergeable > 0) { my $pkg = shift @mergeable; my $ref = shift @{$pkg->{tocopy}}; my $copies = 0; my $currentprefix = $pkg->{prefix}; my @todo = (); my @merged = (); for my $cmp (@mergeable) { if (defined $ref->{d} && $cmp->{tocopy}->[0]->{d}->equals($ref->{d})) { push(@merged, $cmp); $currentprefix .= $cmp->{prefix}; $copies++; } else { push(@todo, $cmp); } } $total_files += $copies; $total_size += $ref->{size} * $copies; $ref->copy_over($wrarc, $currentprefix, $pkg); @mergeable = @todo; $all_copies += $copies; for my $pkg2 (@merged) { my $i = shift @{$pkg2->{tocopy}}; $i->make_alias($wrarc, $currentprefix, $pkg2, $name); } } if ($opt_v) { if ($all_copies) { print "$name (shared: $all_copies)\n"; } else { print $name, "\n"; } } } $wrarc->close; print "Shared $total_files files for $total_size bytes\n" if $opt_v;