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         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 $author;
 306
 307         if (defined $user) {
 308                 $author="Web user: " . $user;
 309         }
 310         elsif (defined $ipaddr) {
 311                 $author="Web IP: " . $ipaddr;
 312         }
 313         else {
 314                 $author="Web: Anonymous";
 315         }
 316
 317         chdir $config{srcdir}
 318             or error("Cannot chdir to $config{srcdir}: $!");
 319
 320         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
 321         my $rev = get_rev();
 322         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
 323                 my $automator = Monotone->new();
 324                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
 325
 326                 # Something has been committed, has this file changed?
 327                 my ($out, $err);
 328                 $automator->setOpts("r", $oldrev, "r", $rev);
 329                 ($out, $err) = $automator->call("content_diff", $file);
 330                 debug("Problem committing $file") if ($err ne "");
 331                 my $diff = $out;
 332
 333                 if ($diff) {
 334                         # Commit a revision with just this file changed off
 335                         # the old revision.
 336                         #
 337                         # first get the contents
 338                         debug("File changed: forming branch");
 339                         my $newfile=readfile("$config{srcdir}/$file");
 340
 341                         # then get the old content ID from the diff
 342                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
 343                                 error("Unable to find previous file ID for $file");
 344                         }
 345                         my $oldFileID = $1;
 346
 347                         # get the branch we're working in
 348                         ($out, $err) = $automator->call("get_option", "branch");
 349                         chomp $out;
 350                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
 351                         my $branch = $1;
 352
 353                         # then put the new content into the DB (and record the new content ID)
 354                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
 355
 356                         $automator->close();
 357
 358                         # if we made it to here then the file has been committed... revert the local copy
 359                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
 360                                 debug("Unable to revert $file after merge on conflicted commit!");
 361                         }
 362                         debug("Divergence created! Attempting auto-merge.");
 363
 364                         # see if it will merge cleanly
 365                         $ENV{MTN_MERGE}="fail";
 366                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
 367                         $ENV{MTN_MERGE}="";
 368
 369                         # push any changes so far
 370                         if (defined($config{mtnsync}) && $config{mtnsync}) {
 371                                 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
 372                                         debug("monotone push failed");
 373                                 }
 374                         }
 375
 376                         if (defined($mergeResult)) {
 377                                 # everything is merged - bring outselves up to date
 378                                 if (system("mtn", "--root=$config{mtnrootdir}",
 379                                            "update", "-r", $mergeResult) != 0) {
 380                                         debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
 381                                 }
 382                         }
 383                         else {
 384                                 debug("Auto-merge failed.  Using diff-merge to add conflict markers.");
 385
 386                                 $ENV{MTN_MERGE}="diffutils";
 387                                 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
 388                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
 389                                 $ENV{MTN_MERGE}="";
 390                                 $ENV{MTN_MERGE_DIFFUTILS}="";
 391
 392                                 if (!defined($mergeResult)) {
 393                                         debug("Unable to insert conflict markers!");
 394                                         error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
 395                                                 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
 396                                                 "but at present the different versions cannot be reconciled through the web interface. ".
 397                                                 "Please use the non-web interface to resolve the conflicts.");
 398                                 }
 399
 400                                 if (system("mtn", "--root=$config{mtnrootdir}",
 401                                            "update", "-r", $mergeResult) != 0) {
 402                                         debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
 403                                 }
 404
 405                                 # return "conflict enhanced" file to the user
 406                                 # for cleanup note, this relies on the fact
 407                                 # that ikiwiki seems to call rcs_prepedit()
 408                                 # again after we return
 409                                 return readfile("$config{srcdir}/$file");
 410                         }
 411                         return undef;
 412                 }
 413                 $automator->close();
 414         }
 415
 416         # If we reached here then the file we're looking at hasn't changed
 417         # since $oldrev. Commit it.
 418
 419         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
 420                    "--author", $author, "--key", $config{mtnkey}, "-m",
 421                    IkiWiki::possibly_foolish_untaint($message), $file) != 0) {
 422                 debug("Traditional commit failed! Returning data as conflict.");
 423                 my $conflict=readfile("$config{srcdir}/$file");
 424                 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
 425                            "--quiet", $file) != 0) {
 426                         debug("monotone revert failed");
 427                 }
 428                 return $conflict;
 429         }
 430         if (defined($config{mtnsync}) && $config{mtnsync}) {
 431                 if (system("mtn", "--root=$config{mtnrootdir}", "push",
 432                            "--quiet", "--ticker=none", "--key",
 433                            $config{mtnkey}) != 0) {
 434                         debug("monotone push failed");
 435                 }
 436         }
 437
 438         return undef # success
 439 }
 440
 441 sub rcs_commit_staged ($$$) {
 442         # Commits all staged changes. Changes can be staged using rcs_add,
 443         # rcs_remove, and rcs_rename.
 444         my ($message, $user, $ipaddr)=@_;
 445
 446         # Note - this will also commit any spurious changes that happen to be
 447         # lying around in the working copy.  There shouldn't be any, but...
 448
 449         chdir $config{srcdir}
 450             or error("Cannot chdir to $config{srcdir}: $!");
 451
 452         my $author;
 453
 454         if (defined $user) {
 455                 $author="Web user: " . $user;
 456         }
 457         elsif (defined $ipaddr) {
 458                 $author="Web IP: " . $ipaddr;
 459         }
 460         else {
 461                 $author="Web: Anonymous";
 462         }
 463
 464         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
 465                    "--author", $author, "--key", $config{mtnkey}, "-m",
 466                    IkiWiki::possibly_foolish_untaint($message)) != 0) {
 467                 error("Monotone commit failed");
 468         }
 469 }
 470
 471 sub rcs_add ($) {
 472         my $file=shift;
 473
 474         chdir $config{srcdir}
 475             or error("Cannot chdir to $config{srcdir}: $!");
 476
 477         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
 478                    $file) != 0) {
 479                 error("Monotone add failed");
 480         }
 481 }
 482
 483 sub rcs_remove ($) {
 484         my $file = shift;
 485
 486         chdir $config{srcdir}
 487             or error("Cannot chdir to $config{srcdir}: $!");
 488
 489         # Note: it is difficult to undo a remove in Monotone at the moment.
 490         # Until this is fixed, it might be better to make 'rm' move things
 491         # into an attic, rather than actually remove them.
 492         # To resurrect a file, you currently add a new file with the contents
 493         # you want it to have.  This loses all connectivity and automated
 494         # merging with the 'pre-delete' versions of the file.
 495
 496         if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
 497                    $file) != 0) {
 498                 error("Monotone remove failed");
 499         }
 500 }
 501
 502 sub rcs_rename ($$) {
 503         my ($src, $dest) = @_;
 504
 505         chdir $config{srcdir}
 506             or error("Cannot chdir to $config{srcdir}: $!");
 507
 508         if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
 509                    $src, $dest) != 0) {
 510                 error("Monotone rename failed");
 511         }
 512 }
 513
 514 sub rcs_recentchanges ($) {
 515         my $num=shift;
 516         my @ret;
 517
 518         chdir $config{srcdir}
 519             or error("Cannot chdir to $config{srcdir}: $!");
 520
 521         # use log --brief to get a list of revs, as this
 522         # gives the results in a nice order
 523         # (otherwise we'd have to do our own date sorting)
 524
 525         my @revs;
 526
 527         my $child = open(MTNLOG, "-|");
 528         if (! $child) {
 529                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
 530                      "--brief", "--last=$num") || error("mtn log failed to run");
 531         }
 532
 533         while (my $line = <MTNLOG>) {
 534                 if ($line =~ m/^($sha1_pattern)/) {
 535                         push @revs, $1;
 536                 }
 537         }
 538         close MTNLOG || debug("mtn log exited $?");
 539
 540         my $automator = Monotone->new();
 541         $automator->open(undef, $config{mtnrootdir});
 542
 543         while (@revs != 0) {
 544                 my $rev = shift @revs;
 545                 # first go through and figure out the messages, etc
 546
 547                 my $certs = [read_certs($automator, $rev)];
 548
 549                 my $user;
 550                 my $when;
 551                 my $committype;
 552                 my (@pages, @message);
 553
 554                 foreach my $cert (@$certs) {
 555                         if ($cert->{signature} eq "ok" &&
 556                             $cert->{trust} eq "trusted") {
 557                                 if ($cert->{name} eq "author") {
 558                                         $user = $cert->{value};
 559                                         # detect the source of the commit
 560                                         # from the changelog
 561                                         if ($cert->{key} eq $config{mtnkey}) {
 562                                                 $committype = "web";
 563                                         }
 564                                         else {
 565                                                 $committype = "mtn";
 566                                         }
 567                                 } elsif ($cert->{name} eq "date") {
 568                                         $when = str2time($cert->{value}, 'UTC');
 569                                 } elsif ($cert->{name} eq "changelog") {
 570                                         my $messageText = $cert->{value};
 571                                         # split the changelog into multiple
 572                                         # lines
 573                                         foreach my $msgline (split(/\n/, $messageText)) {
 574                                                 push @message, { line => $msgline };
 575                                         }
 576                                 }
 577                         }
 578                 }
 579
 580                 my @changed_files = get_changed_files($automator, $rev);
 581
 582                 my ($out, $err) = $automator->call("parents", $rev);
 583                 my @parents = ($out =~ m/^($sha1_pattern)$/);
 584                 my $parent = $parents[0];
 585
 586                 foreach my $file (@changed_files) {
 587                         next unless length $file;
 588
 589                         if (defined $config{diffurl} and (@parents == 1)) {
 590                                 my $diffurl=$config{diffurl};
 591                                 $diffurl=~s/\[\[r1\]\]/$parent/g;
 592                                 $diffurl=~s/\[\[r2\]\]/$rev/g;
 593                                 $diffurl=~s/\[\[file\]\]/$file/g;
 594                                 push @pages, {
 595                                         page => pagename($file),
 596                                         diffurl => $diffurl,
 597                                 };
 598                         }
 599                         else {
 600                                 push @pages, {
 601                                         page => pagename($file),
 602                                 }
 603                         }
 604                 }
 605
 606                 push @ret, {
 607                         rev => $rev,
 608                         user => $user,
 609                         committype => $committype,
 610                         when => $when,
 611                         message => [@message],
 612                         pages => [@pages],
 613                 } if @pages;
 614         }
 615
 616         $automator->close();
 617
 618         return @ret;
 619 }
 620
 621 sub rcs_diff ($) {
 622         my $rev=shift;
 623         my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
 624
 625         chdir $config{srcdir}
 626             or error("Cannot chdir to $config{srcdir}: $!");
 627
 628         my $child = open(MTNDIFF, "-|");
 629         if (! $child) {
 630                 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
 631         }
 632
 633         my (@lines) = <MTNDIFF>;
 634
 635         close MTNDIFF || debug("mtn diff $sha1 exited $?");
 636
 637         if (wantarray) {
 638                 return @lines;
 639         }
 640         else {
 641                 return join("", @lines);
 642         }
 643 }
 644
 645 sub rcs_getctime ($) {
 646         my $file=shift;
 647
 648         chdir $config{srcdir}
 649             or error("Cannot chdir to $config{srcdir}: $!");
 650
 651         my $child = open(MTNLOG, "-|");
 652         if (! $child) {
 653                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
 654                      "--brief", $file) || error("mtn log $file failed to run");
 655         }
 656
 657         my $firstRev;
 658         while (<MTNLOG>) {
 659                 if (/^($sha1_pattern)/) {
 660                         $firstRev=$1;
 661                 }
 662         }
 663         close MTNLOG || debug("mtn log $file exited $?");
 664
 665         if (! defined $firstRev) {
 666                 debug "failed to parse mtn log for $file";
 667                 return 0;
 668         }
 669
 670         my $automator = Monotone->new();
 671         $automator->open(undef, $config{mtnrootdir});
 672
 673         my $certs = [read_certs($automator, $firstRev)];
 674
 675         $automator->close();
 676
 677         my $date;
 678
 679         foreach my $cert (@$certs) {
 680                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
 681                         if ($cert->{name} eq "date") {
 682                                 $date = $cert->{value};
 683                         }
 684                 }
 685         }
 686
 687         if (! defined $date) {
 688                 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
 689                 return 0;
 690         }
 691
 692         $date=str2time($date, 'UTC');
 693         debug("found ctime ".localtime($date)." for $file");
 694         return $date;
 695 }
 696
 697 sub rcs_getmtime ($) {
 698         error "rcs_getmtime is not implemented for monotone\n"; # TODO
 699 }
 700
 701 1