#! /usr/bin/perl

# ex:ts=8 sw=4:
# $OpenBSD: pkg_add,v 1.50 2004/08/12 19:18:03 brad Exp $
#
# Copyright (c) 2003-2004 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.

# this is it ! The hard one
use strict;
use warnings;
use OpenBSD::PackingList;
use OpenBSD::PackageInfo;
use OpenBSD::PackageLocator;
use OpenBSD::PackageName;
use OpenBSD::PkgCfl;
use OpenBSD::Vstat;
use Getopt::Std;
use File::Copy;

our %forced = ();
our ($ftp_only, $cdrom_only);

sub ensure_ldconfig
{
	my $verbose = shift;
	return unless defined $OpenBSD::PackingElement::Lib::todo;
	print "running ldconfig -m ", join(' ', keys %$OpenBSD::PackingElement::Lib::todo), "\n"
	    if  $verbose;
	system(@OpenBSD::PackingElement::Lib::ldconfig, "-m", 
	    keys %$OpenBSD::PackingElement::Lib::todo);
	undef $OpenBSD::PackingElement::Lib::todo;
}

package OpenBSD::PackingElement;

sub install
{
}

sub set_modes
{
	my ($self, $name) = @_;

	if (defined $self->{owner} && defined $self->{group}) {
		system('chown', $self->{owner}.':'.$self->{group}, $name);
	} elsif (defined $self->{owner}) {
		system('chown', $self->{owner}, $name);
	} elsif (defined $self->{group}) {
		system('chown', ':'.$self->{group}, $name);
	}
	if (defined $self->{mode}) {
		system('chmod', $self->{mode}, $name);
	}
}

package OpenBSD::PackingElement::FileBase;
use File::Basename;
use File::Path;

sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;
	my $fullname = $self->fullname();

	my $file=$archive->next();
	if ($file->{name} ne $self->{name}) {
		die "Error: archive does not match", $file->{name}, "!=",
		$self->{name}, "\n";
	}
	print "extracting ", $destdir, $fullname, "\n" if $verbose;
	return if $not;
	$file->{name} = $fullname;
	$file->{cwd} = $self->{cwd};
	$file->{destdir} = $destdir;
	$file->create();
	$self->set_modes($destdir.$fullname);
}

package OpenBSD::PackingElement::Sample;
use File::Copy;

sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;

	my $filename = $destdir.$self->{name};
	my $orig = $self->{copyfrom};
	if (!defined $orig) {
		die "\@sample element does not reference a valid file\n";
	}
	my $origname = $destdir.$orig->fullname();
	if (-e $filename) {
		print "The existing configuration file $filename has NOT been changed\n";
		if (defined $orig->{md5}) {
			require OpenBSD::md5;

			my $md5 = OpenBSD::md5::fromfile($filename);
			if ($md5 eq $orig->{md5}) {
				print "\t(but it seems to match the sample file $origname)\n";
			} else {
				print "\tIt does not match the sample file $origname\n";
				print "You may wish to update it manually\n";
			}
		}
	} else {
		if ($not) {
			print "The configuration file $filename would be installed from $origname\n";
		} else {
			copy($origname, $filename);
			$self->set_modes($filename);
			print "The configuration file $filename has been installed from $origname\n";
		}
	}
}

package OpenBSD::PackingElement::Sampledir;

sub install
{
	&OpenBSD::PackingElement::Dir::install;
}

package OpenBSD::PackingElement::Mandir;

sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;
	$self->SUPER::install($archive, $destdir, $verbose, $not);
	print "You may wish to add ", $self->fullname(), " to /etc/man.conf\n";
}

package OpenBSD::PackingElement::InfoFile;
use File::Basename;

sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;
	$self->SUPER::install($archive, $destdir, $verbose, $not);
	return if $not;
	my $fullname = $destdir.$self->fullname();
	system("install-info", "--info-dir=".dirname($fullname), $fullname);
}

package OpenBSD::PackingElement::Dir;
sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;
	my $fullname = $self->fullname();

	print "new directory ", $destdir, $fullname, "\n" if $verbose;
	return if $not;
	File::Path::mkpath($destdir.$fullname);
	$self->set_modes($destdir.$fullname);
}

package OpenBSD::PackingElement::Exec;

sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;

	main::ensure_ldconfig($verbose) unless $not;
	print "exec ", $self->{expanded}, "\n" if $verbose or $not;
	system('/bin/sh', '-c', $self->{expanded}) unless $not;
}

package OpenBSD::PackingElement::Lib;

sub install
{
	my ($self, $archive, $destdir, $verbose, $not) = @_;
	$self->SUPER::install($archive, $destdir, $verbose, $not);
	$self->mark_ldconfig_directory($destdir);
}

package OpenBSD::PackingElement::Arch;

sub check
{
	my ($self, $forced_arch) = @_;

	my ($machine_arch, $arch);
	for my $ok (@{$self->{arches}}) {
		return 1 if $ok eq '*';
		if (defined $forced_arch) {
			if ($ok eq $forced_arch) {
				return 1;
			} else {
				next;
			}
		}
		if (!defined $machine_arch) {
			chomp($machine_arch = `/usr/bin/arch -s`);
		}
		return 1 if $ok eq $machine_arch;
		if (!defined $arch) {
			chomp($arch = `/usr/bin/uname -m`);
		}
		return 1 if $ok eq $arch;
	}
	return undef;
}

package main;

my $errors = 0;

our ($opt_v, $opt_n, $opt_I, $opt_f, $opt_L, $opt_B, $opt_A, $opt_P);
getopts('vnIL:f:B:A:P:');
if ($opt_f) {
	%forced = map {($_, 1)} split(/,/, $opt_f);
}
if ($opt_P) {
	if ($opt_P eq 'cdrom') {
		$cdrom_only = 1;
	}
	elsif ($opt_P eq 'ftp') { 
		$ftp_only = 1;
	}
	else {
	    die "bad option: -P $opt_P";
	}
}

$opt_L = '/usr/local' unless defined $opt_L;

my $destdir;
if (defined $opt_B) {
	$destdir = $opt_B;
} elsif (defined $ENV{'PKG_PREFIX'}) {
	$destdir = $ENV{'PKG_PREFIX'};
}
if (defined $destdir) {
	$destdir.='/';
	$ENV{'PKG_DESTDIR'} = $destdir;
} else {
	$destdir = '';
}

if ($< && !$forced{nonroot}) {
	die "$0 must be run as root";
}

my $conflict_list = {};

# first, find all possible potential conflicts
for my $pkg (installed_packages()) {
	my $dir = installed_info($pkg);
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS, \&OpenBSD::PackingList::ConflictOnly);
	next unless defined $plist;
	$conflict_list->{$plist->pkgname()} = OpenBSD::PkgCfl->make_conflict_list($plist);
}

sub can_install($)
{
	my $pkgname = shift;

	if (is_installed $pkgname) {
		print "package $pkgname is already installed\n";
		return undef unless $forced{installed};
	}

	while (my ($name, $l) = each %$conflict_list) {
		if ($l->conflicts_with($pkgname)) {
			print "package $pkgname conflicts with installed package $name\n";
			$errors++;
			return undef unless $forced{conflicts};
		}
	}

	return 1;
}


# This does pre_add a package: finding it and reading its package information
sub pre_add($$)
{
	my ($pkg, $not) = @_;
	my $pkgname1;
	my $operation = $not ? "Pretending to add" : "Adding";
	
	if ($pkg ne '-') {
		print "$operation $pkg\n";
		$pkgname1 = OpenBSD::PackageName->new($pkg);
		return undef unless can_install($pkgname1->{pkgname});
	}

	my $handle = OpenBSD::PackageLocator->find($pkg);
	if (!$handle) {
		print "Can't find $pkg\n";
		$errors++;
		return undef;
	}
	my $dir = $handle->info();
    	my $plist = $handle->{plist} = 
	    OpenBSD::PackingList->fromfile($dir.CONTENTS);
	unless (defined $plist) {
		print "Can't find CONTENTS from $pkg\n";
		$errors++;
		return undef;
	}
	if ($plist->pkgbase() ne $opt_L) {
		print "Localbase mismatch: package has: ", $plist->pkgbase(), " , user wants: $opt_L\n";
		$errors++;
		return undef;
	}
	my $pkgname = OpenBSD::PackageName->new($plist->pkgname());
	if (defined $pkgname1) {
		if ($pkgname->{pkgname} ne $pkgname1->{pkgname}) {
			print "Package name is not consistent ???\n";
			$errors++;
			return undef;
		}
	} else {
		print $operation, " ", $pkgname->{pkgname}, "\n";
		return undef unless can_install($pkgname->{pkgname});
	}
	# second handling of conflicts
	my $l = OpenBSD::PkgCfl->make_conflict_list($plist);
	$handle->{conflicts} = $l;
	if ($l->conflicts_with(installed_packages())) {
		print "package $pkg has conflicts\n";
		$errors++;
		return undef unless $forced{conflicts};
	}
	return $handle;
}


sub solve_dependencies
{
	my ($handle, @extra) = @_;
	my $plist = $handle->{plist};
	my $to_register = $handle->{solved_dependencies} = [];
	my $to_install;

	# do simple old style pkgdep first
	my @deps = ();
	for my $dep (@{$plist->{pkgdep}}) {
		if (!is_installed($dep->{name})) {
			push(@deps, $dep->{name});
		}
		push(@$to_register, $dep->{name});
	}
	for my $dep (@{$plist->{newdepend}}, @{$plist->{libdepend}}) {
	    next if defined $dep->{name} and $dep->{name} ne $plist->pkgname();
	    my @candidates = OpenBSD::PackageName::pkgspec_match($dep->{pattern}, installed_packages());
	    if (@candidates >= 1) {
		    push(@$to_register, $candidates[0]);
	    } else {
	    	if (!defined $to_install) {
			$to_install = {};
			for my $fullname (@extra) {
			    $to_install->{OpenBSD::PackageName::url2pkgname($fullname)} = $fullname;
			}
		}
	    	# try against list of packages to install
	    	my @candidates = OpenBSD::PackageName::pkgspec_match($dep->{pattern}, keys %{$to_install});
		if (@candidates >= 1) {
		    push(@deps, $to_install->{$candidates[0]});
		    push(@$to_register, $candidates[0]);
		} else {
		    # try with list of packages
		    my @candidates = OpenBSD::PackageName::pkgspec_match($dep->{pattern}, OpenBSD::PackageLocator::available());
		    # one single choice
		    if (@candidates == 1) {
			push(@deps, $candidates[0]);
			push(@$to_register, $candidates[0]);
		    } elsif (@candidates > 1) {
			# grab default if available
		    	if (grep {$_ eq $dep->{def}} @candidates) {
			    push(@deps, $dep->{def});
			    push(@$to_register, $dep->{def});
			# grab first one otherwise
			} else {
			    push(@deps, $candidates[0]);
			    push(@$to_register, $candidates[0]);
			}
		    } else {
			# can't get a list of packages, assume default
			# will be there.
			push(@deps, $dep->{def});
			push(@$to_register, $dep->{def});
		    }
		}
	    }
	}

	if (@{$to_register} > 0) {
	    print "Dependencies for ", $plist->pkgname(), " resolve to: ", 
	    	join(',', @$to_register);
	    print " (todo: ", join(',', @deps), ")" if @deps > 0;
	    print "\n";
	}
	return @deps;
}

sub register_installation
{
	my ($dir, $dest, $plist) = @_;
	mkdir($dest);
	for my $i (info_names()) {
		copy("$dir$i", "$dest");
	}
	$plist->tofile($dest.CONTENTS);
}

sub borked_installation
{
	my ($plist, $dir) = @_;

	use OpenBSD::PackingElement;

	my $borked = borked_package();
	# fix packing list for pkg_delete
	$plist->{items} = $plist->{done};

	# last file may have not copied correctly
	my $last = $plist->{items}->[@{$plist->{items}}-1];
	if ($last->IsFile()) {
	    require OpenBSD::md5;

	    my $old = $last->{md5};
	    $last->{md5} = OpenBSD::md5::fromfile($last->{fullname});
	    if ($old ne $last->{md5}) {
		print "Adjusting md5 for ", $last->{fullname}, " from ",
		    $old, " to ", $last->{md5}, "\n";
	    }
	}
	OpenBSD::PackingElement::Cwd->add($plist, '.');
	my $pkgname = $plist->pkgname();
	$plist->{name}->{name} = $borked;
	$plist->{pkgdep} = [];
	my $dest = installed_info($borked);
	register_installation($dir, $dest, $plist);
	print "Installation of $pkgname failed.\n";
	print "Partial installation recorded as $borked\n";
}

sub check_lib_specs
{
	my $base = shift;
	my $dir;
	for my $spec (split(/,/, shift)) {
		print "checking libspec $spec " if $opt_v;
		if ($spec =~ m|.*/|) {
			$dir = "$base/$&";
			$spec = $';
		} else {
			$dir = "$base/lib";
		}
		if ($spec =~ m/^(.*)\.(\d+)\.(\d+)$/) {
			my ($libname, $major, $minor) = ($1, $2, $3);
			my @candidates = 
			    grep { /^lib\Q$libname\E\.so\.$major\.(\d+)$/ 
			    	&& $1 >= $minor } 
			    OpenBSD::Vstat::vreaddir($dir);
			if (@candidates == 0) {
				print "not found\n" if $opt_v;
				return undef;
			} else {
			    print "found ", $candidates[0], "\n" if $opt_v;
			}
		} else {
			print "bad spec\n" if $opt_v;
			return undef;
		}
	}
	return 1;
}

sub borked_script($)
{
	my $msg = shift;

	if ($forced{scripts}) {
		print "$msg borked\n";
	} else {
		die "$msg borked";
	}
}

sub collision_report
{
	my $list = shift;
	my %todo = map {($_, 1)} @$list;
	my $bypkg = {};
	

	for my $pkg (installed_packages()) {
		my $plist = OpenBSD::PackingList->fromfile(installed_info($pkg).CONTENTS, \&OpenBSD::PackingList::FilesOnly);
		for my $item (@{$plist->{items}}) {
			next unless $item->IsFile();
			my $name = $item->fullname();
			if (defined $todo{$name}) {
				$bypkg->{$pkg} = [] unless defined $bypkg->{$pkg};
				push(@{$bypkg->{$pkg}}, $name);
				delete $todo{$name};
			}
		}
	}
	print "Collision: the following files already exist\n";
	for my $pkg (sort keys %$bypkg) {
	    for my $item (sort @{$bypkg->{$pkg}}) {
	    	print "\t$item ($pkg)\n";
	    }
	}
	for my $item (sort keys %todo) {
	    print "\t$item\n";
	}
}

sub manpages_index
{
	my ($plist, $destdir) = @_;
	return unless defined $plist->{state}->{mandirs};
	require OpenBSD::Makewhatis;

	while (my ($k, $v) = each %{$plist->{state}->{mandirs}}) {
		my @l = map { $destdir.$_ } @$v;
		eval { OpenBSD::Makewhatis::merge($destdir.$k, \@l); };
		if ($@) {
			print STDERR "Error in makewhatis: $@\n";
		}
	}
}


sub really_add($$)
{
	my ($handle, $destdir) = @_;
	my $plist = $handle->{plist};
	my $dir = $handle->info();
	my $pkgname = $plist->pkgname();
	my $problems = 0;

	my $extra = $plist->{extrainfo};
	if ($cdrom_only && ((!defined $extra) || $extra->{cdrom} ne 'yes')) {
	    print "Package $pkgname is not for cdrom.\n";
	    $problems++;
	}
	if ($ftp_only && ((!defined $extra) || $extra->{ftp} ne 'yes')) {
	    print "Package $pkgname is not for ftp.\n";
	    $problems++;
	}
	$ENV{'PKG_PREFIX'} = $plist->pkgbase();
	# check for collisions with existing stuff
	my $colliding = [];
	for my $item (@{$plist->{items}}) {
		next unless $item->IsFile();
		my $fname = $destdir.$item->fullname();
		if (OpenBSD::Vstat::vexists($fname)) {
			push(@$colliding, $fname);
			$problems++;
		}
		my $s = OpenBSD::Vstat::add($fname, $item->{size});
		next unless defined $s;
		if ($s->{ro}) {
			print "Error: ", $s->{mnt}, " is read-only ($fname)\n";
			$problems++;
		}
		if ($s->avail() < 0) {
			print "Error: ", $s->{mnt}, " is not large enough ($fname)\n";
			$problems++;
		}
	}
	if (@$colliding > 0) {
		collision_report($colliding);
	}
	exit(1) if $problems;

	my $interrupted;
	local $SIG{'INT'} = sub {
		$interrupted = 1;
	};

	if ($plist->has(REQUIRE)) {
		ensure_ldconfig($opt_v) unless $opt_n;
		print "Require script: $dir",REQUIRE," $pkgname INSTALL\n" if $opt_v or $opt_n;
		unless ($opt_n) {
			chmod 0755, $dir.REQUIRE;
			system($dir.REQUIRE, $pkgname, "INSTALL") == 0 or
			    borked_script("require script");
		}
	}

	unless ($opt_I) {
		if ($plist->has(INSTALL)) {
			ensure_ldconfig($opt_v) unless $opt_n;
			print "Install script: $dir",INSTALL," $pkgname PRE-INSTALL\n" if $opt_v or $opt_n;
			unless ($opt_n) {
				chmod 0755, $dir.INSTALL;
				system($dir.INSTALL, $pkgname, "PRE-INSTALL") == 0 or
				    borked_script("install script");
			}
		}
	}

	if (!defined $handle) {
		print STDERR "Archive in $pkgname broken\n";
		$errors++;
		return;
	}


	$plist->{done} = [];
	for my $item (@{$plist->{items}}) {
		eval { $item->install($handle, $destdir, $opt_v, $opt_n); };
		if ($@) {
			print STDERR "$@";
			$errors++;
			last;
		}
		push(@{$plist->{done}}, $item);
		last if $interrupted;
	}

	manpages_index($plist, $destdir);
	$handle->close();

	unless ($opt_I) {
		if ($plist->has(INSTALL) && !$interrupted) {
			ensure_ldconfig($opt_v) unless $opt_n;
			print "Install script: $dir",INSTALL ," $pkgname POST-INSTALL\n" if $opt_v or $opt_n;
			unless ($opt_n) {
				if (system($dir.INSTALL, $pkgname, "POST-INSTALL") != 0) {
					print STDERR "install script for $pkgname borked\n";
					$errors++ unless $forced{scripts};
				}
			}
		}
	}

	unlink($dir.CONTENTS);
	if ($interrupted || $errors) {
		borked_installation($plist, $dir) unless $opt_n;
		exit 1;
	}
	my $dest = installed_info($pkgname);
	register_installation($dir, $dest, $plist) unless $opt_n;
	if (defined $handle->{solved_dependencies} && !$opt_n) {
		require OpenBSD::RequiredBy;

		for my $dep (@{$handle->{solved_dependencies}}) {
			OpenBSD::RequiredBy->new($dep)->add($pkgname);
		}
    	}
	add_installed($pkgname);
	if ($plist->has(DISPLAY)) {
		my $pager = $ENV{'PAGER'} || "/usr/bin/more";
		system("$pager $dir".DISPLAY);
	}
}

my @todo = (@ARGV);
my $cache={};

MAINLOOP:
while (my $pkg = shift @todo) {
	if (!defined $cache->{$pkg}) {
		$cache->{$pkg} = pre_add($pkg, $opt_n);
	}
	my $handle = $cache->{$pkg};
	if ($errors > 0) {
		last unless defined $handle;
	} else {
		next unless defined $handle;
	}

	my $plist = $handle->{plist};

	if (is_installed($plist->pkgname())) {
		$handle->close();
		next;
	}
	if ($plist->has('arch')) {
		unless ($plist->{arch}->check($opt_A)) {
			print "$pkg is not for the right architecture\n";
			next MAINLOOP unless $forced{arch};
		}
	}
	if (!defined $handle->{solved_dependencies}) {
		my @deps = solve_dependencies($handle, @todo);
		if (@deps > 0) {
			unshift(@todo, @deps, $pkg);
			next MAINLOOP;
		}
	}

	# verify dependencies and register them

	for my $dep (@{$handle->{solved_dependencies}}) {
		next if is_installed($dep);
		print "Can't install $pkg: can't resolve $dep\n";
		next MAINLOOP;
	}
	for my $dep (@{$plist->{libdepend}}) {
		# can't check libspecs yet
		next if defined $dep->{name} and $dep->{name} ne $plist->pkgname();
		if (!check_lib_specs($plist->pkgbase(), $dep->{libspec})) {
			print "Can't install $pkg: incorrect libspec: ",
			    $dep->{libspec}, "\n";
			next MAINLOOP unless $forced{libdepends};
		}
	}
	for my $dep (@{$handle->{solved_dependencies}}) {
		OpenBSD::PackingElement::PkgDep->add($plist, $dep);
	}
	really_add($handle, $destdir);
	$conflict_list->{$plist->pkgname()} = $handle->{conflicts};
}

OpenBSD::PackingElement::Fontdir::finish_fontdirs();
ensure_ldconfig($opt_v) unless $opt_n;

if ($opt_n or $opt_v) {
	OpenBSD::Vstat::tally();
}
exit(1) if $errors;
