2 package IkiWiki::Plugin::monotone;
8 use Date::Parse qw(str2time);
9 use Date::Format qw(time2str);
11 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
14 hook(type => "checkconfig", id => "monotone", call => \&checkconfig);
15 hook(type => "getsetup", id => "monotone", call => \&getsetup);
16 hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
17 hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
18 hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
19 hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
20 hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
21 hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
22 hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
23 hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
24 hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
25 hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
26 hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime);
30 if (!defined($config{mtnrootdir})) {
31 $config{mtnrootdir} = $config{srcdir};
33 if (! -d "$config{mtnrootdir}/_MTN") {
34 error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
37 my $child = open(MTN, "-|");
39 open STDERR, ">/dev/null";
40 exec("mtn", "version") || error("mtn version failed to run");
45 if (/^monotone (\d+\.\d+) /) {
50 close MTN || debug("mtn version exited $?");
52 if (!defined($version)) {
53 error("Cannot determine monotone version");
55 if ($version < 0.38) {
56 error("Monotone version too old, is $version but required 0.38");
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"),
70 safe => 0, # rcs plugin
76 example => "/srv/mtn/wiki/_MTN/ikiwiki-netsync-hook",
77 description => "monotone netsync hook to generate",
84 description => "mode for mtn_wrapper (can safely be made suid)",
90 example => 'web@example.com',
91 description => "your monotone key",
97 example => "http://viewmtn.example.com/branch/head/filechanges/com.example.branch/[[file]]",
98 description => "viewmtn url to show file history ([[file]] substituted)",
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)",
112 description => "sync on update and commit?",
113 safe => 0, # paranoia
118 description => "path to your workspace (defaults to the srcdir; specify if the srcdir is a subdirectory of the workspace)",
125 my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
127 ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
129 debug("Unable to get base revision for '$config{srcdir}'.")
135 sub get_rev_auto ($) {
138 my @results = $automator->call("get_base_revision_id");
140 my $sha1 = $results[0];
141 ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
143 debug("Unable to get base revision for '$config{srcdir}'.")
149 sub mtn_merge ($$$$) {
157 my $child = open(MTNMERGE, "-|");
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");
167 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
172 close MTNMERGE || return undef;
174 debug("merged $leftRev, $rightRev to make $mergeRev");
179 sub commit_file_to_new_rev ($$$$$$$$) {
181 my $wsfilename=shift;
183 my $newFileContents=shift;
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);
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");
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");
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"));
222 debug("Added certs for rev: $newRevID");
226 sub read_certs ($$) {
229 my @results = $automator->call("certs", $rev);
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) {
246 sub get_changed_files ($$) {
250 my @results = $automator->call("get_revision", $rev);
251 my $changes=$results[0];
256 while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
258 # don't add the same file multiple times
259 if (! $seen{$file}) {
269 chdir $config{srcdir}
270 or error("Cannot chdir to $config{srcdir}: $!");
272 if (defined($config{mtnsync}) && $config{mtnsync}) {
273 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
274 "--quiet", "--ticker=none",
275 "--key", $config{mtnkey}) != 0) {
276 debug("monotone sync failed before update");
280 if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
281 debug("monotone update failed");
285 sub rcs_prepedit ($) {
288 chdir $config{srcdir}
289 or error("Cannot chdir to $config{srcdir}: $!");
291 # For monotone, return the revision of the file when
296 sub commitauthor (@) {
299 if (defined $params{session}) {
300 if (defined $params{session}->param("name")) {
301 return "Web user: " . $params{session}->param("name");
303 elsif (defined $params{session}->remote_addr()) {
304 return "Web IP: " . $params{session}->remote_addr();
307 return "Web: Anonymous";
312 # Tries to commit the page; returns undef on _success_ and
313 # a version of the page with the rcs's conflict markers on failure.
314 # The file is relative to the srcdir.
317 my $author=IkiWiki::possibly_foolish_untaint(commitauthor(%params)),
319 chdir $config{srcdir}
320 or error("Cannot chdir to $config{srcdir}: $!");
322 my ($oldrev) = $params{token} =~ m/^($sha1_pattern)$/; # untaint
324 if (defined $rev && defined $oldrev && $rev ne $oldrev) {
325 my $automator = Monotone->new();
326 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
328 # Something has been committed, has this file changed?
330 $automator->setOpts("r", $oldrev, "r", $rev);
331 ($out, $err) = $automator->call("content_diff", $params{file});
332 debug("Problem committing $params{file}") if ($err ne "");
336 # Commit a revision with just this file changed off
339 # first get the contents
340 debug("File changed: forming branch");
341 my $newfile=readfile("$config{srcdir}/$params{file}");
343 # then get the old content ID from the diff
344 if ($diff !~ m/^---\s$params{file}\s+($sha1_pattern)$/m) {
345 error("Unable to find previous file ID for $params{file}");
349 # get the branch we're working in
350 ($out, $err) = $automator->call("get_option", "branch");
352 error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
355 # then put the new content into the DB (and record the new content ID)
356 my $newRevID = commit_file_to_new_rev($automator, $params{file}, $oldFileID, $newfile, $oldrev, $branch, $author, $params{message});
360 # if we made it to here then the file has been committed... revert the local copy
361 if (system("mtn", "--root=$config{mtnrootdir}", "revert", $params{file}) != 0) {
362 debug("Unable to revert $params{file} after merge on conflicted commit!");
364 debug("Divergence created! Attempting auto-merge.");
366 # see if it will merge cleanly
367 $ENV{MTN_MERGE}="fail";
368 my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
371 # push any changes so far
372 if (defined($config{mtnsync}) && $config{mtnsync}) {
373 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
374 debug("monotone push failed");
378 if (defined($mergeResult)) {
379 # everything is merged - bring outselves up to date
380 if (system("mtn", "--root=$config{mtnrootdir}",
381 "update", "-r", $mergeResult) != 0) {
382 debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
386 debug("Auto-merge failed. Using diff-merge to add conflict markers.");
388 $ENV{MTN_MERGE}="diffutils";
389 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
390 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
392 $ENV{MTN_MERGE_DIFFUTILS}="";
394 if (!defined($mergeResult)) {
395 debug("Unable to insert conflict markers!");
396 error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
397 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
398 "but at present the different versions cannot be reconciled through the web interface. ".
399 "Please use the non-web interface to resolve the conflicts.");
402 if (system("mtn", "--root=$config{mtnrootdir}",
403 "update", "-r", $mergeResult) != 0) {
404 debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
407 # return "conflict enhanced" file to the user
408 # for cleanup note, this relies on the fact
409 # that ikiwiki seems to call rcs_prepedit()
410 # again after we return
411 return readfile("$config{srcdir}/$params{file}");
418 # If we reached here then the file we're looking at hasn't changed
419 # since $oldrev. Commit it.
421 if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
422 "--author", $author, "--key", $config{mtnkey}, "-m",
423 IkiWiki::possibly_foolish_untaint($params{message}),
424 $params{file}) != 0) {
425 debug("Traditional commit failed! Returning data as conflict.");
426 my $conflict=readfile("$config{srcdir}/$params{file}");
427 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
428 "--quiet", $params{file}) != 0) {
429 debug("monotone revert failed");
433 if (defined($config{mtnsync}) && $config{mtnsync}) {
434 if (system("mtn", "--root=$config{mtnrootdir}", "push",
435 "--quiet", "--ticker=none", "--key",
436 $config{mtnkey}) != 0) {
437 debug("monotone push failed");
441 return undef # success
444 sub rcs_commit_staged (@) {
445 # Commits all staged changes. Changes can be staged using rcs_add,
446 # rcs_remove, and rcs_rename.
449 # Note - this will also commit any spurious changes that happen to be
450 # lying around in the working copy. There shouldn't be any, but...
452 chdir $config{srcdir}
453 or error("Cannot chdir to $config{srcdir}: $!");
455 if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
456 "--author", IkiWiki::possibly_foolish_untaint(commitauthor(%params)),
457 "--key", $config{mtnkey}, "-m",
458 IkiWiki::possibly_foolish_untaint($params{message})) != 0) {
459 error("Monotone commit failed");
466 chdir $config{srcdir}
467 or error("Cannot chdir to $config{srcdir}: $!");
469 if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
471 error("Monotone add failed");
478 chdir $config{srcdir}
479 or error("Cannot chdir to $config{srcdir}: $!");
481 # Note: it is difficult to undo a remove in Monotone at the moment.
482 # Until this is fixed, it might be better to make 'rm' move things
483 # into an attic, rather than actually remove them.
484 # To resurrect a file, you currently add a new file with the contents
485 # you want it to have. This loses all connectivity and automated
486 # merging with the 'pre-delete' versions of the file.
488 if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
490 error("Monotone remove failed");
494 sub rcs_rename ($$) {
495 my ($src, $dest) = @_;
497 chdir $config{srcdir}
498 or error("Cannot chdir to $config{srcdir}: $!");
500 if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
502 error("Monotone rename failed");
506 sub rcs_recentchanges ($) {
510 chdir $config{srcdir}
511 or error("Cannot chdir to $config{srcdir}: $!");
513 # use log --brief to get a list of revs, as this
514 # gives the results in a nice order
515 # (otherwise we'd have to do our own date sorting)
519 my $child = open(MTNLOG, "-|");
521 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
522 "--brief", "--last=$num") || error("mtn log failed to run");
525 while (my $line = <MTNLOG>) {
526 if ($line =~ m/^($sha1_pattern)/) {
530 close MTNLOG || debug("mtn log exited $?");
532 my $automator = Monotone->new();
533 $automator->open(undef, $config{mtnrootdir});
536 my $rev = shift @revs;
537 # first go through and figure out the messages, etc
539 my $certs = [read_certs($automator, $rev)];
544 my (@pages, @message);
546 foreach my $cert (@$certs) {
547 if ($cert->{signature} eq "ok" &&
548 $cert->{trust} eq "trusted") {
549 if ($cert->{name} eq "author") {
550 $user = $cert->{value};
551 # detect the source of the commit
553 if ($cert->{key} eq $config{mtnkey}) {
559 } elsif ($cert->{name} eq "date") {
560 $when = str2time($cert->{value}, 'UTC');
561 } elsif ($cert->{name} eq "changelog") {
562 my $messageText = $cert->{value};
563 # split the changelog into multiple
565 foreach my $msgline (split(/\n/, $messageText)) {
566 push @message, { line => $msgline };
572 my @changed_files = get_changed_files($automator, $rev);
574 my ($out, $err) = $automator->call("parents", $rev);
575 my @parents = ($out =~ m/^($sha1_pattern)$/);
576 my $parent = $parents[0];
578 foreach my $file (@changed_files) {
579 next unless length $file;
581 if (defined $config{diffurl} and (@parents == 1)) {
582 my $diffurl=$config{diffurl};
583 $diffurl=~s/\[\[r1\]\]/$parent/g;
584 $diffurl=~s/\[\[r2\]\]/$rev/g;
585 $diffurl=~s/\[\[file\]\]/$file/g;
587 page => pagename($file),
593 page => pagename($file),
601 committype => $committype,
603 message => [@message],
615 my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
617 chdir $config{srcdir}
618 or error("Cannot chdir to $config{srcdir}: $!");
620 my $child = open(MTNDIFF, "-|");
622 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
625 my (@lines) = <MTNDIFF>;
627 close MTNDIFF || debug("mtn diff $sha1 exited $?");
633 return join("", @lines);
637 sub rcs_getctime ($) {
640 chdir $config{srcdir}
641 or error("Cannot chdir to $config{srcdir}: $!");
643 my $child = open(MTNLOG, "-|");
645 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
646 "--brief", $file) || error("mtn log $file failed to run");
651 if (/^($sha1_pattern)/) {
655 close MTNLOG || debug("mtn log $file exited $?");
657 if (! defined $firstRev) {
658 debug "failed to parse mtn log for $file";
662 my $automator = Monotone->new();
663 $automator->open(undef, $config{mtnrootdir});
665 my $certs = [read_certs($automator, $firstRev)];
671 foreach my $cert (@$certs) {
672 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
673 if ($cert->{name} eq "date") {
674 $date = $cert->{value};
679 if (! defined $date) {
680 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
684 $date=str2time($date, 'UTC');
685 debug("found ctime ".localtime($date)." for $file");
689 sub rcs_getmtime ($) {
690 error "rcs_getmtime is not implemented for monotone\n"; # TODO