X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/21add7ffa87a5e622d18bdbb24c638c15bdb3800..c1041505dcb8e3f918afb3004321e34d6ad06566:/IkiWiki/Plugin/monotone.pm?ds=inline diff --git a/IkiWiki/Plugin/monotone.pm b/IkiWiki/Plugin/monotone.pm index 38abb9a07..105627814 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); @@ -23,6 +25,7 @@ sub import { hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges); hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff); hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime); + hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime); } sub checkconfig () { @@ -39,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}) { @@ -68,6 +70,7 @@ sub getsetup () { plugin => { safe => 0, # rcs plugin rebuild => undef, + section => "rcs", }, mtn_wrapper => { type => "string", @@ -228,7 +231,7 @@ sub read_certs ($$) { my @ret; my $line = $results[0]; - 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) { + 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) { push @ret, { key => $1, signature => $2, @@ -250,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: " . $params{session}->param("name"); + } + elsif (defined $params{session}->remote_addr()) { + return "Web IP: " . $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(); @@ -324,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) { @@ -334,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; @@ -349,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."); @@ -404,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; } @@ -416,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; @@ -436,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"); } } @@ -558,8 +564,9 @@ sub rcs_recentchanges ($) { # from the changelog if ($cert->{key} eq $config{mtnkey}) { $committype = "web"; - } else { - $committype = "monotone"; + } + else { + $committype = "mtn"; } } elsif ($cert->{name} eq "date") { $when = str2time($cert->{value}, 'UTC'); @@ -575,20 +582,20 @@ 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) { + foreach my $file (@changed_files) { 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; + my $efile = uri_escape_utf8($file); + $diffurl=~s/\[\[file\]\]/$efile/g; push @pages, { page => pagename($file), diffurl => $diffurl, @@ -616,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} @@ -628,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 $?"); @@ -652,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; } } @@ -668,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(); @@ -692,4 +717,56 @@ sub rcs_getctime ($) { return $date; } +sub rcs_getmtime ($) { + 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