git.oblomov.eu Git - ikiwiki/blob - IkiWiki/Plugin/monotone.pm

   1 #!/usr/bin/perl
   2 package IkiWiki::Plugin::monotone;
   3
   4 use warnings;
   5 use strict;
   6 use IkiWiki;
   7 use Monotone;
   8 use Date::Parse qw(str2time);
   9 use Date::Format qw(time2str);
  10
  11 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
  12
  13 sub import { #{{{
  14         hook(type => "checkconfig", id => "monotone", call => \&checkconfig);
  15         hook(type => "getsetup", id => "monotone", call => \&getsetup);
  16         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
  17         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
  18         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
  19         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
  20         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
  21         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
  22         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
  23         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
  24         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
  25         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
  26 } #}}}
  27
  28 sub checkconfig () { #{{{
  29         if (!defined($config{mtnrootdir})) {
  30                 $config{mtnrootdir} = $config{srcdir};
  31         }
  32         if (! -d "$config{mtnrootdir}/_MTN") {
  33                 error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
  34         }
  35
  36         my $child = open(MTN, "-|");
  37         if (! $child) {
  38                 open STDERR, ">/dev/null";
  39                 exec("mtn", "version") || error("mtn version failed to run");
  40         }
  41
  42         my $version=undef;
  43         while (<MTN>) {
  44                 if (/^monotone (\d+\.\d+) /) {
  45                         $version=$1;
  46                 }
  47         }
  48
  49         close MTN || debug("mtn version exited $?");
  50
  51         if (!defined($version)) {
  52                 error("Cannot determine monotone version");
  53         }
  54         if ($version < 0.38) {
  55                 error("Monotone version too old, is $version but required 0.38");
  56         }
  57
  58         if (length $config{mtn_wrapper}) {
  59                 push @{$config{wrappers}}, {
  60                         wrapper => $config{mtn_wrapper},
  61                         wrappermode => (defined $config{mtn_wrappermode} ? $config{mtn_wrappermode} : "06755"),
  62                 };
  63         }
  64 } #}}}
  65
  66 sub getsetup () { #{{{
  67         return
  68                 mtn_wrapper => {
  69                         type => "string",
  70                         example => "/srv/mtn/wiki/_MTN/ikiwiki-netsync-hook",
  71                         description => "monotone netsync hook executable to generate",
  72                         safe => 0, # file
  73                         rebuild => 0,
  74                 },
  75                 mtn_wrappermode => {
  76                         type => "string",
  77                         example => '06755',
  78                         description => "mode for mtn_wrapper (can safely be made suid)",
  79                         safe => 0,
  80                         rebuild => 0,
  81                 },
  82                 mtnkey => {
  83                         type => "string",
  84                         example => 'web@example.com',
  85                         description => "your monotone key",
  86                         safe => 1,
  87                         rebuild => 0,
  88                 },
  89                 historyurl => {
  90                         type => "string",
  91                         example => "http://viewmtn.example.com/branch/head/filechanges/com.example.branch/[[file]]",
  92                         description => "viewmtn url to show file history ([[file]] substituted)",
  93                         safe => 1,
  94                         rebuild => 1,
  95                 },
  96                 diffurl => {
  97                         type => "string",
  98                         example => "http://viewmtn.example.com/revision/diff/[[r1]]/with/[[r2]]/[[file]]",
  99                         description => "viewmtn url to show a diff ([[r1]], [[r2]], and [[file]] substituted)",
 100                         safe => 1,
 101                         rebuild => 1,
 102                 },
 103                 mtnsync => {
 104                         type => "boolean",
 105                         example => 0,
 106                         description => "sync on update and commit?",
 107                         safe => 0, # paranoia
 108                         rebuild => 0,
 109                 },
 110                 mtnrootdir => {
 111                         type => "string",
 112                         description => "path to your workspace (defaults to the srcdir; specify if the srcdir is a subdirectory of the workspace)",
 113                         safe => 0, # path
 114                         rebuild => 0,
 115                 },
 116 } #}}}
 117
 118 sub get_rev () { #{{{
 119         my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
 120
 121         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
 122         if (! $sha1) {
 123                 debug("Unable to get base revision for '$config{srcdir}'.")
 124         }
 125
 126         return $sha1;
 127 } #}}}
 128
 129 sub get_rev_auto ($) { #{{{
 130         my $automator=shift;
 131
 132         my @results = $automator->call("get_base_revision_id");
 133
 134         my $sha1 = $results[0];
 135         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
 136         if (! $sha1) {
 137                 debug("Unable to get base revision for '$config{srcdir}'.")
 138         }
 139
 140         return $sha1;
 141 } #}}}
 142
 143 sub mtn_merge ($$$$) { #{{{
 144         my $leftRev=shift;
 145         my $rightRev=shift;
 146         my $branch=shift;
 147         my $author=shift;
 148
 149         my $mergeRev;
 150
 151         my $child = open(MTNMERGE, "-|");
 152         if (! $child) {
 153                 open STDERR, ">&STDOUT";
 154                 exec("mtn", "--root=$config{mtnrootdir}",
 155                      "explicit_merge", $leftRev, $rightRev,
 156                      $branch, "--author", $author, "--key",
 157                      $config{mtnkey}) || error("mtn merge failed to run");
 158         }
 159
 160         while (<MTNMERGE>) {
 161                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
 162                         $mergeRev=$1;
 163                 }
 164         }
 165
 166         close MTNMERGE || return undef;
 167
 168         debug("merged $leftRev, $rightRev to make $mergeRev");
 169
 170         return $mergeRev;
 171 } #}}}
 172
 173 sub commit_file_to_new_rev ($$$$$$$$) { #{{{
 174         my $automator=shift;
 175         my $wsfilename=shift;
 176         my $oldFileID=shift;
 177         my $newFileContents=shift;
 178         my $oldrev=shift;
 179         my $branch=shift;
 180         my $author=shift;
 181         my $message=shift;
 182
 183         #store the file
 184         my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
 185         my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
 186         error("Failed to store file data for $wsfilename in repository")
 187                 if (! defined $newFileID || length $newFileID != 40);
 188
 189         # get the mtn filename rather than the workspace filename
 190         ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
 191         my ($filename) = ($out =~ m/^file "(.*)"$/);
 192         error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
 193         debug("Converted ws filename of $wsfilename to repos filename of $filename");
 194
 195         # then stick in a new revision for this file
 196         my $manifest = "format_version \"1\"\n\n".
 197                        "new_manifest [0000000000000000000000000000000000000000]\n\n".
 198                        "old_revision [$oldrev]\n\n".
 199                        "patch \"$filename\"\n".
 200                        " from [$oldFileID]\n".
 201                        "   to [$newFileID]\n";
 202         ($out, $err) = $automator->call("put_revision", $manifest);
 203         my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
 204         error("Unable to make new monotone repository revision")
 205                 if (! defined $newRevID || length $newRevID != 40);
 206         debug("put revision: $newRevID");
 207
 208         # now we need to add certs for this revision...
 209         # author, branch, changelog, date
 210         $automator->call("cert", $newRevID, "author", $author);
 211         $automator->call("cert", $newRevID, "branch", $branch);
 212         $automator->call("cert", $newRevID, "changelog", $message);
 213         $automator->call("cert", $newRevID, "date",
 214                 time2str("%Y-%m-%dT%T", time, "UTC"));
 215
 216         debug("Added certs for rev: $newRevID");
 217         return $newRevID;
 218 } #}}}
 219
 220 sub read_certs ($$) { #{{{
 221         my $automator=shift;
 222         my $rev=shift;
 223         my @results = $automator->call("certs", $rev);
 224         my @ret;
 225
 226         my $line = $results[0];
 227         while ($line =~ m/\s+key\s"(.*?)"\nsignature\s"(ok|bad|unknown)"\n\s+name\s"(.*?)"\n\s+value\s"(.*?)"\n\s+trust\s"(trusted|untrusted)"\n/sg) {
 228                 push @ret, {
 229                         key => $1,
 230                         signature => $2,
 231                         name => $3,
 232                         value => $4,
 233                         trust => $5,
 234                 };
 235         }
 236
 237         return @ret;
 238 } #}}}
 239
 240 sub get_changed_files ($$) { #{{{
 241         my $automator=shift;
 242         my $rev=shift;
 243
 244         my @results = $automator->call("get_revision", $rev);
 245         my $changes=$results[0];
 246
 247         my @ret;
 248         my %seen = ();
 249
 250         while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
 251                 my $file = $2;
 252                 # don't add the same file multiple times
 253                 if (! $seen{$file}) {
 254                         push @ret, $file;
 255                         $seen{$file} = 1;
 256                 }
 257         }
 258
 259         return @ret;
 260 } #}}}
 261
 262 sub rcs_update () { #{{{
 263         chdir $config{srcdir}
 264             or error("Cannot chdir to $config{srcdir}: $!");
 265
 266         if (defined($config{mtnsync}) && $config{mtnsync}) {
 267                 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
 268                            "--quiet", "--ticker=none",
 269                            "--key", $config{mtnkey}) != 0) {
 270                         debug("monotone sync failed before update");
 271                 }
 272         }
 273
 274         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
 275                 debug("monotone update failed");
 276         }
 277 } #}}}
 278
 279 sub rcs_prepedit ($) { #{{{
 280         my $file=shift;
 281
 282         chdir $config{srcdir}
 283             or error("Cannot chdir to $config{srcdir}: $!");
 284
 285         # For monotone, return the revision of the file when
 286         # editing begins.
 287         return get_rev();
 288 } #}}}
 289
 290 sub rcs_commit ($$$;$$) { #{{{
 291         # Tries to commit the page; returns undef on _success_ and
 292         # a version of the page with the rcs's conflict markers on failure.
 293         # The file is relative to the srcdir.
 294         my $file=shift;
 295         my $message=shift;
 296         my $rcstoken=shift;
 297         my $user=shift;
 298         my $ipaddr=shift;
 299         my $author;
 300
 301         if (defined $user) {
 302                 $author="Web user: " . $user;
 303         }
 304         elsif (defined $ipaddr) {
 305                 $author="Web IP: " . $ipaddr;
 306         }
 307         else {
 308                 $author="Web: Anonymous";
 309         }
 310
 311         chdir $config{srcdir}
 312             or error("Cannot chdir to $config{srcdir}: $!");
 313
 314         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
 315         my $rev = get_rev();
 316         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
 317                 my $automator = Monotone->new();
 318                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
 319
 320                 # Something has been committed, has this file changed?
 321                 my ($out, $err);
 322                 $automator->setOpts("r", $oldrev, "r", $rev);
 323                 ($out, $err) = $automator->call("content_diff", $file);
 324                 debug("Problem committing $file") if ($err ne "");
 325                 my $diff = $out;
 326
 327                 if ($diff) {
 328                         # Commit a revision with just this file changed off
 329                         # the old revision.
 330                         #
 331                         # first get the contents
 332                         debug("File changed: forming branch");
 333                         my $newfile=readfile("$config{srcdir}/$file");
 334
 335                         # then get the old content ID from the diff
 336                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
 337                                 error("Unable to find previous file ID for $file");
 338                         }
 339                         my $oldFileID = $1;
 340
 341                         # get the branch we're working in
 342                         ($out, $err) = $automator->call("get_option", "branch");
 343                         chomp $out;
 344                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
 345                         my $branch = $1;
 346
 347                         # then put the new content into the DB (and record the new content ID)
 348                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
 349
 350                         $automator->close();
 351
 352                         # if we made it to here then the file has been committed... revert the local copy
 353                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
 354                                 debug("Unable to revert $file after merge on conflicted commit!");
 355                         }
 356                         debug("Divergence created! Attempting auto-merge.");
 357
 358                         # see if it will merge cleanly
 359                         $ENV{MTN_MERGE}="fail";
 360                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
 361                         $ENV{MTN_MERGE}="";
 362
 363                         # push any changes so far
 364                         if (defined($config{mtnsync}) && $config{mtnsync}) {
 365                                 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
 366                                         debug("monotone push failed");
 367                                 }
 368                         }
 369
 370                         if (defined($mergeResult)) {
 371                                 # everything is merged - bring outselves up to date
 372                                 if (system("mtn", "--root=$config{mtnrootdir}",
 373                                            "update", "-r", $mergeResult) != 0) {
 374                                         debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
 375                                 }
 376                         }
 377                         else {
 378                                 debug("Auto-merge failed.  Using diff-merge to add conflict markers.");
 379
 380                                 $ENV{MTN_MERGE}="diffutils";
 381                                 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
 382                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
 383                                 $ENV{MTN_MERGE}="";
 384                                 $ENV{MTN_MERGE_DIFFUTILS}="";
 385
 386                                 if (!defined($mergeResult)) {
 387                                         debug("Unable to insert conflict markers!");
 388                                         error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
 389                                                 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
 390                                                 "but at present the different versions cannot be reconciled through the web interface. ".
 391                                                 "Please use the non-web interface to resolve the conflicts.");
 392                                 }
 393
 394                                 if (system("mtn", "--root=$config{mtnrootdir}",
 395                                            "update", "-r", $mergeResult) != 0) {
 396                                         debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
 397                                 }
 398
 399                                 # return "conflict enhanced" file to the user
 400                                 # for cleanup note, this relies on the fact
 401                                 # that ikiwiki seems to call rcs_prepedit()
 402                                 # again after we return
 403                                 return readfile("$config{srcdir}/$file");
 404                         }
 405                         return undef;
 406                 }
 407                 $automator->close();
 408         }
 409
 410         # If we reached here then the file we're looking at hasn't changed
 411         # since $oldrev. Commit it.
 412
 413         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
 414                    "--author", $author, "--key", $config{mtnkey}, "-m",
 415                    IkiWiki::possibly_foolish_untaint($message), $file) != 0) {
 416                 debug("Traditional commit failed! Returning data as conflict.");
 417                 my $conflict=readfile("$config{srcdir}/$file");
 418                 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
 419                            "--quiet", $file) != 0) {
 420                         debug("monotone revert failed");
 421                 }
 422                 return $conflict;
 423         }
 424         if (defined($config{mtnsync}) && $config{mtnsync}) {
 425                 if (system("mtn", "--root=$config{mtnrootdir}", "push",
 426                            "--quiet", "--ticker=none", "--key",
 427                            $config{mtnkey}) != 0) {
 428                         debug("monotone push failed");
 429                 }
 430         }
 431
 432         return undef # success
 433 } #}}}
 434
 435 sub rcs_commit_staged ($$$) {
 436         # Commits all staged changes. Changes can be staged using rcs_add,
 437         # rcs_remove, and rcs_rename.
 438         my ($message, $user, $ipaddr)=@_;
 439
 440         # Note - this will also commit any spurious changes that happen to be
 441         # lying around in the working copy.  There shouldn't be any, but...
 442
 443         chdir $config{srcdir}
 444             or error("Cannot chdir to $config{srcdir}: $!");
 445
 446         my $author;
 447
 448         if (defined $user) {
 449                 $author="Web user: " . $user;
 450         }
 451         elsif (defined $ipaddr) {
 452                 $author="Web IP: " . $ipaddr;
 453         }
 454         else {
 455                 $author="Web: Anonymous";
 456         }
 457
 458         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
 459                    "--author", $author, "--key", $config{mtnkey}, "-m",
 460                    IkiWiki::possibly_foolish_untaint($message)) != 0) {
 461                 error("Monotone commit failed");
 462         }
 463 }
 464
 465 sub rcs_add ($) { #{{{
 466         my $file=shift;
 467
 468         chdir $config{srcdir}
 469             or error("Cannot chdir to $config{srcdir}: $!");
 470
 471         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
 472                    $file) != 0) {
 473                 error("Monotone add failed");
 474         }
 475 } #}}}
 476
 477 sub rcs_remove ($) { # {{{
 478         my $file = shift;
 479
 480         chdir $config{srcdir}
 481             or error("Cannot chdir to $config{srcdir}: $!");
 482
 483         # Note: it is difficult to undo a remove in Monotone at the moment.
 484         # Until this is fixed, it might be better to make 'rm' move things
 485         # into an attic, rather than actually remove them.
 486         # To resurrect a file, you currently add a new file with the contents
 487         # you want it to have.  This loses all connectivity and automated
 488         # merging with the 'pre-delete' versions of the file.
 489
 490         if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
 491                    $file) != 0) {
 492                 error("Monotone remove failed");
 493         }
 494 } #}}}
 495
 496 sub rcs_rename ($$) { # {{{
 497         my ($src, $dest) = @_;
 498
 499         chdir $config{srcdir}
 500             or error("Cannot chdir to $config{srcdir}: $!");
 501
 502         if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
 503                    $src, $dest) != 0) {
 504                 error("Monotone rename failed");
 505         }
 506 } #}}}
 507
 508 sub rcs_recentchanges ($) { #{{{
 509         my $num=shift;
 510         my @ret;
 511
 512         chdir $config{srcdir}
 513             or error("Cannot chdir to $config{srcdir}: $!");
 514
 515         # use log --brief to get a list of revs, as this
 516         # gives the results in a nice order
 517         # (otherwise we'd have to do our own date sorting)
 518
 519         my @revs;
 520
 521         my $child = open(MTNLOG, "-|");
 522         if (! $child) {
 523                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
 524                      "--brief") || error("mtn log failed to run");
 525         }
 526
 527         while (($num >= 0) and (my $line = <MTNLOG>)) {
 528                 if ($line =~ m/^($sha1_pattern)/) {
 529                         push @revs, $1;
 530                         $num -= 1;
 531                 }
 532         }
 533         close MTNLOG || debug("mtn log exited $?");
 534
 535         my $automator = Monotone->new();
 536         $automator->open(undef, $config{mtnrootdir});
 537
 538         while (@revs != 0) {
 539                 my $rev = shift @revs;
 540                 # first go through and figure out the messages, etc
 541
 542                 my $certs = [read_certs($automator, $rev)];
 543
 544                 my $user;
 545                 my $when;
 546                 my $committype;
 547                 my (@pages, @message);
 548
 549                 foreach my $cert (@$certs) {
 550                         if ($cert->{signature} eq "ok" &&
 551                             $cert->{trust} eq "trusted") {
 552                                 if ($cert->{name} eq "author") {
 553                                         $user = $cert->{value};
 554                                         # detect the source of the commit
 555                                         # from the changelog
 556                                         if ($cert->{key} eq $config{mtnkey}) {
 557                                                 $committype = "web";
 558                                         } else {
 559                                                 $committype = "monotone";
 560                                         }
 561                                 } elsif ($cert->{name} eq "date") {
 562                                         $when = str2time($cert->{value}, 'UTC');
 563                                 } elsif ($cert->{name} eq "changelog") {
 564                                         my $messageText = $cert->{value};
 565                                         # split the changelog into multiple
 566                                         # lines
 567                                         foreach my $msgline (split(/\n/, $messageText)) {
 568                                                 push @message, { line => $msgline };
 569                                         }
 570                                 }
 571                         }
 572                 }
 573
 574                 my @changed_files = get_changed_files($automator, $rev);
 575                 my $file;
 576
 577                 my ($out, $err) = $automator->call("parents", $rev);
 578                 my @parents = ($out =~ m/^($sha1_pattern)$/);
 579                 my $parent = $parents[0];
 580
 581                 foreach $file (@changed_files) {
 582                         next unless length $file;
 583
 584                         if (defined $config{diffurl} and (@parents == 1)) {
 585                                 my $diffurl=$config{diffurl};
 586                                 $diffurl=~s/\[\[r1\]\]/$parent/g;
 587                                 $diffurl=~s/\[\[r2\]\]/$rev/g;
 588                                 $diffurl=~s/\[\[file\]\]/$file/g;
 589                                 push @pages, {
 590                                         page => pagename($file),
 591                                         diffurl => $diffurl,
 592                                 };
 593                         }
 594                         else {
 595                                 push @pages, {
 596                                         page => pagename($file),
 597                                 }
 598                         }
 599                 }
 600
 601                 push @ret, {
 602                         rev => $rev,
 603                         user => $user,
 604                         committype => $committype,
 605                         when => $when,
 606                         message => [@message],
 607                         pages => [@pages],
 608                 } if @pages;
 609         }
 610
 611         $automator->close();
 612
 613         return @ret;
 614 } #}}}
 615
 616 sub rcs_diff ($) { #{{{
 617         my $rev=shift;
 618         my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
 619
 620         chdir $config{srcdir}
 621             or error("Cannot chdir to $config{srcdir}: $!");
 622
 623         my $child = open(MTNDIFF, "-|");
 624         if (! $child) {
 625                 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
 626         }
 627
 628         my (@lines) = <MTNDIFF>;
 629
 630         close MTNDIFF || debug("mtn diff $sha1 exited $?");
 631
 632         if (wantarray) {
 633                 return @lines;
 634         }
 635         else {
 636                 return join("", @lines);
 637         }
 638 } #}}}
 639
 640 sub rcs_getctime ($) { #{{{
 641         my $file=shift;
 642
 643         chdir $config{srcdir}
 644             or error("Cannot chdir to $config{srcdir}: $!");
 645
 646         my $child = open(MTNLOG, "-|");
 647         if (! $child) {
 648                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
 649                      "--brief", $file) || error("mtn log $file failed to run");
 650         }
 651
 652         my $firstRev;
 653         while (<MTNLOG>) {
 654                 if (/^($sha1_pattern)/) {
 655                         $firstRev=$1;
 656                 }
 657         }
 658         close MTNLOG || debug("mtn log $file exited $?");
 659
 660         if (! defined $firstRev) {
 661                 debug "failed to parse mtn log for $file";
 662                 return 0;
 663         }
 664
 665         my $automator = Monotone->new();
 666         $automator->open(undef, $config{mtnrootdir});
 667
 668         my $certs = [read_certs($automator, $firstRev)];
 669
 670         $automator->close();
 671
 672         my $date;
 673
 674         foreach my $cert (@$certs) {
 675                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
 676                         if ($cert->{name} eq "date") {
 677                                 $date = $cert->{value};
 678                         }
 679                 }
 680         }
 681
 682         if (! defined $date) {
 683                 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
 684                 return 0;
 685         }
 686
 687         $date=str2time($date, 'UTC');
 688         debug("found ctime ".localtime($date)." for $file");
 689         return $date;
 690 } #}}}
 691
 692 1