path: root/usr.sbin/pkg_add/pkg_merge

#! /usr/bin/perl
# Copyright (c) 2005 Marc Espie <espie@openbsd.org>
# 
# 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 OpenBSD::PackageLocator;
use OpenBSD::PackageInfo;
use OpenBSD::PackingList;
use OpenBSD::Getopt;
use OpenBSD::Error;
use OpenBSD::Ustar;
use OpenBSD::ArcCheck;
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->{name})) {
		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->{name})) {
		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;
}


set_usage('pkg_merge [-v] -o result pkg pkg2 ...');

our ($opt_o, $opt_v);

try {
	getopts('o:v');
} catchall {
	Usage($_);
};

if (!defined $opt_o) {
	Usage "Missing -o result";
}

if (@ARGV<2) {
	Usage "Can't merge less than two packages";
}
my @tomerge;

my $prefix = 'a';
my $allprefix = '';
open( my $outfh, "|gzip -c >$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->visit('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->{md5} && $cmp->{tocopy}->[0]->{md5} eq $ref->{md5}) {
		    	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;