#! /usr/bin/perl # Copyright (c) 2005-2007 Marc Espie # $OpenBSD: pkg_merge,v 1.21 2010/07/28 12:19:54 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, $state) = @_; my $e = $pkg->{pkg}->next; if (!$e->check_name($self)) { $state->fatal("Names don't match: #1 vs #2", $e->{name}, $self->{name}); } $e->{name} = $prefix."/".$e->{name}; $e->copy_long($wrarc); } sub make_alias { my ($self, $wrarc, $prefix, $pkg, $alias, $state) = @_; my $e = $pkg->{pkg}->next; if (!$e->check_name($self)) { $state->fatal("Names don't match: #1 vs #2", $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, $state) = @_; 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->{no_exports} = 1; $ui->handle_options('o:v', '[-v] -o result pkg pkg2 ...'); my $out = $ui->opt('o'); my $verbose = $ui->opt('v'); if (!$out) { $ui->usage("Missing -o result"); } if (-e $out) { $ui->unlink($verbose, $out); } 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", $out); my $wrarc = OpenBSD::Ustar->new($outfh, $ui, "."); for my $pkgname (@ARGV) { my $true_package = $ui->repo->find($pkgname); $ui->fatal("No such package #1", $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, $ui); $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; if (defined $ref->{size}) { $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, $ui); } } if ($verbose) { if ($all_copies) { $ui->say("#1 (shared: #2)", $name, $all_copies); } else { $ui->say("#1", $name); } } } $wrarc->close; $ui->say("Shared #1 files for #2 bytes", $total_files, $total_size) if $verbose;