# Copyright (C) 2013, Eric Wong <normalperson@yhbt.net> and all contributors
# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
#
# Note: some trivial code here stolen from git-svn + Perl modules distributed
# with git.  I wrote these long ago and I retain my copyright to it, so I'm
# within my right to relicense as AGPLv3+
#
# Not using Git.pm and friends directly because some git installations may use
# a different Perl than this (and I might end up rewriting this entirely
# in C at a later time...)
package Ssoma::Git;
use strict;
use warnings;
use File::Path qw/mkpath/;
use IO::Handle;
use Fcntl;
use File::FcntlLock;
use Email::Simple;
use Digest::SHA qw/sha1_hex/;

# Future versions of Ssoma will always be able to handle this version, at least
our $REPO_VERSION = 1;

sub new {
	my ($class, $git_dir) = @_;
	bless {
		git_dir => $git_dir,
		index => "$git_dir/ssoma.index",
	}, $class;
}

# initialize a git repository
sub init_db {
	my ($self, @opts) = @_;

	my @cmd = (qw(git init --bare), @opts);
	push @cmd, $self->{git_dir};

	system(@cmd) == 0 or die join(' ', @cmd)." failed: $?\n";

	$self->tmp_git_do(sub {
		@cmd = (qw(git config ssoma.repoversion), $REPO_VERSION);
		system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";
	});
}

sub lockfile { $_[0]->{git_dir} . "/ssoma.lock" }

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

	my $fs = File::FcntlLock->new;
	$fs->l_type(F_WRLCK);
	$fs->l_type(SEEK_CUR);
	$fs->l_start(0);
	$fs->l_len(0);

	my $path = $self->lockfile;
	my $lock;

	# we must not race here because this is concurrent:
	sysopen($lock, $path, O_WRONLY) or
		sysopen($lock, $path, O_CREAT|O_EXCL|O_WRONLY) or
		sysopen($lock, $path, O_WRONLY) or
		die "failed to open lock $path: $!\n";

	# wait for other processes to be done
	$fs->lock($lock, F_SETLKW) or die "lock failed: " . $fs->error . "\n";

	# run the sub!
	my @ret = eval { &$sub };
	my $err = $@;

	# these would happen anyways, but be explicit so we can detect errors
	$fs->lock($lock, F_UNLCK) or die "unlock failed: " . $fs->error . "\n";
	close $lock or die "close lockfile($path) failed: $!\n";

	die $err if $err;

	wantarray ? @ret : $ret[0];
}

# perform sub with the given GIT_DIR
sub tmp_git_do {
	my ($self, $sub) = @_;
	local $ENV{GIT_DIR} = $self->{git_dir};
	&$sub;
}

# perform sub with a temporary index
sub tmp_index_do {
	my ($self, $sub) = @_;
	local $ENV{GIT_INDEX_FILE} = $self->{index};

	my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#);
	mkpath([$dir]) unless -d $dir;
	-d $dir or die "$dir creation failed $!\n";
	&$sub;
}

# bidirectional pipe, output would be SHA-1 hexdigest
sub bidi_sha1 {
	my ($self, @cmd) = @_;
	my $sub = pop @cmd;
	my $cmd = join(' ', @cmd);
	my ($in_0, $in_1, $out_0, $out_1);

	pipe($in_0, $in_1) or die "pipe failed: $!\n";
	pipe($out_0, $out_1) or die "pipe failed: $!\n";

	my $pid = fork;
	defined $pid or die "fork failed: $!\n";

	if ($pid == 0) {
		open STDIN, '<&', $in_0 or die "redirect stdin failed: $!\n";
		open STDOUT, '>&', $out_1 or die "redirect stdout failed: $!\n";
		exec @cmd;
		die "exec($cmd) failed: $!\n";
	}

	close $in_0 or die "close in_0 failed: $!\n";
	close $out_1 or die "close out_1 failed: $!\n";
	$sub->($in_1);
	close $in_1 or die "close in_1 failed: $!\n";
	my $sha1 = <$out_0>;
	close $out_0 or die "close out_0 failed: $!\n";
	waitpid($pid, 0) or die "waitpid $pid failed: $!\n";
	$? == 0 or die "$cmd failed: $?\n";
	chomp $sha1;
	$sha1 =~ /\A[a-f0-9]{40}\z/i or die "not a SHA-1: $sha1\n";
	$sha1;
}

# run a command described by str and return the SHA-1 hexdigest output
sub qx_sha1 {
	my ($self, $str) = @_;
	my $sha1 = `$str`;

	die "$str failed: $?\n" if $?;
	chomp $sha1;
	$sha1 =~ /\A[a-f0-9]{40}\z/i or
		die "not a SHA-1 hexdigest from: $str\n";
	$sha1;
}

# returns a blob identifier the new message
sub simple_to_blob {
	my ($self, $simple) = @_;
	$self->bidi_sha1(qw/git hash-object -w --stdin/, sub {
		my ($io) = @_;
		print $io $simple->as_string or die "print failed: $!\n";
	});
}

# converts the given object name to an Email::Simple object
sub blob_to_simple {
	my ($self, $obj) = @_;
	Email::Simple->new($self->cat_blob($obj));
}

# returns key-value pairs of config directives in a hash
sub config_list {
	my ($self, $file) = @_;

	local $ENV{GIT_CONFIG} = $file;

	my @cfg = `git config -l`;
	$? == 0 or die "git config -l failed: $?\n";
	chomp @cfg;
	my %rv = map { split(/=/, $_, 2) } @cfg;
	\%rv;
}

# used to hash the relevant portions of a message when there are conflicts
sub hash_simple2 {
	my ($self, $simple) = @_;
	my $dig = Digest::SHA->new("SHA-1");
	$dig->add($simple->header("Subject"));
	$dig->add($simple->body);
	$dig->hexdigest;
}

# we currently only compare messages for equality based on
# Message-ID, Subject: header and body, nothing else.
# both args are Email::Simple objects
sub simple_eq {
	my ($self, $cur, $new) = @_;

	(($cur->header("Subject") eq $new->header("Subject")) &&
	 ($cur->body eq $new->body));
}

# kills leading/trailing space in-place
sub stripws {
	$_[0] =~ s/\A\s*//;
	$_[0] =~ s/\s*\z//;
}

sub mid2path {
	my ($self, $message_id) = @_;
	stripws($message_id);
	my $hex = sha1_hex($message_id);
	$hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or
			die "BUG: not a SHA-1 hex: $hex";
	"$1/$2";
}

sub cat_blob {
	my ($self, $blob_id) = @_;
	my $cmd = "git cat-file blob $blob_id";
	my $str = `$cmd`;
	die "$cmd failed: $?\n" if $?;
	$str;
}

sub type {
	my ($self, $obj) = @_;
	my $cmd = "git cat-file -t $obj";
	my $str = `$cmd`;
	die "$cmd failed: $?\n" if $?;
	chomp $str;
	$str;
}

# only used for conflict resolution
sub each_in_tree {
	my ($self, $obj, $sub) = @_;
	my $cmd = "git ls-tree $obj";
	my @tree = `$cmd`;
	$? == 0 or die "$cmd failed: $!\n";
	my $x40 = '[a-f0-9]{40}';
	foreach my $line (@tree) {
		if ($line =~ m!\A100644 blob ($x40)\t($x40)$!o) {
			my ($blob_id, $path) = ($1, $2);
			$sub->($blob_id, $path);
		} else {
			warn "unexpected: bad line from $cmd:\n$line";
		}
	}
}

sub commit_index {
	my ($self, $gii, $need_parent, $ref, $message) = @_;

	# this is basically what git commit(1) does,
	# but we use git plumbing, not porcelain
	$gii->done;
	my $tree = $self->qx_sha1("git write-tree");

	# can't rely on qx_sha1 since we initial commit may not have a parent
	my $cmd = "git rev-parse $ref^0";
	my $parent;
	if ($need_parent) {
		$parent = $self->qx_sha1($cmd);
	} else {
		$parent = eval { $self->qx_sha1("$cmd 2>/dev/null") };
		if (defined $parent && $parent !~ /\A[a-f0-9]{40}\z/) {
			die "$cmd returned bad SHA-1: $parent\n";
		}
	}

	# make the commit
	my @cmd = (qw/git commit-tree -m/, $message);
	push @cmd, '-p', $parent if $parent;
	push @cmd, $tree;
	my $commit = $self->qx_sha1(join(' ', @cmd));

	# update the ref
	@cmd = (qw/git update-ref/, $ref, $commit);
	push @cmd, $parent if $parent; # verification
	system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";

	# gc if needed
	@cmd = qw/git gc --auto/;
	system(@cmd) == 0 or die "command: ". join(' ', @cmd) . ": $?\n";
}

1;
