#!/usr/bin/perl -w
#-
# Copyright (c) 2000-2005 Dag-Erling Coïdan Smørgrav
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer
#    in this position and unchanged.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $FreeBSD$
#

use strict;
use Fcntl;
use Getopt::Long;

my $VERSION	= "2.8.4";
my $COPYRIGHT	= "Copyright (c) 2000-2005 Dag-Erling Smørgrav. " .
		  "All rights reserved.";

# Constants
sub ANONCVS_ROOT	{ ":ext:anoncvs\@anoncvs.FreeBSD.org:/home/ncvs" }
sub REQ_EXPLICIT	{ 1 }
sub REQ_IMPLICIT	{ 2 }

sub PATH_BZIP2		{ "/usr/bin/bzip2" }
sub PATH_CVS		{ "/usr/bin/cvs" }
sub PATH_FETCH		{ "/usr/bin/fetch" }
sub PATH_LDCONFIG	{ "/sbin/ldconfig" }
sub PATH_MAKE		{ "/usr/bin/make" }
sub PATH_RSH		{ "/usr/bin/rsh" }
sub PATH_SSH		{ "/usr/bin/ssh" }

# Global parameters
my $dbdir     = "/var/db/pkg";	# Package database directory
my $index     = undef;		# INDEX file
my $moved     = undef;		# MOVED file
my $portsdir  = "/usr/ports";	# Ports directory
my $tag	      = undef;		# CVS tag to use
my $date      = undef;		# CVS date to use
my $release   = undef;		# OS release

# Global flags
my $anoncvs   = 0;		# Use anoncvs1.FreeBSD.org
my $clean     = 0;		# Clean ports
my $cvsroot   = 0;		# CVS root directory
my $exclude   = 0;		# Do not list installed ports
my $fetch     = 0;		# Fetch ports
my $force     = 0;		# Force package registration
my $installed = 0;		# Select installed ports
my $info      = 0;		# Show port info
my $dontclean = 0;		# Don't clean after build
my $packages  = 0;		# Build packages
my $list      = 0;		# List ports
my $plist     = 0;		# Print packing list
my $build     = 0;		# Build ports
my $status    = 0;		# List installed ports and their status
my $update    = 0;		# Update ports tree from CVS
my $verbose   = 0;		# Verbose mode
my $website   = 0;		# Show website URL

# Global variables
my $need_deps;			# Need dependency information
my $have_index;			# INDEX has been read
my $have_moved;			# MOVED has been read
my %ports;			# Maps ports to their directory.
my %pkgname;			# Inverse of the above map
my %masterport;			# Maps ports to their master ports
my %reqd;			# Ports that need to be installed
my %have_dep;			# Dependencies that are already present
my %port_dep;			# Map ports to their dependency lists
my %installed;			# Installed ports
my %moved;			# Ports that have moved
my $capture;			# Capture output

#
# Set process title
#
sub setproctitle(;$) {
    my $title = shift;

    $0 = "porteasy $VERSION";
    $0 .= ": $title"
	if defined($title);
}

#
# Shortcut for 'print STDERR'
#
sub stderr(@) {
    print(STDERR @_);
}

#
# Similar to err(3)
#
sub bsd::err($$@) {
    my $code = shift;		# Return code
    my $fmt = shift;		# Format string
    my @args = @_;		# Arguments

    my $msg;			# Error message

    $msg = sprintf($fmt, @args);
    stderr("$msg: $!\n");
    exit($code);
}

#
# Similar to errx(3)
#
sub bsd::errx($$@) {
    my $code = shift;		# Return code
    my $fmt = shift;		# Format string
    my @args = @_;		# Arguments

    my $msg;			# Error message

    $msg = sprintf($fmt, @args);
    stderr("$msg\n");
    exit($code);
}

#
# Similar to warn(3)
#
sub bsd::warn($@) {
    my $fmt = shift;		# Format string
    my @args = @_;		# Arguments

    my $msg;			# Error message

    $msg = sprintf($fmt, @args);
    stderr("$msg: $!\n");
}

#
# Similar to warnx(3)
#
sub bsd::warnx($@) {
    my $fmt = shift;		# Format string
    my @args = @_;		# Arguments

    my $msg;			# Error message

    $msg = sprintf($fmt, @args);
    stderr("$msg\n");
}

#
# Call the specified sub with $capture set
#
sub capture($@) {
    my $subr = shift;		# Subroutine to call
    my @args = @_;		# Arguments

    my $oldcapture;		# Old capture flag
    my $rtn;			# Return value

    $oldcapture = $capture;
    $capture = 1;
    $rtn = &{$subr}(@args);
    $capture = $oldcapture;
    return $rtn;
}

#
# Print an info message
#
sub info(@) {

    my $msg;			# Message

    if ($verbose) {
	$msg = join(' ', @_);
	chomp($msg);
	stderr("$msg\n");
    }
}

#
# Print an info message about a subprocess
#
sub cmdinfo(@) {
    info(">>>", @_);
}

#
# Change working directory
#
sub cd($) {
    my $dir = shift;		# Directory to change to

    cmdinfo("cd $dir");
    chdir($dir)
	or bsd::err(1, "unable to chdir to %s", $dir);
}

#
# Run a command and return its output
#
sub cmd($@) {
    my $cmd = shift;		# Command to run
    my @args = @_;		# Arguments

    my $pid;			# Child pid
    local *PIPE;		# Pipe
    my $output;			# Output
    my $rtn;			# Return value

    cmdinfo(join(" ", $cmd, @args));
    $pid = ($capture || $verbose) ? open(PIPE, "-|") : fork();
    if (!defined($pid)) {
	bsd::err(1, ($capture || $verbose) ? "open()" : "fork()");
    } elsif ($pid == 0) {
	exec($cmd, @args);
	die("child: exec(): $!\n");
    }
    if ($capture || $verbose) {
	$output = "";
	while (<PIPE>) {
	    $output .= $_;
	    if ($verbose) {
		stderr($_);
	    }
	}
    }
    $rtn = ($capture || $verbose) ? close(PIPE) : (waitpid($pid, 0) == $pid);
    if (!$rtn) {
	if ($? & 0xff) {
	    bsd::warnx("%s caught signal %d", $cmd, $? & 0x7f);
	} elsif ($? >> 8) {
	    bsd::warnx("%s returned exit code %d", $cmd, $? >> 8);
	} else {
	    bsd::warn("close()");
	}
	return undef;
    }
    if ($capture) {
	$output =~ s/\n*$//s;
	return $output;
    }
    return 1;
}

#
# Run CVS
#
sub cvs($;@) {
    my $cmd = shift;		# CVS command

    my @args;			# Arguments to CVS

    if (!$update) {
	return "\n";
    }
    if (!$verbose) {
	push(@args, "-q");
    }
    push(@args, "-f", "-z3", "-R", "-d$cvsroot", $cmd, "-A", "-T");
    if ($cmd eq "checkout") {
	push(@args, "-P");
    } elsif ($cmd eq "update") {
	push(@args, "-P", "-d");
    }
    if ($tag) {
	push(@args, "-r$tag");
    }
    if ($date) {
	push(@args, "-D$date");
    }
    push(@args, @_);
    return cmd(&PATH_CVS, @args);
}

#
# Run make
#
sub make($@) {
    my $port = shift;		# Port category/name
    my @args = @_;

    push(@args, "PORTSDIR=$portsdir")
	unless ($portsdir eq "/usr/ports");
    cd("$portsdir/$port");
    return cmd(&PATH_MAKE, @args);
}

#
# The undocumented command.
#
sub ecks() {

    local *FILE;		# File handle

    sysopen(FILE, "/var/db/port.mkversion", O_RDWR|O_CREAT|O_TRUNC, 0644)
	or bsd::err(1, "open()");
    print(FILE "20380119\n");
    close(FILE);
}

#
# Update the root of the ports tree
#
sub update_root() {

    my $parent;		# Parent directory

    $parent = $portsdir;
    $parent =~ s/\/*ports\/*$//;
    if (! -d "ports/CVS") {
	cd($parent);
	cvs("checkout", "-l", "ports")
	    or bsd::errx(1, "error checking out the root of the ports tree");
	cd($portsdir);
    } else {
	cd($portsdir);
	cvs("update", "-l")
	    or bsd::errx(1, "error updating the root of the ports tree");
    }
    if ($packages && ! -d "$portsdir/packages") {
	mkdir("$portsdir/packages", 0777)
	    or bsd::errx(1, "error creating the package directory");
    }
    cvs("update", "Mk", "Templates", "Tools")
	or bsd::errx(1, "error updating the ports infrastructure");
    $moved = "$portsdir/MOVED";
}

#
# Update the index
#
sub update_index() {

    my $ifn;			# Index file name

    cd($portsdir);
    $ifn = capture(\&cmd, ("make", "-VINDEXFILE"));
    if ($update || ! -f $ifn) {
	my $izfn = "$ifn.bz2";
	info("Retrieving $izfn");
	if (!cmd(&PATH_FETCH, $verbose ? "-mv" : "-m",
	    "http://www.freebsd.org/ports/$izfn") || ! -f $izfn) {
	    bsd::errx(1, "Failed to retrieve index file");
	}
	if (! -f $ifn || (stat($izfn))[9] > (stat($ifn))[9]) {
	    info("Decompressing $izfn");
	    if (!cmd(&PATH_BZIP2, "-dfk", $izfn)) {
		bsd::errx(1, "Failed to decompress index file");
	    }
	}
    }
    $index = "$portsdir/$ifn";
    if (! -f $index) {
	$index = "$portsdir/INDEX";
    }
}

#
# Read the ports index
#
sub read_index() {

    local *INDEX;		# File handle
    my $line;			# Line from file

    return if ($have_index);
    update_index();
    info("Reading $index");
    sysopen(INDEX, $index, O_RDONLY)
	or bsd::err(1, "can't open $index");
    while ($line = <INDEX>) {
	my @port;		# Port info

	@port = split(/\|/, $line, 3);
	$port[1] =~ s|^/usr/ports/*||;
	$ports{$port[0]} = $port[1];
	$pkgname{$port[1]} = $port[0];
    }
    close(INDEX);
    info(keys(%ports) . " ports in index");
    $have_index = 1;
}

#
# Read the list of moved ports
#
sub read_moved() {

    local *MOVED;		# File handle
    my $line;			# Line from file

    return if ($have_moved);
    info("Reading $moved");
    sysopen(MOVED, $moved, O_RDONLY)
	or bsd::err(1, "can't open $moved");
    while ($line = <MOVED>) {
	if ($line =~ m/^([\w\/-]+)\|([\w\/-]*)\|([\d-]+)\|(.*)$/) {
	    $moved{$1} = [ $2, $3, $4 ];
	}
    }
    $have_moved = 1;
}

#
# Find a port by a portion of it's package name
#
sub find_port($) {
    my $port = shift;		# Port to find

    my @suggest;		# Suggestions

    stderr("Can't find required port '$port'");
    my $portre = $port;
    $portre =~ s/([^\w\*\?])/\\$1/g;
    $portre =~ s/\*/\.\*/g;
    $portre =~ s/\?/\./g;
    @suggest = grep(/^$portre/i, keys(%ports));
    if (@suggest == 1 && $suggest[0] =~ m/^$portre[0-9.-]/) {
	$port = $ports{$suggest[0]};
	stderr(", assuming you mean $pkgname{$port}.\n");
	return $port;
    } elsif (@suggest) {
	stderr(", maybe you mean:\n  " . (join("\n  ", @suggest)));
    }
    stderr("\n");
    return undef;
}

#
# Find out if a port has moved
#
sub find_moved($) {
    my $port = shift;		# Port to check

    my $date = "1900-01-01";

    if (!$have_moved) {
	read_moved();
    }
    while (exists($moved{$port}) && $moved{$port}->[1] gt $date) {
	if (!$moved{$port}->[0]) {
	    info("$port was removed" .
		 " on $moved{$port}->[1]: $moved{$port}->[2]");
	    return undef;
	}
	info("$port was renamed to $moved{$port}->[0]" .
	     " on $moved{$port}->[1]: $moved{$port}->[2]");
	($port, $date) = @{$moved{$port}};
    }
    return $port;
}

#
# Add a port to the list of required ports
#
sub add_port($$) {
    my $port = shift;		# Port to add
    my $req = shift;		# Requirement (explicit or implicit)

    my $realport;		# Real port name

    if ($port =~ m|^([^/]+/[^/]+)$|) {
	$realport = $1;
    } else {
	if (!$have_index) {
	    read_index();
	}
	if (exists($ports{$port})) {
	    $realport = $ports{$port};
	} else {
	    $realport = find_port($port);
	}
	if ($realport) {
	    $realport = find_moved($realport);
	}
    }
    if (!$realport) {
	return 1;
    }
    if (!exists($reqd{$realport})) {
	$reqd{$realport} = 0;
    }
    $reqd{$realport} |= $req;
    return 0;
}

#
# Get the ORIGIN line from a manifest
#
sub get_origin($) {
    my $port = shift;		# Port to inspect

    local *FILE;		# File handle
    my $origin;			# Origin

    if (!sysopen(FILE, "$dbdir/$port/+CONTENTS", O_RDONLY)) {
	bsd::warn("can't read manifest for $port");
	return undef;
    }
    while (<FILE>) {
	if (m/^\@comment\s+ORIGIN:(.*)\s*$/) {
	    $origin = $1;
	    last;
	}
    }
    close(FILE);
    if (!$origin) {
	warn("$port has no known origin\n");
	return undef;
    }
    info("$port -> $origin\n");
    $origin = find_moved($origin);
    return $origin;
}

#
# Get list of installed ports
#
sub get_installed() {

    local *DIR;			# Directory handle
    my $port;			# Installed port
    my $origin;			# Port's origin

    opendir(DIR, $dbdir)
	or bsd::err(1, "can't read database directory");
    foreach $port (readdir(DIR)) {
	next if ($port eq "." || $port eq ".." || ! -d "$dbdir/$port");
	$origin = get_origin($port);
	if (!defined($origin) || !$origin) {
	    bsd::warnx("$port has no known origin");
	} else {
	    if ($installed{$origin}) {
		bsd::warnx("$origin is already installed as " .
		    join(', ', @{$installed{$origin}}));
	    } else {
		$installed{$origin} = [ ];
	    }
	    push(@{$installed{$origin}}, $port);
	}
    }
    closedir(DIR);
}

#
# Find master directory for a port
#
sub find_master($) {
    my $port = shift;		# Port

    local *FILE;		# File handle

    if ($masterport{$port}) {
	return $masterport{$port};
    }

    # Look for MASTERDIR in the Makefile. We can't use 'make -V'
    # because the Makefile might try to include the master port's
    # Makefile, which might not be checked out yet.
    sysopen(FILE, "$portsdir/$port/Makefile", O_RDONLY)
	or bsd::err(1, "unable to read Makefile for $port");
    while (<FILE>) {
	my $master;		# Master directory

	if (/^MASTERDIR\s*=\s*(\S+)\s*$/) {
	    $master = $1;
	} elsif (/^\.?include \"([^\s\"]+)\/(?:[^\s\/\"]*)\"\s*$/) {
	    $master = $1;
	}
	if (defined($master) && $master !~ m/WRKDIRPREFIX/) {
	    $master =~ s/^\$\{.CURDIR\}//;
	    $master =~ s/^\$\{PORTSDIR\}/..\/../;
	    $master = "/$port/$master";
	    $master =~ s|/+|/|g;
	    1 while ($master =~ s|/[^\./]*/\.\./|/|);
	    $master =~ s|^/||;
	    $master =~ s|/$||;
	    if ($master eq $port) {
		#bsd::warnx("master port heuristics failed for %s", $port);
		next;
	    }
	    if ($master !~ m|^[^/]+/[^/]+$|) {
		bsd::warnx("invalid master for %s: %s", $port, $master);
		next;
	    }
	    close(FILE);
	    info("$master is master for $port\n");
	    return $masterport{$port} = $master;
	}
    }
    close(FILE);
    return undef;
}

#
# Find a dynamic library
#
sub find_library($) {
    my $library = shift;	# Library to find

    my $ldconfig;		# Output from ldconfig(8)

    $ldconfig = capture(\&cmd, (&PATH_LDCONFIG, "-r"));
    defined($ldconfig)
	or errx(1, "unable to run ldconfig");
    if ($ldconfig =~ m/^\s*\d+:-l$library(\.\d+)* => (.*)$/m) {
	info("The $library library is installed as $2");
	return 1;
    }
    return 0;
}

#
# Find a file
#
sub find_file($) {
    my $file = shift;		# File to find

    my $dir;			# Directory

    if ($file =~ m|^/|) {
	if (-e $file) {
	    info("$file is installed");
	    return 1;
	}
	return 0;
    }
    foreach $dir (split(/:/, $ENV{'PATH'})) {
	if (-x "$dir/$file") {
	    info("$file is installed as $dir/$file");
	    return 1;
	}
    }
    return 0;
}

#
# Process a dependency list
#
sub add_dependencies($$@) {
    my $port = shift;		# Port
    my $finder = shift;		# Finder function
    my @dependlist = @_;	# Dependency list

    my $item;			# Iterator

    foreach $item (@dependlist) {
	$item =~ s|\`([^\`]+)\`|capture(\&cmd, "sh", "-c", $1)|eg;
	1 while ($item =~ s|/[^\./]*/\.\./|/|);
	if ($item !~ m|^(?:([^:]+):)?$portsdir/([^/:]+/[^/:]+)/?(:[^:]+)?$|) {
	    bsd::warnx("invalid dependency: %s", $item);
	    next;
	}
	my ($lhs, $rhs, $target) = ($1, $2, $3);
	next if ($port_dep{$port}->{$rhs});
	# XXX this isn't quite right; lhs-less dependencies should be
	# XXX checked against /var/db/pkg or something.
	if ($exclude && defined($lhs)) {
	    if ($have_dep{$rhs}) {
		next;
	    }
	    info("Verifying status of $rhs ($lhs)");
	    if (($lhs =~ m|^/| && -f $lhs) || &{$finder}($lhs)) {
		info("$rhs seems to be installed");
		$have_dep{$rhs} = 1;
		next;
	    }
	    $have_dep{$rhs} = -1;
	}
	info("Adding $rhs as a dependency for $port");
	$port_dep{$port}->{$rhs} = $target || 'install';
    }
}

#
# Find a port's dependencies
#
sub find_dependencies($) {
    my $port = shift;		# Port

    my $dependvars;		# Dependency variables

    return () unless $need_deps;
    if (!exists($port_dep{$port})) {
	$dependvars = capture(\&make, ($port, "-VLIB_DEPENDS"));
	defined($dependvars)
	    or bsd::errx(1, "failed to obtain dependency list");
	add_dependencies($port, \&find_library, split(' ', $dependvars));
	$dependvars = capture(\&make, ($port,
				       "-VEXTRACT_DEPENDS",
				       "-VPATCH_DEPENDS",
				       "-VFETCH_DEPENDS",
				       "-VBUILD_DEPENDS",
				       "-VRUN_DEPENDS",
				       "-VDEPENDS"));
	defined($dependvars)
	    or bsd::errx(1, "failed to obtain dependency list");
	add_dependencies($port, \&find_file, split(' ', $dependvars));
    }
    return keys(%{$port_dep{$port}});
}

#
# Update a batch of port directories
#
my %have_updated;
sub update_ports(@) {
    my @origins = @_;

    my %need_update;

    foreach my $origin (@origins) {
	my ($category, $port) = split('/', $origin);
	if (!exists($have_updated{$category}) ||
	    !exists($have_updated{$category}->{$port})) {
	    if (!exists($need_update{$category})) {
		$need_update{$category} = { };
	    }
	    $need_update{$category}->{$port} = 1;
	}
    }
    if (keys(%need_update)) {
	cd($portsdir);
	cvs("update", "-l", keys(%need_update))
	    or bsd::errx(1, "error updating categories");
	foreach my $category (keys(%need_update)) {
	    if (!exists($have_updated{$category})) {
		$have_updated{$category} = { };
	    }
	    cd("$portsdir/$category");
	    cvs("update", keys(%{$need_update{$category}}))
		or bsd::errx(1, "error updating $category ports");
	    foreach my $port (keys(%{$need_update{$category}})) {
		$have_updated{$category}->{$port} = 1;
	    }
	}
    }
}

#
# Update all necessary files to build the specified ports
#
sub update_ports_tree(@) {
    my @ports = @_;		# Ports to update

    my @more_ports;		# Additional ports to update
    my %processed;		# Hash of processed ports
    my $n;			# Pass count

    @more_ports = @ports;
    @ports = ();
    for ($n = 0; ; ++$n) {
	my $item;		# Iterator
	my $master;		# Master port
	my $dependency;		# Dependency

	setproctitle("updating");

	if (@more_ports) {
	    info("Ports added since previous pass:", join(' ', @more_ports));
	    update_ports(@more_ports);
	    push(@ports, @more_ports);
	    @more_ports = ();
	}
	info("Pass $n:", @ports - keys(%processed));
	info("Ports:", sort(@ports));
	info("Processed:", sort(keys(%processed)));
	last if (keys(%processed) == @ports);

	# Process all unprocessed ports we know of so far
	foreach my $port (@ports) {
	    next if ($processed{$port});
	    if (! -f "$portsdir/$port/Makefile") {
		bsd::warnx("$port does not exist in $portsdir");
		$pkgname{$port} = $installed{$port}->[0] || "";
		$processed{$port} = 1;
		next;
	    }
	    setproctitle("updating $port");

	    # See if the port has an unprocessed master port
	    if (($master = find_master($port)) && !$processed{$master}) {
		info("$port has unprocessed master: $master");
		update_ports($master);
	    }

	    # Find the port's package name
	    if (!exists($pkgname{$port})) {
		my $makev = capture(\&make, ($port, "-VPKGNAME"));
		if ($makev =~ m/^\s*(\S+)\s*$/s) {
		    $pkgname{$port} = $1;
		} else {
		    bsd::warnx("failed to obtain package name for $port");
		}
	    }

	    # Find the port's dependencies
	    foreach $dependency (find_dependencies($port)) {
		next if ($processed{$dependency});
		add_port($dependency, &REQ_IMPLICIT);
		info("Adding $dependency to back of line");
		push(@more_ports, $dependency)
		    unless(grep({ $_ eq $dependency } (@ports, @more_ports)));
	    }

	    # Mark port as processed
	    info("marking $port as processed");
	    $processed{$port} = 1;
	}
    }
    setproctitle();
}

#
# Find a specific file belonging to a specific port
#
sub find_port_file($$) {
    my $port = shift;		# Port
    my $file = shift;		# File to look for

    my $master;			# Master port

    $master = $port;
    while (!-f "$portsdir/$master/$file") {
	if (!($master = $masterport{$master})) {
	    bsd::errx(1, "$port has no $file");
	}
    }
    return "$portsdir/$master/$file";
}

#
# Show port info
#
sub show_port_info($) {
    my $port = shift;		# Port to show info for

    local *FILE;		# File handle
    my $info;			# Port info

    sysopen(FILE, find_port_file($port, "pkg-descr"), O_RDONLY)
	or bsd::err(1, "can't read description for $port");
    $info = join("| ", <FILE>);
    close(FILE);
    print("+--- Description for $port ($pkgname{$port}):\n| ${info}+---\n");
}

#
# Show port's website URL
#
sub show_port_website($) {
    my $port = shift;		# Port to show info for

    local *FILE;		# File handle
    my $website;		# Port's website

    sysopen(FILE, find_port_file($port, "pkg-descr"), O_RDONLY)
	or bsd::err(1, "can't read description for $port");
    while (<FILE>) {
	if (m/^WWW:\s*(\S+)\s*$/) {
	    $website = $1;
	}
    }
    close(FILE);
    if (!defined($website)) {
	bsd::warnx("No website for $port");
    } else {
	print("$website\n");
    }
}

#
# Show port plist
#
sub show_port_plist($) {
    my $port = shift;		# Port to show plist for

    my $master;			# Master port
    local *FILE;		# File handle
    my $file;			# File name
    my %files;			# Files to list
    my $plist_sub;		# Substitution list (text)
    my %plist_sub;		# Substitution list (hash)
    my $prefix;			# Prefix

    $plist_sub = capture(\&make, ($port, "-VPLIST_SUB"));
    while ($plist_sub =~ m/\G\s*(\w+)=(\"[^\"]*\"|[^\"\s]*)/g) {
	my ($lhs, $rhs) = ($1, $2);
	$rhs =~ s/^\"(.*)\"$/$1/;
	$plist_sub{$lhs} = $rhs;
    }
    $prefix = capture(\&make, ($port, "-VPREFIX"));
    chomp($prefix);
    sysopen(FILE, find_port_file($port, "pkg-plist"), O_RDONLY)
	or bsd::err(1, "can't read packing list for $port");
    while (<FILE>) {
	chomp();
	s{\%\%(\w+)\%\%}{exists($plist_sub{$1}) ? $plist_sub{$1} : "%%$1%%"}eg;
	$file = undef;
	if (m/^[^\@]/) {
	    $file = $_;
	} elsif (m/^\@cwd\s+(\S+)\s*$/) {
	    $prefix = $1;
	} elsif (m/^\@dirrm\s+(\S+)\s*$/) {
	    $file = "$1/";
	} elsif (m/^\@comment\s+/) {
	    # ignore
	} elsif (m/^\@(un)?exec\s+/) {
	    # ignore
	} else {
	    bsd::warnx("unrecognized plist directive: %s", $_);
	}
	if (defined($file)) {
	    if ($file !~ m/^\//) {
		$file = "$prefix/$file";
	    }
	    $file =~ s|/+|/|g;
	    $files{$file} = 1;
	}
    }
    close(FILE);
    # XXX list man pages?
    print("+--- Packing list for $port ($pkgname{$port}):\n");
    foreach (sort(keys(%files))) {
	print("| $_\n");
    }
    print("+---\n");
}

#
# Compare two package names to determine which is newer
#
sub cmp_version($$) {
    my $inst = shift;		# Installed package
    my $port = shift;		# Newest version

    # Shortcut
    if ($inst eq $port) {
	return '=';
    }

    # Compare port epochs
    my ($inst_epoch, $port_epoch) = (0, 0);
    $inst =~ s/,(\d+)$//
	and $inst_epoch = $1;
    $port =~ s/,(\d+)$//
	and $port_epoch = $1;
    if ($inst_epoch != $port_epoch) {
	return ($inst_epoch > $port_epoch) ? '>' : '<';
    }

    # Split it into components
    my @a = split(/[\._-]/, $inst);
    my @b = split(/[\._-]/, $port);

    # Compare the components one by one
    while (@a && @b) {
	($a, $b) = (shift(@a), shift(@b));
	next if $a eq $b;
	if ($a =~ m/^\d+$/ && $b =~ m/^\d+$/) {
	    return ($a > $b) ? '>' : '<';
	}
	return ($a gt $b) ? '>' : '<';
    }

    # Anything left?
    if (@a) {
	return '>';
    } elsif (@b) {
	return '<';
    }
    return '=';
}

#
# Show port status
#
sub show_port_status($) {
    my $port = shift;		# Port to show status for

    my $cmp;			# Comparator

    if ($installed{$port}) {
	foreach my $pkg (@{$installed{$port}}) {
	    if (-d "$portsdir/$port") {
		$cmp = cmp_version($pkg, $pkgname{$port});
	    } else {
		$cmp = '?';
	    }
	    if ($cmp eq '=') {
		print("   $pkg\n");
	    } else {
		printf(" $cmp $pkg ($pkgname{$port})\n");
	    }
	}
    } else {
	printf(" ! $port\n");
    }
}

#
# Clean a port
#
sub clean_port($) {
    my $port = shift;		# Port to clean

    setproctitle("cleaning $port");
    make($port, "clean")
	or bsd::warnx("failed to clean %s", $port);
    setproctitle();
}

#
# Clean the tree
#
sub clean_tree() {

    my $port;			# Port name

    # We could just cd to $portsdir and 'make clean', but it'd
    # be extremely noisy due to only having a partial tree
    foreach $port (keys(%ports)) {
	if (-d "$portsdir/$port") {
	    make($port, "clean", "NO_DEPENDS=yes")
		or bsd::warnx("failed to clean %s", $port);
	}
    }
}

#
# Fetch a port
#
sub fetch_port($) {
    my $port = shift;		# Port to fetch

    setproctitle("fetching $port");
    make($port, "checksum")
	or bsd::errx(1, "failed to fetch %s", $port);
    setproctitle();
}

#
# Build a port
#
sub build_port($) {
    my $port = shift;		# Port to build

    my @makeargs;		# Arguments to make()

    if ($packages) {
	push(@makeargs, "package");
	push(@makeargs, "DEPENDS_TARGET=package");
    } else {
	push(@makeargs, "install");
    }
    if ($force) {
	push(@makeargs, "-DFORCE_PKG_REGISTER");
    }
    if (!$dontclean) {
	push(@makeargs, "clean");
	push(@makeargs, "DEPENDS_CLEAN=YES");
    }
    setproctitle("building $port");
    if (!make($port, @makeargs)) {
	bsd::errx(1, "failed to %s %s",
	    $packages ? "package" : "build", $port);
    }
    setproctitle();
}

#
# Print usage message and exit
#
sub usage() {

    stderr("Usage: porteasy [-abCceFfhIikLlsuVvw] [-D date] [-d dir]\n" .
	   "    [-p dir] [-r dir] [-t tag] [port ...]\n");
    exit(1);
}

#
# Print version
#
sub version() {

    stderr("This is porteasy $VERSION.
$COPYRIGHT
");
    exit(1);
}

#
# Print help text
#
sub help() {

    stderr("This is porteasy $VERSION.
$COPYRIGHT

Options:
  -a, --anoncvs            Use the FreeBSD project's anoncvs server
  -b, --build              Build required ports
  -C, --dontclean          Don't clean after build
  -c, --clean              Clean the specified ports
  -e, --exclude-installed  Exclude installed ports
  -F, --force-pkg-register Force package registration
  -f, --fetch              Fetch distfiles
  -h, --help               Show this information
  -I, --installed          Select installed ports
  -i, --info               Show info about specified ports
  -k, --packages           Build packages for the specified ports
  -L, --plist              Show the packing lists for the specified ports
  -l, --list               List required ports and their dependencies
  -R, --use-rsh            Force use of rsh for cvs :ext: method
  -S, --use-ssh            Force use of ssh for cvs :ext: method
  -s, --status             List installed ports and their status
  -u, --update             Update relevant portions of the ports tree
  -V, --version            Show version number
  -v, --verbose            Verbose mode
  -w, --website            Show the URL to the port's website

Parameters:
  -D, --date=DATE          Specify CVS date
  -d, --dbdir=DIR          Specify package directory (default $dbdir)
  -p, --portsdir=DIR       Specify ports directory (default $portsdir)
  -r, --cvsroot=DIR        Specify CVS root
  -t, --tag=TAG            Specify CVS tag

Report bugs to <des\@freebsd.org>.
");
    exit(1);
}

MAIN:{
    my $port;			# Port name
    my $err = 0;		# Error count
    my $requested = 0;		# Number of ports on command line

    setproctitle();

    # Show usage if no arguments were specified on the command line
    if (!@ARGV) {
	usage();
    }

    # Get option defaults
    if ($ENV{'PORTEASY_OPTIONS'}) {
	foreach (split(' ', $ENV{'PORTEASY_OPTIONS'})) {
	    unshift(@ARGV, $_);
	}
    }

    # Scan command line options
    Getopt::Long::Configure("auto_abbrev", "bundling");
    GetOptions(
	       "a|anoncvs"		=> \$anoncvs,
	       "b|build"		=> \$build,
	       "c|clean"		=> \$clean,
	       "C|dontclean"		=> \$dontclean,
	       "D|date=s"		=> \$date,
	       "d|dbdir=s"		=> \$dbdir,
	       "e|exclude-installed"	=> \$exclude,
	       "F|force-pkg-register"	=> \$force,
	       "f|fetch"		=> \$fetch,
	       "h|help"			=> \&help,
	       "I|installed"		=> \$installed,
	       "i|info"			=> \$info,
	       "k|packages"		=> \$packages,
	       "L|plist"		=> \$plist,
	       "l|list"			=> \$list,
	       "p|portsdir=s"		=> \$portsdir,
	       "R|use-rsh"		=> sub { $ENV{'CVS_RSH'} = &PATH_RSH },
	       "r|cvsroot=s"		=> \$cvsroot,
	       "S|use-ssh"		=> sub { $ENV{'CVS_RSH'} = &PATH_SSH },
	       "s|status"		=> \$status,
	       "t|tag=s"		=> \$tag,
	       "u|update"		=> \$update,
	       "V|version"		=> \&version,
	       "v|verbose"		=> \$verbose,
	       "w|website"		=> \$website,
	       "x|ecks"			=> \&ecks,
	       )
	or usage();

    if (!@ARGV && !$installed &&
	($build || $fetch || $list || $packages || $plist || $website)) {
	usage();
    }

    if ($portsdir !~ m/^\//) {
	$portsdir = `pwd` . $portsdir;
	$portsdir =~ s/\n/\//s;
    }

    if ($portsdir !~ m/\/ports\/?$/) {
	bsd::errx(1, "ports directory must be named 'ports'");
    }

    # 'package' implies 'build'
    if ($packages) {
	$build = 1;
    }

    # Set and check CVS root
    if ($anoncvs && !$cvsroot) {
	$ENV{'CVS_RSH'} = &PATH_SSH;
	$cvsroot = &ANONCVS_ROOT;
    }
    if (!$cvsroot) {
	$cvsroot = $ENV{'CVSROOT'};
    }
    if (!$cvsroot && -f "$portsdir/CVS/Root") {
	local *FILE;

	if (sysopen(FILE, "$portsdir/CVS/Root", O_RDONLY)) {
	    $cvsroot = <FILE>;
	    chomp($cvsroot);
	    close(FILE);
	}
    }
    if ($update && !$cvsroot) {
	bsd::errx(1, "No CVS root, please use the -r option or set \$CVSROOT");
    }

    # Unset potentially troublesom environment variables
    foreach my $var (sort(keys(%ENV))) {
	if ($var =~ m/^(CLASSPATH|(LD|USE|JAVA|WANT)_\w+)$/) {
	    bsd::warnx("Removing $var from environment");
	    delete($ENV{$var});
	}
    }

    # Step 1: update the ports tree infrastructure
    $release = `uname -r`;
    update_root();

    # Step 2: build list of explicitly required ports
    foreach my $arg (@ARGV) {
	if ($arg =~ m/^(?:-D)?([A-Z0-9_]+)=(.*)$/) {
	    $ENV{$1} = $2;
	} elsif ($arg =~ m/^-D([A-Z0-9_]+)$/) {
	    $ENV{$1} = '';
	} else {
	    $err += add_port($arg, &REQ_EXPLICIT);
	    ++$requested;
	}
    }
    if ($err) {
	bsd::errx(1, "some required ports were not found.");
    }
    if ($installed || $status || $exclude) {
	get_installed();
    }
    if ($installed || ($status && $requested == 0)) {
	foreach $port (keys(%installed)) {
	    add_port($port, &REQ_EXPLICIT);
	}
    }

    # Step 3: update port directories and discover dependencies
    $need_deps = ($update || $fetch || $list);
    update_ports_tree(keys(%reqd));

    # Step 4: deselect ports which are already installed
    if ($exclude) {
	foreach $port (keys(%reqd)) {
	    if (defined($installed{$port})) {
		info("$port is already installed");
		delete $reqd{$port};
	    }
	}
    }

    # Step 5: list selected ports
    if ($list) {
	foreach $port (sort(keys(%reqd))) {
	    print((($reqd{$port} & &REQ_EXPLICIT) ? " * " : "   "),
		  "$port ($pkgname{$port})\n");
	}
    }

    # Step 6: list installed ports
    if ($status) {
	foreach $port (sort({ $pkgname{$a} cmp $pkgname{$b} } keys(%reqd))) {
	    show_port_status($port);
	}
    }

    # Step 7: show info
    if ($info) {
	foreach $port (keys(%reqd)) {
	    if ($reqd{$port} & &REQ_EXPLICIT) {
		show_port_info($port);
	    }
	}
    }

    # Step 8: show packing list
    if ($plist) {
	foreach $port (keys(%reqd)) {
	    if ($reqd{$port} & &REQ_EXPLICIT) {
		show_port_plist($port);
	    }
	}
    }

    # Step 9: show website URL
    if ($website) {
	foreach $port (keys(%reqd)) {
	    if ($reqd{$port} & &REQ_EXPLICIT) {
		show_port_website($port);
	    }
	}
    }

    # Step A: clean the ports directories (or the entire tree)
    if ($clean) {
	if (!$requested) {
	    clean_tree();
	} else {
	    foreach $port (keys(%reqd)) {
		if ($reqd{$port} & &REQ_EXPLICIT) {
		    clean_port($port);
		}
	    }
	}
    }

    # Step B: fetch distfiles
    if ($fetch) {
	foreach $port (keys(%reqd)) {
	    fetch_port($port);
	}
    }

    # Step C: build ports - only the explicitly required ones, since
    # some dependencies (most commonly XFree86) may be bogus.
    if ($build || $packages) {
	foreach $port (keys(%reqd)) {
	    if ($reqd{$port} & &REQ_EXPLICIT) {
		build_port($port);
	    }
	}
    }

    # Done!
    exit(0);
}