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