]> Git — Sourcephile - git-remote-gpg.git/blob - git-remote-gpg
38124221e0198ed6dfb4e5e3ce63bfb2b7381969
[git-remote-gpg.git] / git-remote-gpg
1 #!/usr/bin/perl
2 package git::remote::gpg;
3 package main;
4 our $VERSION = '2014.04.29';
5 # License
6 # This file is a git-remote-helpers(1) to use a gpg(1)
7 # as a cryptographic layer below git(1)'s objects.
8 # Copyright (C) 2014 Julien Moutinho
9 #
10 # This program is free software: you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published
12 # by the Free Software Foundation, either version 3 of the License,
13 # or any later version.
14 #
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty
17 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
18 # See the GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License
21 # along with this program. If not, see <http://www.gnu.org/licenses/>.
22 # Dependencies
23 use strict;
24 use warnings FATAL => qw(all);
25 use Carp;
26 use Cwd;
27 use File::Basename;
28 use File::Copy;
29 use File::Path;
30 use File::Spec::Functions qw(:ALL);
31 use File::Temp qw(tempdir);
32 use Getopt::Long;
33 use IPC::Run;
34 # NOTE: to debug: IPCRUNDEBUG=basic|data|details|gory
35 use IO::Handle;
36 use JSON;
37 use POSIX qw(WNOHANG);
38 use URI;
39
40 require Pod::Usage;
41 require Data::Dumper;
42 # Trace utilities
43 sub trace (@) {
44 foreach my $msg (@_) {
45 print STDERR $msg
46 if defined $msg;
47 }
48 }
49 sub debug (@) {
50 my $call = (caller(1))[3];
51 if ($ENV{TRACE}) {
52 trace
53 ( "\e[35mDEBUG\e[m"
54 , "\e[30m\e[1m.", join('.', $call."\e[m")
55 , " ", (map {
56 ref $_ eq 'CODE'
57 ? $_->()
58 : Data::Dumper::Dumper($_)
59 } @_)
60 );
61 }
62 return 1;
63 }
64 sub info (@) {
65 my $call = (caller(1))[3];
66 trace
67 ( "\e[32mINFO\e[m"
68 , "\e[30m\e[1m.", join('.', $call."\e[m")
69 , " ", (ref $_ eq 'CODE'?(join("\n ", $_->()), "\n"):(@_, "\n"))
70 );
71 }
72 sub warning (@) {
73 local $Carp::CarpLevel = 1;
74 carp("\e[33mWARNING\e[m ", @_, "\n\t");
75 }
76 sub error (@) {
77 local $Carp::CarpLevel = 1;
78 croak("\e[31mERROR\e[m ", @_, "\n\t");
79 }
80 # System utilities
81 sub rm (@) {
82 foreach my $file (@_) {
83 debug(sub{"file=$file\n"});
84 if (-e $file) {
85 unlink($file)
86 or error("rm $file");
87 }
88 }
89 }
90 sub mkdir (@) {
91 foreach my $dir (@_) {
92 debug(sub{"dir=$dir\n"});
93 File::Path::make_path($dir, {verbose=>0, error => \my $error});
94 if (@$error) {
95 for my $diag (@$error) {
96 my ($dir, $message) = %$diag;
97 error("dir=$dir: $message");
98 }
99 }
100 }
101 }
102 # grg crypto
103 sub grg_rand ($$) {
104 my ($ctx, $size) = @_;
105 local $_;
106 IPC::Run::run([@{$ctx->{config}->{gpg}}
107 , '--armor', '--gen-rand', '1', $size]
108 , '>', \$_)
109 or error("failed to get random bits");
110 chomp;
111 return $_;
112 }
113 sub grg_hash ($$;$) {
114 my ($ctx, $algo, $run) = @_;
115 $run = sub {return @_} unless defined $run;
116 my $hash;
117 IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
118 , '--with-colons', '--print-md', $algo]
119 , '>', \$hash))
120 or error("failed to hash data");
121 return ((split(':', $hash))[2]);
122 }
123 sub gpg_fingerprint($$$) {
124 my ($ctx, $id, $caps_needed) = @_;
125 my ($output);
126 my %h = ();
127 if (IPC::Run::run([@{$ctx->{config}->{gpg}}
128 , '--fixed-list-mode', '--with-colons', '--with-fingerprint', '--list-keys', $id]
129 , '>', \$output)) {
130 my @lines = split(/\n/,$output);
131 while (my $line = shift @lines) {
132 if (my ($longkeyid, $caps) = $line =~ m/^pub:[^:]*:[^:]*:[^:]*:([^:]*):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]+):.*$/) {
133 my $skip = 0;
134 foreach my $cap (@$caps_needed) {
135 if (not ($caps =~ m/$cap/)) {
136 warning("skipping key 0x$longkeyid which has not usable capability: $cap, but matches: `$id'");
137 $skip = 1;
138 }
139 }
140 if (not $skip) {
141 my $fpr = undef;
142 my $uid = undef;
143 while ((not defined $fpr or not defined $uid)
144 and $line = shift @lines) {
145 (not defined $fpr and (($fpr) = $line =~ m/^fpr:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([0-9A-F]+):.*$/)) or
146 (not defined $uid and (($uid) = $line =~ m/^uid:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]+):.*$/)) or
147 1;
148 }
149 error("unable to extract fingerprint and user ID")
150 unless defined $fpr
151 and defined $uid;
152 $h{$fpr} = $uid;
153 }
154 }
155 }
156 }
157 error("unable to find any OpenPGP key with usable capability: ".join('', @$caps_needed)." for: `$id'")
158 unless scalar(%h) gt 0;
159 debug(sub{"$id -> "}, \%h);
160 return %h;
161 }
162 sub grg_encrypt_symmetric ($$$;$) {
163 my ($ctx, $clear, $key, $run) = @_;
164 $run = sub {return @_} unless defined $run;
165 IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
166 , '--batch', '--yes'
167 , '--compress-algo', 'none'
168 , '--force-mdc'
169 , '--passphrase-fd', '3'
170 , '--s2k-mode', '1'
171 , '--trust-model', 'always'
172 , '--symmetric']
173 , '<', \$clear, '3<', \$key))
174 or error("failed to encrypt symmetrically data");
175 }
176 sub grg_decrypt_symmetric ($$$;$) {
177 my ($ctx, $key, $run) = @_;
178 $run = sub {return @_} unless defined $run;
179 IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
180 , '--batch', '--no-default-keyring', '--keyring', '/dev/null', '--secret-keyring', '/dev/null'
181 , '--passphrase-fd', '3', '--quiet', '--decrypt']
182 , '3<', \$key))
183 or error("failed to decrypt symmetrically data");
184 }
185 sub grg_encrypt_asymmetric ($$;$) {
186 my ($ctx, $clear, $run) = @_;
187 $run = sub {return @_} unless defined $run;
188 my @recipients =
189 ( (map { ('--recipient', '0x'.$_) } (keys %{$ctx->{config}->{keys}}))
190 , (map { ('--hidden-recipient', '0x'.$_) } (keys %{$ctx->{config}->{'hidden-keys'}})) );
191 @recipients = ('--default-recipient-self')
192 if @recipients == 0;
193 IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
194 , '--batch', '--yes'
195 , '--compress-algo', 'none'
196 , '--trust-model', 'always'
197 , '--sign', '--encrypt'
198 , ($ctx->{config}->{signingkey}->{fpr} ? ('--local-user', $ctx->{config}->{signingkey}->{fpr}) : ())
199 , @recipients ]
200 , '<', \$clear))
201 or error("failed to encrypt asymmetrically data");
202 }
203 sub grg_decrypt_asymmetric ($$;$) {
204 my ($ctx, $run) = @_;
205 my ($clear, $status);
206 $run = sub {return @_} unless defined $run;
207 IPC::Run::run($run->([@{$ctx->{config}->{gpg}}
208 , '--batch', '--no-default-keyring',
209 , '--status-fd', '3', '--quiet', '--decrypt']
210 , '>', \$clear, '3>', \$status))
211 or error("failed to decrypt asymmetrically data");
212 debug(sub{"status=\n$status"});
213 my @lines = split(/\n/,$status);
214 my ($enc_to, $goodsig, $validsig, $validpub, $goodmdc);
215 foreach my $line (@lines) {
216 (not defined $enc_to and (($enc_to) = $line =~ m/^\[GNUPG:\] ENC_TO ([0-9A-F]+).*$/)) or
217 (not defined $goodsig and (($goodsig) = $line =~ m/^\[GNUPG:\] GOODSIG ([0-9A-F]+).*$/)) or
218 (not defined $goodmdc and (($goodmdc) = $line =~ m/^\[GNUPG:\] (GOODMDC)$/)) or
219 (not defined $validsig and not defined $validpub and (($validsig, $validpub)
220 = $line =~ m/^\[GNUPG:\] VALIDSIG ([0-9A-F]+) [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ ([0-9A-F]+).*$/)) or
221 1;
222 }
223 error("data expected to be encrypted")
224 unless $enc_to;
225 debug(sub{"enc_to=$enc_to\n"});
226 error("data expected to be signed")
227 unless $goodsig;
228 debug(sub{"goodsig=$goodsig\n"});
229 error("modification detection code incorrect")
230 unless $goodmdc;
231 debug(sub{"good_mdc=$goodmdc\n"});
232 error("data signature invalid")
233 unless $validsig and $validpub;
234 debug(sub{"validsig=$validsig\n"});
235 debug(sub{"validpub=$validpub\n"});
236 error("data signature refused")
237 unless exists $ctx->{config}->{keys}->{$validpub}
238 or exists $ctx->{config}->{'hidden-keys'}->{$validpub};
239 debug(sub{"accepted:$validpub\n"});
240 return $clear;
241 }
242 # grg remote I/O
243 # XXX: there is no locking mechanism
244 sub grg_remote_fetch_file ($) {
245 my ($ctx) = @_;
246 # NOTE: avoid File::Copy::copy().
247 while (my ($file, undef) = each %{$ctx->{remote}->{fetch}}) {
248 my $path = File::Spec->catfile($ctx->{remote}->{uri}->file, $file);
249 if (-r $path) {
250 my $h = $ctx->{remote}->{fetch}->{$file};
251 $h->{path} = $path;
252 $h->{preserve} = 1;
253 }
254 else { return 0; }
255 }
256 return 1;
257 }
258 sub grg_remote_fetch_rsync ($) {
259 my ($ctx) = @_;
260 my $uri = $ctx->{remote}->{uri}->clone;
261 my @src;
262 if ($uri->opaque =~ m{^//}) {
263 $uri->fragment(undef);
264 $uri->query(undef);
265 @src = map { $uri->path($_); $uri->as_string; }
266 (keys %{$ctx->{remote}->{fetch}});
267 }
268 else {
269 my ($authority, $path, $fragment)
270 = $uri->as_string =~ m|^rsync:(?:([^/#:]+):)?([^?#]*)(?:#(.*))?$|;
271 @src = map { "$authority:$path/$_" }
272 (keys %{$ctx->{remote}->{fetch}});
273 }
274 IPC::Run::run([@{$ctx->{config}->{rsync}}
275 , '-i', '--ignore-times', '--inplace', '--progress'
276 , @src
277 , $ctx->{'dir-cache'}.'/']
278 , '>&2')
279 }
280 sub grg_remote_fetch_sftp ($) {
281 my ($ctx) = @_;
282 IPC::Run::run([@{$ctx->{config}->{curl}}
283 , '--show-error'
284 , '--output', File::Spec->catfile($ctx->{'dir-cache'}, '#1')
285 , $ctx->{remote}->{uri}->as_string.'/'.'{'.join(',', (keys %{$ctx->{remote}->{fetch}})).'}' ]
286 , '>&2')
287 }
288 sub grg_remote_fetch ($$) {
289 my ($ctx, $files) = @_;
290 debug(sub{'files='}, $files);
291 my $scheme = $ctx->{remote}->{uri}->scheme;
292 $ctx->{remote}->{fetch}
293 = {map { $_ =>
294 { path => File::Spec->catfile($ctx->{'dir-cache'}, $_)
295 , preserve => 0 }
296 } @$files};
297 my $fct =
298 { file => \&grg_remote_fetch_file
299 , rsync => \&grg_remote_fetch_rsync
300 , sftp => \&grg_remote_fetch_sftp
301 }->{$scheme};
302 error("URL scheme not supported: `$scheme'")
303 unless $fct;
304 $fct->($ctx)
305 or $ctx->{remote}->{fetch} = {};
306 return $ctx->{remote}->{fetch};
307 }
308 sub grg_remote_init_file ($) {
309 my ($ctx) = @_;
310 my $dst = $ctx->{remote}->{uri}->file;
311 &mkdir($dst);
312 return 1;
313 }
314 sub grg_remote_init_rsync ($) {
315 my ($ctx) = @_;
316 my $tmp = tempdir('grg_rsync_XXXXXXXX', CLEANUP => 1);
317 my $uri = $ctx->{remote}->{uri}->clone;
318 my ($path, $dst);
319 if ($uri->opaque =~ m{^//}) {
320 $uri->fragment(undef);
321 $uri->query(undef);
322 $path = $uri->path;
323 $dst = $uri->as_string;
324 }
325 else {
326 my ($authority, $fragment);
327 ($authority, $path, $fragment)
328 = $uri->as_string =~ m|^rsync:(?:([^/#:]+):)?([^?#]*)(?:#(.*))?$|;
329 $dst = "$authority:";
330 }
331 &mkdir(File::Spec->catdir($tmp, $path));
332 IPC::Run::run([@{$ctx->{config}->{rsync}}
333 , '-i', '--recursive', '--relative'
334 , '--exclude=*', '.'
335 , $dst]
336 , '>&2'
337 , init => sub { chdir $tmp or die $!; })
338 }
339 sub grg_remote_init_sftp ($) {
340 my ($ctx) = @_;
341 my $uri = $ctx->{remote}->{uri}->clone;
342 my ($path) = $uri->path =~ m|^/?(.*)$|;
343 $uri->fragment(undef);
344 $uri->path(undef);
345 $uri->query(undef);
346 IPC::Run::run([@{$ctx->{config}->{curl}}
347 , '--show-error', '--ftp-create-dirs'
348 , '-Q', "+mkdir ".$path
349 , $uri->as_string]
350 , '>&2')
351 }
352 sub grg_remote_init ($) {
353 my ($ctx) = @_;
354 my $scheme = $ctx->{remote}->{uri}->scheme;
355 my $fct =
356 { file => \&grg_remote_init_file
357 , rsync => \&grg_remote_init_rsync
358 , sftp => \&grg_remote_init_sftp
359 }->{$scheme};
360 error("URL scheme not supported: `$scheme'")
361 unless $fct;
362 $fct->($ctx)
363 or error("remote init failed");
364 return;
365 }
366 sub grg_remote_push_file ($) {
367 my ($ctx) = @_;
368 my $ok = 1;
369 foreach my $file (@{$ctx->{remote}->{push}}) {
370 my $src = File::Spec->catfile($ctx->{'dir-cache'}, $file);
371 my $dst = File::Spec->catfile($ctx->{remote}->{uri}->file, $file);
372 debug(sub{"File::Copy::move('$src', '$dst')\n"});
373 if (not File::Copy::move($src, $dst)) {
374 $ok = 0;
375 last;
376 }
377 }
378 return $ok;
379 }
380 sub grg_remote_push_rsync ($) {
381 my ($ctx) = @_;
382 my $uri = $ctx->{remote}->{uri}->clone;
383 $uri->fragment(undef);
384 $uri->query(undef);
385 my ($path, $dst);
386 if ($uri->opaque =~ m{^//}) {
387 $uri->fragment(undef);
388 $uri->query(undef);
389 $dst = $uri->as_string;
390 }
391 else {
392 my ($authority, $path, $fragment)
393 = $uri->as_string =~ m|^rsync:(?:([^/#:]+):)?([^?#]*)(?:#(.*))?$|;
394 $dst = "$authority:$path/";
395 }
396 IPC::Run::run([@{$ctx->{config}->{rsync}}
397 , '-i', '--relative'
398 , (@{$ctx->{remote}->{push}})
399 , $dst]
400 , '>&2'
401 , init => sub { chdir $ctx->{'dir-cache'} or die $!; });
402 }
403 sub grg_remote_push_sftp ($) {
404 my ($ctx) = @_;
405 my $uri = $ctx->{remote}->{uri}->clone;
406 $uri->fragment(undef);
407 $uri->query(undef);
408 IPC::Run::run([@{$ctx->{config}->{curl}}
409 , '--show-error', '--ftp-create-dirs', '--upload-file'
410 , File::Spec->catfile($ctx->{'dir-cache'},'{'.join(',', @{$ctx->{remote}->{push}}).'}')
411 , $uri->as_string.'/']
412 , '>&2')
413 }
414 sub grg_remote_push ($) {
415 my ($ctx) = @_;
416 my $scheme = $ctx->{remote}->{uri}->scheme;
417 grg_remote_init($ctx)
418 unless $ctx->{remote}->{checked};
419 return 1
420 if @{$ctx->{remote}->{push}} == 0;
421 my $fct =
422 { file => \&grg_remote_push_file
423 , rsync => \&grg_remote_push_rsync
424 , sftp => \&grg_remote_push_sftp
425 }->{$scheme};
426 error("URL scheme not supported: `$scheme'")
427 unless $fct;
428 $fct->($ctx)
429 or error("remote push failed");
430 rm(map {File::Spec->catfile($ctx->{'dir-cache'}, $_)} @{$ctx->{remote}->{push}});
431 return 1;
432 }
433 sub grg_remote_remove ($) {
434 my ($ctx) = @_;
435 #my $scheme = $ctx->{remote}->{uri}->scheme;
436 #my $fct =
437 # { file => sub {
438 # File::Copy::remove_tree
439 # ( map { File::Spec->catfile($ctx->{remote}->{uri}->path, $_) } @$files
440 # , verbose => 1 )
441 # }
442 # , rsync => sub {
443 # IPC::Run::run([@{$ctx->{config}->{rsync}}
444 # , '--verbose', '--ignore-times', '--recursive', '--delete'
445 # , @$files
446 # , $ctx->{remote}->{uri}])
447 # }
448 # , sftp => sub {
449 # IPC::Run::run([@{$ctx->{config}->{curl}}
450 # , '--show-error'
451 # , map { ('-Q', 'rm '.$_) } @$files
452 # , $ctx->{remote}->{uri}])
453 # }
454 # }->{$scheme};
455 #error("URL scheme not supported: `$scheme'")
456 # unless $fct;
457 #$fct->($ctx, $ctx->{remote}->{remove})
458 # or error("remote remove failed");
459 #return;
460 }
461 # grg packing
462 sub grg_pack_fetch ($$) {
463 my ($ctx, $fetch_objects) = @_;
464 local $_;
465 # %remote_objects
466 my %remote_objects = ();
467 while (my ($pack_id, $pack) = each %{$ctx->{manifest}->{packs}}) {
468 foreach my $obj (@{$pack->{objects}}) {
469 $remote_objects{$obj} = $pack_id;
470 }
471 }
472 # @packs_to_fetch
473 my %packs_to_fetch = ();
474 foreach my $obj (@$fetch_objects) {
475 my @packs = ($remote_objects{$obj});
476 while (my $pack_id = shift @packs) {
477 if (not exists $packs_to_fetch{$pack_id}) {
478 $packs_to_fetch{$pack_id} = 1;
479 my $manifest_pack = $ctx->{manifest}->{packs}->{$pack_id};
480 error("manifest is missing a dependency pack: $pack_id")
481 unless defined $manifest_pack;
482 @packs = (@packs, @{$manifest_pack->{deps}});
483 }
484 }
485 }
486 my @packs_to_fetch = keys %packs_to_fetch;
487 my $packs_fetched = grg_remote_fetch($ctx, [@packs_to_fetch]);
488 foreach my $pack_id (@packs_to_fetch) {
489 my $pack_fetched
490 = exists $packs_fetched->{$pack_id}
491 ? $packs_fetched->{$pack_id}
492 : {path => File::Spec->catfile($ctx->{'dir-cache'}, $pack_id), preserve => 0};
493 my $manifest_pack = $ctx->{manifest}->{packs}->{$pack_id};
494 my $pack_key = $manifest_pack->{key};
495 my $pack_data;
496 grg_decrypt_symmetric($ctx, $pack_key, sub {
497 push @{$_[0]}, ($pack_fetched->{path});
498 return (@_, '>', \$pack_data);
499 });
500 my $pack_hash_algo = $manifest_pack->{hash_algo};
501 my $pack_hash = grg_hash($ctx
502 , $pack_hash_algo
503 , sub { return (@_, '<', \$pack_data); });
504 error("pack data hash differs from pack manifest hash")
505 unless $pack_hash eq $manifest_pack->{hash};
506 rm($pack_fetched->{path})
507 unless $pack_fetched->{preserve};
508 IPC::Run::run(['git', 'index-pack', '-v', '--stdin']
509 , '<', \$pack_data
510 , '>&2');
511 }
512 }
513 sub grg_pack_push ($$) {
514 my ($ctx, $push_objects) = @_;
515 local $_;
516 debug(sub{"push_objects=\n"}, $push_objects);
517 # %remote_objects
518 my %remote_objects = ();
519 while (my ($pack_id, $pack) = each %{$ctx->{manifest}->{packs}}) {
520 foreach my $obj (@{$pack->{objects}}) {
521 $remote_objects{$obj} = $pack_id;
522 }
523 }
524 # @common_objects
525 IPC::Run::run(['git', 'cat-file', '--batch-check']
526 , '<', \join("\n", keys %remote_objects)
527 , '>', \$_)
528 or error("failed to query local git objects");
529 my @common_objects
530 = map {
531 if ($_ =~ m/ missing$/) { () }
532 else { s/ .*//; $_ }
533 } (split(/\n/, $_));
534 # @pack_objects, @pack_deps_objects
535 IPC::Run::run(['git', 'rev-list', '--objects-edge', '--stdin', '--']
536 , '<', \join("\n", ((map {'^'.$_} @common_objects), @$push_objects))
537 , '>', \$_)
538 or error("failed to query objects to pack");
539 my @pack_objects_edge = split(/\n/, $_);
540 foreach (@pack_objects_edge) {s/ .*//}
541 my @pack_objects = grep {m/^[^-]/} @pack_objects_edge;
542 my @pack_deps_objects = grep {s/^-//} @pack_objects_edge;
543 # %pack_deps
544 my %pack_deps = ();
545 foreach my $obj (@pack_deps_objects) {
546 my $pack = $remote_objects{$obj};
547 error("manifest is missing object dependencies")
548 unless defined $pack;
549 $pack_deps{$pack} = 1;
550 }
551 if (@pack_objects > 0) {
552 # $pack_id
553 my $pack_id;
554 my $pack_id_try = 0;
555 while (not defined $pack_id
556 or exists $ctx->{manifest}->{packs}->{$pack_id}) {
557 $pack_id = grg_rand($ctx, $ctx->{config}->{'pack-filename-size'});
558 $pack_id =~ s{/}{-}g;
559 error("failed to pick an unused random pack filename after 512 tries; retry or increase grg.pack-filename-size")
560 if $pack_id_try++ >= 512;
561 }
562 my $pack_key = grg_rand($ctx, $ctx->{config}->{'pack-key-size'});
563 my $pack_data;
564 IPC::Run::run(['git', 'pack-objects', '--stdout']
565 , '<', \join("\n", @pack_objects)
566 , '>', \$pack_data)
567 or error("failed to pack objects to push");
568 my $pack_hash = grg_hash($ctx
569 , $ctx->{config}->{'pack-hash-algo'}
570 , sub { return (@_, '<', \$pack_data); });
571 grg_encrypt_symmetric($ctx, $pack_data, $pack_key, sub {
572 push @{$_[0]}, ('--output', File::Spec->catfile($ctx->{'dir-cache'}, $pack_id));
573 return @_;
574 });
575 push @{$ctx->{remote}->{push}}, $pack_id;
576 $ctx->{manifest}->{packs}->{$pack_id} =
577 { deps => [keys %pack_deps]
578 , hash => $pack_hash
579 , hash_algo => $ctx->{config}->{'pack-hash-algo'}
580 , key => $pack_key
581 , objects => \@pack_objects
582 };
583 }
584 }
585 # grg manifest
586 sub grg_manifest_fetch ($) {
587 my ($ctx) = @_;
588 debug(sub{'remote->checked='},$ctx->{remote}->{checked});
589 return
590 if defined $ctx->{remote}->{checked};
591 $ctx->{manifest} =
592 { 'hidden-keys' => {}
593 , keys => {}
594 , packs => {}
595 , refs => {}
596 , version => $VERSION
597 };
598 my $fetched = grg_remote_fetch($ctx, [$ctx->{'manifest-file'}]);
599 my $crypt = $fetched->{$ctx->{'manifest-file'}}->{path};
600 if (defined $crypt) {
601 my $json;
602 grg_decrypt_asymmetric($ctx, sub {
603 push @{$_[0]}, $crypt;
604 return (@_, '>', \$json); });
605 my $manifest;
606 ($manifest = JSON::decode_json($json) and ref $manifest eq 'HASH')
607 or error("failed to decode JSON manifest");
608 $ctx->{remote}->{checked} = 1;
609 rm($fetched->{$ctx->{'manifest-file'}}->{path})
610 unless $fetched->{$ctx->{'manifest-file'}}->{preserve};
611 $ctx->{manifest} = {%{$ctx->{manifest}}, %$manifest};
612 foreach my $slot (qw(keys hidden-keys)) {
613 while (my ($fpr, $uid) = each %{$ctx->{manifest}->{$slot}}) {
614 my %keys = gpg_fingerprint($ctx, '0x'.$fpr, ['E']);
615 my ($fpr, $uid) = each %keys;
616 $ctx->{config}->{$slot}->{$fpr} = $uid;
617 }
618 }
619 }
620 else {
621 if ($ctx->{command} eq 'push' or $ctx->{command} eq 'list for-push') {
622 $ctx->{remote}->{checked} = 0;
623 }
624 elsif ($ctx->{remote}->{checking}) {
625 exit 100;
626 }
627 else {
628 error("remote checking failed");
629 }
630 }
631 }
632 sub grg_manifest_push ($) {
633 my ($ctx) = @_;
634 foreach my $slot (qw(keys hidden-keys)) {
635 $ctx->{manifest}->{$slot} = {};
636 while (my ($fpr, $uid) = each %{$ctx->{config}->{$slot}}) {
637 $ctx->{manifest}->{$slot}->{$fpr} = $uid;
638 }
639 }
640 my $json = JSON::encode_json($ctx->{manifest})
641 or error("failed to encode JSON manifest");
642 grg_encrypt_asymmetric($ctx, $json, sub {
643 push @{$_[0]}
644 , ('--output', File::Spec->catfile($ctx->{'dir-cache'}, $ctx->{'manifest-file'}));
645 return @_; });
646 push @{$ctx->{remote}->{push}}, $ctx->{'manifest-file'};
647 }
648 # grg config
649 sub grg_config_read($) {
650 my ($ctx) = @_;
651 my $cfg = $ctx->{config};
652 local $/ = "\n";
653
654 foreach my $name (qw(gpg signingkey keys)
655 , grep { !m/^(gpg|signingkey|keys)$/ } (keys %$cfg)) {
656 my $value;
657 IPC::Run::run(['git', 'config', '--get', 'remote.'.$ctx->{remote}->{name}.'.'.$name, '.+'], '>', \$value) or
658 IPC::Run::run(['git', 'config', '--get', 'grg.'.$name, '.+'], '>', \$value) or 1;
659 if ($name eq 'signingkey') {
660 IPC::Run::run(['git', 'config', '--get', 'user.'.$name, '.+'], '>', \$value)
661 if (not $value);
662 chomp $value;
663 my %keys = gpg_fingerprint($ctx, $value, ['S']);
664 warning("signing key ID is not matching a unique key: taking only one")
665 unless scalar(keys %keys) == 1;
666 my ($fpr, $uid) = each %keys;
667 $cfg->{$name} = {fpr => $fpr, uid => $uid};
668 }
669 elsif ($name eq 'keys' or $name eq 'hidden-keys') {
670 IPC::Run::run(['git', 'config', '--get', 'user.'.$name, '.+'], '>', \$value)
671 if (not $value);
672 chomp $value;
673 my @ids = split(/,/, $value);
674 if (@ids > 0) {
675 foreach my $key (@ids) {
676 my %keys = gpg_fingerprint($ctx, $key, ['E']);
677 while (my ($fpr, $uid) = each %keys) {
678 $cfg->{$name}->{$fpr} = $uid;
679 }
680 }
681 }
682 }
683 elsif (grep(/^$name$/, qw(curl gpg rsync))) {
684 IPC::Run::run(['git', 'config', '--get', $name.'.program', '.+'], '>', \$value)
685 if (not $value);
686 $cfg->{$name} = [split(' ', $value)]
687 if $value;
688 }
689 else {
690 chomp $value;
691 $cfg->{$name} = $value
692 if $value;
693 }
694 }
695 error("no signingkey configured; to do so you may use one of following commands:\n"
696 , "\t\$ git config remote.'$ctx->{remote}->{name}'.signingkey \$your_openpgp_id\n"
697 , "\t\$ git config grg.signingkey \$your_openpgp_id\n"
698 , "\t\$ git config user.signingkey \$your_openpgp_id"
699 ) unless defined $cfg->{signingkey};
700 if ( (scalar (keys %{$cfg->{keys}}) == 0)
701 and (scalar (keys %{$cfg->{'hidden-keys'}}) == 0) ) {
702 $cfg->{keys} = { $cfg->{signingkey}->{fpr} => $cfg->{signingkey}->{uid} };
703 }
704
705 debug(sub{'config='},$cfg);
706 }
707 # grg system
708 sub grg_connect ($) {
709 my ($ctx) = @_;
710 grg_config_read($ctx);
711 grg_manifest_fetch($ctx);
712 }
713 sub grg_disconnect ($) {
714 my ($ctx) = @_;
715 grg_remote_push($ctx);
716 }
717 # grg commands
718 sub gpg_command_answer ($) {
719 my @cmd = @_;
720 debug(sub{join('', @cmd)."\n"});
721 print STDOUT (@cmd, "\n");
722 STDOUT->flush
723 if (@cmd == 1 and $cmd[0] eq "");
724 }
725 sub grg_command_capabilities ($) {
726 my ($ctx) = @_;
727 $ctx->{command} = 'capabilities';
728 gpg_command_answer("fetch");
729 gpg_command_answer("push");
730 gpg_command_answer("");
731 }
732 sub grg_command_fetch ($$) {
733 my ($ctx, $fetch_refs) = @_;
734 $ctx->{command} = 'fetch';
735 debug(sub{"fetch_refs="}, $fetch_refs);
736 grg_connect($ctx);
737 # @fetch_objects
738 my @fetch_objects= ();
739 foreach my $ref (@$fetch_refs) {
740 push @fetch_objects, $ref->{sha1};
741 }
742 grg_pack_fetch($ctx, \@fetch_objects);
743 }
744 sub grg_command_list ($$) {
745 my ($ctx, $command) = @_;
746 $ctx->{command} = $command;
747 grg_connect($ctx);
748 my $manifest_refs = $ctx->{manifest}->{refs};
749 while (my ($ref, $obj) = each %$manifest_refs) {
750 if ($obj =~ m|^ref: *(.*) *$|) {
751 $obj = $manifest_refs->{$1};
752 }
753 gpg_command_answer("$obj $ref")
754 if defined $obj;
755 };
756 gpg_command_answer("");
757 }
758 sub grg_command_push ($$) {
759 my ($ctx, $push_refs) = @_;
760 local $_;
761 $ctx->{command} = 'push';
762 debug(sub{"push_refs="}, $push_refs);
763 grg_connect($ctx);
764 # @push_objects
765 my @push_objects= ();
766 foreach my $ref (@$push_refs) {
767 IPC::Run::run(['git', 'rev-list', '--ignore-missing', '--max-count=1', $ref->{src}, '--']
768 , '>', \$_)
769 or error("failed to dereference ref to push: ".$ref->{src});
770 chomp;
771 $ref->{src_obj} = $_;
772 push @push_objects, $_;
773 }
774 grg_pack_push($ctx, \@push_objects);
775 my $manifest_refs = $ctx->{manifest}->{refs};
776 foreach my $ref (@$push_refs) {
777 $manifest_refs->{$ref->{dst}} = $ref->{src_obj};
778 }
779 $manifest_refs->{HEAD} = 'ref: refs/heads/master'
780 unless defined $manifest_refs->{HEAD};
781 grg_manifest_push($ctx);
782 grg_disconnect($ctx);
783 }
784 sub grg_commands(@) {
785 my ($ctx) = @_;
786 my $line = undef;
787 local $/ = "\n";
788 #STDOUT->autoflush(1);
789 while (defined $line or (not eof(*STDIN) and
790 (defined($line = readline(*STDIN)))
791 ? (chomp $line or 1)
792 : error("readline failed: $!")
793 )) {
794 debug(sub{"line=\"",$line,"\"\n"});
795 $ctx->{command} = undef;
796 if ($line eq 'capabilities') {
797 grg_command_capabilities($ctx);
798 $line = undef;
799 }
800 elsif ($line =~ m/^fetch .*$/) {
801 my @refs = ();
802 my ($sha1, $name);
803 while ((defined $line or (not eof(*STDIN) and
804 ((defined($line = readline(*STDIN)))
805 ? (chomp $line or 1)
806 : error("readline failed: $!")))) and
807 (($sha1, $name) = ($line =~ m/^fetch ([0-9a-f]{40}) (.+)$/))
808 ) {
809 debug(sub{"fetch line=\"",$line,"\"\n"});
810 push @refs, {sha1=>$sha1, name=>$name};
811 $line = undef;
812 }
813 error("failed to parse command: $line")
814 if @refs == 0;
815 grg_command_fetch($ctx, \@refs);
816 }
817 elsif ($line eq 'list' or $line eq 'list for-push') {
818 grg_command_list($ctx, $line);
819 $line = undef;
820 }
821 elsif ($line =~ m/^push .*$/) {
822 my @refs = ();
823 my ($force, $src, $dst);
824 while ((defined $line or (not eof(*STDIN) and
825 ((defined($line = readline(*STDIN)))
826 ? (chomp $line or 1)
827 : error("readline failed: $!")))) and
828 (($force, $src, $dst) = ($line =~ m/^push (\+)?([^:]+):(.+)$/))
829 ) {
830 debug(sub{"push line=\"",$line,"\"\n"});
831 push @refs, {force=>(defined $force), src=>$src, dst=>$dst};
832 $line = undef;
833 }
834 error("failed to parse command: $line")
835 if @refs == 0;
836 grg_command_push($ctx, \@refs);
837 }
838 elsif ($line =~ m/^$/) {
839 $line = undef;
840 {
841 local $SIG{'PIPE'} = 'IGNORE';
842 gpg_command_answer("");
843 }
844 return 0;
845 }
846 else {
847 warning("unsupported command supplied: `$line'");
848 $line = undef;
849 }
850 }
851 }
852 sub main {
853 $ENV{GIT_DIR} = $ENV{GIT_DIR} || '.git';
854 $ENV{GITCEPTION} = ($ENV{GITCEPTION} || '') . '+';
855 my $ctx =
856 { command => undef
857 , config =>
858 { curl => ['curl']
859 , gpg => ['gpg']
860 , keys => {}
861 , 'hidden-keys' => {}
862 , 'manifest-hash-algo' => 'SHA224' # NOTE: SHA512, SHA384, SHA256, SHA224 supported.
863 , 'pack-filename-size' => 42
864 , 'pack-hash-algo' => 'SHA224' # NOTE: SHA512, SHA384, SHA256, SHA224 supported.
865 , 'pack-key-size' => 64
866 , signingkey => undef
867 , rsync => ['rsync']
868 }
869 , 'dir-cache' => undef
870 , manifest => undef
871 , 'manifest-file' => undef
872 , remote =>
873 { checking => 0
874 , checked => undef
875 , name => undef
876 , uri => undef
877 , push => []
878 }
879 };
880 Getopt::Long::Configure
881 ( 'auto_version'
882 , 'pass_through'
883 , 'require_order'
884 );
885 Getopt::Long::GetOptions
886 ( help => sub { Pod::Usage::pod2usage
887 ( -exitstatus => 0
888 , -sections => ['SYNOPSIS', 'OPTIONS', 'REMOTES', 'CONFIG']
889 , -verbose => 99 ); }
890 , man => sub { Pod::Usage::pod2usage(-verbose => 2); }
891 , check => sub {
892 $ctx->{remote}->{checking} = 1;
893 }
894 );
895 if (not $ctx->{remote}->{checking}) {
896 my $name = shift @ARGV;
897 Pod::Usage::pod2usage(-verbose => 1)
898 unless defined $name;
899 ($ctx->{remote}->{name}) = ($name =~ m/^((\w|-)+)$/);
900 error("valid name of remote Git required, got: `$name'")
901 unless $ctx->{remote}->{name};
902 }
903 my $uri = shift @ARGV;
904 Pod::Usage::pod2usage(-verbose => 1)
905 unless defined $uri;
906 $ctx->{remote}->{uri} = URI->new($uri);
907 error("valid URL of remote Git required, got: `$uri'")
908 unless $ctx->{remote}->{uri};
909 my $fragment = $ctx->{remote}->{uri}->fragment;
910 $fragment = ''
911 unless defined $fragment;
912 $ctx->{'manifest-file'} = grg_hash($ctx
913 , $ctx->{config}->{'manifest-hash-algo'}
914 , sub { return (@_, '<', \$fragment); });
915 if (-d $ENV{GIT_DIR}) {
916 $ctx->{'dir-cache'} = File::Spec->catdir
917 ( $ENV{GIT_DIR}, 'cache', 'remotes'
918 , $ctx->{remote}->{name}, 'gpg');
919 &mkdir($ctx->{'dir-cache'});
920 }
921 else {
922 $ctx->{'dir-cache'} = tempdir('grg_cache_XXXXXXXX', CLEANUP => 1);
923 }
924 debug(sub{"ctx="},$ctx);
925 grg_commands($ctx);
926 }
927 main;
928 1;
929 __END__
930
931 =encoding utf8
932
933 =head1 NAME
934
935 git-remote-gpg - git-remote-helpers(1) to encrypt remote repository through gpg(1)
936
937 =head1 SYNOPSIS
938
939 =item git-remote-gpg $gpg_remote $gpg_url
940
941 =item git-remote-gpg --check $gpg_url
942
943 =head1 OPTIONS
944
945 =over 8
946
947 =item B<-h>, B<--help>
948
949 =item B<--version>
950
951 =back
952
953 =head1 REMOTES
954
955 =head2 Via rsync(1)
956
957 =item git remote add $remote gpg::rsync:${user:+$user@}$host:$path
958
959 =item git remote add $remote gpg::rsync://${user:+$user@}$host${port:+:$port}/$path
960
961 =head2 Via curl(1)
962
963 =item git remote add $remote gpg::sftp://${user:+$user@}$host${port:+:$port}/$path
964
965 =head2 Via File::Copy(3pm)
966
967 =item git remote add $remote gpg::file://$path
968
969 =head1 CONFIG
970
971 =head2 git-config(1)
972
973 =over 8
974
975 =item B<grg.curl>, B<remote.$remote.curl>
976
977 =item B<grg.gpg>, B<remote.$remote.gpg>
978
979 =item B<grg.keys>, B<remote.$remote.keys>
980
981 =item B<grg.hidden-keys>, B<remote.$remote.hidden-keys>
982
983 =item B<grg.manifest-hash-algo>, B<remote.$remote.manifest-hash-algo>
984
985 =item B<grg.pack-filename-size>, B<remote.$remote.pack-filename-size>
986
987 =item B<grg.pack-hash-algo>, B<remote.$remote.pack-hash-algo>
988
989 =item B<grg.pack-key-size>, B<remote.$remote.pack-key-size>
990
991 =item B<grg.signingkey>, B<remote.$remote.signingkey>
992
993 =item B<grg.rsync>, B<remote.$remote.rsync>
994
995 =back
996
997 =cut