9 use Date::Parse qw(str2time);
10 use Date::Format qw(time2str);
12 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
14 hook(type => "checkconfig", id => "monotone", call => sub { #{{{
15 if (!defined($config{mtnrootdir})) {
16 $config{mtnrootdir} = $config{srcdir};
18 if (! -d "$config{mtnrootdir}/_MTN") {
19 error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
22 my $child = open(MTN, "-|");
24 open STDERR, ">/dev/null";
25 exec("mtn", "version") || error("mtn version failed to run");
30 if (/^monotone (\d+\.\d+) /) {
35 close MTN || debug("mtn version exited $?");
37 if (!defined($version)) {
38 error("Cannot determine monotone version");
40 if ($version < 0.38) {
41 error("Monotone version too old, is $version but required 0.38");
44 if (exists $config{mtn_wrapper}) {
45 push @{$config{wrappers}}, {
46 wrapper => $config{mtn_wrapper},
47 wrappermode => (defined $config{mtn_wrappermode} ? $config{mtn_wrappermode} : "06755"),
52 hook(type => "getsetup", id => "monotone", call => sub { #{{{
56 example => "/srv/mtn/wiki/_MTN/ikiwiki-netsync-hook",
57 description => "monotone netsync hook executable to generate",
64 description => "mode for mtn_wrapper (can safely be made suid)",
70 example => 'web@example.com',
71 description => "your monotone key",
77 example => "http://viewmtn.example.com/branch/head/filechanges/com.example.branch/[[file]]",
78 description => "viewmtn url to show file history ([[file]] substituted)",
84 example => "http://viewmtn.example.com/revision/diff/[[r1]]/with/[[r2]]/[[file]]",
85 description => "viewmtn url to show a diff ([[r1]], [[r2]], and [[file]] substituted)",
92 description => "sync on update and commit?",
98 description => "path to your workspace (defaults to the srcdir; specify if the srcdir is a subdirectory of the workspace)",
104 sub get_rev () { #{{{
105 my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
107 ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
109 debug("Unable to get base revision for '$config{srcdir}'.")
115 sub get_rev_auto ($) { #{{{
118 my @results = $automator->call("get_base_revision_id");
120 my $sha1 = $results[0];
121 ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
123 debug("Unable to get base revision for '$config{srcdir}'.")
129 sub mtn_merge ($$$$) { #{{{
137 my $child = open(MTNMERGE, "-|");
139 open STDERR, ">&STDOUT";
140 exec("mtn", "--root=$config{mtnrootdir}",
141 "explicit_merge", $leftRev, $rightRev,
142 $branch, "--author", $author, "--key",
143 $config{mtnkey}) || error("mtn merge failed to run");
147 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
152 close MTNMERGE || return undef;
154 debug("merged $leftRev, $rightRev to make $mergeRev");
159 sub commit_file_to_new_rev($$$$$$$$) { #{{{
161 my $wsfilename=shift;
163 my $newFileContents=shift;
170 my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
171 my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
172 error("Failed to store file data for $wsfilename in repository")
173 if (! defined $newFileID || length $newFileID != 40);
175 # get the mtn filename rather than the workspace filename
176 ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
177 my ($filename) = ($out =~ m/^file "(.*)"$/);
178 error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
179 debug("Converted ws filename of $wsfilename to repos filename of $filename");
181 # then stick in a new revision for this file
182 my $manifest = "format_version \"1\"\n\n".
183 "new_manifest [0000000000000000000000000000000000000000]\n\n".
184 "old_revision [$oldrev]\n\n".
185 "patch \"$filename\"\n".
186 " from [$oldFileID]\n".
187 " to [$newFileID]\n";
188 ($out, $err) = $automator->call("put_revision", $manifest);
189 my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
190 error("Unable to make new monotone repository revision")
191 if (! defined $newRevID || length $newRevID != 40);
192 debug("put revision: $newRevID");
194 # now we need to add certs for this revision...
195 # author, branch, changelog, date
196 $automator->call("cert", $newRevID, "author", $author);
197 $automator->call("cert", $newRevID, "branch", $branch);
198 $automator->call("cert", $newRevID, "changelog", $message);
199 $automator->call("cert", $newRevID, "date",
200 time2str("%Y-%m-%dT%T", time, "UTC"));
202 debug("Added certs for rev: $newRevID");
206 sub read_certs ($$) { #{{{
209 my @results = $automator->call("certs", $rev);
212 my $line = $results[0];
213 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) {
226 sub get_changed_files ($$) { #{{{
230 my @results = $automator->call("get_revision", $rev);
231 my $changes=$results[0];
236 while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
238 # don't add the same file multiple times
239 if (! $seen{$file}) {
248 sub rcs_update () { #{{{
249 chdir $config{srcdir}
250 or error("Cannot chdir to $config{srcdir}: $!");
252 if (defined($config{mtnsync}) && $config{mtnsync}) {
253 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
254 "--quiet", "--ticker=none",
255 "--key", $config{mtnkey}) != 0) {
256 debug("monotone sync failed before update");
260 if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
261 debug("monotone update failed");
265 sub rcs_prepedit ($) { #{{{
268 chdir $config{srcdir}
269 or error("Cannot chdir to $config{srcdir}: $!");
271 # For monotone, return the revision of the file when
276 sub rcs_commit ($$$;$$) { #{{{
277 # Tries to commit the page; returns undef on _success_ and
278 # a version of the page with the rcs's conflict markers on failure.
279 # The file is relative to the srcdir.
288 $author="Web user: " . $user;
290 elsif (defined $ipaddr) {
291 $author="Web IP: " . $ipaddr;
294 $author="Web: Anonymous";
297 chdir $config{srcdir}
298 or error("Cannot chdir to $config{srcdir}: $!");
300 my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
302 if (defined $rev && defined $oldrev && $rev ne $oldrev) {
303 my $automator = Monotone->new();
304 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
306 # Something has been committed, has this file changed?
308 $automator->setOpts("r", $oldrev, "r", $rev);
309 ($out, $err) = $automator->call("content_diff", $file);
310 debug("Problem committing $file") if ($err ne "");
314 # Commit a revision with just this file changed off
317 # first get the contents
318 debug("File changed: forming branch");
319 my $newfile=readfile("$config{srcdir}/$file");
321 # then get the old content ID from the diff
322 if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
323 error("Unable to find previous file ID for $file");
327 # get the branch we're working in
328 ($out, $err) = $automator->call("get_option", "branch");
330 error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
333 # then put the new content into the DB (and record the new content ID)
334 my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
338 # if we made it to here then the file has been committed... revert the local copy
339 if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
340 debug("Unable to revert $file after merge on conflicted commit!");
342 debug("Divergence created! Attempting auto-merge.");
344 # see if it will merge cleanly
345 $ENV{MTN_MERGE}="fail";
346 my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
349 # push any changes so far
350 if (defined($config{mtnsync}) && $config{mtnsync}) {
351 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
352 debug("monotone push failed");
356 if (defined($mergeResult)) {
357 # everything is merged - bring outselves up to date
358 if (system("mtn", "--root=$config{mtnrootdir}",
359 "update", "-r", $mergeResult) != 0) {
360 debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
364 debug("Auto-merge failed. Using diff-merge to add conflict markers.");
366 $ENV{MTN_MERGE}="diffutils";
367 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
368 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
370 $ENV{MTN_MERGE_DIFFUTILS}="";
372 if (!defined($mergeResult)) {
373 debug("Unable to insert conflict markers!");
374 error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
375 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
376 "but at present the different versions cannot be reconciled through the web interface. ".
377 "Please use the non-web interface to resolve the conflicts.");
380 if (system("mtn", "--root=$config{mtnrootdir}",
381 "update", "-r", $mergeResult) != 0) {
382 debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
385 # return "conflict enhanced" file to the user
386 # for cleanup note, this relies on the fact
387 # that ikiwiki seems to call rcs_prepedit()
388 # again after we return
389 return readfile("$config{srcdir}/$file");
396 # If we reached here then the file we're looking at hasn't changed
397 # since $oldrev. Commit it.
399 if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
400 "--author", $author, "--key", $config{mtnkey}, "-m",
401 possibly_foolish_untaint($message), $file) != 0) {
402 debug("Traditional commit failed! Returning data as conflict.");
403 my $conflict=readfile("$config{srcdir}/$file");
404 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
405 "--quiet", $file) != 0) {
406 debug("monotone revert failed");
410 if (defined($config{mtnsync}) && $config{mtnsync}) {
411 if (system("mtn", "--root=$config{mtnrootdir}", "push",
412 "--quiet", "--ticker=none", "--key",
413 $config{mtnkey}) != 0) {
414 debug("monotone push failed");
418 return undef # success
421 sub rcs_commit_staged ($$$) {
422 # Commits all staged changes. Changes can be staged using rcs_add,
423 # rcs_remove, and rcs_rename.
424 my ($message, $user, $ipaddr)=@_;
426 # Note - this will also commit any spurious changes that happen to be
427 # lying around in the working copy. There shouldn't be any, but...
429 chdir $config{srcdir}
430 or error("Cannot chdir to $config{srcdir}: $!");
435 $author="Web user: " . $user;
437 elsif (defined $ipaddr) {
438 $author="Web IP: " . $ipaddr;
441 $author="Web: Anonymous";
444 if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
445 "--author", $author, "--key", $config{mtnkey}, "-m",
446 possibly_foolish_untaint($message)) != 0) {
447 error("Monotone commit failed");
451 sub rcs_add ($) { #{{{
454 chdir $config{srcdir}
455 or error("Cannot chdir to $config{srcdir}: $!");
457 if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
459 error("Monotone add failed");
463 sub rcs_remove ($) { # {{{
466 chdir $config{srcdir}
467 or error("Cannot chdir to $config{srcdir}: $!");
469 # Note: it is difficult to undo a remove in Monotone at the moment.
470 # Until this is fixed, it might be better to make 'rm' move things
471 # into an attic, rather than actually remove them.
472 # To resurrect a file, you currently add a new file with the contents
473 # you want it to have. This loses all connectivity and automated
474 # merging with the 'pre-delete' versions of the file.
476 if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
478 error("Monotone remove failed");
482 sub rcs_rename ($$) { # {{{
483 my ($src, $dest) = @_;
485 chdir $config{srcdir}
486 or error("Cannot chdir to $config{srcdir}: $!");
488 if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
490 error("Monotone rename failed");
494 sub rcs_recentchanges ($) { #{{{
498 chdir $config{srcdir}
499 or error("Cannot chdir to $config{srcdir}: $!");
501 # use log --brief to get a list of revs, as this
502 # gives the results in a nice order
503 # (otherwise we'd have to do our own date sorting)
507 my $child = open(MTNLOG, "-|");
509 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
510 "--brief") || error("mtn log failed to run");
513 while (($num >= 0) and (my $line = <MTNLOG>)) {
514 if ($line =~ m/^($sha1_pattern)/) {
519 close MTNLOG || debug("mtn log exited $?");
521 my $automator = Monotone->new();
522 $automator->open(undef, $config{mtnrootdir});
525 my $rev = shift @revs;
526 # first go through and figure out the messages, etc
528 my $certs = [read_certs($automator, $rev)];
533 my (@pages, @message);
535 foreach my $cert (@$certs) {
536 if ($cert->{signature} eq "ok" &&
537 $cert->{trust} eq "trusted") {
538 if ($cert->{name} eq "author") {
539 $user = $cert->{value};
540 # detect the source of the commit
542 if ($cert->{key} eq $config{mtnkey}) {
545 $committype = "monotone";
547 } elsif ($cert->{name} eq "date") {
548 $when = str2time($cert->{value}, 'UTC');
549 } elsif ($cert->{name} eq "changelog") {
550 my $messageText = $cert->{value};
551 # split the changelog into multiple
553 foreach my $msgline (split(/\n/, $messageText)) {
554 push @message, { line => $msgline };
560 my @changed_files = get_changed_files($automator, $rev);
563 my ($out, $err) = $automator->call("parents", $rev);
564 my @parents = ($out =~ m/^($sha1_pattern)$/);
565 my $parent = $parents[0];
567 foreach $file (@changed_files) {
568 next unless length $file;
570 if (defined $config{diffurl} and (@parents == 1)) {
571 my $diffurl=$config{diffurl};
572 $diffurl=~s/\[\[r1\]\]/$parent/g;
573 $diffurl=~s/\[\[r2\]\]/$rev/g;
574 $diffurl=~s/\[\[file\]\]/$file/g;
576 page => pagename($file),
582 page => pagename($file),
590 committype => $committype,
592 message => [@message],
602 sub rcs_diff ($) { #{{{
604 my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
606 chdir $config{srcdir}
607 or error("Cannot chdir to $config{srcdir}: $!");
609 my $child = open(MTNDIFF, "-|");
611 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
614 my (@lines) = <MTNDIFF>;
616 close MTNDIFF || debug("mtn diff $sha1 exited $?");
622 return join("", @lines);
626 sub rcs_getctime ($) { #{{{
629 chdir $config{srcdir}
630 or error("Cannot chdir to $config{srcdir}: $!");
632 my $child = open(MTNLOG, "-|");
634 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
635 "--brief", $file) || error("mtn log $file failed to run");
640 if (/^($sha1_pattern)/) {
644 close MTNLOG || debug("mtn log $file exited $?");
646 if (! defined $firstRev) {
647 debug "failed to parse mtn log for $file";
651 my $automator = Monotone->new();
652 $automator->open(undef, $config{mtnrootdir});
654 my $certs = [read_certs($automator, $firstRev)];
660 foreach my $cert (@$certs) {
661 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
662 if ($cert->{name} eq "date") {
663 $date = $cert->{value};
668 if (! defined $date) {
669 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
673 $date=str2time($date, 'UTC');
674 debug("found ctime ".localtime($date)." for $file");