X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/54f600af14bf6dc067ffc30ec6f22d517001fe99..c2ac80b185a2a1487f739c310a8ddb03028da2ca:/IkiWiki/Plugin/monotone.pm diff --git a/IkiWiki/Plugin/monotone.pm b/IkiWiki/Plugin/monotone.pm index 67d4abbaa..b0bba5661 100644 --- a/IkiWiki/Plugin/monotone.pm +++ b/IkiWiki/Plugin/monotone.pm @@ -7,8 +7,10 @@ use IkiWiki; use Monotone; use Date::Parse qw(str2time); use Date::Format qw(time2str); +use URI::Escape q{uri_escape_utf8}; my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums +my $mtn_version = undef; sub import { hook(type => "checkconfig", id => "monotone", call => \&checkconfig); @@ -40,20 +42,19 @@ sub checkconfig () { exec("mtn", "version") || error("mtn version failed to run"); } - my $version=undef; while () { - if (/^monotone (\d+\.\d+) /) { - $version=$1; + if (/^monotone (\d+\.\d+)(?:(?:\.\d+){0,2}|dev)? /) { + $mtn_version=$1; } } close MTN || debug("mtn version exited $?"); - if (!defined($version)) { + if (!defined($mtn_version)) { error("Cannot determine monotone version"); } - if ($version < 0.38) { - error("Monotone version too old, is $version but required 0.38"); + if ($mtn_version < 0.38) { + error("Monotone version too old, is $mtn_version but required 0.38"); } if (defined $config{mtn_wrapper} && length $config{mtn_wrapper}) { @@ -252,9 +253,20 @@ sub get_changed_files ($$) { my @ret; my %seen = (); - + + # we need to strip off the relative path to the source dir + # because monotone outputs all file paths absolute according + # to the workspace root + my $rel_src_dir = $config{'srcdir'}; + $rel_src_dir =~ s/^\Q$config{'mtnrootdir'}\E\/?//; + $rel_src_dir .= "/" if length $rel_src_dir; + while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?param("name")) { + return "Web user: " . IkiWiki::cloak($params{session}->param("name")); + } + elsif (defined $params{session}->remote_addr()) { + return "Web IP: " . IkiWiki::cloak($params{session}->remote_addr()); + } + } + return "Web: Anonymous"; +} + + +sub rcs_commit (@) { # Tries to commit the page; returns undef on _success_ and # a version of the page with the rcs's conflict markers on failure. # The file is relative to the srcdir. - my $file=shift; - my $message=shift; - my $rcstoken=shift; - my $user=shift; - my $ipaddr=shift; - my $author; + my %params=@_; - if (defined $user) { - $author="Web user: " . $user; - } - elsif (defined $ipaddr) { - $author="Web IP: " . $ipaddr; - } - else { - $author="Web: Anonymous"; - } + my $author=IkiWiki::possibly_foolish_untaint(commitauthor(%params)), chdir $config{srcdir} or error("Cannot chdir to $config{srcdir}: $!"); - my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint + my ($oldrev) = $params{token} =~ m/^($sha1_pattern)$/; # untaint my $rev = get_rev(); if (defined $rev && defined $oldrev && $rev ne $oldrev) { my $automator = Monotone->new(); @@ -326,8 +340,8 @@ sub rcs_commit ($$$;$$) { # Something has been committed, has this file changed? my ($out, $err); $automator->setOpts("r", $oldrev, "r", $rev); - ($out, $err) = $automator->call("content_diff", $file); - debug("Problem committing $file") if ($err ne ""); + ($out, $err) = $automator->call("content_diff", $params{file}); + debug("Problem committing $params{file}") if ($err ne ""); my $diff = $out; if ($diff) { @@ -336,11 +350,11 @@ sub rcs_commit ($$$;$$) { # # first get the contents debug("File changed: forming branch"); - my $newfile=readfile("$config{srcdir}/$file"); + my $newfile=readfile("$config{srcdir}/$params{file}"); # then get the old content ID from the diff - if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) { - error("Unable to find previous file ID for $file"); + if ($diff !~ m/^---\s$params{file}\s+($sha1_pattern)$/m) { + error("Unable to find previous file ID for $params{file}"); } my $oldFileID = $1; @@ -351,13 +365,13 @@ sub rcs_commit ($$$;$$) { my $branch = $1; # then put the new content into the DB (and record the new content ID) - my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message); + my $newRevID = commit_file_to_new_rev($automator, $params{file}, $oldFileID, $newfile, $oldrev, $branch, $author, $params{message}); $automator->close(); # 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) { - debug("Unable to revert $file after merge on conflicted commit!"); + if (system("mtn", "--root=$config{mtnrootdir}", "revert", $params{file}) != 0) { + debug("Unable to revert $params{file} after merge on conflicted commit!"); } debug("Divergence created! Attempting auto-merge."); @@ -406,7 +420,7 @@ sub rcs_commit ($$$;$$) { # 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 readfile("$config{srcdir}/$params{file}"); } return undef; } @@ -418,11 +432,12 @@ sub rcs_commit ($$$;$$) { if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", "--author", $author, "--key", $config{mtnkey}, "-m", - IkiWiki::possibly_foolish_untaint($message), $file) != 0) { + IkiWiki::possibly_foolish_untaint($params{message}), + $params{file}) != 0) { debug("Traditional commit failed! Returning data as conflict."); - my $conflict=readfile("$config{srcdir}/$file"); + my $conflict=readfile("$config{srcdir}/$params{file}"); if (system("mtn", "--root=$config{mtnrootdir}", "revert", - "--quiet", $file) != 0) { + "--quiet", $params{file}) != 0) { debug("monotone revert failed"); } return $conflict; @@ -438,32 +453,21 @@ sub rcs_commit ($$$;$$) { return undef # success } -sub rcs_commit_staged ($$$) { +sub rcs_commit_staged (@) { # Commits all staged changes. Changes can be staged using rcs_add, # rcs_remove, and rcs_rename. - my ($message, $user, $ipaddr)=@_; - + my %params=@_; + # Note - this will also commit any spurious changes that happen to be # lying around in the working copy. There shouldn't be any, but... chdir $config{srcdir} or error("Cannot chdir to $config{srcdir}: $!"); - 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", - IkiWiki::possibly_foolish_untaint($message)) != 0) { + "--author", IkiWiki::possibly_foolish_untaint(commitauthor(%params)), + "--key", $config{mtnkey}, "-m", + IkiWiki::possibly_foolish_untaint($params{message})) != 0) { error("Monotone commit failed"); } } @@ -590,7 +594,8 @@ sub rcs_recentchanges ($) { my $diffurl=$config{diffurl}; $diffurl=~s/\[\[r1\]\]/$parent/g; $diffurl=~s/\[\[r2\]\]/$rev/g; - $diffurl=~s/\[\[file\]\]/$file/g; + my $efile = uri_escape_utf8($file); + $diffurl=~s/\[\[file\]\]/$efile/g; push @pages, { page => pagename($file), diffurl => $diffurl, @@ -618,8 +623,9 @@ sub rcs_recentchanges ($) { return @ret; } -sub rcs_diff ($) { +sub rcs_diff ($;$) { my $rev=shift; + my $maxlines=shift; my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint chdir $config{srcdir} @@ -630,7 +636,11 @@ sub rcs_diff ($) { exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run"); } - my (@lines) = ; + my @lines; + while (my $line=) { + last if defined $maxlines && @lines == $maxlines; + push @lines, $line; + } close MTNDIFF || debug("mtn diff $sha1 exited $?"); @@ -654,9 +664,11 @@ sub rcs_getctime ($) { "--brief", $file) || error("mtn log $file failed to run"); } + my $prevRev; my $firstRev; while () { if (/^($sha1_pattern)/) { + $prevRev=$firstRev; $firstRev=$1; } } @@ -670,6 +682,17 @@ sub rcs_getctime ($) { my $automator = Monotone->new(); $automator->open(undef, $config{mtnrootdir}); + # mtn 0.48 has a bug that makes it list the creation of parent + # directories as last (first) log entry... So when we're dealing + # with that version, let's check that the file we're looking for + # is actually part of the last (first) revision. Otherwise, pick + # the one before (after) that one. + if ($mtn_version == 0.48) { + my $changes = [get_changed_files($automator, $firstRev)]; + if (! exists {map { $_ => 1 } @$changes}->{$file}) { + $firstRev = $prevRev; + } + } my $certs = [read_certs($automator, $firstRev)]; $automator->close(); @@ -695,7 +718,55 @@ sub rcs_getctime ($) { } sub rcs_getmtime ($) { - error "rcs_getmtime is not implemented for monotone\n"; # TODO + my $file=shift; + + chdir $config{srcdir} + or error("Cannot chdir to $config{srcdir}: $!"); + + my $child = open(MTNLOG, "-|"); + if (! $child) { + exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", + "--brief", $file) || error("mtn log $file failed to run"); + } + + my $lastRev = ""; + while () { + if (/^($sha1_pattern)/ && $lastRev eq "") { + $lastRev=$1; + } + } + close MTNLOG || debug("mtn log $file exited $?"); + + if (! defined $lastRev) { + debug "failed to parse mtn log for $file"; + return 0; + } + + my $automator = Monotone->new(); + $automator->open(undef, $config{mtnrootdir}); + + my $certs = [read_certs($automator, $lastRev)]; + + $automator->close(); + + my $date; + + foreach my $cert (@$certs) { + if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") { + if ($cert->{name} eq "date") { + $date = $cert->{value}; + } + } + } + + if (! defined $date) { + debug "failed to find date cert for revision $lastRev when looking for creation time of $file"; + return 0; + } + + $date=str2time($date, 'UTC'); + debug("found mtime ".localtime($date)." for $file"); + return $date; } 1