IkiWiki/Rcs/monotone.pm

   1 #!/usr/bin/perl
   2
   3 package IkiWiki;
   4
   5 use warnings;
   6 use strict;
   7 use IkiWiki;
   8 use Monotone;
   9 use Date::Parse qw(str2time);
  10 use Date::Format qw(time2str);
  11
  12 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
  13
  14 sub check_config() { #{{{
  15         if (!defined($config{mtnrootdir})) {
  16                 $config{mtnrootdir} = $config{srcdir};
  17         }
  18         if (! -d "$config{mtnrootdir}/_MTN") {
  19                 error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
  20         }
  21
  22         chdir $config{srcdir}
  23             or error("Cannot chdir to $config{srcdir}: $!");
  24
  25         my $child = open(MTN, "-|");
  26         if (! $child) {
  27                 open STDERR, ">/dev/null";
  28                 exec("mtn", "version") || error("mtn version failed to run");
  29         }
  30
  31         my $version=undef;
  32         while (<MTN>) {
  33                 if (/^monotone (\d+\.\d+) /) {
  34                         $version=$1;
  35                 }
  36         }
  37
  38         close MTN || debug("mtn version exited $?");
  39
  40         if (!defined($version)) {
  41                 error("Cannot determine monotone version");
  42         }
  43         if ($version < 0.38) {
  44                 error("Monotone version too old, is $version but required 0.38");
  45         }
  46 } #}}}
  47
  48 sub get_rev () { #{{{
  49         my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
  50
  51         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
  52         if (! $sha1) {
  53                 debug("Unable to get base revision for '$config{srcdir}'.")
  54         }
  55
  56         return $sha1;
  57 } #}}}
  58
  59 sub get_rev_auto ($) { #{{{
  60         my $automator=shift;
  61
  62         my @results = $automator->call("get_base_revision_id");
  63
  64         my $sha1 = $results[0];
  65         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
  66         if (! $sha1) {
  67                 debug("Unable to get base revision for '$config{srcdir}'.")
  68         }
  69
  70         return $sha1;
  71 } #}}}
  72
  73 sub mtn_merge ($$$$) { #{{{
  74         my $leftRev=shift;
  75         my $rightRev=shift;
  76         my $branch=shift;
  77         my $author=shift;
  78
  79         my $mergeRev;
  80
  81         my $child = open(MTNMERGE, "-|");
  82         if (! $child) {
  83                 open STDERR, ">&STDOUT";
  84                 exec("mtn", "--root=$config{mtnrootdir}",
  85                      "explicit_merge", $leftRev, $rightRev,
  86                      $branch, "--author", $author, "--key",
  87                      $config{mtnkey}) || error("mtn merge failed to run");
  88         }
  89
  90         while (<MTNMERGE>) {
  91                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
  92                         $mergeRev=$1;
  93                 }
  94         }
  95
  96         close MTNMERGE || return undef;
  97
  98         debug("merged $leftRev, $rightRev to make $mergeRev");
  99
 100         return $mergeRev;
 101 } #}}}
 102
 103 sub commit_file_to_new_rev($$$$$$$$) { #{{{
 104         my $automator=shift;
 105         my $wsfilename=shift;
 106         my $oldFileID=shift;
 107         my $newFileContents=shift;
 108         my $oldrev=shift;
 109         my $branch=shift;
 110         my $author=shift;
 111         my $message=shift;
 112
 113         #store the file
 114         my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
 115         my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
 116         error("Failed to store file data for $wsfilename in repository")
 117                 if (! defined $newFileID || length $newFileID != 40);
 118
 119         # get the mtn filename rather than the workspace filename
 120         ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
 121         my ($filename) = ($out =~ m/^file "(.*)"$/);
 122         error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
 123         debug("Converted ws filename of $wsfilename to repos filename of $filename");
 124
 125         # then stick in a new revision for this file
 126         my $manifest = "format_version \"1\"\n\n".
 127                        "new_manifest [0000000000000000000000000000000000000000]\n\n".
 128                        "old_revision [$oldrev]\n\n".
 129                        "patch \"$filename\"\n".
 130                        " from [$oldFileID]\n".
 131                        "   to [$newFileID]\n";
 132         ($out, $err) = $automator->call("put_revision", $manifest);
 133         my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
 134         error("Unable to make new monotone repository revision")
 135                 if (! defined $newRevID || length $newRevID != 40);
 136         debug("put revision: $newRevID");
 137
 138         # now we need to add certs for this revision...
 139         # author, branch, changelog, date
 140         $automator->call("cert", $newRevID, "author", $author);
 141         $automator->call("cert", $newRevID, "branch", $branch);
 142         $automator->call("cert", $newRevID, "changelog", $message);
 143         $automator->call("cert", $newRevID, "date",
 144                 time2str("%Y-%m-%dT%T", time, "UTC"));
 145
 146         debug("Added certs for rev: $newRevID");
 147         return $newRevID;
 148 } #}}}
 149
 150 sub read_certs ($$) { #{{{
 151         my $automator=shift;
 152         my $rev=shift;
 153         my @results = $automator->call("certs", $rev);
 154         my @ret;
 155
 156         my $line = $results[0];
 157         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) {
 158                 push @ret, {
 159                         key => $1,
 160                         signature => $2,
 161                         name => $3,
 162                         value => $4,
 163                         trust => $5,
 164                 };
 165         }
 166
 167         return @ret;
 168 } #}}}
 169
 170 sub get_changed_files ($$) { #{{{
 171         my $automator=shift;
 172         my $rev=shift;
 173
 174         my @results = $automator->call("get_revision", $rev);
 175         my $changes=$results[0];
 176
 177         my @ret;
 178         my %seen = ();
 179
 180         while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
 181                 my $file = $2;
 182                 # don't add the same file multiple times
 183                 if (! $seen{$file}) {
 184                         push @ret, $file;
 185                         $seen{$file} = 1;
 186                 }
 187         }
 188
 189         return @ret;
 190 } #}}}
 191
 192 sub rcs_update () { #{{{
 193         check_config();
 194
 195         if (defined($config{mtnsync}) && $config{mtnsync}) {
 196                 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
 197                            "--quiet", "--ticker=none",
 198                            "--key", $config{mtnkey}) != 0) {
 199                         debug("monotone sync failed before update");
 200                 }
 201         }
 202
 203         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
 204                 debug("monotone update failed");
 205         }
 206 } #}}}
 207
 208 sub rcs_prepedit ($) { #{{{
 209         my $file=shift;
 210
 211         check_config();
 212
 213         # For monotone, return the revision of the file when
 214         # editing begins.
 215         return get_rev();
 216 } #}}}
 217
 218 sub rcs_commit ($$$;$$) { #{{{
 219         # Tries to commit the page; returns undef on _success_ and
 220         # a version of the page with the rcs's conflict markers on failure.
 221         # The file is relative to the srcdir.
 222         my $file=shift;
 223         my $message=shift;
 224         my $rcstoken=shift;
 225         my $user=shift;
 226         my $ipaddr=shift;
 227         my $author;
 228
 229         if (defined $user) {
 230                 $author="Web user: " . $user;
 231         }
 232         elsif (defined $ipaddr) {
 233                 $author="Web IP: " . $ipaddr;
 234         }
 235         else {
 236                 $author="Web: Anonymous";
 237         }
 238
 239         check_config();
 240
 241         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
 242         my $rev = get_rev();
 243         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
 244                 my $automator = Monotone->new();
 245                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
 246
 247                 # Something has been committed, has this file changed?
 248                 my ($out, $err);
 249                 $automator->setOpts("r", $oldrev, "r", $rev);
 250                 ($out, $err) = $automator->call("content_diff", $file);
 251                 debug("Problem committing $file") if ($err ne "");
 252                 my $diff = $out;
 253
 254                 if ($diff) {
 255                         # Commit a revision with just this file changed off
 256                         # the old revision.
 257                         #
 258                         # first get the contents
 259                         debug("File changed: forming branch");
 260                         my $newfile=readfile("$config{srcdir}/$file");
 261
 262                         # then get the old content ID from the diff
 263                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
 264                                 error("Unable to find previous file ID for $file");
 265                         }
 266                         my $oldFileID = $1;
 267
 268                         # get the branch we're working in
 269                         ($out, $err) = $automator->call("get_option", "branch");
 270                         chomp $out;
 271                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
 272                         my $branch = $1;
 273
 274                         # then put the new content into the DB (and record the new content ID)
 275                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
 276
 277                         $automator->close();
 278
 279                         # if we made it to here then the file has been committed... revert the local copy
 280                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
 281                                 debug("Unable to revert $file after merge on conflicted commit!");
 282                         }
 283                         debug("Divergence created! Attempting auto-merge.");
 284
 285                         # see if it will merge cleanly
 286                         $ENV{MTN_MERGE}="fail";
 287                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
 288                         $ENV{MTN_MERGE}="";
 289
 290                         # push any changes so far
 291                         if (defined($config{mtnsync}) && $config{mtnsync}) {
 292                                 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
 293                                         debug("monotone push failed");
 294                                 }
 295                         }
 296
 297                         if (defined($mergeResult)) {
 298                                 # everything is merged - bring outselves up to date
 299                                 if (system("mtn", "--root=$config{mtnrootdir}",
 300                                            "update", "-r", $mergeResult) != 0) {
 301                                         debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
 302                                 }
 303                         }
 304                         else {
 305                                 debug("Auto-merge failed.  Using diff-merge to add conflict markers.");
 306
 307                                 $ENV{MTN_MERGE}="diffutils";
 308                                 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
 309                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
 310                                 $ENV{MTN_MERGE}="";
 311                                 $ENV{MTN_MERGE_DIFFUTILS}="";
 312
 313                                 if (!defined($mergeResult)) {
 314                                         debug("Unable to insert conflict markers!");
 315                                         error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
 316                                                 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
 317                                                 "but at present the different versions cannot be reconciled through the web interface. ".
 318                                                 "Please use the non-web interface to resolve the conflicts.");
 319                                 }
 320
 321                                 if (system("mtn", "--root=$config{mtnrootdir}",
 322                                            "update", "-r", $mergeResult) != 0) {
 323                                         debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
 324                                 }
 325
 326                                 # return "conflict enhanced" file to the user
 327                                 # for cleanup note, this relies on the fact
 328                                 # that ikiwiki seems to call rcs_prepedit()
 329                                 # again after we return
 330                                 return readfile("$config{srcdir}/$file");
 331                         }
 332                         return undef;
 333                 }
 334                 $automator->close();
 335         }
 336
 337         # If we reached here then the file we're looking at hasn't changed
 338         # since $oldrev. Commit it.
 339
 340         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
 341                    "--author", $author, "--key", $config{mtnkey}, "-m",
 342                    possibly_foolish_untaint($message), $file) != 0) {
 343                 debug("Traditional commit failed! Returning data as conflict.");
 344                 my $conflict=readfile("$config{srcdir}/$file");
 345                 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
 346                            "--quiet", $file) != 0) {
 347                         debug("monotone revert failed");
 348                 }
 349                 return $conflict;
 350         }
 351         if (defined($config{mtnsync}) && $config{mtnsync}) {
 352                 if (system("mtn", "--root=$config{mtnrootdir}", "push",
 353                            "--quiet", "--ticker=none", "--key",
 354                            $config{mtnkey}) != 0) {
 355                         debug("monotone push failed");
 356                 }
 357         }
 358
 359         return undef # success
 360 } #}}}
 361
 362 sub rcs_add ($) { #{{{
 363         my $file=shift;
 364
 365         check_config();
 366
 367         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
 368                    $file) != 0) {
 369                 error("Monotone add failed");
 370         }
 371 } #}}}
 372
 373 sub rcs_remove ($) { # {{{
 374         my $file = shift;
 375
 376         error("rcs_remove not implemented for monotone"); # TODO
 377 } #}}}
 378
 379 sub rcs_recentchanges ($) { #{{{
 380         my $num=shift;
 381         my @ret;
 382
 383         check_config();
 384
 385         # use log --brief to get a list of revs, as this
 386         # gives the results in a nice order
 387         # (otherwise we'd have to do our own date sorting)
 388
 389         my @revs;
 390
 391         my $child = open(MTNLOG, "-|");
 392         if (! $child) {
 393                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
 394                      "--brief") || error("mtn log failed to run");
 395         }
 396
 397         while (($num >= 0) and (my $line = <MTNLOG>)) {
 398                 if ($line =~ m/^($sha1_pattern)/) {
 399                         push @revs, $1;
 400                         $num -= 1;
 401                 }
 402         }
 403         close MTNLOG || debug("mtn log exited $?");
 404
 405         my $automator = Monotone->new();
 406         $automator->open(undef, $config{mtnrootdir});
 407
 408         while (@revs != 0) {
 409                 my $rev = shift @revs;
 410                 # first go through and figure out the messages, etc
 411
 412                 my $certs = [read_certs($automator, $rev)];
 413
 414                 my $user;
 415                 my $when;
 416                 my $committype;
 417                 my (@pages, @message);
 418
 419                 foreach my $cert (@$certs) {
 420                         if ($cert->{signature} eq "ok" &&
 421                             $cert->{trust} eq "trusted") {
 422                                 if ($cert->{name} eq "author") {
 423                                         $user = $cert->{value};
 424                                         # detect the source of the commit
 425                                         # from the changelog
 426                                         if ($cert->{key} eq $config{mtnkey}) {
 427                                                 $committype = "web";
 428                                         } else {
 429                                                 $committype = "monotone";
 430                                         }
 431                                 } elsif ($cert->{name} eq "date") {
 432                                         $when = str2time($cert->{value}, 'UTC');
 433                                 } elsif ($cert->{name} eq "changelog") {
 434                                         my $messageText = $cert->{value};
 435                                         # split the changelog into multiple
 436                                         # lines
 437                                         foreach my $msgline (split(/\n/, $messageText)) {
 438                                                 push @message, { line => $msgline };
 439                                         }
 440                                 }
 441                         }
 442                 }
 443
 444                 my @changed_files = get_changed_files($automator, $rev);
 445                 my $file;
 446
 447                 my ($out, $err) = $automator->call("parents", $rev);
 448                 my @parents = ($out =~ m/^($sha1_pattern)$/);
 449                 my $parent = $parents[0];
 450
 451                 foreach $file (@changed_files) {
 452                         next unless length $file;
 453
 454                         if (defined $config{diffurl} and (@parents == 1)) {
 455                                 my $diffurl=$config{diffurl};
 456                                 $diffurl=~s/\[\[r1\]\]/$parent/g;
 457                                 $diffurl=~s/\[\[r2\]\]/$rev/g;
 458                                 $diffurl=~s/\[\[file\]\]/$file/g;
 459                                 push @pages, {
 460                                         page => pagename($file),
 461                                         diffurl => $diffurl,
 462                                 };
 463                         }
 464                         else {
 465                                 push @pages, {
 466                                         page => pagename($file),
 467                                 }
 468                         }
 469                 }
 470
 471                 push @ret, {
 472                         rev => $rev,
 473                         user => $user,
 474                         committype => $committype,
 475                         when => $when,
 476                         message => [@message],
 477                         pages => [@pages],
 478                 } if @pages;
 479         }
 480
 481         $automator->close();
 482
 483         return @ret;
 484 } #}}}
 485
 486 sub rcs_diff ($) { #{{{
 487         # TODO
 488 } #}}}
 489
 490 sub rcs_getctime ($) { #{{{
 491         my $file=shift;
 492
 493         check_config();
 494
 495         my $child = open(MTNLOG, "-|");
 496         if (! $child) {
 497                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
 498                      "--brief", $file) || error("mtn log $file failed to run");
 499         }
 500
 501         my $firstRev;
 502         while (<MTNLOG>) {
 503                 if (/^($sha1_pattern)/) {
 504                         $firstRev=$1;
 505                 }
 506         }
 507         close MTNLOG || debug("mtn log $file exited $?");
 508
 509         if (! defined $firstRev) {
 510                 debug "failed to parse mtn log for $file";
 511                 return 0;
 512         }
 513
 514         my $automator = Monotone->new();
 515         $automator->open(undef, $config{mtnrootdir});
 516
 517         my $certs = [read_certs($automator, $firstRev)];
 518
 519         $automator->close();
 520
 521         my $date;
 522
 523         foreach my $cert (@$certs) {
 524                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
 525                         if ($cert->{name} eq "date") {
 526                                 $date = $cert->{value};
 527                         }
 528                 }
 529         }
 530
 531         if (! defined $date) {
 532                 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
 533                 return 0;
 534         }
 535
 536         $date=str2time($date, 'UTC');
 537         debug("found ctime ".localtime($date)." for $file");
 538         return $date;
 539 } #}}}
 540
 541 1