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