f003ef9e355fe7446aa49a89f3f7e03e6582c04d
[notmuch] / contrib / nmbug / nmbug
1 #!/usr/bin/env perl
2 # Copyright (c) 2011 David Bremner
3 # License: same as notmuch
4
5 use strict;
6 use warnings;
7 use File::Temp qw(tempdir);
8 use Pod::Usage;
9
10 no encoding;
11
12 my $NMBGIT = $ENV{NMBGIT} || $ENV{HOME}.'/.nmbug';
13
14 $NMBGIT .= '/.git' if (-d $NMBGIT.'/.git');
15
16 my $TAGPREFIX = $ENV{NMBPREFIX} || 'notmuch::';
17
18 # magic hash for git
19 my $EMPTYBLOB = 'e69de29bb2d1d6434b8b29ae775ad8c2e48c5391';
20
21 # for encoding
22
23 my $ESCAPE_CHAR =       '%';
24 my $NO_ESCAPE =         'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'.
25                         '0123456789+-_@=.:,';
26 my $MUST_ENCODE =       qr{[^\Q$NO_ESCAPE\E]};
27 my $ESCAPED_RX =        qr{$ESCAPE_CHAR([A-Fa-f0-9]{2})};
28
29 my %command = (
30              archive    => \&do_archive,
31              checkout   => \&do_checkout,
32              commit     => \&do_commit,
33              fetch      => \&do_fetch,
34              help       => \&do_help,
35              log        => \&do_log,
36              merge      => \&do_merge,
37              pull       => \&do_pull,
38              push       => \&do_push,
39              status     => \&do_status,
40              );
41
42 my $subcommand = shift || usage ();
43
44 if (!exists $command{$subcommand}) {
45   usage ();
46 }
47
48 &{$command{$subcommand}}(@ARGV);
49
50 sub git_pipe {
51   my $envref = (ref $_[0] eq 'HASH') ? shift : {};
52   my $ioref  = (ref $_[0] eq 'ARRAY') ? shift : undef;
53   my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : undef;
54
55   unshift @_, 'git';
56   $envref->{GIT_DIR} ||= $NMBGIT;
57   spawn ($envref, defined $ioref ? $ioref : (), defined $dir ? $dir : (), @_);
58 }
59
60 sub git {
61   my $fh = git_pipe (@_);
62   my $str = join ('', <$fh>);
63   unless (close $fh) {
64     die "'git @_' exited with nonzero value\n";
65   }
66   chomp($str);
67   return $str;
68 }
69
70 sub spawn {
71   my $envref = (ref $_[0] eq 'HASH') ? shift : {};
72   my $ioref  = (ref $_[0] eq 'ARRAY') ? shift : undef;
73   my $dir = ($_[0] eq '-|' or $_[0] eq '|-') ? shift : '-|';
74
75   die unless @_;
76
77   if (open my $child, $dir) {
78     return $child;
79   }
80   # child
81   while (my ($key, $value) = each %{$envref}) {
82     $ENV{$key} = $value;
83   }
84
85   if (defined $ioref && $dir eq '-|') {
86       open my $fh, '|-', @_ or die "open |- @_: $!";
87       foreach my $line (@{$ioref}) {
88         print $fh $line, "\n";
89       }
90       exit ! close $fh;
91     } else {
92       if ($dir ne '|-') {
93         open STDIN, '<', '/dev/null' or die "reopening stdin: $!"
94       }
95       exec @_;
96       die "exec @_: $!";
97     }
98 }
99
100
101 sub get_tags {
102   my $prefix = shift;
103   my @tags;
104
105   my $fh = spawn ('-|', qw/notmuch search --output=tags/, "*")
106     or die 'error dumping tags';
107
108   while (<$fh>) {
109     chomp ();
110     push @tags, $_ if (m/^$prefix/);
111   }
112   unless (close $fh) {
113     die "'notmuch search --output=tags *' exited with nonzero value\n";
114   }
115   return @tags;
116 }
117
118
119 sub do_archive {
120   system ('git', "--git-dir=$NMBGIT", 'archive', 'HEAD');
121 }
122
123
124 sub is_committed {
125   my $status = shift;
126   return scalar (@{$status->{added}} ) + scalar (@{$status->{deleted}} ) == 0;
127 }
128
129
130 sub do_commit {
131   my @args = @_;
132
133   my $status = compute_status ();
134
135   if ( is_committed ($status) ) {
136     print "Nothing to commit\n";
137     return;
138   }
139
140   my $index = read_tree ('HEAD');
141
142   update_index ($index, $status);
143
144   my $tree = git ( { GIT_INDEX_FILE => $index }, 'write-tree')
145     or die 'no output from write-tree';
146
147   my $parent = git ( 'rev-parse', 'HEAD'  )
148     or die 'no output from rev-parse';
149
150   my $commit = git ([ @args ], 'commit-tree', $tree, '-p', $parent)
151     or die 'commit-tree';
152
153   git ('update-ref', 'HEAD', $commit);
154
155   unlink $index || die "unlink: $!";
156
157 }
158
159 sub read_tree {
160   my $treeish = shift;
161   my $index = $NMBGIT.'/nmbug.index';
162   git ({ GIT_INDEX_FILE => $index }, 'read-tree', '--empty');
163   git ({ GIT_INDEX_FILE => $index }, 'read-tree', $treeish);
164   return $index;
165 }
166
167 sub update_index {
168   my $index = shift;
169   my $status = shift;
170
171   my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
172                      '|-', qw/git update-index --index-info/)
173     or die 'git update-index';
174
175   foreach my $pair (@{$status->{deleted}}) {
176     index_tags_for_msg ($git, $pair->{id}, 'D', $pair->{tag});
177   }
178
179   foreach my $pair (@{$status->{added}}) {
180     index_tags_for_msg ($git, $pair->{id}, 'A', $pair->{tag});
181   }
182   unless (close $git) {
183     die "'git update-index --index-info' exited with nonzero value\n";
184   }
185
186 }
187
188
189 sub do_fetch {
190   my $remote = shift || 'origin';
191
192   git ('fetch', $remote);
193 }
194
195
196 sub notmuch {
197   my @args = @_;
198   system ('notmuch', @args) == 0 or die  "notmuch @args failed: $?";
199 }
200
201
202 sub index_tags {
203
204   my $index = $NMBGIT.'/nmbug.index';
205
206   my $query = join ' ', map ("tag:$_", get_tags ($TAGPREFIX));
207
208   my $fh = spawn ('-|', qw/notmuch dump --/, $query)
209     or die "notmuch dump: $!";
210
211   git ('read-tree', '--empty');
212   my $git = spawn ({ GIT_DIR => $NMBGIT, GIT_INDEX_FILE => $index },
213                      '|-', qw/git update-index --index-info/)
214     or die 'git update-index';
215
216   while (<$fh>) {
217     m/ ( [^ ]* ) \s+ \( ([^\)]* ) \) /x || die 'syntax error in dump';
218     my ($id,$rest) = ($1,$2);
219
220     #strip prefixes before writing
221     my @tags = grep { s/^$TAGPREFIX//; } split (' ', $rest);
222     index_tags_for_msg ($git,$id, 'A', @tags);
223   }
224   unless (close $git) {
225     die "'git update-index --index-info' exited with nonzero value\n";
226   }
227   unless (close $fh) {
228     die "'notmuch dump -- $query' exited with nonzero value\n";
229   }
230   return $index;
231 }
232
233 sub index_tags_for_msg {
234   my $fh = shift;
235   my $msgid = shift;
236   my $mode = shift;
237
238   my $hash = $EMPTYBLOB;
239   my $blobmode = '100644';
240
241   if ($mode eq 'D') {
242     $blobmode = '0';
243     $hash = '0000000000000000000000000000000000000000';
244   }
245
246   foreach my $tag (@_) {
247     my $tagpath = 'tags/' . encode_for_fs ($msgid) . '/' . encode_for_fs ($tag);
248     print $fh "$blobmode $hash\t$tagpath\n";
249   }
250 }
251
252
253 sub do_checkout {
254   do_sync (action => 'checkout');
255 }
256
257
258 sub do_sync {
259
260   my %args = @_;
261
262   my $status = compute_status ();
263   my ($A_action, $D_action);
264
265   if ($args{action} eq 'checkout') {
266     $A_action = '-';
267     $D_action = '+';
268   } else {
269     $A_action = '+';
270     $D_action = '-';
271   }
272
273   foreach my $pair (@{$status->{added}}) {
274
275     notmuch ('tag', $A_action.$TAGPREFIX.$pair->{tag},
276              'id:'.$pair->{id});
277   }
278
279   foreach my $pair (@{$status->{deleted}}) {
280     notmuch ('tag', $D_action.$TAGPREFIX.$pair->{tag},
281              'id:'.$pair->{id});
282   }
283
284 }
285
286
287 sub insist_committed {
288
289   my $status=compute_status();
290   if ( !is_committed ($status) ) {
291     print "Uncommitted changes to $TAGPREFIX* tags in notmuch
292
293 For a summary of changes, run 'nmbug status'
294 To save your changes,     run 'nmbug commit' before merging/pull
295 To discard your changes,  run 'nmbug checkout'
296 ";
297     exit (1);
298   }
299
300 }
301
302
303 sub do_pull {
304   my $remote = shift || 'origin';
305
306   git ( 'fetch', $remote);
307
308   do_merge ();
309 }
310
311
312 sub do_merge {
313   insist_committed ();
314
315   my $tempwork = tempdir ('/tmp/nmbug-merge.XXXXXX', CLEANUP => 1);
316
317   git ( { GIT_WORK_TREE => $tempwork }, 'checkout', '-f', 'HEAD');
318
319   git ( { GIT_WORK_TREE => $tempwork }, 'merge', 'FETCH_HEAD');
320
321   do_checkout ();
322 }
323
324
325 sub do_log {
326   # we don't want output trapping here, because we want the pager.
327   system ( 'git', "--git-dir=$NMBGIT", 'log', '--name-status', @_);
328 }
329
330
331 sub do_push {
332   my $remote = shift || 'origin';
333
334   git ('push', $remote);
335 }
336
337
338 sub do_status {
339   my $status = compute_status ();
340
341   my %output = ();
342   foreach my $pair (@{$status->{added}}) {
343     $output{$pair->{id}} ||= {};
344     $output{$pair->{id}}{$pair->{tag}} = 'A'
345   }
346
347   foreach my $pair (@{$status->{deleted}}) {
348     $output{$pair->{id}} ||= {};
349     $output{$pair->{id}}{$pair->{tag}} = 'D'
350   }
351
352   foreach my $pair (@{$status->{missing}}) {
353     $output{$pair->{id}} ||= {};
354     $output{$pair->{id}}{$pair->{tag}} = 'U'
355   }
356
357   if (is_unmerged ()) {
358     foreach my $pair (diff_refs ('A')) {
359       $output{$pair->{id}} ||= {};
360       $output{$pair->{id}}{$pair->{tag}} ||= ' ';
361       $output{$pair->{id}}{$pair->{tag}} .= 'a';
362     }
363
364     foreach my $pair (diff_refs ('D')) {
365       $output{$pair->{id}} ||= {};
366       $output{$pair->{id}}{$pair->{tag}} ||= ' ';
367       $output{$pair->{id}}{$pair->{tag}} .= 'd';
368     }
369   }
370
371   foreach my $id (sort keys %output) {
372     foreach my $tag (sort keys %{$output{$id}}) {
373       printf "%s\t%s\t%s\n", $output{$id}{$tag}, $id, $tag;
374     }
375   }
376 }
377
378
379 sub is_unmerged {
380
381   return 0 if (! -f $NMBGIT.'/FETCH_HEAD');
382
383   my $fetch_head = git ('rev-parse', 'FETCH_HEAD');
384   my $base = git ( 'merge-base', 'HEAD', 'FETCH_HEAD');
385
386   return ($base ne $fetch_head);
387
388 }
389
390 sub compute_status {
391   my %args = @_;
392
393   my @added;
394   my @deleted;
395   my @missing;
396
397   my $index = index_tags ();
398
399   my @maybe_deleted = diff_index ($index, 'D');
400
401   foreach my $pair (@maybe_deleted) {
402
403     my $id = $pair->{id};
404
405     my $fh = spawn ('-|', qw/notmuch search --output=files/,"id:$id")
406       or die "searching for $id";
407     if (!<$fh>) {
408       push @missing, $pair;
409     } else {
410       push @deleted, $pair;
411     }
412     unless (close $fh) {
413       die "'notmuch search --output=files id:$id' exited with nonzero value\n";
414     }
415   }
416
417
418   @added = diff_index ($index, 'A');
419
420   unlink $index || die "unlink $index: $!";
421
422   return { added => [@added], deleted => [@deleted], missing => [@missing] };
423 }
424
425
426 sub diff_index {
427   my $index = shift;
428   my $filter = shift;
429
430   my $fh = git_pipe ({ GIT_INDEX_FILE => $index },
431                   qw/diff-index --cached/,
432                  "--diff-filter=$filter", qw/--name-only HEAD/ );
433
434   my @lines = unpack_diff_lines ($fh);
435   unless (close $fh) {
436     die "'git diff-index --cached --diff-filter=$filter --name-only HEAD' ",
437         "exited with nonzero value\n";
438   }
439   return @lines;
440 }
441
442
443 sub diff_refs {
444   my $filter = shift;
445   my $ref1 = shift || 'HEAD';
446   my $ref2 = shift || 'FETCH_HEAD';
447
448   my $fh= git_pipe ( 'diff', "--diff-filter=$filter", '--name-only',
449                  $ref1, $ref2);
450
451   my @lines = unpack_diff_lines ($fh);
452   unless (close $fh) {
453     die "'git diff --diff-filter=$filter --name-only $ref1 $ref2' ",
454         "exited with nonzero value\n";
455   }
456   return @lines;
457 }
458
459
460 sub unpack_diff_lines {
461   my $fh = shift;
462
463   my @found;
464   while(<$fh>) {
465     chomp ();
466     my ($id,$tag) = m|tags/ ([^/]+) / ([^/]+) |x;
467
468     $id = decode_from_fs ($id);
469     $tag = decode_from_fs ($tag);
470
471     push @found, { id => $id, tag => $tag };
472   }
473
474   return @found;
475 }
476
477
478 sub encode_for_fs {
479   my $str = shift;
480
481   $str =~ s/($MUST_ENCODE)/"$ESCAPE_CHAR".sprintf ("%02x",ord ($1))/ge;
482   return $str;
483 }
484
485
486 sub decode_from_fs {
487   my $str = shift;
488
489   $str =~ s/$ESCAPED_RX/ chr (hex ($1))/eg;
490
491   return $str;
492
493 }
494
495
496 sub usage {
497   pod2usage ();
498   exit (1);
499 }
500
501
502 sub do_help {
503   pod2usage ( -verbose => 2 );
504   exit (0);
505 }
506
507 __END__
508
509 =head1 NAME
510
511 nmbug - manage notmuch tags about notmuch
512
513 =head1 SYNOPSIS
514
515 nmbug subcommand [options]
516
517 B<nmbug help> for more help
518
519 =head1 OPTIONS
520
521 =head2 Most common commands
522
523 =over 8
524
525 =item B<commit> [message]
526
527 Commit appropriately prefixed tags from the notmuch database to
528 git. Any extra arguments are used (one per line) as a commit message.
529
530 =item  B<push> [remote]
531
532 push local nmbug git state to remote repo
533
534 =item  B<pull> [remote]
535
536 pull (merge) remote repo changes to notmuch. B<pull> is equivalent to
537 B<fetch> followed by B<merge>.
538
539 =back
540
541 =head2 Other Useful Commands
542
543 =over 8
544
545 =item B<checkout>
546
547 Update the notmuch database from git. This is mainly useful to discard
548 your changes in notmuch relative to git.
549
550 =item B<fetch> [remote]
551
552 Fetch changes from the remote repo (see merge to bring those changes
553 into notmuch).
554
555 =item B<help> [subcommand]
556
557 print help [for subcommand]
558
559 =item B<log> [parameters]
560
561 A simple wrapper for git log. After running C<nmbug fetch>, you can
562 inspect the changes with C<nmbug log HEAD..FETCH_HEAD>
563
564 =item B<merge>
565
566 Merge changes from FETCH_HEAD into HEAD, and load the result into
567 notmuch.
568
569 =item  B<status>
570
571 Show pending updates in notmuch or git repo. See below for more
572 information about the output format.
573
574 =back
575
576 =head2 Less common commands
577
578 =over 8
579
580 =item B<archive>
581
582 Dump a tar archive (using git archive) of the current nmbug tag set.
583
584 =back
585
586 =head1 STATUS FORMAT
587
588 B<nmbug status> prints lines of the form
589
590    ng Message-Id tag
591
592 where n is a single character representing notmuch database status
593
594 =over 8
595
596 =item B<A>
597
598 Tag is present in notmuch database, but not committed to nmbug
599 (equivalently, tag has been deleted in nmbug repo, e.g. by a pull, but
600 not restored to notmuch database).
601
602 =item B<D>
603
604 Tag is present in nmbug repo, but not restored to notmuch database
605 (equivalently, tag has been deleted in notmuch)
606
607 =item B<U>
608
609 Message is unknown (missing from local notmuch database)
610
611 =back
612
613 The second character (if present) represents a difference between remote
614 git and local. Typically C<nmbug fetch> needs to be run to update this.
615
616 =over 8
617
618
619 =item B<a>
620
621 Tag is present in remote, but not in local git.
622
623
624 =item B<d>
625
626 Tag is present in local git, but not in remote git.
627
628
629 =back
630
631 =head1 DUMP FORMAT
632
633 Each tag $tag for message with Message-Id $id is written to
634 an empty file
635
636         tags/encode($id)/encode($tag)
637
638 The encoding preserves alphanumerics, and the characters "+-_@=.:,"
639 (not the quotes).  All other octets are replaced with '%' followed by
640 a two digit hex number.
641
642 =head1 ENVIRONMENT
643
644 B<NMBGIT> specifies the location of the git repository used by nmbug.
645 If not specified $HOME/.nmbug is used.
646
647 B<NMBPREFIX> specifies the prefix in the notmuch database for tags of
648 interest to nmbug. If not specified 'notmuch::' is used.