ood-ports-lbsd/infrastructure/bin/proot

#! /usr/bin/perl
# ex:ts=8 sw=4:
# $OpenBSD: proot,v 1.57 2017/04/30 20:56:19 espie Exp $
#
# Copyright (c) 2016 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 warnings;

my $ports1;
use FindBin;
BEGIN {
	$ports1 = $ENV{PORTSDIR} || '/usr/ports';
}

use lib ("$ports1/infrastructure/lib", "$FindBin::Bin/../lib");
use OpenBSD::Getopt;
use OpenBSD::Paths;
use OpenBSD::State;
use OpenBSD::ProgressMeter;
use DPB::User;

package MyUser;
our @ISA = qw(DPB::User);

use File::Basename;
use File::Find;

sub new
{
	my $class = shift;
	return $class->SUPER::new(@_)->enforce_local;
}

sub mkpath
{
	my ($self, $dir) = @_;
	my $p = dirname($dir);
	if (! -d $p) {
		$self->mkpath($p);
	}
	$self->mkdir($dir);
}

sub mkRpath
{
	my ($self, $dir, @except) = @_;
	my %dont = map {($_, 1)} @except;
	if (-d $dir) {
		find(sub {
		    if ($dont{$_}) {
			    $File::Find::prune = 1;
			    return;
		    }
		    $self->own($_);
		}, $dir);
	} else {
		$self->mkpath($dir);
	}
}

sub own
{
	my ($self, $path) = @_;
	chown $self->{uid}, $self->{gid}, $path;
}

sub mkdir
{
	my ($self, $dir) = @_;
	mkdir($dir);
	$self->own($dir);
}

package MyState;
our @ISA = (qw(OpenBSD::State));

use File::Copy;
use File::Spec;
use File::Basename;
use File::Find;
use File::Path qw(remove_tree);

sub set_chroot
{
	my $state = shift;
	for my $item (keys %{$state->{dontrm}}) {
		$state->add_chroot_preserved($item);
	}
}

sub fatal_error
{
	my $self = shift;
	$self->errsay(@_);
	$self->{error} = 1;
}

sub add_chroot_preserved
{
	my ($state, $item) = @_;
	$state->{chroot_dont}{$state->chroot($item)} = 1;
}

sub add_preserved
{
	my ($state, $item) = @_;
	$state->{dontrm}{$item} = 1;
	if (exists $state->{chroot_dont}) {
		$state->add_chroot_preserved($item);
	}
}

sub canonical_dir
{
	my ($state, $path) = @_;
	$path = File::Spec->canonpath($path);
	$path =~ s,/+$,,;
	return $path;
}

sub do_parm
{
	my ($state, $k, $v) = @_;

	my $opts = {
	    chroot => sub {
		    $state->{chroot} = File::Spec->canonpath($v);
	    }, srcroot => sub {
		    $state->{srcroot} = File::Spec->canonpath($v);
	    }, PORT_USER => sub {
		    $state->{portuser} = MyUser->new($v);
	    }, LOG_USER => sub {
		    $state->{loguser} = MyUser->new($v);
	    }, FETCH_USER => sub {
		    $state->{fetchuser} = MyUser->new($v);
	    }, BUILD_USER => sub {
		    $state->{builduser} = MyUser->new($v);
	    }, PORTSDIR => sub {
		    $state->{PORTSDIR} = File::Spec->canonpath($v);
	    }, DISTDIR => sub {
		    $state->{DISTDIR} = File::Spec->canonpath($v);
	    }, PACKAGE_REPOSITORY => sub {
		    $state->{PACKAGE_REPOSITORY} = File::Spec->canonpath($v);
	    }, PLIST_REPOSITORY => sub {
		    $state->{PLIST_REPOSITORY} = File::Spec->canonpath($v);
	    }, NFSDIR => sub {
		    $state->{DISTDIR} = File::Spec->canonpath("$v/distfiles");
		    $state->{PACKAGE_REPOSITORY} = 
			File::Spec->canonpath("$v/packages");
		    $state->{PLIST_REPOSITORY} =
		    	File::Spec->canonpath("$v/plist");
	    }, LOCALDIR => sub {
		    $state->{WRKOBJDIR} = File::Spec->canonpath("$v/pobj");
		    $state->{LOCKDIR} = File::Spec->canonpath("$v/locks");
	    }, preserve => sub {
		    $state->add_preserved($v);
	    }, portscvs => sub {
		    $state->{portscvs} = $v;
	    }, ignorecvs => sub {
		    $state->{ignorecvs} = 1;
	    }, chown_all => sub {
		    $state->{chown_all} = $v;
	    }, WRKOBJDIR => sub {
	    	$state->{WRKOBJDIR} = File::Spec->canonpath($v);
	    }, DISTDIR => sub {
	    	$state->{DISTDIR} = File::Spec->canonpath($v);
	    }, LOCKDIR => sub {
	    	$state->{LOCKDIR} = File::Spec->canonpath($v);
	    }, snapshot => sub {
	    	$state->{snapshot} = $v;
	    }, actions => sub {
	    	if ($v eq 'none') {
			delete $state->{actions};
		}
		if ($v =~ m/^-(.*)/) {
			$state->{actions}{$1} = 0;
		} else {
			$state->{actions}{$v} = 1;
		}
	    }, sets => sub {
	    	if ($v =~ m/^-(.*)/) {
			$state->{sets}{$1} = 0;
		} else {
			$state->{sets}{$v} = 1;
		}
	    }, extra => sub {
	    	$state->{known}{$v} = 1;
	    }, mkconf_tail => sub {
	    	$state->{mkconf_tail} = $v;
	    }, mkconf_lines => sub {
	    	push(@{$state->{mkconf_lines}}, $v);
	    }
	};

	if (defined $opts->{$k}) {
		&{$opts->{$k}};
	} else {
		$state->fatal_error("Unknown options #1=#2", $k, $v);
	}
}

sub read_configfile
{
	my ($state, $name) = @_;
	open(my $f, '<', $name) or die "Can't open config $name: $!";
	my ($k, $v);

	while (<$f>) {
		chomp;
		my $line = $_;
		s/\s*\#.*//;
		next if /^$/;
		if (m/^(.*?)\s*\=\s*(.*)$/) {
			($k, $v) = ($1, $2);
		} elsif (m/^\s+(.*)$/) {
			$v = $1;
		} else {
			$state->fatal_error("Error in config file #1: #2", 
			    $., $line);
			next;
		} 
		$state->do_parm($k, $v);
	}
	close($f);
}

sub handle_options
{
	my $state = shift;
	# default shit
	$state->{actions} = {
	    check_mount => 1,
	    devs => 1,
	    ldconfig => 1,
	    ports_subdirs => 1,
	    unpopulate_light => 1,
	    resolv => 1,
	    write_mk => 1,
	};
	$state->{sets} = {
		base => 1,
		comp => 1,
		etc => 1,
		xetc => 1,
		xbase => 1,
		xfont => 1,
		xshare => 1,
	};

	$state->{error} = 0;
	$state->{no_exports} = 1;
	$state->{opt} = {
		B => sub { $state->{fchroot} = File::Spec->canonpath(shift); },
		S => sub { $state->{fsrcroot} = File::Spec->canonpath(shift); },
		c => sub { $state->read_configfile(shift); },
	    };
	$state->SUPER::handle_options("B:S:c:mx", 
	    "[-B chroot] [-c configfile] [-S chroot] [arg=value...]");

	# command-line trump configuration file
	my ($k, $v);
	for my $arg (@ARGV) {
		if ($arg =~ m/^(.*?)\s*\=\s*(.*)$/) {
			($k, $v) = ($1, $2);
		} else {
			$v = $arg;
		}
		$state->do_parm($k, $v);
	}
	if (defined $state->{fchroot}) {
		$state->{chroot} = $state->{fchroot};
	}
	$state->set_chroot;
	if (defined $state->{fsrcroot}) {
		$state->{srcroot} = $state->{fsrcroot};
	}

	# more basic option defaults
	if (!defined $state->{actions}{snapshot} && 
	    !defined $state->{actions}{locate} && 
	    !defined $state->{actions}{none}) {
	    	if ($state->{snapshot}) {
			$state->{actions}{snapshot} = 1;
		} else {
			$state->{actions}{locate} = 1;
		}
	}
	if (defined $state->{portscvs} && 
	    !defined $state->{actions}{checkout_ports}) {
	    	$state->{actions}{checkout_ports} = 1;
	}
	if ($state->{actions}{unpopulate}) {
		delete $state->{actions}{unpopulate_light};
	}

	if (!defined $state->{chroot}) {
		$state->usage("need a chroot base");
	}
	if (defined $state->{actions}{checkout_ports} &&
	    !defined $state->{portuser}) {
	    	$state->usage("can't do action checkout_ports without a PORT_USER");
	}
	if (defined $state->{snapshot} &&
	    $state->{snapshot} =~ m/^\Q$state->{chroot}\E(.*)/) {
	    	$state->add_preserved($1);
	}

	$state->{progressmeter} = OpenBSD::ProgressMeter->new;
	$state->{progressmeter}->setup($state->opt('x'), $state->opt('m'), 
	    $state);
	if ($< != 0) {
		$state->fatal("Must be root");
	}
	for my $i (qw(PORTSDIR DISTDIR WRKOBJDIR PACKAGE_REPOSITORY PLIST_REPOSITORY LOCKDIR LOGDIR)) {
		if (defined $state->{$i}) {
			$state->{write}{$i} = 1;
		}
	}
	$state->{PORTSDIR} //= "/usr/ports";
	$state->{DISTDIR} //= join('/', $state->{PORTSDIR}, 'distfiles');
	$state->{WRKOBJDIR} //= join('/', $state->{PORTSDIR}, 'pobj');
	$state->{LOCKDIR} //= join('/', $state->{WRKOBJDIR}, 'locks');
	$state->{LOGDIR} //= join('/', $state->{PORTSDIR}, 'logs');
	$state->{fetchuser} //= MyUser->new('_pfetch');
	$state->{builduser} //= MyUser->new('_pbuild');
	$state->{loguser} //= $state->{builduser};
	$state->{PACKAGE_REPOSITORY} //= join('/', $state->{PORTSDIR}, 'packages');
	$state->{PLIST_REPOSITORY} //= join('/', $state->{PORTSDIR}, 'plist');
	$state->{sysdir} //= '/usr/src/sys';
	for my $dir (qw(DISTDIR WRKOBJDIR LOGDIR PACKAGE_REPOSITORY PLIST_REPOSITORY LOCKDIR)) {
		$state->{$dir} = $state->canonical_dir($state->{$dir});
		$state->add_preserved($state->{$dir});
	}
	$state->{PORTSDIR} = $state->canonical_dir($state->{PORTSDIR});
	if (!$state->{actions}{copy_ports}) {
		$state->add_preserved($state->{PORTSDIR});
	}

	for my $i (qw(portuser loguser fetchuser builduser)) {
		if (defined $state->{$i}) {
			$state->say("#1: #2", $i, $state->{$i}{user});
		}
	}
	for my $i (qw(PORTSDIR DISTDIR WRKOBJDIR LOCKDIR LOGDIR 
	    PACKAGE_REPOSITORY PLIST_REPOSITORY)) {
		$state->say("#1=#2", $i, $state->{$i});
	}
}

sub chroot
{
	my $state = shift;
	if (defined $state->{chroot}) {
		unshift @_, $state->{chroot};
	}
	return File::Spec->canonpath(join('/', @_));
}

sub srcroot
{
	my $state = shift;
	if (defined $state->{srcroot}) {
		unshift @_, $state->{srcroot};
	}
	return File::Spec->canonpath(join('/', @_));
}

sub chdir
{
	my ($state, $dir) = @_;
	CORE::chdir($dir) or $state->fatal("Can't change to #1: #2", $dir, $!);
}

sub banner
{
	my ($self, $text, $sub) = @_;
	$self->{progressmeter}->set_header($text);
	&$sub;
	$self->{progressmeter}->next;
}

sub run_chroot
{
	my ($self, $text, $sub) = @_;
	$self->{progressmeter}->set_header($text);
	my $r = fork();
	if (!defined $r) {
		$self->fatal("Couldn't fork");
	}
	if ($r == 0) {
		CORE::chroot($self->chroot) or
		    $self->fatal("Can't chroot into #1: #2", 
		    $self->chroot, $!); 
		CORE::chdir('/') or
		    $self->fatal("Can't chdir after chroot: #1", $!);
		&$sub;
		exit(0);
	}
	waitpid($r, 0);
	if ($? != 0) {
		$self->fatal("Running task failed");
	}
	# XXX fork'd so we don't know what we showed
	eval {
		$self->{progressmeter}->forked;
	};

	$self->{progressmeter}->next;
}

sub sync_display
{
	my $self = shift;
	$self->{progressmeter}->clear if defined $self->{progressmeter};
}

sub check_mountpoint
{
	my $state = shift; 
	open(my $cmd, "-|", OpenBSD::Paths->mount);
	my ($dev, $nosuid, $wx);
	while (<$cmd>)  {
		chomp;
		if (m/^(\S+)\s+on\s+(\S+)\s+type\s+(\S+)\s+\((.+)\)$/) {
			my ($dir, $type, $options) = ($2, $3, $4);
			my %opts = map {($_, 1)} split(/,\s+/, $options);
			if ($opts{nodev}) {
				$dev->{$dir} = 0;
			} else {
				$dev->{$dir} = 1;
			}
			if ($opts{nosuid}) {
				$nosuid->{$dir} = 1;
			} else {
				$nosuid->{$dir} = 0;
			}
			if ($opts{wxallowed}) {
				$wx->{$dir} = 1;
			} else {
				$wx->{$dir} = 0;
			}
			my $devno = (stat $dir)[0];
			if ($type eq 'nfs') {
				$state->{nfs}{$devno} = $dir;
			}
		}
	}
	close($cmd);
	my $root = $state->{chroot};
	if (-l $root) {
		$root = readlink $root;
	}
	for my $dir (keys %$dev) {
		if ($dir =~ m/^\Q$root\E(\/.*)/) {
			$state->say("Preserve #1", $1);
			$state->add_preserved($1);
			my $devno = (stat $dir)[0];
			$state->{dontrm_dev}{$devno} = 1;
		}
	}
	my $mnt = $root;
	do {{
		if (!defined $dev->{$mnt}) {
			$mnt = dirname($mnt);
			next;
		}
		$state->errsay("#1 is under #2 which is nodev", $root, $mnt)
		    if $dev->{$mnt} == 0;
		$state->errsay("#1 is under #2 which does not have nosuid",
		    $root, $mnt) if $nosuid->{$mnt} == 0;
		$state->errsay("#1 is under #2 which does not have wxallowed",
		    $root, $mnt) if $wx->{$mnt} == 0;
			return;
	}} while ($mnt ne dirname($mnt));
	$state->fatal_error("Couldn't find mountpoint for #1 ???", $root);
}

sub special_data
{
	my $state = shift;
	$state->{known}{'/etc/resolv.conf'} = 1;
	$state->{known}{'/etc/hosts'} = 1;
}

sub read_locates
{
	my $state = shift;
	$state->banner("Running locate",
	    sub {
		open(my $cmd, '-|', 'locate',
		    '-d', $state->srcroot(OpenBSD::Paths->srclocatedb),
		    '-d', $state->srcroot(OpenBSD::Paths->xlocatedb), ':');
		while (<$cmd>) {
			chomp;
			my ($set, $path) = split(':', $_, 2);
			$set =~ s/\d+//;
#			next if $path =~ m/\.ph$/;
			if ($state->{sets}{$set}) {
				$state->{known}{$path} = 1;
			}
			$state->{progressmeter}->working(1000);
		}
		close($cmd);
	    });
}

# THIS IS THE WORK HORSE
sub simple_copy
{
	my ($state, $path, $cpath, $user) = @_;

	$state->{accounted}{$path} = 1;
	if (-l $path) {
		return if $state->{chroot_dont}{$cpath};
		remove_tree($cpath);
		my $target = readlink $path;
		if (!defined $target) {
			$state->fatal_error("Can't read link to #1: #2", 
			    $path, $!);
		} else {
			symlink($target, $cpath) or
			    $state->fatal_error("Can't symlink #1 -> #2", 
			    	$target, $cpath);
		}
		return;
	} else {
		my ($dev, $ino, $mode, $uid, $gid, $sz, $atime, $mtime) = 
		    (stat $path)[0, 1, 2, 4, 5, 7, 8, 9];
		if (-d $path) {
			if (!-d $cpath && -e _) {
				return if $state->{chroot_dont}{$cpath};
				remove_tree($cpath);
			}
			mkdir $cpath, $mode;
			if (!-d $cpath) {
				$state->fatal_error("Can't mkdir #1", $cpath);
			}
			if (defined $user) {
				$user->own($cpath);
			} else {
				chown $uid, $gid, $cpath;
			}
			chmod $mode, $cpath;
			utime $atime, $mtime, $cpath;
			return;
		} elsif (-f $path) {
			my ($dev2, $ino2, $sz2, $mtime2) = 
			    (stat $cpath)[0, 1, 7, 9];
			if (defined $dev2 && $dev2 == $dev && $ino2 == $ino) {
				return;
			}
			my $key = "$dev/$ino";

			if (exists $state->{copied}{$key}) {
				return if $state->{chroot_dont}{$cpath};
				remove_tree($cpath);
				link($state->{copied}{$key}, $cpath);
				return;
			}
			# avoid the copy if same filesystem
			if (link($path, $cpath)) {
				return;
			}

			my $okay = 0;
			if (defined $sz2 && $sz2 == $sz && $mtime2 >= $mtime) {
				$okay = 1;
			} else {
				return if $state->{chroot_dont}{$cpath};
				remove_tree($cpath);
				$okay = copy($path, $cpath);
			}
			if ($okay) {
				if (defined $user) {
					$user->own($cpath);
				} else {
					chown $uid, $gid, $cpath;
				}
				chmod $mode, $cpath;
				utime $atime, $mtime, $cpath;
				$state->{copied}{$key} = $cpath;
				return;
			}
		}
	}
	$state->fatal_error("Can't copy #1: #2", $path, $!);
}

sub recursive_copy
{
	my ($state, $path) = @_;

	my $d = dirname($path);
	if ($d ne $path) {
		if (!-d $state->chroot($d)) {
			$state->recursive_copy($d);
		}
	}
	my $spath = $state->srcroot($path);
	if (!-e $spath) {
		$state->errsay("#1 does not exist", $spath);
		return;
    	}
	$state->simple_copy($spath, $state->chroot($path));
}

sub copy_sync
{
	my $state = shift;
	# farting all over the place
	$state->banner("Copying stuff over",
	    sub {
		my $old = umask;
		umask 0;
		for my $path (sort keys %{$state->{known}}) {
			$state->recursive_copy($path);
			$state->{progressmeter}->message($path);
		}
		umask $old;
	    });
}

sub best_user
{
	my $state = shift;
	local $_ = shift;

	if (m/^\Q$state->{LOGDIR}\E/) {
		return $state->{loguser};
	}
	if (m/^\Q$state->{DISTDIR}\E\/build-stats/) {
		return $state->{loguser};
	}
	if (m/^\Q$state->{PLIST_REPOSITORY}\E/) {
		return $state->{builduser};
	}
	if (m/^\Q$state->{PACKAGE_REPOSITORY}\E/) {
		return $state->{builduser};
	}
	if (m/^\Q$state->{DISTDIR}\E/) {
		return $state->{fetchuser};
	}
	if (m/^\Q$state->{DISTDIR}\E/) {
		return $state->{fetchuser};
	}
	return $state->{portuser};
}

sub grab_file
{
	my ($state, $snapdir, $file) = @_;

	my $baseurl = $state->{snapshot};

	unless (-f $file) {
		if ($state->system('/usr/bin/ftp' , "-C", "-o", 
		    "$snapdir/$file.part", "$baseurl/$file") == 0) {
			rename("$snapdir/$file.part", "$snapdir/$file");
		} else {
			$state->fatal("fetch #1 failed", $file);
		}

	}
}

sub extract_archive
{
	my ($state, $dir, $archive) = @_;
	require IO::Uncompress::AnyUncompress;

	my $in = IO::Uncompress::AnyUncompress->new("$dir/$archive", 
	    MultiStream => 1);
	if (!$in) {
		$state->fatal("Couldn't open #1", "$dir/$archive");
	}
	require OpenBSD::Ustar;
	my $arc = OpenBSD::Ustar->new($in, $state, $state->chroot);
	while (my $o = $arc->next) {
		$o->{name} =~ s,^\./,/,;
		if (defined $o->{linkname}) {
			$o->{linkname} =~ s,^\./,/,;
		}
		unlink($state->chroot($o->{name}));
#		$state->say("$o->{name}");
		$state->{progressmeter}->message("$archive: $o->{name}");
		$state->{accounted}{$o->{name}} = 1;
		$o->create;
	}
	$arc->close;
	$in->close;
}

sub get_snapshot
{
	my $state = shift;

	$state->banner("Grabbing snapshot",
	    sub {
	    	my ($snapdir, $grab);
	    	if ($state->{snapshot} =~ m/^(https?|ftp):/) {
			$snapdir = $state->chroot('/tmp');
			File::Path::make_path($snapdir);
			$grab = sub { $state->grab_file($snapdir, shift); }
		} else {
			$snapdir = $state->{snapshot};
			$grab = sub {};
		}

		&$grab("SHA256.sig");
		open my $f, '<', "$snapdir/SHA256.sig" 
		    or $state->fatal("no SHA256.sig");
		my $line = <$f>;
		if ($line !~ m/openbsd\s+(\d+)\.(\d+)\s+base/) {
			$state->fatal("Unrecognized snapshot");
		}
		my $v = "$1$2";
		my (@files, @later);
		for my $set (sort keys %{$state->{sets}}) {
			if ($set =~ m/etc/) {
				push(@later, "$set.tgz");
			} else {
				my $file = "$set$v.tgz";
				&$grab($file);
				push(@files, $file);
			}
		}
		if ($state->system(
		    sub {
			$state->chdir($snapdir); },
		    '/usr/bin/signify', '-C', '-p',
		    "/etc/signify/openbsd-$v-base.pub", '-x', 'SHA256.sig',
		    @files) != 0) {
			$state->fatal("Checksum error");
		}
		for my $archive (@files) {
			$state->extract_archive($snapdir, $archive);
		}
		for my $archive (@later) {
			$state->extract_archive($state->chroot("var/sysmerge"), 
			    $archive);
		}
	    	if ($state->{snapshot} =~ m/^(https?|ftp):/) {
			for my $file (@files) {
				unlink("$snapdir/$file");
			}
		}
	    });
}

sub copy_ports
{
	my $state = shift;
	$state->banner("Copying ports",
	    sub {
		my $old = umask;
		umask 0;
		my $portsdir = $state->{PORTSDIR};
		my $srcports = $state->srcroot($portsdir);
		if (-l $srcports) {
			$srcports = readlink $srcports;
		}
		my $destports = $state->chroot($portsdir);
		find(sub {
			if ($state->{ignorecvs} && $_ eq 'CVS' && -d $_) {
				$File::Find::prune = 1;
				return;
			}
			my $realname = $File::Find::name;
			$realname =~ s,^\Q$srcports\E\b,,;
			my $r2 = $realname;
			$r2 =~ s,^,$portsdir,;
			if ($r2 eq $state->{WRKOBJDIR}) {
				$File::Find::prune = 1;
				return;
			}
			$realname =~ s,^/,,;
			$state->{progressmeter}->message($realname);
			$state->simple_copy($File::Find::name, 
			    $state->chroot($r2), $state->best_user($r2));
		    }, $srcports);
		umask $old;
	    });
}

sub copy_sys
{
	my $state = shift;
	$state->banner("Copying sys includes",
	    sub {
		my $old = umask;
		umask 0;
		my $srcsys = $state->srcroot($state->{sysdir});
		my $destsys = $state->chroot($state->{sysdir});
		find(sub {
			# XXX don't bother copying stuff that's NOT .h
			return if -f $_ && !m/\.h$/ && $_ ne 'Makefile';
			if (-d _ && $_ eq 'obj' || $_ eq 'CVS') {
				$File::Find::prune = 1;
				return;
			}
			my $destname = $File::Find::name;
			$destname =~ s,^\Q$srcsys\E\b,$destsys,;
			$state->{progressmeter}->message($File::Find::name);
			$state->simple_copy($File::Find::name, $destname);
		    }, $srcsys);
		umask $old;
	    });
}

sub regen_devs
{
	my $state = shift;
	$state->banner("Generating devices",
	    sub {
		$state->system(
		    sub {
			$state->chdir($state->chroot("/dev"));
		    }, '/bin/sh', './MAKEDEV', 'all');
		$state->add_preserved('/dev');
	    });
	$state->run_chroot("Generating devices db",
	    sub {
	    	$state->system("/usr/sbin/dev_mkdb");
	    });
}

sub run_ldconfig
{
	my $state = shift;
	$state->banner("Running ldconfig",
	    sub {
		$state->system(
		    sub {
			CORE::chroot($state->chroot) or exit 1;
		    }, 
		    'ldconfig', '/usr/lib', '/usr/X11R6/lib', '/usr/local/lib');
		$state->{accounted}{'/var/run/ld.so.hints'} = 1;
	    });
}

sub checkout_ports
{
	my $state = shift;
	$state->banner("Checking out ports tree",
	    sub {
	    	my @cvs = ("/usr/bin/cvs", "-z3", "-d", $state->{portscvs});
		my $dir = $state->chroot($state->{PORTSDIR});
		if (-d "$dir/CVS") {
			$state->{portuser}->run_as(sub {
			    $state->system(
			    	sub { $state->chdir($dir); },
				@cvs, "update", "-dP", "-A");
			    });
		} else {
			# okay, so stupid cvs creates the dir, work-around that
			$state->{portuser}->mkpath("$dir.tmp");
			$state->{portuser}->run_as(sub {
			    $state->system(
			    	sub { $state->chdir("$dir.tmp"); },
			    	@cvs, "co", "-P", "-A", "ports");
			    });
			rename("$dir.tmp/ports", "$dir");
			rmdir("$dir.tmp");
		}
	    });
}

sub unpopulate_chroot
{
	my $state = shift;
	$state->run_chroot("Cleaning up files and directories",
	    sub {
		my @dirs;
	    	find(
		    sub {
		    	my $devno = (lstat $_)[0];
			if ($state->{dontrm_dev}{$devno} || 
			    $state->{dontrm}{$File::Find::name}) {
				$File::Find::prune = 1 if -d _;
				return;
			}
			if ($state->{accounted}{$File::Find::name}) {
				return;
			}
		    	$state->{progressmeter}->message($File::Find::name);
		    	if (-l _ || ! -d _) {
				unlink($_);
			} else {
				push(@dirs, $File::Find::name);
			}
		    }, '/');
		for my $dir (reverse @dirs) {
			#$state->say("rmdir #1", $dir);
			rmdir $dir;
		}
	    });
}

sub verbose_shit
{
	my $state = shift;
	$state->run_chroot("Showing up stragglers",
	    sub {
	    	find(
		    sub {
			if (-d $_ && $state->{dontrm}{$File::Find::name}) {
				$File::Find::prune = 1;
				return;
			}
			if ($state->{dontrm}{$File::Find::name}) {
				return;
			}
			if ($state->{accounted}{$File::Find::name} || 
			    $File::Find::name eq '/') {
				return;
			}
			$state->say("#1", $File::Find::name);
		    }, '/');
	    });
}

sub show_absolute_symlinks
{
	my $state = shift;
	my $wrapper = '/usr/sbin/mailwrapper';
	my $expected = {
		'/etc/localtime' => undef,
		'/etc/rmt' => '/usr/sbin/rmt',
		'/etc/termcap' => '/usr/share/misc/termcap',
		'/usr/bin/hoststat' => $wrapper,
		'/usr/bin/mailq' => $wrapper,
		'/usr/bin/newaliases' => $wrapper,
		'/usr/bin/purgestat' => $wrapper,
		'/usr/bin/rcs2log' => '/usr/libexec/cvs/contrib/rcs2log',
		'/usr/local/lib/X11/app-defaults' => '/etc/X11/app-defaults',
		'/usr/sbin/makemap' => $wrapper,
		'/usr/sbin/sendmail' => $wrapper,
    	};

	$state->run_chroot("Showing absolute symlinks",
	    sub {
	    	find(
		    sub {
		    	return unless -l $_;
			my $dest = readlink $_;
			return unless $dest =~ m/^\//;
			my $ok = 0;
			my $n = $File::Find::name;
			if (exists $expected->{$n}) {
				$ok = 1;
				if (defined $expected->{$n}
				    and $expected->{$n} ne $dest) {
				    $ok = 0;
				}
			}
			if (!$ok) {
				$state->errsay("#1 points to #2", $n, $dest);
			}
		    }, '/');
	    });
}

sub is_under_nfs
{
	my ($state, $dir) = @_;

	my $devno = (stat $dir)[0];
	if (defined $devno && exists $state->{nfs}{$devno}) {
		return 1;
	} else {
		return 0;
	}
}

use constant { WHINE => 1, MKPATH => 2 };

sub build_dir
{
	my ($state, $opts, $username, $dirname, @r) = @_;
	$state->{progressmeter}->message($dirname);
	my $dir = join('/', $state->{$dirname}, @r);
	$state->{$username}->mkpath($dir);
	my $nfs = $state->is_under_nfs($dir);
	if (($opts & WHINE) && $nfs) {
		$state->errsay("#1 (#2) is under nfs", $dirname, $dir);
	}
		
	if ($state->{chown_all} && !$nfs && !($opts & MKPATH)) {
		$state->{$username}->mkRpath($dir);
	} 
}


sub make_ports_subdirs
{
	my $state = shift;
	$state->run_chroot("Adjusting ports directories",
	    sub {
	    	$state->build_dir(0, "fetchuser", "DISTDIR");
		if (defined $state->{loguser}) {
			$state->build_dir(0, "loguser", "LOGDIR"); 
			$state->build_dir(0, "loguser", "DISTDIR", "build-stats"); 
		}

		$state->build_dir(WHINE|MKPATH , "builduser", "WRKOBJDIR");
		$state->build_dir(0, "builduser", "PACKAGE_REPOSITORY");
		$state->build_dir(0, "builduser", "PLIST_REPOSITORY");
		$state->build_dir(WHINE, "builduser", "LOCKDIR");
	    });
}

sub write_mk_conf
{
	my $state = shift;
	$state->banner("Writing mk.conf",
	    sub {
		open(my $f, ">", $state->chroot("/etc/mk.conf"));
		print $f "# Automatically generated by $state->{cmd}\n\n";
		for my $i (sort keys %{$state->{write}}) {
			print $f "$i = $state->{$i}\n";
		}
		if (exists $state->{mkconf_lines}) {
			print $f "\n";
			for my $l (@{$state->{mkconf_lines}}) {
				print $f $l, "\n";
			}
		}
		if (exists $state->{mkconf_tail}) {
			open(my $g, "<", $state->{mkconf_tail}) or
			    $state->fatal_error("Couldn't read tail #1: #2",
				$state->{mkconf_tail}, $!);
			print $f "# Copied from $state->{mkconf_tail}\n";
			while(<$g>) {
				print $f $_;
			}
			close $g;
		}
		close($f);
	    });
}

package main;

my $state = MyState->new("proot");
$state->handle_options;
if ($state->{actions}{check_mount}) {
	$state->check_mountpoint;
}
if ($state->{actions}{unpopulate}) {
	$state->unpopulate_chroot;
}
if ($state->{actions}{locate}) {
	$state->read_locates;
}

if ($state->{actions}{snapshot}) {
	$state->get_snapshot;
}
if ($state->{actions}{resolv}) {
	$state->special_data;
}
if (defined $state->{known}) {
	$state->copy_sync;
}
if ($state->{actions}{copy_ports}) {
	$state->copy_ports;
}
if ($state->{actions}{copy_sys}) {
	$state->copy_sys;
}
if ($state->{actions}{unpopulate_light}) {
	$state->unpopulate_chroot;
}
if ($state->{actions}{ldconfig}) {
	$state->run_ldconfig;
}
if ($state->{actions}{devs}) {
	$state->regen_devs;
}
if ($state->{actions}{checkout_ports}) {
	$state->checkout_ports;
}
if ($state->{actions}{ports_subdirs}) {
	$state->make_ports_subdirs;
}
if ($state->{actions}{stragglers}) {
	$state->verbose_shit;
}
if ($state->{actions}{write_mk} && 
    exists $state->{write} || exists $state->{mkconf_tail}) {
	$state->write_mk_conf;
}
if ($state->{actions}{check_symlinks}) {
	$state->show_absolute_symlinks;
}

exit($state->{error});