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 sub check_config() { #{{{
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)!");
23 or error("Cannot chdir to $config{srcdir}: $!");
25 my $child = open(MTN, "-|");
27 open STDERR, ">/dev/null";
28 exec("mtn", "version") || error("mtn version failed to run");
33 if (/^monotone (\d+\.\d+) /) {
38 close MTN || debug("mtn version exited $?");
40 if (!defined($version)) {
41 error("Cannot determine monotone version");
43 if ($version < 0.38) {
44 error("Monotone version too old, is $version but required 0.38");
49 my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
51 ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
53 debug("Unable to get base revision for '$config{srcdir}'.")
59 sub get_rev_auto ($) { #{{{
62 my @results = $automator->call("get_base_revision_id");
64 my $sha1 = $results[0];
65 ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
67 debug("Unable to get base revision for '$config{srcdir}'.")
73 sub mtn_merge ($$$$) { #{{{
81 my $child = open(MTNMERGE, "-|");
83 open STDERR, ">&STDOUT";
84 exec("mtn", "--root=$config{mtnrootdir}",
85 "explicit_merge", $leftRev, $rightRev,
86 $branch, "--author", $author, "--key",
87 $config{mtnkey}) || error("mtn merge failed to run");
91 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
96 close MTNMERGE || return undef;
98 debug("merged $leftRev, $rightRev to make $mergeRev");
103 sub commit_file_to_new_rev($$$$$$$$) { #{{{
105 my $wsfilename=shift;
107 my $newFileContents=shift;
114 my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
115 my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
116 error("Failed to store file data for $wsfilename in repository")
117 if (! defined $newFileID || length $newFileID != 40);
119 # get the mtn filename rather than the workspace filename
120 ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
121 my ($filename) = ($out =~ m/^file "(.*)"$/);
122 error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
123 debug("Converted ws filename of $wsfilename to repos filename of $filename");
125 # then stick in a new revision for this file
126 my $manifest = "format_version \"1\"\n\n".
127 "new_manifest [0000000000000000000000000000000000000000]\n\n".
128 "old_revision [$oldrev]\n\n".
129 "patch \"$filename\"\n".
130 " from [$oldFileID]\n".
131 " to [$newFileID]\n";
132 ($out, $err) = $automator->call("put_revision", $manifest);
133 my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
134 error("Unable to make new monotone repository revision")
135 if (! defined $newRevID || length $newRevID != 40);
136 debug("put revision: $newRevID");
138 # now we need to add certs for this revision...
139 # author, branch, changelog, date
140 $automator->call("cert", $newRevID, "author", $author);
141 $automator->call("cert", $newRevID, "branch", $branch);
142 $automator->call("cert", $newRevID, "changelog", $message);
143 $automator->call("cert", $newRevID, "date",
144 time2str("%Y-%m-%dT%T", time, "UTC"));
146 debug("Added certs for rev: $newRevID");
150 sub read_certs ($$) { #{{{
153 my @results = $automator->call("certs", $rev);
156 my $line = $results[0];
157 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) {
170 sub get_changed_files ($$) { #{{{
174 my @results = $automator->call("get_revision", $rev);
175 my $changes=$results[0];
180 while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
182 # don't add the same file multiple times
183 if (! $seen{$file}) {
192 sub rcs_update () { #{{{
195 if (defined($config{mtnsync}) && $config{mtnsync}) {
196 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
197 "--quiet", "--ticker=none",
198 "--key", $config{mtnkey}) != 0) {
199 debug("monotone sync failed before update");
203 if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
204 debug("monotone update failed");
208 sub rcs_prepedit ($) { #{{{
213 # For monotone, return the revision of the file when
218 sub rcs_commit ($$$;$$) { #{{{
219 # Tries to commit the page; returns undef on _success_ and
220 # a version of the page with the rcs's conflict markers on failure.
221 # The file is relative to the srcdir.
230 $author="Web user: " . $user;
232 elsif (defined $ipaddr) {
233 $author="Web IP: " . $ipaddr;
236 $author="Web: Anonymous";
241 my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
243 if (defined $rev && defined $oldrev && $rev ne $oldrev) {
244 my $automator = Monotone->new();
245 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
247 # Something has been committed, has this file changed?
249 $automator->setOpts("r", $oldrev, "r", $rev);
250 ($out, $err) = $automator->call("content_diff", $file);
251 debug("Problem committing $file") if ($err ne "");
255 # Commit a revision with just this file changed off
258 # first get the contents
259 debug("File changed: forming branch");
260 my $newfile=readfile("$config{srcdir}/$file");
262 # then get the old content ID from the diff
263 if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
264 error("Unable to find previous file ID for $file");
268 # get the branch we're working in
269 ($out, $err) = $automator->call("get_option", "branch");
271 error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
274 # then put the new content into the DB (and record the new content ID)
275 my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
279 # if we made it to here then the file has been committed... revert the local copy
280 if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
281 debug("Unable to revert $file after merge on conflicted commit!");
283 debug("Divergence created! Attempting auto-merge.");
285 # see if it will merge cleanly
286 $ENV{MTN_MERGE}="fail";
287 my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
290 # push any changes so far
291 if (defined($config{mtnsync}) && $config{mtnsync}) {
292 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
293 debug("monotone push failed");
297 if (defined($mergeResult)) {
298 # everything is merged - bring outselves up to date
299 if (system("mtn", "--root=$config{mtnrootdir}",
300 "update", "-r", $mergeResult) != 0) {
301 debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
305 debug("Auto-merge failed. Using diff-merge to add conflict markers.");
307 $ENV{MTN_MERGE}="diffutils";
308 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
309 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
311 $ENV{MTN_MERGE_DIFFUTILS}="";
313 if (!defined($mergeResult)) {
314 debug("Unable to insert conflict markers!");
315 error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
316 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
317 "but at present the different versions cannot be reconciled through the web interface. ".
318 "Please use the non-web interface to resolve the conflicts.");
321 if (system("mtn", "--root=$config{mtnrootdir}",
322 "update", "-r", $mergeResult) != 0) {
323 debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
326 # return "conflict enhanced" file to the user
327 # for cleanup note, this relies on the fact
328 # that ikiwiki seems to call rcs_prepedit()
329 # again after we return
330 return readfile("$config{srcdir}/$file");
337 # If we reached here then the file we're looking at hasn't changed
338 # since $oldrev. Commit it.
340 if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
341 "--author", $author, "--key", $config{mtnkey}, "-m",
342 possibly_foolish_untaint($message), $file) != 0) {
343 debug("Traditional commit failed! Returning data as conflict.");
344 my $conflict=readfile("$config{srcdir}/$file");
345 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
346 "--quiet", $file) != 0) {
347 debug("monotone revert failed");
351 if (defined($config{mtnsync}) && $config{mtnsync}) {
352 if (system("mtn", "--root=$config{mtnrootdir}", "push",
353 "--quiet", "--ticker=none", "--key",
354 $config{mtnkey}) != 0) {
355 debug("monotone push failed");
359 return undef # success
362 sub rcs_commit_staged ($$$) {
363 # Commits all staged changes. Changes can be staged using rcs_add,
364 # rcs_remove, and rcs_rename.
365 my ($message, $user, $ipaddr)=@_;
367 # Note - this will also commit any spurious changes that happen to be
368 # lying around in the working copy. There shouldn't be any, but...
375 $author="Web user: " . $user;
377 elsif (defined $ipaddr) {
378 $author="Web IP: " . $ipaddr;
381 $author="Web: Anonymous";
384 if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
385 "--author", $author, "--key", $config{mtnkey}, "-m",
386 possibly_foolish_untaint($message)) != 0) {
387 error("Monotone commit failed");
391 sub rcs_add ($) { #{{{
396 if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
398 error("Monotone add failed");
402 sub rcs_remove ($) { # {{{
407 # Note: it is difficult to undo a remove in Monotone at the moment.
408 # Until this is fixed, it might be better to make 'rm' move things
409 # into an attic, rather than actually remove them.
410 # To resurrect a file, you currently add a new file with the contents
411 # you want it to have. This loses all connectivity and automated
412 # merging with the 'pre-delete' versions of the file.
414 if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
416 error("Monotone remove failed");
420 sub rcs_rename ($$) { # {{{
421 my ($src, $dest) = @_;
425 if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
427 error("Monotone rename failed");
431 sub rcs_recentchanges ($) { #{{{
437 # use log --brief to get a list of revs, as this
438 # gives the results in a nice order
439 # (otherwise we'd have to do our own date sorting)
443 my $child = open(MTNLOG, "-|");
445 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
446 "--brief") || error("mtn log failed to run");
449 while (($num >= 0) and (my $line = <MTNLOG>)) {
450 if ($line =~ m/^($sha1_pattern)/) {
455 close MTNLOG || debug("mtn log exited $?");
457 my $automator = Monotone->new();
458 $automator->open(undef, $config{mtnrootdir});
461 my $rev = shift @revs;
462 # first go through and figure out the messages, etc
464 my $certs = [read_certs($automator, $rev)];
469 my (@pages, @message);
471 foreach my $cert (@$certs) {
472 if ($cert->{signature} eq "ok" &&
473 $cert->{trust} eq "trusted") {
474 if ($cert->{name} eq "author") {
475 $user = $cert->{value};
476 # detect the source of the commit
478 if ($cert->{key} eq $config{mtnkey}) {
481 $committype = "monotone";
483 } elsif ($cert->{name} eq "date") {
484 $when = str2time($cert->{value}, 'UTC');
485 } elsif ($cert->{name} eq "changelog") {
486 my $messageText = $cert->{value};
487 # split the changelog into multiple
489 foreach my $msgline (split(/\n/, $messageText)) {
490 push @message, { line => $msgline };
496 my @changed_files = get_changed_files($automator, $rev);
499 my ($out, $err) = $automator->call("parents", $rev);
500 my @parents = ($out =~ m/^($sha1_pattern)$/);
501 my $parent = $parents[0];
503 foreach $file (@changed_files) {
504 next unless length $file;
506 if (defined $config{diffurl} and (@parents == 1)) {
507 my $diffurl=$config{diffurl};
508 $diffurl=~s/\[\[r1\]\]/$parent/g;
509 $diffurl=~s/\[\[r2\]\]/$rev/g;
510 $diffurl=~s/\[\[file\]\]/$file/g;
512 page => pagename($file),
518 page => pagename($file),
526 committype => $committype,
528 message => [@message],
538 sub rcs_diff ($) { #{{{
540 my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
544 my $child = open(MTNDIFF, "-|");
546 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
549 my (@lines) = <MTNDIFF>;
551 close MTNDIFF || debug("mtn diff $sha1 exited $?");
557 return join("", @lines);
561 sub rcs_getctime ($) { #{{{
566 my $child = open(MTNLOG, "-|");
568 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
569 "--brief", $file) || error("mtn log $file failed to run");
574 if (/^($sha1_pattern)/) {
578 close MTNLOG || debug("mtn log $file exited $?");
580 if (! defined $firstRev) {
581 debug "failed to parse mtn log for $file";
585 my $automator = Monotone->new();
586 $automator->open(undef, $config{mtnrootdir});
588 my $certs = [read_certs($automator, $firstRev)];
594 foreach my $cert (@$certs) {
595 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
596 if ($cert->{name} eq "date") {
597 $date = $cert->{value};
602 if (! defined $date) {
603 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
607 $date=str2time($date, 'UTC');
608 debug("found ctime ".localtime($date)." for $file");