X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/4fcf25a8200a25a850f095ac90b5ac9f4e395664..c401cf4f0ccdf3817fdedc7b0cff5801286dc9bf:/IkiWiki/Rcs/monotone.pm?ds=sidebyside diff --git a/IkiWiki/Rcs/monotone.pm b/IkiWiki/Rcs/monotone.pm index 0435dc45c..500af5c58 100644 --- a/IkiWiki/Rcs/monotone.pm +++ b/IkiWiki/Rcs/monotone.pm @@ -1,4 +1,7 @@ #!/usr/bin/perl + +package IkiWiki; + use warnings; use strict; use IkiWiki; @@ -6,11 +9,9 @@ use Monotone; use Date::Parse qw(str2time); use Date::Format qw(time2str); -package IkiWiki; - my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums -sub check_config() { +sub check_config() { #{{{ if (!defined($config{mtnrootdir})) { $config{mtnrootdir} = $config{srcdir}; } @@ -18,26 +19,44 @@ sub check_config() { error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!"); } - if (!defined($config{mtnmergerc})) { - $config{mtnmergerc} = "$config{mtnrootdir}/_MTN/mergerc"; - } - chdir $config{srcdir} or error("Cannot chdir to $config{srcdir}: $!"); -} -sub get_rev () { + my $child = open(MTN, "-|"); + if (! $child) { + open STDERR, ">/dev/null"; + exec("mtn", "version") || error("mtn version failed to run"); + } + + my $version=undef; + while () { + if (/^monotone (\d+\.\d+) /) { + $version=$1; + } + } + + close MTN || debug("mtn version exited $?"); + + if (!defined($version)) { + error("Cannot determine monotone version"); + } + if ($version < 0.38) { + error("Monotone version too old, is $version but required 0.38"); + } +} #}}} + +sub get_rev () { #{{{ my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`; ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now if (! $sha1) { - warn("Unable to get base revision for '$config{srcdir}'.") + debug("Unable to get base revision for '$config{srcdir}'.") } return $sha1; -} +} #}}} -sub get_rev_auto ($) { +sub get_rev_auto ($) { #{{{ my $automator=shift; my @results = $automator->call("get_base_revision_id"); @@ -45,27 +64,27 @@ sub get_rev_auto ($) { my $sha1 = $results[0]; ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now if (! $sha1) { - warn("Unable to get base revision for '$config{srcdir}'.") + debug("Unable to get base revision for '$config{srcdir}'.") } return $sha1; -} +} #}}} -sub mtn_merge ($$$$$) { - my $leftRev=shift; - my $rightRev=shift; - my $branch=shift; - my $author=shift; - my $message=shift; # ignored for the moment because mtn doesn't support it +sub mtn_merge ($$$$) { #{{{ + my $leftRev=shift; + my $rightRev=shift; + my $branch=shift; + my $author=shift; - my $mergeRev; + my $mergeRev; - my $mergerc = $config{mtnmergerc}; - my $child = open(MTNMERGE, "-|"); if (! $child) { open STDERR, ">&STDOUT"; - exec("mtn", "--root=$config{mtnrootdir}", "--rcfile", $mergerc, "explicit_merge", $leftRev, $rightRev, $branch, "--author", $author, "--key", $config{mtnkey}) || error("mtn merge failed to run"); + exec("mtn", "--root=$config{mtnrootdir}", + "explicit_merge", $leftRev, $rightRev, + $branch, "--author", $author, "--key", + $config{mtnkey}) || error("mtn merge failed to run"); } while () { @@ -76,12 +95,12 @@ sub mtn_merge ($$$$$) { close MTNMERGE || return undef; - warn("merged $leftRev, $rightRev to make $mergeRev"); + debug("merged $leftRev, $rightRev to make $mergeRev"); return $mergeRev; -} +} #}}} -sub commit_file_to_new_rev($$$$$$$$) { +sub commit_file_to_new_rev($$$$$$$$) { #{{{ my $automator=shift; my $wsfilename=shift; my $oldFileID=shift; @@ -94,98 +113,41 @@ sub commit_file_to_new_rev($$$$$$$$) { #store the file my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents); my ($newFileID) = ($out =~ m/^($sha1_pattern)$/); - error("Failed to store file data for $wsfilename in repository") if (!defined($newFileID) || 40 != length $newFileID); + error("Failed to store file data for $wsfilename in repository") + if (! defined $newFileID || length $newFileID != 40); # get the mtn filename rather than the workspace filename ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev); my ($filename) = ($out =~ m/^file "(.*)"$/); error("Couldn't find monotone repository path for file $wsfilename") if (! $filename); - warn("Converted ws filename of $wsfilename to repos filename of $filename"); + debug("Converted ws filename of $wsfilename to repos filename of $filename"); # then stick in a new revision for this file - my $manifest = "format_version \"1\"\n\n". - "new_manifest [0000000000000000000000000000000000000000]\n\n". - "old_revision [$oldrev]\n\n". - "patch \"$filename\"\n". - " from [$oldFileID]\n". - " to [$newFileID]\n"; + my $manifest = "format_version \"1\"\n\n". + "new_manifest [0000000000000000000000000000000000000000]\n\n". + "old_revision [$oldrev]\n\n". + "patch \"$filename\"\n". + " from [$oldFileID]\n". + " to [$newFileID]\n"; ($out, $err) = $automator->call("put_revision", $manifest); my ($newRevID) = ($out =~ m/^($sha1_pattern)$/); - error("Unable to make new monotone repository revision") if (!defined($newRevID) || 40 != length $newRevID); - warn("put revision: $newRevID"); + error("Unable to make new monotone repository revision") + if (! defined $newRevID || length $newRevID != 40); + debug("put revision: $newRevID"); # now we need to add certs for this revision... # author, branch, changelog, date $automator->call("cert", $newRevID, "author", $author); $automator->call("cert", $newRevID, "branch", $branch); $automator->call("cert", $newRevID, "changelog", $message); - $automator->call("cert", $newRevID, "date", time2str("%Y-%m-%dT%T", time, "UTC")); + $automator->call("cert", $newRevID, "date", + time2str("%Y-%m-%dT%T", time, "UTC")); - warn("Added certs for rev: $newRevID"); + debug("Added certs for rev: $newRevID"); return $newRevID; -} +} #}}} -sub check_mergerc() { - my $mergerc = $config{mtnmergerc}; - if (! -r $mergerc ) { - warn("$mergerc doesn't exist. Creating file with default mergers."); - open(DATA, ">$mergerc") or error("can't open $mergerc $!"); - my $defaultrc = "". -" function local_execute_redirected(stdin, stdout, stderr, path, ...)\n". -" local pid\n". -" local ret = -1\n". -" io.flush();\n". -" pid = spawn_redirected(stdin, stdout, stderr, path, unpack(arg))\n". -" if (pid ~= -1) then ret, pid = wait(pid) end\n". -" return ret\n". -" end\n". -" if (not execute_redirected) then -- use standard function if available\n". -" execute_redirected = local_execute_redirected\n". -" end\n". -" if (not mergers.fail) then -- use standard merger if available\n". -" mergers.fail = {\n". -" cmd = function (tbl) return false end,\n". -" available = function () return true end,\n". -" wanted = function () return true end\n". -" }\n". -" end\n". -" mergers.diffutils_force = {\n". -" cmd = function (tbl)\n". -" local ret = execute_redirected(\n". -" \"\",\n". -" tbl.outfile,\n". -" \"\",\n". -" \"diff3\",\n". -" \"--merge\",\n". -" \"--show-overlap\",\n". -" \"--label\", string.format(\"[Yours]\", tbl.left_path ),\n". -" \"--label\", string.format(\"[Original]\", tbl.anc_path ),\n". -" \"--label\", string.format(\"[Theirs]\", tbl.right_path),\n". -" tbl.lfile,\n". -" tbl.afile,\n". -" tbl.rfile\n". -" )\n". -" if (ret > 1) then\n". -" io.write(gettext(\"Error running GNU diffutils 3-way difference tool 'diff3'\"))\n". -" return false\n". -" end\n". -" return tbl.outfile\n". -" end,\n". -" available =\n". -" function ()\n". -" return program_exists_in_path(\"diff3\");\n". -" end,\n". -" wanted =\n". -" function ()\n". -" return true\n". -" end\n". -" }\n"; - print DATA $defaultrc; - close(DATA); - } -} - -sub read_certs ($$) { +sub read_certs ($$) { #{{{ my $automator=shift; my $rev=shift; my @results = $automator->call("certs", $rev); @@ -203,9 +165,9 @@ sub read_certs ($$) { } return @ret; -} +} #}}} -sub get_changed_files ($$) { +sub get_changed_files ($$) { #{{{ my $automator=shift; my $rev=shift; @@ -217,38 +179,33 @@ sub get_changed_files ($$) { while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?setOpts("-r", $oldrev, "-r", $rev); - #my ($out, $err) = $automator->call("content_diff", $file); - #debug("Problem committing $file") if ($err ne ""); - # FIXME: use of $file in these backticks is not wise from a - # security POV. Probably safe, but should be avoided - # anyway. - my $diff = `mtn --root=$config{mtnrootdir} au content_diff -r $oldrev -r $rev $file`; # was just $out; - + $automator->setOpts("r", $oldrev, "r", $rev); + ($out, $err) = $automator->call("content_diff", $file); + debug("Problem committing $file") if ($err ne ""); + my $diff = $out; + if ($diff) { - # this file has changed - # commit a revision with just this file changed off - # the old revision + # Commit a revision with just this file changed off + # the old revision. + # # first get the contents - warn("File changed: forming branch\n"); + debug("File changed: forming branch"); my $newfile=readfile("$config{srcdir}/$file"); # then get the old content ID from the diff @@ -324,52 +278,55 @@ sub rcs_commit ($$$;$$) { # if we made it to here then the file has been committed... revert the local copy if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) { - warn("Unable to revert $file after merge on conflicted commit!"); + debug("Unable to revert $file after merge on conflicted commit!"); } - warn("Divergence created! Attempting auto-merge."); - - check_mergerc(); + debug("Divergence created! Attempting auto-merge."); # see if it will merge cleanly $ENV{MTN_MERGE}="fail"; - my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author, "Auto-merging parallel web edits."); + my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author); $ENV{MTN_MERGE}=""; # push any changes so far if (defined($config{mtnsync}) && $config{mtnsync}) { if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) { - warn("monotone push failed\n"); + debug("monotone push failed"); } } if (defined($mergeResult)) { # everything is merged - bring outselves up to date - if (system("mtn", "--root=$config{mtnrootdir}", "update", "-r", $mergeResult) != 0) { - warn("Unable to update to rev $mergeResult after merge on conflicted commit!"); + if (system("mtn", "--root=$config{mtnrootdir}", + "update", "-r", $mergeResult) != 0) { + debug("Unable to update to rev $mergeResult after merge on conflicted commit!"); } - } else { - warn("Auto-merge failed. Using diff-merge to add conflict markers."); + } + else { + debug("Auto-merge failed. Using diff-merge to add conflict markers."); - $ENV{MTN_MERGE}="diffutils_force"; - my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author, "Merge parallel conflicting web edits (adding inline conflict markers).\nThis revision should be cleaned up manually."); + $ENV{MTN_MERGE}="diffutils"; + $ENV{MTN_MERGE_DIFFUTILS}="partial=true"; + $mergeResult = mtn_merge($newRevID, $rev, $branch, $author); $ENV{MTN_MERGE}=""; + $ENV{MTN_MERGE_DIFFUTILS}=""; if (!defined($mergeResult)) { - warn("Unable to insert conflict markers!"); - error("Your commit succeeded. Unfortunately, someone else committed something to the same\n". - "part of the wiki at the same time. Both versions are stored in the monotone repository,\n". - "but at present the different versions cannot be reconciled through the web interface.\n\n". - "Please use the non-web interface to resolve the conflicts.\n"); + debug("Unable to insert conflict markers!"); + error("Your commit succeeded. Unfortunately, someone else committed something to the same ". + "part of the wiki at the same time. Both versions are stored in the monotone repository, ". + "but at present the different versions cannot be reconciled through the web interface. ". + "Please use the non-web interface to resolve the conflicts."); } - # suspend this revision because it has conflict markers... - if (system("mtn", "--root=$config{mtnrootdir}", "update", "-r", $mergeResult) != 0) { - warn("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!"); + if (system("mtn", "--root=$config{mtnrootdir}", + "update", "-r", $mergeResult) != 0) { + debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!"); } - # return "conflict enhanced" file to the user for cleanup - # note, this relies on the fact that ikiwiki seems to call rcs_prepedit() again - # after we return + # return "conflict enhanced" file to the user + # for cleanup note, this relies on the fact + # that ikiwiki seems to call rcs_prepedit() + # again after we return return readfile("$config{srcdir}/$file"); } return undef; @@ -377,59 +334,101 @@ sub rcs_commit ($$$;$$) { $automator->close(); } - # if we reached here then the file we're looking at hasn't changed since $oldrev. Commit it. + # If we reached here then the file we're looking at hasn't changed + # since $oldrev. Commit it. - if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", "--author", $author, "--key", $config{mtnkey}, - "-m", possibly_foolish_untaint($message), $file) != 0) { - warn("Traditional commit failed!\nReturning data as conflict.\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", + "--author", $author, "--key", $config{mtnkey}, "-m", + possibly_foolish_untaint($message), $file) != 0) { + debug("Traditional commit failed! Returning data as conflict."); my $conflict=readfile("$config{srcdir}/$file"); - if (system("mtn", "--root=$config{mtnrootdir}", "revert", "--quiet", $file) != 0) { - warn("monotone revert failed\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "revert", + "--quiet", $file) != 0) { + debug("monotone revert failed"); } return $conflict; } if (defined($config{mtnsync}) && $config{mtnsync}) { - if (system("mtn", "--root=$config{mtnrootdir}", "sync", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) { - warn("monotone sync failed\n"); + if (system("mtn", "--root=$config{mtnrootdir}", "push", + "--quiet", "--ticker=none", "--key", + $config{mtnkey}) != 0) { + debug("monotone push failed"); } } return undef # success +} #}}} + +sub rcs_commit_staged ($$$) { + # Commits all staged changes. Changes can be staged using rcs_add, + # rcs_remove, and rcs_rename. + my ($message, $user, $ipaddr)=@_; + + # Note - this will also commit any spurious changes that happen to be + # lying around in the working copy. There shouldn't be any, but... + + check_config(); + + my $author; + + if (defined $user) { + $author="Web user: " . $user; + } + elsif (defined $ipaddr) { + $author="Web IP: " . $ipaddr; + } + else { + $author="Web: Anonymous"; + } + + if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", + "--author", $author, "--key", $config{mtnkey}, "-m", + possibly_foolish_untaint($message)) != 0) { + error("Monotone commit failed"); + } } -sub rcs_add ($) { - # Add a file. The filename is relative to the root of the srcdir. +sub rcs_add ($) { #{{{ my $file=shift; check_config(); - if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet", "$config{srcdir}/$file") != 0) { + if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet", + $file) != 0) { error("Monotone add failed"); } -} +} #}}} + +sub rcs_remove ($) { # {{{ + my $file = shift; -sub rcs_recentchanges ($) { - # Examine the RCS history and generate a list of recent changes. - # The data structure returned for each change is: - # { - # user => # name of user who made the change, - # committype => # either "web" or the name of the rcs, - # when => # time when the change was made, - # message => [ - # { line => "commit message line" }, - # { line => "commit message line" }, - # # etc, - # ], - # pages => [ - # { - # page => # name of page changed, - # diffurl => # optional url to a diff showing - # # the changes, - # }, - # # repeat for each page changed in this commit, - # ], - # } + check_config(); + + # Note: it is difficult to undo a remove in Monotone at the moment. + # Until this is fixed, it might be better to make 'rm' move things + # into an attic, rather than actually remove them. + # To resurrect a file, you currently add a new file with the contents + # you want it to have. This loses all connectivity and automated + # merging with the 'pre-delete' versions of the file. + if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet", + $file) != 0) { + error("Monotone remove failed"); + } +} #}}} + +sub rcs_rename ($$) { # {{{ + my ($src, $dest) = @_; + + check_config(); + + if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet", + $src, $dest) != 0) { + error("Monotone rename failed"); + } +} #}}} + +sub rcs_recentchanges ($) { #{{{ my $num=shift; my @ret; @@ -443,18 +442,17 @@ sub rcs_recentchanges ($) { my $child = open(MTNLOG, "-|"); if (! $child) { - exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", "--brief") || error("mtn log failed to run"); + exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", + "--brief") || error("mtn log failed to run"); } - my $line; - - while (($num >= 0) and ($line = )) { + while (($num >= 0) and (my $line = )) { if ($line =~ m/^($sha1_pattern)/) { push @revs, $1; $num -= 1; } } - close MTNLOG || warn "mtn log exited $?"; + close MTNLOG || debug("mtn log exited $?"); my $automator = Monotone->new(); $automator->open(undef, $config{mtnrootdir}); @@ -471,20 +469,23 @@ sub rcs_recentchanges ($) { my (@pages, @message); foreach my $cert (@$certs) { - if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") { + if ($cert->{signature} eq "ok" && + $cert->{trust} eq "trusted") { if ($cert->{name} eq "author") { $user = $cert->{value}; - # detect the source of the commit from the changelog + # detect the source of the commit + # from the changelog if ($cert->{key} eq $config{mtnkey}) { $committype = "web"; } else { $committype = "monotone"; } } elsif ($cert->{name} eq "date") { - $when = time - str2time($cert->{value}, 'UTC'); + $when = str2time($cert->{value}, 'UTC'); } elsif ($cert->{name} eq "changelog") { my $messageText = $cert->{value}; - # split the changelog into multiple lines + # split the changelog into multiple + # lines foreach my $msgline (split(/\n/, $messageText)) { push @message, { line => $msgline }; } @@ -495,10 +496,28 @@ sub rcs_recentchanges ($) { my @changed_files = get_changed_files($automator, $rev); my $file; + my ($out, $err) = $automator->call("parents", $rev); + my @parents = ($out =~ m/^($sha1_pattern)$/); + my $parent = $parents[0]; + foreach $file (@changed_files) { - push @pages, { - page => pagename($file), - } if length $file; + next unless length $file; + + if (defined $config{diffurl} and (@parents == 1)) { + my $diffurl=$config{diffurl}; + $diffurl=~s/\[\[r1\]\]/$parent/g; + $diffurl=~s/\[\[r2\]\]/$rev/g; + $diffurl=~s/\[\[file\]\]/$file/g; + push @pages, { + page => pagename($file), + diffurl => $diffurl, + }; + } + else { + push @pages, { + page => pagename($file), + } + } } push @ret, { @@ -514,70 +533,40 @@ sub rcs_recentchanges ($) { $automator->close(); return @ret; -} +} #}}} -sub rcs_notify () { - # This function is called when a change is committed to the wiki, - # and ikiwiki is running as a post-commit hook from the RCS. - # It should examine the repository to somehow determine what pages - # changed, and then send emails to users subscribed to those pages. - - warn("The monotone rcs_notify function is currently untested. Use at own risk!"); - - if (! exists $ENV{REV}) { - error(gettext("REV is not set, not running from mtn post-commit hook, cannot send notifications")); - } - if ($ENV{REV} !~ m/($sha1_pattern)/) { # sha1 is untainted now - error(gettext("REV is not a valid revision identifier, cannot send notifications")); - } - my $rev = $1; +sub rcs_diff ($) { #{{{ + my $rev=shift; + my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint check_config(); - my $automator = Monotone->new(); - $automator->open(undef, $config{mtnrootdir}); + my $child = open(MTNDIFF, "-|"); + if (! $child) { + exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run"); + } - my $certs = [read_certs($automator, $rev)]; - my $user; - my $message; - my $when; + my (@lines) = ; - foreach my $cert (@$certs) { - if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") { - if ($cert->{name} eq "author") { - $user = $cert->{value}; - } elsif ($cert->{name} eq "date") { - $when = $cert->{value}; - } elsif ($cert->{name} eq "changelog") { - $message = $cert->{value}; - } - } + close MTNDIFF || debug("mtn diff $sha1 exited $?"); + + if (wantarray) { + return @lines; } - - my @changed_pages = get_changed_files($automator, $rev); - - $automator->close(); - - require IkiWiki::UserInfo; - send_commit_mails( - sub { - return $message; - }, - sub { - `mtn --root=$config{mtnrootdir} au content_diff -r $rev`; - }, $user, @changed_pages); -} + else { + return join("", @lines); + } +} #}}} -sub rcs_getctime ($) { - # Optional, used to get the page creation time from the RCS. - # error gettext("getctime not implemented"); +sub rcs_getctime ($) { #{{{ my $file=shift; check_config(); my $child = open(MTNLOG, "-|"); if (! $child) { - exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", "--brief", $file) || error("mtn log $file failed to run"); + exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", + "--brief", $file) || error("mtn log $file failed to run"); } my $firstRev; @@ -586,10 +575,10 @@ sub rcs_getctime ($) { $firstRev=$1; } } - close MTNLOG || warn "mtn log $file exited $?"; + close MTNLOG || debug("mtn log $file exited $?"); if (! defined $firstRev) { - warn "failed to parse mtn log for $file\n"; + debug "failed to parse mtn log for $file"; return 0; } @@ -611,11 +600,13 @@ sub rcs_getctime ($) { } if (! defined $date) { - warn "failed to find date cert for revision $firstRev when looking for creation time of $file\n"; + debug "failed to find date cert for revision $firstRev when looking for creation time of $file"; return 0; } $date=str2time($date, 'UTC'); debug("found ctime ".localtime($date)." for $file"); return $date; -} +} #}}} + +1