#! /usr/bin/perl

# ex:ts=8 sw=4:
# $OpenBSD: link-checksums,v 1.5 2011/09/05 07:59:28 espie Exp $
#
# Copyright (c) 2011 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.

eval 'exec perl $0 "$@"'
	if 0;

use warnings;
use strict;
use File::Find;
use File::Path;

sub create_tables
{
	my $db = shift;

}

my $distdir = $ENV{DISTDIR} // '/usr/ports/distfiles';
my $ciphers = $ENV{CIPHERS} // 'sha1 md5 rmd160 sha256';
my ($stat, $stat2) = (0, 0);
my ($db, $update, $check);

# set up DB if wanted (requires DBD::SQLite)
if (defined $ENV{CIPHER_CACHE}) {
	require DBI;

	$db = DBI->connect("dbi:SQLite:dbname=$ENV{CIPHER_CACHE}", '', '');
	$db->do(q{CREATE TABLE IF NOT EXISTS 
		KNOWN(NAME TEXT PRIMARY KEY, TS INTEGER)});
	$check = $db->prepare(q{SELECT TS FROM KNOWN WHERE NAME LIKE (?)});
	$update = $db->prepare(q{INSERT OR REPLACE INTO KNOWN 
		(NAME, TS) VALUES (?, ?)});

}

my @ciphers = split(/\s+/, $ciphers);

my %ciphers = map {$_, 1} @ciphers;

if (@ARGV > 0 && $ARGV[0] eq 'fix') {
	$db->do(q{DELETE FROM KNOWN WHERE NAME LIKE '%/%'}) if defined $db;
	find(sub {
		return unless -d $_;
		return unless $_ eq 'by_cipher';
		$File::Find::prune = 1;
		return if $File::Find::name eq "$distdir/by_cipher";
		File::Path::remove_tree($_);
	}, $distdir);
}

find(sub {
	# don't recurse down own results
	if (-d $_) {
		if ($_ eq 'by_cipher' || $ciphers{$_}) {
			$File::Find::prune = 1;
		}
		return;
	}
	# avoid DPB partial fetches
	return if m/\.part$/;
	$stat++;

	# avoid rechecksumming
	my ($ts, $filename);
	if (defined $db) {
		$ts = (stat _)[9];
		$filename = $File::Find::name;
		$filename =~ s/^\Q$distdir\E\///;
		$check->execute($filename);
		my $a = $check->fetchrow_arrayref;
		if (defined $a) {
			return if $a->[0] == $ts;
		}
	}

	# compute all checksums in one pipe
	$stat2++;
	my $pid = open(my $pipe, '-|');
	die "Can't fork: $!" if !defined $pid;
	if ($pid == 0) {
		close STDIN;
		open STDIN, '<', $_;
		exec {'cksum'} ('cksum', '-a', join(',', @ciphers), '-b');
		exit 1;
	}
	# and grab results in order
	my @list = @ciphers;
	while (defined(my $result = <$pipe>)) {
		my $ci = shift @list;
		chomp $result;
		if ($result =~ m/^(..)/) {
			my $target = "$distdir/by_cipher/$ci/$1/$result";
			File::Path::make_path($target);
			next if -f "$target/$_";
			link $_, "$target/$_" or die "link: $!";
		} else {
			die "Bad result $result";
		}
	}
	if (@list != 0) {
		die "Error: missing checksum for $File::Find::name";
	}
	if (!close $pipe) {
		die "cksum aborted: $?";
	}
	if (defined $db) {
		$update->execute($filename, $ts);
	}
}, $distdir);

print "$stat files seen";
if (defined $db) {
	print ", of which $stat2 new files\n";
} else {
	print "\n";
}