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