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+)(?:(?:\.\d+){0,2}|dev)? /) {
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 # 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;
263 while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
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//;
269 # don't add the same file multiple times
270 if (! $seen{$file}) {
280 chdir $config{srcdir}
281 or error("Cannot chdir to $config{srcdir}: $!");
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");
291 if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
292 debug("monotone update failed");
296 sub rcs_prepedit ($) {
299 chdir $config{srcdir}
300 or error("Cannot chdir to $config{srcdir}: $!");
302 # For monotone, return the revision of the file when
307 sub commitauthor (@) {
310 if (defined $params{session}) {
311 if (defined $params{session}->param("name")) {
312 return "Web user: " . $params{session}->param("name");
314 elsif (defined $params{session}->remote_addr()) {
315 return "Web IP: " . $params{session}->remote_addr();
318 return "Web: Anonymous";
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.
328 my $author=IkiWiki::possibly_foolish_untaint(commitauthor(%params)),
330 chdir $config{srcdir}
331 or error("Cannot chdir to $config{srcdir}: $!");
333 my ($oldrev) = $params{token} =~ m/^($sha1_pattern)$/; # untaint
335 if (defined $rev && defined $oldrev && $rev ne $oldrev) {
336 my $automator = Monotone->new();
337 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
339 # Something has been committed, has this file changed?
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 "");
347 # Commit a revision with just this file changed off
350 # first get the contents
351 debug("File changed: forming branch");
352 my $newfile=readfile("$config{srcdir}/$params{file}");
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}");
360 # get the branch we're working in
361 ($out, $err) = $automator->call("get_option", "branch");
363 error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
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});
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!");
375 debug("Divergence created! Attempting auto-merge.");
377 # see if it will merge cleanly
378 $ENV{MTN_MERGE}="fail";
379 my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
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");
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!");
397 debug("Auto-merge failed. Using diff-merge to add conflict markers.");
399 $ENV{MTN_MERGE}="diffutils";
400 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
401 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
403 $ENV{MTN_MERGE_DIFFUTILS}="";
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.");
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!");
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}");
429 # If we reached here then the file we're looking at hasn't changed
430 # since $oldrev. Commit it.
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");
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");
452 return undef # success
455 sub rcs_commit_staged (@) {
456 # Commits all staged changes. Changes can be staged using rcs_add,
457 # rcs_remove, and rcs_rename.
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...
463 chdir $config{srcdir}
464 or error("Cannot chdir to $config{srcdir}: $!");
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");
477 chdir $config{srcdir}
478 or error("Cannot chdir to $config{srcdir}: $!");
480 if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
482 error("Monotone add failed");
489 chdir $config{srcdir}
490 or error("Cannot chdir to $config{srcdir}: $!");
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.
499 if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
501 error("Monotone remove failed");
505 sub rcs_rename ($$) {
506 my ($src, $dest) = @_;
508 chdir $config{srcdir}
509 or error("Cannot chdir to $config{srcdir}: $!");
511 if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
513 error("Monotone rename failed");
517 sub rcs_recentchanges ($) {
521 chdir $config{srcdir}
522 or error("Cannot chdir to $config{srcdir}: $!");
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)
530 my $child = open(MTNLOG, "-|");
532 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
533 "--brief", "--last=$num") || error("mtn log failed to run");
536 while (my $line = <MTNLOG>) {
537 if ($line =~ m/^($sha1_pattern)/) {
541 close MTNLOG || debug("mtn log exited $?");
543 my $automator = Monotone->new();
544 $automator->open(undef, $config{mtnrootdir});
547 my $rev = shift @revs;
548 # first go through and figure out the messages, etc
550 my $certs = [read_certs($automator, $rev)];
555 my (@pages, @message);
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
564 if ($cert->{key} eq $config{mtnkey}) {
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
576 foreach my $msgline (split(/\n/, $messageText)) {
577 push @message, { line => $msgline };
583 my @changed_files = get_changed_files($automator, $rev);
585 my ($out, $err) = $automator->call("parents", $rev);
586 my @parents = ($out =~ m/^($sha1_pattern)$/);
587 my $parent = $parents[0];
589 foreach my $file (@changed_files) {
590 next unless length $file;
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;
598 page => pagename($file),
604 page => pagename($file),
612 committype => $committype,
614 message => [@message],
626 my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
628 chdir $config{srcdir}
629 or error("Cannot chdir to $config{srcdir}: $!");
631 my $child = open(MTNDIFF, "-|");
633 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
636 my (@lines) = <MTNDIFF>;
638 close MTNDIFF || debug("mtn diff $sha1 exited $?");
644 return join("", @lines);
648 sub rcs_getctime ($) {
651 chdir $config{srcdir}
652 or error("Cannot chdir to $config{srcdir}: $!");
654 my $child = open(MTNLOG, "-|");
656 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
657 "--brief", $file) || error("mtn log $file failed to run");
662 if (/^($sha1_pattern)/) {
666 close MTNLOG || debug("mtn log $file exited $?");
668 if (! defined $firstRev) {
669 debug "failed to parse mtn log for $file";
673 my $automator = Monotone->new();
674 $automator->open(undef, $config{mtnrootdir});
676 my $certs = [read_certs($automator, $firstRev)];
682 foreach my $cert (@$certs) {
683 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
684 if ($cert->{name} eq "date") {
685 $date = $cert->{value};
690 if (! defined $date) {
691 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
695 $date=str2time($date, 'UTC');
696 debug("found ctime ".localtime($date)." for $file");
700 sub rcs_getmtime ($) {
701 error "rcs_getmtime is not implemented for monotone\n"; # TODO