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