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