#! /usr/bin/perl
# ex:ts=8 sw=4:
# $OpenBSD: pkg_create,v 1.8 2004/01/31 17:56:13 espie Exp $
#
# Copyright (c) 2003 Marc Espie.
# 
# 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.
# 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 OPENBSD PROJECT 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 OPENBSD
# PROJECT 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.

use strict;
use warnings;
use OpenBSD::PackingList;
use OpenBSD::PackageInfo;
use Getopt::Std;
use OpenBSD::md5;
use OpenBSD::Temp;
use File::Copy;

# Extra stuff needed to archive files
package OpenBSD::PackingElement;
sub archive_cmd { () }

package OpenBSD::PackingElement::File;
sub archive_cmd
{
	my ($self, $pfh, $use_cwd) = @_;
	my $fh = $$pfh;
	print $fh $self->{name}, "\n";
	if (@$use_cwd != 0) {
	    my @r = @$use_cwd;
	    @$use_cwd = ();
	    return @r;
	} else {
	    return ();
	}
}

package OpenBSD::PackingElement::Cwd;
use OpenBSD::Temp;

sub archive_cmd
{
	my ($self, $pfh, $use_cwd, $dir, $base) = @_;
	my ($fh, $fname) = OpenBSD::Temp::list($dir);
	$$pfh = $fh;
	@$use_cwd = ("-C", $base."/".$self->{name}, "-I", $fname );
	return ();
}

package OpenBSD::PackingList;
use OpenBSD::md5;

sub archive_cmd
{
	my ($self, $dir, $base) = @_;
	my $fh;
	my @use_cwd = ();
	my @cmd = ();
	for my $item (@{$self->{items}}) {
		push(@cmd, $item->archive_cmd(\$fh, \@use_cwd, $dir, $base));
	}
	return @cmd;
}

sub compute_checksum
{
	my ($self, $base) = @_;
	my $fname = $self->fullname();
	if (-l "$base/$fname") {
		return if $base eq '/' or $base eq '';
		my $value = readlink "$base/$fname";
		if ($value =~ m/^\Q$base/) {
			print STDERR "Error in package: symlink $base/$fname refers to $value\n";
			$main::errors++;
		}
	} else {
		$self->{md5} = OpenBSD::md5::fromfile("$base/$fname");
		$self->{size} = (stat "$base/$fname")[7];
	}
}

sub makesum
{
	my ($self, $base) = @_;
	for my $item (@{$self->{items}}) {
		if ($item->IsFile()) {
			compute_checksum($item, $base);
		}
	}
}

sub avert_duplicates
{
	my ($self) = @_;
	my $allfiles = {};
	for my $item (@{$self->{items}}) {
		if ($item->IsFile() || $item->isa("OpenBSD::PackingElement::DirRm")) {
			my $n = $item->fullname();
			if (defined $allfiles->{$n}) {
				print STDERR "Error in packing-list: duplicate file $n\n";
				$main::errors++;
			}
			$allfiles->{$n} = 1;
		} 
	}
}


package main;

our $errors = 0;

our ($opt_p, $opt_f, $opt_c, $opt_d, $opt_v, $opt_i, $opt_k, $opt_r, $opt_D,
	$opt_S, $opt_m, $opt_h, $opt_s, $opt_O, $opt_P, $opt_C, $opt_A, $opt_L,
	$opt_B);
getopts('p:f:c:d:vi:k:r:D:S:m:hs:OP:C:A:L:B:');

if (@ARGV != 1) {
	die "Exactly one single package name is required";
}

my $dir = OpenBSD::Temp::dir();

if (defined $opt_s) {
	die "Option s is no longer supported";
}

if (defined $opt_O) {
	die "Option O is no longer supported";
}

if (defined $opt_f) {
	if ($opt_f eq '-') {
	    copy(\*STDIN, $dir.CONTENTS);
	} else {
	    copy($opt_f, $dir.CONTENTS);
	}
} else {
	die "Packing list required";
}

if (defined $opt_c) {
    if ($opt_c =~ /^\-/) {
	open(my $fh, '>', $dir.COMMENT) or die "Can't write to COMMENT: $!";
	print $fh $';
	close($fh);
    } else {
	copy($opt_c, $dir.COMMENT);
    }
} else {
	die "Comment required";
}

if (defined $opt_d) {
    if ($opt_d =~ /^\-/) {
	open(my $fh, '>', $dir.DESC) or die "Can't write to DESC: $!";
	print $fh $';
	close($fh);
    } else {
	copy($opt_d, $dir.DESC);
    }
} else {
	die "Description required";
}

print "Creating package $ARGV[0]\n" if $opt_v;

my $plist = new OpenBSD::PackingList;
if (defined $opt_p) {
	OpenBSD::PackingElement::Cwd->add($plist, $opt_p);
} else {
	die "Prefix required";
}

if ($ARGV[0] =~ m|([^/]+)\.tgz$|) {
	OpenBSD::PackingElement::Name->add($plist, $1);
}

if (defined $opt_P) {
	for my $e (split(/\s+/, $opt_P)) {
		OpenBSD::PackingElement::PkgDep->add($plist, $e);
    	}
}

if (defined $opt_C) {
	for my $e (split(/\s+/, $opt_C)) {
		OpenBSD::PackingElement::PkgConflict->add($plist, $e);
    	}
}

if (defined $opt_A) {
	OpenBSD::PackingElement::Arch->add($plist, $opt_A);
}

if (defined $opt_L) {
	OpenBSD::PackingElement::LocalBase->add($plist, $opt_L);
}

$plist->fromfile($dir.CONTENTS) or die "Can't open packing list";


my $base = '/';
if (defined $opt_B) {
	$base = $opt_B;
} elsif (defined $opt_S) {
	$base = $opt_S;
} elsif (defined $ENV{'PKG_PREFIX'}) {
	$base = $ENV{'PKG_PREFIX'};
}

$plist->makesum($base);
$plist->avert_duplicates();
if ($errors) {
	exit(1);
}

my @cmd = $plist->archive_cmd($dir, $base);

if (defined $opt_i) {
    copy($opt_i, $dir.INSTALL);
}
	
if (defined $opt_k) {
    copy($opt_k, $dir.DEINSTALL);
}

if (defined $opt_r) {
    copy($opt_r, $dir.REQUIRE);
}

if (defined $opt_D) {
    copy($opt_D, $dir.DISPLAY);
}

if (defined $opt_m) {
    copy($opt_m, $dir.MTREE_DIRS);
}


my @extra_files = ();
OpenBSD::PackingElement::Cwd->add($plist, '.');
for my $special (info_names()) {
    next unless -f $dir.$special;
    push(@extra_files, $special);
    # Do not record contents in itself...
    next if $special eq CONTENTS;
    my $f = OpenBSD::PackingElement::File->add($plist, $special);
    $f->{ignore} = 1;
    $f->{md5} = OpenBSD::md5::fromfile($dir.$special);
}

$plist->tofile($dir.CONTENTS) or die "Can't write packing list";

print "Creating gzip'd tar ball in '$ARGV[0]'\n" if $opt_v;
system('tar', $opt_h ? "zcfh" : "zcf", $ARGV[0], "-C", $dir, 
    @extra_files, @cmd) == 0 or
	die "tar failed";