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