#!/usr/bin/perl our $VERSION = '2014.01.28'; # License # This file is a git-remote-helpers(1) to use a gpg(1) # as a cryptographic layer below git(1)'s objects. # Copyright (C) 2014 Julien Moutinho # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published # by the Free Software Foundation, either version 3 of the License, # or any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # Dependencies use strict; use warnings FATAL => qw(all); use Carp; use Cwd; use File::Basename; use File::Copy; use File::Path; 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"); } # System utilities sub rm (@) { foreach my $file (@_) { debug(sub{"file=$file\n"}); if (-e $file) { unlink($file) or error("rm $file"); } } } sub mkdir (@) { foreach my $dir (@_) { debug(sub{"dir=$dir\n"}); File::Path::make_path($dir, {verbose=>0, error => \my $error}); if (@$error) { for my $diag (@$error) { my ($dir, $message) = %$diag; error("dir=$dir: $message"); } } } } # 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) = @_; # NOTE: avoid File::Copy::copy(). while (my ($file, undef) = each %{$ctx->{remote}->{fetch}}) { my $path = File::Spec->catfile($ctx->{remote}->{uri}->file, $file); if (-r $path) { my $h = $ctx->{remote}->{fetch}->{$file}; $h->{path} = $path; $h->{preserve} = 1; } else { return 0; } } return 1; } sub grg_remote_fetch_rsync ($) { my ($ctx) = @_; my $uri = $ctx->{remote}->{uri}->clone; my @src; if ($uri->opaque =~ m{^//}) { $uri->fragment(undef); $uri->query(undef); @src = map { $uri->path($_); $uri->as_string; } (keys %{$ctx->{remote}->{fetch}}); } else { my ($authority, $path, $fragment) = $uri->as_string =~ m|^rsync:(?:([^/#:]+):)?([^?#]*)(?:#(.*))?$|; @src = map { "$authority:$path/$_" } (keys %{$ctx->{remote}->{fetch}}); } IPC::Run::run([@{$ctx->{config}->{rsync}} , '-i', '--ignore-times', '--inplace', '--progress' , @src , $ctx->{'dir-cache'}.'/'] , '>&2') } sub grg_remote_fetch_sftp ($) { my ($ctx) = @_; IPC::Run::run([@{$ctx->{config}->{curl}} , '--show-error' , '--output', File::Spec->catfile($ctx->{'dir-cache'}, '#1') , File::Spec->catfile($ctx->{remote}->{uri}->as_string , '{'.join(',', (keys %{$ctx->{remote}->{fetch}})).'}') ]) } sub grg_remote_fetch ($$) { my ($ctx, $files) = @_; debug(sub{'files='}, $files); my $scheme = $ctx->{remote}->{uri}->scheme; $ctx->{remote}->{fetch} = {map { $_ => { path => File::Spec->catfile($ctx->{'dir-cache'}, $_) , preserve => 0 } } @$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) or $ctx->{remote}->{fetch} = {}; return $ctx->{remote}->{fetch}; } sub grg_remote_init_file ($) { my ($ctx) = @_; my $dst = $ctx->{remote}->{uri}->file; &mkdir($dst); return 1; } sub grg_remote_init_rsync ($) { my ($ctx) = @_; my $tmp = File::Temp->tempdir('grg_rsync_XXXXXXXX', CLEANUP => 1); my $uri = $ctx->{remote}->{uri}->clone; my ($path, $dst); if ($uri->opaque =~ m{^//}) { $uri->fragment(undef); $uri->query(undef); $path = $uri->path; $dst = $uri->as_string; } else { my ($authority, $fragment); ($authority, $path, $fragment) = $uri->as_string =~ m|^rsync:(?:([^/#:]+):)?([^?#]*)(?:#(.*))?$|; $dst = "$authority:"; } &mkdir(File::Spec->catdir($tmp, $path)); IPC::Run::run([@{$ctx->{config}->{rsync}} , '-i', '--recursive', '--relative' , '--exclude=*', '.' , $dst] , '>&2' , 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) = @_; my $ok = 1; foreach my $file (@{$ctx->{remote}->{push}}) { 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"}); if (not File::Copy::move($src, $dst)) { $ok = 0; last; } } return $ok; } sub grg_remote_push_rsync ($) { my ($ctx) = @_; my $uri = $ctx->{remote}->{uri}->clone; $uri->fragment(undef); $uri->query(undef); my ($path, $dst); if ($uri->opaque =~ m{^//}) { $uri->fragment(undef); $uri->query(undef); $dst = $uri->as_string; } else { my ($authority, $path, $fragment) = $uri->as_string =~ m|^rsync:(?:([^/#:]+):)?([^?#]*)(?:#(.*))?$|; $dst = "$authority:$path/"; } IPC::Run::run([@{$ctx->{config}->{rsync}} , '-i', '--relative' , (@{$ctx->{remote}->{push}}) , $dst] , '>&2' , init => sub { chdir $ctx->{'dir-cache'} or die $!; }); } sub grg_remote_push_sftp ($) { my ($ctx) = @_; my $uri = $ctx->{remote}->{uri}->clone; $uri->fragment(''); $uri->query(''); IPC::Run::run([@{$ctx->{config}->{curl}} , '--show-error', '--ftp-create-dirs', '--upload-file' , '{'.join(',', @{$ctx->{remote}->{push}}).'}' , $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) or error("remote push failed"); rm(map {File::Spec->catfile($ctx->{'dir-cache'}, $_)} @{$ctx->{remote}->{push}}); 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; my $packs_fetched = grg_remote_fetch($ctx, [@packs_to_fetch]); foreach my $pack_id (@packs_to_fetch) { my $pack_fetched = exists $packs_fetched->{$pack_id} ? $packs_fetched->{$pack_id} : {path => File::Spec->catfile($ctx->{'dir-cache'}, $pack_id), preserve => 0}; 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_fetched->{path}); 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_fetched) unless $pack_fetched->{preserve}; 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 $fetched = grg_remote_fetch($ctx, [$ctx->{'manifest-file'}]); my $crypt = $fetched->{$ctx->{'manifest-file'}}->{path}; if (defined $crypt) { $ctx->{remote}->{checked} = 1; my $json; grg_decrypt_asymmetric($ctx, sub { push @{$_[0]}, $crypt; return (@_, '>', \$json); }); rm($fetched->{$ctx->{'manifest-file'}}->{path}) unless $fetched->{$ctx->{'manifest-file'}}->{preserve}; 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' or $ctx->{command} eq 'list for-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, $command) = @_; $ctx->{command} = $command; 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 @$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); $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; { local $SIG{'PIPE'} = 'IGNORE'; 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'); &mkdir($ctx->{'dir-cache'}); } else { $ctx->{'dir-cache'} = File::Temp->tempdir('grg_cache_XXXXXXXX', 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 =item git remote add $remote gpg::rsync://${user:+$user@}$host${port:+:$port}/$path =head2 Via curl(1) =item git remote add $remote gpg::sftp://${user:+$user@}$host${port:+:$port}/$path =head2 Via File::Copy(3pm) =item git remote add $remote gpg::file://$path =head1 CONFIG =head2 git-config(1) =over 8 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =cut