X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/f41448d9caf591ba369bf319297d15552be94678..b58db6f68ce59fe70889038780828da769d352f8:/IkiWiki/Plugin/monotone.pm?ds=sidebyside diff --git a/IkiWiki/Plugin/monotone.pm b/IkiWiki/Plugin/monotone.pm index 4b9be316a..38313a542 100644 --- a/IkiWiki/Plugin/monotone.pm +++ b/IkiWiki/Plugin/monotone.pm @@ -10,7 +10,7 @@ use Date::Format qw(time2str); my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums -sub import { #{{{ +sub import { hook(type => "checkconfig", id => "monotone", call => \&checkconfig); hook(type => "getsetup", id => "monotone", call => \&getsetup); hook(type => "rcs", id => "rcs_update", call => \&rcs_update); @@ -23,9 +23,10 @@ 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 () { #{{{ +sub checkconfig () { if (!defined($config{mtnrootdir})) { $config{mtnrootdir} = $config{srcdir}; } @@ -41,7 +42,7 @@ sub checkconfig () { #{{{ my $version=undef; while () { - if (/^monotone (\d+\.\d+) /) { + if (/^monotone (\d+\.\d+)(?:(?:\.\d+){0,2}|dev)? /) { $version=$1; } } @@ -55,20 +56,25 @@ sub checkconfig () { #{{{ error("Monotone version too old, is $version but required 0.38"); } - if (length $config{mtn_wrapper}) { + if (defined $config{mtn_wrapper} && length $config{mtn_wrapper}) { push @{$config{wrappers}}, { wrapper => $config{mtn_wrapper}, wrappermode => (defined $config{mtn_wrappermode} ? $config{mtn_wrappermode} : "06755"), }; } -} #}}} +} -sub getsetup () { #{{{ +sub getsetup () { return + plugin => { + safe => 0, # rcs plugin + rebuild => undef, + section => "rcs", + }, mtn_wrapper => { type => "string", example => "/srv/mtn/wiki/_MTN/ikiwiki-netsync-hook", - description => "monotone netsync hook executable to generate", + description => "monotone netsync hook to generate", safe => 0, # file rebuild => 0, }, @@ -113,9 +119,9 @@ sub getsetup () { #{{{ safe => 0, # path rebuild => 0, }, -} #}}} +} -sub get_rev () { #{{{ +sub get_rev () { my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`; ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now @@ -124,9 +130,9 @@ sub get_rev () { #{{{ } return $sha1; -} #}}} +} -sub get_rev_auto ($) { #{{{ +sub get_rev_auto ($) { my $automator=shift; my @results = $automator->call("get_base_revision_id"); @@ -138,9 +144,9 @@ sub get_rev_auto ($) { #{{{ } return $sha1; -} #}}} +} -sub mtn_merge ($$$$) { #{{{ +sub mtn_merge ($$$$) { my $leftRev=shift; my $rightRev=shift; my $branch=shift; @@ -168,9 +174,9 @@ sub mtn_merge ($$$$) { #{{{ 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; @@ -215,16 +221,16 @@ sub commit_file_to_new_rev ($$$$$$$$) { #{{{ debug("Added certs for rev: $newRevID"); return $newRevID; -} #}}} +} -sub read_certs ($$) { #{{{ +sub read_certs ($$) { my $automator=shift; my $rev=shift; my @results = $automator->call("certs", $rev); 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, @@ -235,9 +241,9 @@ sub read_certs ($$) { #{{{ } return @ret; -} #}}} +} -sub get_changed_files ($$) { #{{{ +sub get_changed_files ($$) { my $automator=shift; my $rev=shift; @@ -246,9 +252,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 ($$$;$$) { #{{{ + +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(); @@ -320,8 +339,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) { @@ -330,11 +349,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; @@ -345,13 +364,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."); @@ -400,7 +419,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; } @@ -412,11 +431,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; @@ -430,39 +450,28 @@ 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"); } } -sub rcs_add ($) { #{{{ +sub rcs_add ($) { my $file=shift; chdir $config{srcdir} @@ -472,9 +481,9 @@ sub rcs_add ($) { #{{{ $file) != 0) { error("Monotone add failed"); } -} #}}} +} -sub rcs_remove ($) { # {{{ +sub rcs_remove ($) { my $file = shift; chdir $config{srcdir} @@ -491,9 +500,9 @@ sub rcs_remove ($) { # {{{ $file) != 0) { error("Monotone remove failed"); } -} #}}} +} -sub rcs_rename ($$) { # {{{ +sub rcs_rename ($$) { my ($src, $dest) = @_; chdir $config{srcdir} @@ -503,9 +512,9 @@ sub rcs_rename ($$) { # {{{ $src, $dest) != 0) { error("Monotone rename failed"); } -} #}}} +} -sub rcs_recentchanges ($) { #{{{ +sub rcs_recentchanges ($) { my $num=shift; my @ret; @@ -521,13 +530,12 @@ sub rcs_recentchanges ($) { #{{{ my $child = open(MTNLOG, "-|"); if (! $child) { exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", - "--brief") || error("mtn log failed to run"); + "--brief", "--last=$num") || error("mtn log failed to run"); } - while (($num >= 0) and (my $line = )) { + while (my $line = ) { if ($line =~ m/^($sha1_pattern)/) { push @revs, $1; - $num -= 1; } } close MTNLOG || debug("mtn log exited $?"); @@ -555,8 +563,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'); @@ -572,13 +581,12 @@ 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)) { @@ -611,10 +619,11 @@ sub rcs_recentchanges ($) { #{{{ $automator->close(); return @ret; -} #}}} +} -sub rcs_diff ($) { #{{{ +sub rcs_diff ($;$) { my $rev=shift; + my $maxlines=shift; my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint chdir $config{srcdir} @@ -625,7 +634,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 $?"); @@ -635,9 +648,9 @@ sub rcs_diff ($) { #{{{ else { return join("", @lines); } -} #}}} +} -sub rcs_getctime ($) { #{{{ +sub rcs_getctime ($) { my $file=shift; chdir $config{srcdir} @@ -687,6 +700,10 @@ sub rcs_getctime ($) { #{{{ $date=str2time($date, 'UTC'); debug("found ctime ".localtime($date)." for $file"); return $date; -} #}}} +} + +sub rcs_getmtime ($) { + error "rcs_getmtime is not implemented for monotone\n"; # TODO +} 1