From 0aacc1c5f17e9ad0d9bc8ec92d602601aeb8c6f3 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+git-remote-gpg@autogeree.net>
Date: Mon, 10 Mar 2014 19:52:00 +0100
Subject: [PATCH 1/1] init

---
 git-remote-gpg | 896 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 896 insertions(+)
 create mode 100755 git-remote-gpg

diff --git a/git-remote-gpg b/git-remote-gpg
new file mode 100755
index 0000000..7797d6a
--- /dev/null
+++ b/git-remote-gpg
@@ -0,0 +1,896 @@
+#!/usr/bin/perl
+our $VERSION = '2014.01.28';
+# dependencies
+	use strict;
+	use warnings FATAL => qw(all);
+	use Carp;
+	use Cwd;
+	use File::Basename;
+	use File::Copy;
+	use File::Spec::Functions qw(:ALL);
+	use File::Temp;
+	use Getopt::Long;
+	use IPC::Run;
+		# NOTE: to debug: IPCRUNDEBUG=basic|data|details|gory
+	use IO::Handle;
+	use JSON;
+	use POSIX qw(WNOHANG);
+	use URI;
+	
+	require Pod::Usage;
+	require Data::Dumper;
+# trace utilities
+	sub trace (@) {
+		foreach my $msg (@_) {
+			print STDERR $msg
+				if defined $msg;
+		 }
+	 }
+	sub debug (@) {
+		my $call = (caller(1))[3];
+		if ($ENV{TRACE}) {
+			trace
+			 ( "\e[35mDEBUG\e[m"
+			 , "\e[30m\e[1m.", join('.', $call."\e[m")
+			 , " ", (map {
+				ref $_ eq 'CODE'
+				 ? $_->()
+				 : Data::Dumper::Dumper($_)
+				} @_)
+			 );
+		 }
+		return 1;
+	 }
+	sub info (@) {
+		my $call = (caller(1))[3];
+		trace
+		 ( "\e[32mINFO\e[m"
+		 , "\e[30m\e[1m.", join('.', $call."\e[m")
+		 , " ", (ref $_ eq 'CODE'?(join("\n      ", $_->()), "\n"):(@_, "\n"))
+		 );
+	 }
+	sub warning (@) {
+		local $Carp::CarpLevel = 1;
+		carp("\e[33mWARNING\e[m ", @_, "\n\t");
+	 }
+	sub error (@) {
+		local $Carp::CarpLevel = 1;
+		croak("\e[31mERROR\e[m ", @_, "\n\t");
+	 }
+# utilities
+# system utilities
+	sub rm ($) {
+		my ($file) = @_;
+		debug(sub{"file="},$file);
+		unlink($file)
+			or error("rm $file");
+	 }
+# grg crypto
+	sub grg_rand ($$) {
+		my ($ctx, $size) = @_;
+		local $_;
+		IPC::Run::run([@{$ctx->{config}->{gpg}}
+		 , '--armor', '--gen-rand', '1', $size]
+		 , '>', \$_)
+			or error("failed to get random bits");
+		chomp;
+		return $_;
+	 }
+	sub grg_hash ($$;$) {
+		my ($ctx, $algo, $run) = @_;
+		$run = sub {return @_} unless defined $run;
+		my $hash;
+		IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
+		 , '--with-colons', '--print-md', $algo]
+		 , '>', \$hash))
+			or error("failed to hash data");
+		return ((split(':', $hash))[2]);
+	 }
+	sub gpg_fingerprint($$$) {
+		my ($ctx, $id, $caps_needed) = @_;
+		my ($output);
+		my %h = ();
+		if (IPC::Run::run([@{$ctx->{config}->{gpg}}
+		 , '--fixed-list-mode', '--with-colons', '--with-fingerprint', '--list-keys', $id]
+		 , '>', \$output)) {
+			my @lines = split(/\n/,$output);
+			while (my $line = shift @lines) {
+				if (my ($longkeyid, $caps) = $line =~ m/^pub:[^:]*:[^:]*:[^:]*:([^:]*):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]+):.*$/) {
+					my $skip = 0;
+					foreach my $cap (@$caps_needed) {
+						if (not ($caps =~ m/$cap/)) {
+							warning("skipping key 0x$longkeyid which has not usable capability: $cap, but matches: `$id'");
+							$skip = 1;
+						 }
+					 }
+					if (not $skip) {
+						my $fpr = undef;
+						my $uid = undef;
+						while ((not defined $fpr or not defined $uid)
+						 and $line = shift @lines) {
+							(not defined $fpr and (($fpr) = $line =~ m/^fpr:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([0-9A-F]+):.*$/)) or
+							(not defined $uid and (($uid) = $line =~ m/^uid:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]+):.*$/)) or
+							1;
+						 }
+						error("unable to extract fingerprint and user ID")
+							unless defined $fpr
+							and    defined $uid;
+						$h{$fpr} = $uid;
+					 }
+				 }
+			 }
+		 }
+		error("unable to find any OpenPGP key with usable capability: ".join('', @$caps_needed)." for: `$id'")
+			unless scalar(%h) gt 0;
+		debug(sub{"$id -> "}, \%h);
+		return %h;
+	 }
+	sub grg_encrypt_symmetric ($$$;$) {
+		my ($ctx, $clear, $key, $run) = @_;
+		$run = sub {return @_} unless defined $run;
+		IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
+		 , '--batch', '--yes'
+		 , '--compress-algo', 'none'
+		 , '--force-mdc'
+		 , '--passphrase-fd', '3'
+		 , '--s2k-mode', '1'
+		 , '--trust-model', 'always'
+		 , '--symmetric']
+		 , '<', \$clear, '3<', \$key))
+			or error("failed to encrypt symmetrically data");
+	 }
+	sub grg_decrypt_symmetric ($$$;$) {
+		my ($ctx, $key, $run) = @_;
+		$run = sub {return @_} unless defined $run;
+		IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
+		 , '--batch', '--no-default-keyring', '--keyring', '/dev/null', '--secret-keyring', '/dev/null'
+		 , '--passphrase-fd', '3', '--quiet', '--decrypt']
+		 , '3<', \$key))
+			or error("failed to decrypt symmetrically data");
+	 }
+	sub grg_encrypt_asymmetric ($$;$) {
+		my ($ctx, $clear, $run) = @_;
+		$run = sub {return @_} unless defined $run;
+		my @recipients = 
+		 ( (map { ('--recipient', '0x'.$_) } (keys %{$ctx->{config}->{keys}}))
+		 , (map { ('--hidden-recipient', '0x'.$_) } (keys %{$ctx->{config}->{'hidden-keys'}})) );
+		@recipients = ('--default-recipient-self')
+			if @recipients == 0;
+		IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
+		 , '--batch', '--yes'
+		 , '--compress-algo', 'none'
+		 , '--trust-model', 'always'
+		 , '--sign', '--encrypt'
+		 , ($ctx->{config}->{signingkey}->{fpr} ? ('--local-user', $ctx->{config}->{signingkey}->{fpr}) : ())
+		 , @recipients ]
+		 , '<', \$clear))
+			or error("failed to encrypt asymmetrically data");
+	 }
+	sub grg_decrypt_asymmetric ($$;$) {
+		my ($ctx, $run) = @_;
+		my ($clear, $status);
+		$run = sub {return @_} unless defined $run;
+		IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
+		 , '--batch', '--no-default-keyring',
+		 , '--status-fd', '3', '--quiet', '--decrypt']
+		 , '>', \$clear, '3>', \$status))
+			or error("failed to decrypt asymmetrically data");
+		debug(sub{"status=\n$status"});
+		my @lines = split(/\n/,$status);
+		my ($enc_to, $goodsig, $validsig, $validpub, $goodmdc);
+		foreach my $line (@lines) {
+			(not defined $enc_to and (($enc_to)   = $line =~ m/^\[GNUPG:\] ENC_TO ([0-9A-F]+).*$/)) or
+			(not defined $goodsig and (($goodsig) = $line =~ m/^\[GNUPG:\] GOODSIG ([0-9A-F]+).*$/)) or
+			(not defined $goodmdc and (($goodmdc) = $line =~ m/^\[GNUPG:\] (GOODMDC)$/)) or
+			(not defined $validsig and not defined $validpub and (($validsig, $validpub)
+				 = $line =~ m/^\[GNUPG:\] VALIDSIG ([0-9A-F]+) [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ ([0-9A-F]+).*$/)) or
+			1;
+		 }
+		error("data expected to be encrypted")
+			unless $enc_to;
+		debug(sub{"enc_to=$enc_to\n"});
+		error("data expected to be signed")
+			unless $goodsig;
+		debug(sub{"goodsig=$goodsig\n"});
+		error("modification detection code incorrect")
+			unless $goodmdc;
+		debug(sub{"good_mdc=$goodmdc\n"});
+		error("data signature invalid")
+			unless $validsig and $validpub;
+		debug(sub{"validsig=$validsig\n"});
+		debug(sub{"validpub=$validpub\n"});
+		error("data signature refused")
+			unless exists $ctx->{config}->{keys}->{$validpub}
+			or exists $ctx->{config}->{'hidden-keys'}->{$validpub};
+		debug(sub{"accepted:$validpub\n"});
+		return $clear;
+	 }
+# grg remote I/O
+	sub grg_remote_fetch_file ($$$) {
+		my ($ctx, $files, $fetch_files) = @_;
+		# NOTE: avoid File::Copy::copy().
+		@$fetch_files = map { File::Spec->catfile($ctx->{remote}->{uri}->file, $_) } @$files;
+		foreach my $file (@$fetch_files) {
+			-r $file or return ();
+		 }
+		return 1;
+	 }
+	sub grg_remote_fetch_rsync ($$$) {
+		my ($ctx, $files, $fetch_files) = @_;
+		my $uri  = $ctx->{remote}->{uri}->clone;
+		$uri->scheme(undef);
+		$uri->fragment(undef);
+		$uri->query(undef);
+		$uri = $uri->as_string;
+		IPC::Run::run([@{$ctx->{config}->{rsync}}
+		 , '--verbose', '--ignore-times', '--inplace', '--progress'
+		 , (map { File::Spec->catfile($uri, $_) } @$files)
+		 , $ctx->{'dir-cache'}.'/']
+		 , '>&2')
+	 }
+	sub grg_remote_fetch_sftp ($$$) {
+		my ($ctx, $files, $fetch_files) = @_;
+		IPC::Run::run([@{$ctx->{config}->{curl}}
+		 , '--show-error'
+		 , '--output', File::Spec->catfile($ctx->{'dir-cache'}, '#1')
+		 , File::Spec->catfile($ctx->{remote}->{uri}, '{'.join(',',@$files).'}') ])
+	 }
+	sub grg_remote_fetch ($$) {
+		my ($ctx, $files) = @_;
+		debug(sub{'files='}, $files);
+		my $scheme = $ctx->{remote}->{uri}->scheme;
+		my $fetch_files = [map { File::Spec->catfile($ctx->{'dir-cache'}, $_) } @$files];
+		my $fct =
+		 { file  => \&grg_remote_fetch_file
+		 , rsync => \&grg_remote_fetch_rsync
+		 , sftp  => \&grg_remote_fetch_sftp
+		 }->{$scheme};
+		error("URL scheme not supported: `$scheme'")
+			unless $fct;
+		$fct->($ctx, $files, $fetch_files)
+			or return ();
+		return @$fetch_files;
+	 }
+	sub grg_remote_init_file ($) {
+		my ($ctx) = @_;
+		my $dst = $ctx->{remote}->{uri}->file;
+		debug(sub{"File::Path::make_path('$dst')\n"});
+		defined File::Path::make_path($dst, {verbose => 1})
+	 }
+	sub grg_remote_init_rsync ($) {
+		my ($ctx) = @_;
+		my $tmp = File::Temp->tempdir(CLEANUP => 1);
+		my $path = $ctx->{remote}->{uri}->path;
+		my $uri  = $ctx->{remote}->{uri}->clone;
+		$uri->fragment(undef);
+		$uri->path(undef);
+		$uri->query(undef);
+		File::Path::make_path(File::Spec->catdir($tmp, $path), {verbose => 0}) and
+		IPC::Run::run([@{$ctx->{config}->{rsync}}
+		 , '--verbose', '--recursive', '--relative'
+		 , '--exclude=*', '.'
+		 , File::Spec->catfile($uri->as_string)]
+		 , init => sub { chdir $tmp or die $!; })
+	 }
+	sub grg_remote_init_sftp ($) {
+		my ($ctx) = @_;
+		my $path = $ctx->{remote}->{uri}->path;
+		my $uri  = $ctx->{remote}->{uri}->clone;
+		$uri->fragment(undef);
+		$uri->path(undef);
+		$uri->query(undef);
+		IPC::Run::run([@{$ctx->{config}->{curl}}
+		 , '--show-error', '--ftp-create-dirs'
+		 , '-Q', "+mkdir ".$path
+		 , $uri->as_string])
+	 }
+	sub grg_remote_init ($) {
+		my ($ctx) = @_;
+		my $scheme = $ctx->{remote}->{uri}->scheme;
+		my $fct =
+		 { file  => \&grg_remote_init_file
+		 , rsync => \&grg_remote_init_rsync
+		 , sftp  => \&grg_remote_init_sftp
+		 }->{$scheme};
+		error("URL scheme not supported: `$scheme'")
+			unless $fct;
+		$fct->($ctx)
+			or error("remote init failed");
+		return;
+	 }
+	sub grg_remote_push_file ($$) {
+		my ($ctx, $files) = @_;
+		foreach my $file (@$files) {
+			my $src = File::Spec->catfile($ctx->{'dir-cache'}, $file);
+			my $dst = File::Spec->catfile($ctx->{remote}->{uri}->file, $file);
+			debug(sub{"File::Copy::move('$src', '$dst')\n"});
+			File::Copy::move($src, $dst);
+		 }
+		return 1;
+	 }
+	sub grg_remote_push_rsync ($$) {
+		my ($ctx, $files) = @_;
+		my $uri  = $ctx->{remote}->{uri}->clone;
+		$uri->fragment('');
+		$uri->query('');
+		IPC::Run::run([@{$ctx->{config}->{rsync}}
+		 , '--verbose', '--relative'
+		 , @$files
+		 , $uri->as_string])
+	 }
+	sub grg_remote_push_sftp ($$) {
+		my ($ctx, $files) = @_;
+		my $uri  = $ctx->{remote}->{uri}->clone;
+		$uri->fragment('');
+		$uri->query('');
+		IPC::Run::run([@{$ctx->{config}->{curl}}
+		 , '--show-error', '--ftp-create-dirs', '--upload-file'
+		 , '{'.join(',', @$files).'}'
+		 , $uri->as_string.'/'])
+	 }
+	sub grg_remote_push ($) {
+		my ($ctx) = @_;
+		my $scheme = $ctx->{remote}->{uri}->scheme;
+		grg_remote_init($ctx)
+			unless $ctx->{remote}->{checked};
+		return 1
+			if @{$ctx->{remote}->{push}} == 0;
+		my $fct =
+		 { file  => \&grg_remote_push_file
+		 , rsync => \&grg_remote_push_rsync
+		 , sftp  => \&grg_remote_push_sftp
+		 }->{$scheme};
+		error("URL scheme not supported: `$scheme'")
+			unless $fct;
+		$fct->($ctx, $ctx->{remote}->{push})
+			or error("remote push failed");
+		return 1;
+	 }
+	sub grg_remote_remove ($) {
+		my ($ctx) = @_;
+		#my $scheme = $ctx->{remote}->{uri}->scheme;
+		#my $fct =
+		# { file => sub {
+		#		File::Copy::remove_tree
+		#		 ( map { File::Spec->catfile($ctx->{remote}->{uri}->path, $_) } @$files
+		#		 , verbose => 1 )
+		#	 }
+		# , rsync => sub {
+		#		IPC::Run::run([@{$ctx->{config}->{rsync}}
+		#		 , '--verbose', '--ignore-times', '--recursive', '--delete'
+		#		 , @$files
+		#		 , $ctx->{remote}->{uri}])
+		#	 }
+		# , sftp => sub {
+		#		IPC::Run::run([@{$ctx->{config}->{curl}}
+		#		 , '--show-error'
+		#		 , map { ('-Q', 'rm '.$_) } @$files
+		#		 , $ctx->{remote}->{uri}])
+		#	 }
+		# }->{$scheme};
+		#error("URL scheme not supported: `$scheme'")
+		#	unless $fct;
+		#$fct->($ctx, $ctx->{remote}->{remove})
+		#	or error("remote remove failed");
+		#return;
+	 }
+# grg packing
+	sub grg_pack_fetch ($$) {
+		my ($ctx, $fetch_objects) = @_;
+		local $_;
+		# %remote_objects
+			my %remote_objects = ();
+			while (my ($pack_id, $pack) = each %{$ctx->{manifest}->{packs}}) {
+				foreach my $obj (@{$pack->{objects}}) {
+					$remote_objects{$obj} = $pack_id;
+				 }
+			 }
+		# @packs_to_fetch
+			my %packs_to_fetch = ();
+			foreach my $obj (@$fetch_objects) {
+				my @packs = ($remote_objects{$obj});
+				while (my $pack_id = shift @packs) {
+					if (not exists $packs_to_fetch{$pack_id}) {
+						$packs_to_fetch{$pack_id} = 1;
+						my $manifest_pack = $ctx->{manifest}->{packs}->{$pack_id};
+						error("manifest is missing a dependency pack: $pack_id")
+							unless defined $manifest_pack;
+						@packs = (@packs, @{$manifest_pack->{deps}});
+					 }
+				 }
+			 }
+			my @packs_to_fetch = keys %packs_to_fetch;
+		grg_remote_fetch($ctx, [@packs_to_fetch]);
+		foreach my $pack_id (@packs_to_fetch) {
+			my $pack_file = File::Spec->catfile($ctx->{'dir-cache'}, $pack_id);
+			my $manifest_pack = $ctx->{manifest}->{packs}->{$pack_id};
+			my $pack_key = $manifest_pack->{key};
+			my $pack_data;
+			grg_decrypt_symmetric($ctx, $pack_key, sub {
+				push @{$_[0]}, ($pack_file);
+				return (@_, '>', \$pack_data);
+			 });
+			my $pack_hash_algo = $manifest_pack->{hash_algo};
+			my $pack_hash = grg_hash($ctx
+			 , $pack_hash_algo
+			 , sub { return (@_, '<', \$pack_data); });
+			error("pack data hash differs from pack manifest hash")
+				unless $pack_hash eq $manifest_pack->{hash};
+			rm($pack_file);
+			IPC::Run::run(['git', 'index-pack', '-v', '--stdin']
+			 , '<', \$pack_data
+			 , '>&2');
+		 }
+	 }
+	sub grg_pack_push ($$) {
+		my ($ctx, $push_objects) = @_;
+		local $_;
+		debug(sub{"push_objects=\n"}, $push_objects);
+		# %remote_objects
+			my %remote_objects = ();
+			while (my ($pack_id, $pack) = each %{$ctx->{manifest}->{packs}}) {
+				foreach my $obj (@{$pack->{objects}}) {
+					$remote_objects{$obj} = $pack_id;
+				 }
+			 }
+		# @common_objects
+			IPC::Run::run(['git', 'cat-file', '--batch-check']
+			 , '<', \join("\n", keys %remote_objects)
+			 , '>', \$_)
+				or error("failed to query local git objects");
+			my @common_objects
+			 = map {
+				if ($_ =~ m/ missing$/) { () }
+				else { s/ .*//; $_ }
+			 } (split(/\n/, $_));
+		# @pack_objects, @pack_deps_objects
+			IPC::Run::run(['git', 'rev-list', '--objects-edge', '--stdin', '--']
+			 , '<', \join("\n", ((map {'^'.$_} @common_objects), @$push_objects))
+			 , '>', \$_)
+				or error("failed to query objects to pack");
+			my @pack_objects_edge = split(/\n/, $_);
+			foreach (@pack_objects_edge) {s/ .*//}
+			my @pack_objects = grep {m/^[^-]/} @pack_objects_edge;
+			my @pack_deps_objects = grep {s/^-//} @pack_objects_edge;
+		# %pack_deps
+			my %pack_deps = ();
+			foreach my $obj (@pack_deps_objects) {
+				my $pack = $remote_objects{$obj};
+				error("manifest is missing object dependencies")
+					unless defined $pack;
+				$pack_deps{$pack} = 1;
+			 }
+		if (@pack_objects > 0) {
+			# $pack_id
+				my $pack_id;
+				my $pack_id_try = 0;
+				while (not defined $pack_id
+				 or exists $ctx->{manifest}->{packs}->{$pack_id}) {
+					$pack_id = grg_rand($ctx, $ctx->{config}->{'pack-filename-size'});
+					$pack_id =~ s{/}{-}g;
+					error("failed to pick an unused random pack filename after 512 tries; retry or increase grg.pack-filename-size")
+						if $pack_id_try++ >= 512;
+				 }
+			my $pack_key = grg_rand($ctx, $ctx->{config}->{'pack-key-size'});
+			my $pack_data;
+			IPC::Run::run(['git', 'pack-objects', '--stdout']
+			 , '<', \join("\n", @pack_objects)
+			 , '>', \$pack_data)
+				or error("failed to pack objects to push");
+			my $pack_hash = grg_hash($ctx
+			 , $ctx->{config}->{'pack-hash-algo'}
+			 , sub { return (@_, '<', \$pack_data); });
+			grg_encrypt_symmetric($ctx, $pack_data, $pack_key, sub {
+				push @{$_[0]}, ('--output', File::Spec->catfile($ctx->{'dir-cache'}, $pack_id));
+				return @_;
+			 });
+			push @{$ctx->{remote}->{push}}, $pack_id;
+			$ctx->{manifest}->{packs}->{$pack_id} =
+			 { deps => [keys %pack_deps]
+			 , hash => $pack_hash
+			 , hash_algo => $ctx->{config}->{'pack-hash-algo'}
+			 , key => $pack_key
+			 , objects => \@pack_objects
+			 };
+		 }
+	 }
+# grg manifest
+	sub grg_manifest_fetch ($) {
+		my ($ctx) = @_;
+		$ctx->{manifest} =
+		 { 'hidden-keys' => {}
+		 , keys => {}
+		 , packs => {}
+		 , refs => {}
+		 , version => undef
+		 };
+		my ($crypt) = grg_remote_fetch($ctx, [$ctx->{'manifest-file'}]);
+		if (defined $crypt) {
+			$ctx->{remote}->{checked} = 1;
+			my $json;
+			grg_decrypt_asymmetric($ctx, sub {
+				push @{$_[0]}, $crypt;
+				return (@_, '>', \$json); });
+			# TODO: remove cached manifest?
+			my $manifest;
+			($manifest = JSON::decode_json($json) and ref $manifest eq 'HASH')
+				or error("failed to decode JSON manifest");
+			$ctx->{manifest} = {%{$ctx->{manifest}}, %$manifest};
+			foreach my $slot (qw(keys hidden-keys)) {
+				while (my ($fpr, $uid) = each %{$ctx->{manifest}->{$slot}}) {
+					my %keys = gpg_fingerprint($ctx, '0x'.$fpr, ['E']);
+					my ($fpr, $uid) = each %keys;
+					$ctx->{config}->{$slot}->{$fpr} = $uid;
+				 }
+			 }
+		 }
+		else {
+			debug(sub{'ctx='}, $ctx);
+			if ($ctx->{command} eq 'push') {
+				$ctx->{remote}->{checked} = 0;
+			 }
+			elsif ($ctx->{remote}->{checking}) {
+				exit 100;
+			 }
+			else {
+				error("remote checking failed");
+			 }
+		 }
+	 }
+	sub grg_manifest_push ($) {
+		my ($ctx) = @_;
+		foreach my $slot (qw(keys hidden-keys)) {
+			$ctx->{manifest}->{$slot} = {};
+			while (my ($fpr, $uid) = each %{$ctx->{config}->{$slot}}) {
+				$ctx->{manifest}->{$slot}->{$fpr} = $uid;
+			 }
+		 }
+		my $json = JSON::encode_json($ctx->{manifest})
+			or error("failed to encode JSON manifest");
+		grg_encrypt_asymmetric($ctx, $json, sub {
+			push @{$_[0]}
+			 , ('--output', File::Spec->catfile($ctx->{'dir-cache'}, $ctx->{'manifest-file'}));
+			return @_; });
+		push @{$ctx->{remote}->{push}}, $ctx->{'manifest-file'};
+	 }
+# grg config
+	sub grg_config_read($) {
+		my ($ctx) = @_;
+		my $cfg = $ctx->{config};
+		local $/ = "\n";
+		
+		foreach my $name (qw(gpg signingkey keys)
+		 , grep {       !m/^(gpg|signingkey|keys)$/ } (keys %$cfg)) {
+			my $value;
+			IPC::Run::run(['git', 'config', '--get', 'remote.'.$ctx->{remote}->{name}.'.'.$name, '.+'], '>', \$value) or
+			IPC::Run::run(['git', 'config', '--get', 'grg.'.$name, '.+'], '>', \$value) or 1;
+			if ($name eq 'signingkey') {
+				IPC::Run::run(['git', 'config', '--get', 'user.'.$name, '.+'], '>', \$value)
+					if (not $value);
+				chomp $value;
+				my %keys = gpg_fingerprint($ctx, $value, ['S']);
+				warning("signing key ID is not matching a unique key: taking only one")
+					unless scalar(keys %keys) == 1;
+				my ($fpr, $uid) = each %keys;
+				$cfg->{$name} = {fpr => $fpr, uid => $uid};
+			 }
+			elsif ($name eq 'keys' or $name eq 'hidden-keys') {
+				IPC::Run::run(['git', 'config', '--get', 'user.'.$name, '.+'], '>', \$value)
+					if (not $value);
+				chomp $value;
+				my @ids = split(/,/, $value);
+				if (@ids > 0) {
+					foreach my $key (@ids) {
+						my %keys = gpg_fingerprint($ctx, $key, ['E']);
+						while (my ($fpr, $uid) = each %keys) {
+							$cfg->{$name}->{$fpr} = $uid;
+						 }
+					 }
+				 }
+			 }
+			elsif (grep(/^$name$/, qw(curl gpg rsync))) {
+				IPC::Run::run(['git', 'config', '--get', $name.'.program', '.+'], '>', \$value)
+					if (not $value);
+				$cfg->{$name} = [split(' ', $value)]
+					if $value;
+			 }
+			else {
+				chomp $value;
+				$cfg->{$name} = $value
+					if $value;
+			 }
+		 }
+		error("no signingkey configured; to do so you may use one of following commands:\n"
+		 , "\t\$ git config remote.'$ctx->{remote}->{name}'.signingkey \$your_openpgp_id\n"
+		 , "\t\$ git config grg.signingkey \$your_openpgp_id\n"
+		 , "\t\$ git config user.signingkey \$your_openpgp_id"
+		 ) unless defined $cfg->{signingkey};
+		if ( (scalar (keys %{$cfg->{keys}}) == 0)
+		 and (scalar (keys %{$cfg->{'hidden-keys'}}) == 0) ) {
+			$cfg->{keys} = { $cfg->{signingkey}->{fpr} => $cfg->{signingkey}->{uid} };
+		 }
+		
+		debug(sub{'config='},$cfg);
+	 }
+# grg system
+	sub grg_connect ($) {
+		my ($ctx) = @_;
+		grg_config_read($ctx);
+		grg_manifest_fetch($ctx);
+	 }
+	sub grg_disconnect ($) {
+		my ($ctx) = @_;
+		grg_remote_push($ctx);
+	 }
+# grg commands
+	sub gpg_command_answer ($) {
+		my @cmd = @_;
+		debug(sub{join('', @cmd)."\n"});
+		print STDOUT (@cmd, "\n");
+	 }
+	sub grg_command_capabilities ($) {
+		my ($ctx) = @_;
+		$ctx->{command} = 'capabilities';
+		gpg_command_answer("fetch");
+		gpg_command_answer("push");
+		gpg_command_answer("");
+		STDOUT->flush;
+	 }
+	sub grg_command_fetch ($$) {
+		my ($ctx, $fetch_refs) = @_;
+		$ctx->{command} = 'fetch';
+		debug(sub{"fetch_refs="}, $fetch_refs);
+		grg_connect($ctx);
+		# @fetch_objects
+			my @fetch_objects= ();
+			foreach my $ref (@$fetch_refs) {
+				push @fetch_objects, $ref->{sha1};
+			 }
+		grg_pack_fetch($ctx, \@fetch_objects);
+	 }
+	sub grg_command_list ($) {
+		my ($ctx) = @_;
+		$ctx->{command} = 'list';
+		grg_connect($ctx);
+		while (my ($ref, $obj) = each %{$ctx->{manifest}->{refs}}) {
+			gpg_command_answer("$obj $ref");
+		 };
+		gpg_command_answer("");
+	 }
+	sub grg_command_push ($$) {
+		my ($ctx, $push_refs) = @_;
+		local $_;
+		$ctx->{command} = 'push';
+		debug(sub{"push_refs="}, $push_refs);
+		grg_connect($ctx);
+		# @push_objects
+			my @push_objects= ();
+			foreach my $ref (@$push_refs) {
+				IPC::Run::run(['git', 'rev-list', '--ignore-missing', '--max-count=1', $ref->{src}, '--']
+				 , '>', \$_)
+					or error("failed to dereference ref to push: ".$ref->{src});
+				chomp;
+				$ref->{src_obj} = $_;
+				push @push_objects, $_;
+			 }
+		grg_pack_push($ctx, \@push_objects);
+		my $manifest_refs = $ctx->{manifest}->{refs};
+		foreach my $ref (@$push_refs) {
+			$manifest_refs->{$ref->{dst}} = $ref->{src_obj};
+		 }
+		$manifest_refs->{HEAD}
+		 = $push_refs->[-1]->{src_obj}
+			unless exists $manifest_refs->{HEAD}
+			or @$push_refs == 0;
+		grg_manifest_push($ctx);
+		grg_disconnect($ctx);
+	 }
+	sub grg_commands(@) {
+		my ($ctx) = @_;
+		my $line = undef;
+		local $/ = "\n";
+		#STDOUT->autoflush(1);
+		while (defined $line or (not eof(*STDIN) and
+			(defined($line = readline(*STDIN)))
+			 ? (chomp $line or 1)
+			 : error("readline failed: $!")
+		 )) {
+			debug(sub{"line=\"",$line,"\"\n"});
+			$ctx->{command} = undef;
+			if ($line eq 'capabilities') {
+				grg_command_capabilities($ctx);
+				$line = undef;
+			 }
+			elsif ($line =~ m/^fetch .*$/) {
+				my @refs = ();
+				my ($sha1, $name);
+				while ((defined $line or (not eof(*STDIN) and
+					((defined($line = readline(*STDIN)))
+					 ? (chomp $line or 1)
+					 : error("readline failed: $!")))) and
+					(($sha1, $name) = ($line =~ m/^fetch ([0-9a-f]{40}) (.+)$/))
+				 ) {
+					debug(sub{"fetch line=\"",$line,"\"\n"});
+					push @refs, {sha1=>$sha1, name=>$name};
+					$line = undef;
+				 }
+				error("failed to parse command: $line")
+					if @refs == 0;
+				grg_command_fetch($ctx, \@refs);
+			 }
+			elsif ($line eq 'list' or $line eq 'list for-push') {
+				grg_command_list($ctx);
+				$line = undef;
+			 }
+			elsif ($line =~ m/^push .*$/) {
+				my @refs = ();
+				my ($force, $src, $dst);
+				while ((defined $line or (not eof(*STDIN) and
+					((defined($line = readline(*STDIN)))
+					 ? (chomp $line or 1)
+					 : error("readline failed: $!")))) and
+					(($force, $src, $dst) = ($line =~ m/^push (\+)?([^:]+):(.+)$/))
+				 ) {
+					debug(sub{"push line=\"",$line,"\"\n"});
+					push @refs, {force=>(defined $force), src=>$src, dst=>$dst};
+					$line = undef;
+				 }
+				error("failed to parse command: $line")
+					if @refs == 0;
+				grg_command_push($ctx, \@refs);
+			 }
+			elsif ($line =~ m/^$/) {
+				$line = undef;
+				gpg_command_answer("");
+				return 0;
+			 }
+			else {
+				warning("unsupported command supplied: `$line'");
+				$line = undef;
+			 }
+		 }
+	 }
+sub main {
+	$ENV{GIT_DIR} = $ENV{GIT_DIR} || '.git';
+	$ENV{GITCEPTION} = ($ENV{GITCEPTION} || '') . '+';
+	my $ctx =
+	 { command => undef
+	 , config =>
+		 { curl => ['curl']
+		 , gpg => ['gpg']
+		 , keys => {}
+		 , 'hidden-keys' => {}
+		 , 'manifest-hash-algo' => 'SHA224' # NOTE: SHA512, SHA384, SHA256, SHA224 supported.
+		 , 'pack-filename-size' => 42
+		 , 'pack-hash-algo' => 'SHA224' # NOTE: SHA512, SHA384, SHA256, SHA224 supported.
+		 , 'pack-key-size' => 64
+		 , signingkey => undef
+		 , rsync => ['rsync']
+		 }
+	 , 'dir-cache' => undef
+	 , manifest => {}
+	 , 'manifest-file' => undef
+	 , remote =>
+		 { checking => 0
+		 , checked => undef
+		 , name => undef
+		 , uri => undef
+		 , push => []
+		 }
+	 };
+	Getopt::Long::Configure
+	 ( 'auto_version'
+	 , 'pass_through'
+	 , 'require_order'
+	 );
+	Getopt::Long::GetOptions
+	 ( help => sub { Pod::Usage::pod2usage
+		 ( -exitstatus => 0
+		 , -sections   => ['SYNOPSIS', 'OPTIONS', 'REMOTES', 'CONFIG']
+		 , -verbose    => 99 ); }
+	 , man => sub { Pod::Usage::pod2usage(-verbose => 2); }
+	 , check => sub {
+			$ctx->{remote}->{checking} = 1;
+		 }
+	 );
+	if (not $ctx->{remote}->{checking}) {
+		my $name = shift @ARGV;
+		Pod::Usage::pod2usage(-verbose => 1)
+			unless defined $name;
+		($ctx->{remote}->{name}) = ($name =~ m/^((\w|-)+)$/);
+		error("valid name of remote Git required, got: `$name'")
+			unless $ctx->{remote}->{name};
+	 }
+	my $uri = shift @ARGV;
+	Pod::Usage::pod2usage(-verbose => 1)
+		unless defined $uri;
+	$ctx->{remote}->{uri} = URI->new($uri);
+	error("valid URL of remote Git required, got: `$uri'")
+		unless $ctx->{remote}->{uri};
+	my $fragment = $ctx->{remote}->{uri}->fragment;
+	$fragment = ''
+		unless defined $fragment;
+	$ctx->{'manifest-file'} = grg_hash($ctx
+	 , $ctx->{config}->{'manifest-hash-algo'}
+	 , sub { return (@_, '<', \$fragment); });
+	if (-d $ENV{GIT_DIR}) {
+		$ctx->{'dir-cache'} = File::Spec->catdir
+		 ( $ENV{GIT_DIR}, 'cache', 'remotes'
+		 , $ctx->{remote}->{name}, 'gpg');
+		File::Path::make_path($ctx->{'dir-cache'}, {verbose => 1});
+	 }
+	else {
+		$ctx->{'dir-cache'} = File::Temp->tempdir(CLEANUP => 1);
+	 }
+	debug(sub{"ctx="},$ctx);
+	grg_commands($ctx);
+ }
+main;
+1;
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+git-remote-gpg - git-remote-helpers(1) to encrypt remote repository through gpg(1)
+
+=head1 SYNOPSIS
+
+=item git-remote-gpg $gpg_remote $gpg_url
+
+=item git-remote-gpg --check $gpg_url
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-h>, B<--help>
+
+=item B<--version>
+
+=back
+
+=head1 REMOTES
+
+=head2 Via rsync(1)
+
+=item git remote add $remote gpg::rsync://${user:+$user@}$host/$path
+
+=head2 Via curl(1)
+
+=item git remote add $remote gpg::sftp://${user:+$user@}$host/$path
+
+=head2 Via File::Copy(3pm)
+
+=item git remote add $remote gpg::file://$path
+
+=head1 CONFIG
+
+=head2 git-config(1)
+
+=over 8
+
+=item B<grg.curl>
+
+=item B<grg.gpg>
+
+=item B<grg.keys>
+
+=item B<grg.hidden-keys>
+
+=item B<grg.manifest-hash-algo>
+
+=item B<grg.pack-filename-size>
+
+=item B<grg.pack-hash-algo>
+
+=item B<grg.pack-key-size>
+
+=item B<grg.signingkey>
+
+=item B<grg.rsync>
+
+=back
+
+=cut
-- 
2.44.1