Merge branch 'master' into autoconfig
[ikiwiki.git] / IkiWiki / Plugin / monotone.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::monotone;
3
4 use warnings;
5 use strict;
6 use IkiWiki;
7 use Monotone;
8 use Date::Parse qw(str2time);
9 use Date::Format qw(time2str);
10
11 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
12
13 sub import { #{{{
14         hook(type => "checkconfig", id => "monotone", call => \&checkconfig);
15         hook(type => "getsetup", id => "monotone", call => \&getsetup);
16         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
17         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
18         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
19         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
20         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
21         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
22         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
23         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
24         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
25         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
26 } #}}}
27
28 sub checkconfig () { #{{{
29         if (!defined($config{mtnrootdir})) {
30                 $config{mtnrootdir} = $config{srcdir};
31         }
32         if (! -d "$config{mtnrootdir}/_MTN") {
33                 error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
34         }
35         
36         my $child = open(MTN, "-|");
37         if (! $child) {
38                 open STDERR, ">/dev/null";
39                 exec("mtn", "version") || error("mtn version failed to run");
40         }
41
42         my $version=undef;
43         while (<MTN>) {
44                 if (/^monotone (\d+\.\d+) /) {
45                         $version=$1;
46                 }
47         }
48
49         close MTN || debug("mtn version exited $?");
50
51         if (!defined($version)) {
52                 error("Cannot determine monotone version");
53         }
54         if ($version < 0.38) {
55                 error("Monotone version too old, is $version but required 0.38");
56         }
57
58         if (length $config{mtn_wrapper}) {
59                 push @{$config{wrappers}}, {
60                         wrapper => $config{mtn_wrapper},
61                         wrappermode => (defined $config{mtn_wrappermode} ? $config{mtn_wrappermode} : "06755"),
62                 };
63         }
64 } #}}}
65
66 sub getsetup () { #{{{
67         return
68                 mtn_wrapper => {
69                         type => "string",
70                         example => "/srv/mtn/wiki/_MTN/ikiwiki-netsync-hook",
71                         description => "monotone netsync hook executable to generate",
72                         safe => 0, # file
73                         rebuild => 0,
74                 },
75                 mtn_wrappermode => {
76                         type => "string",
77                         example => '06755',
78                         description => "mode for mtn_wrapper (can safely be made suid)",
79                         safe => 0,
80                         rebuild => 0,
81                 },
82                 mtnkey => {
83                         type => "string",
84                         example => 'web@example.com',
85                         description => "your monotone key",
86                         safe => 1,
87                         rebuild => 0,
88                 },
89                 historyurl => {
90                         type => "string",
91                         example => "http://viewmtn.example.com/branch/head/filechanges/com.example.branch/[[file]]",
92                         description => "viewmtn url to show file history ([[file]] substituted)",
93                         safe => 1,
94                         rebuild => 1,
95                 },
96                 diffurl => {
97                         type => "string",
98                         example => "http://viewmtn.example.com/revision/diff/[[r1]]/with/[[r2]]/[[file]]",
99                         description => "viewmtn url to show a diff ([[r1]], [[r2]], and [[file]] substituted)",
100                         safe => 1,
101                         rebuild => 1,
102                 },
103                 mtnsync => {
104                         type => "boolean",
105                         example => 0,
106                         description => "sync on update and commit?",
107                         safe => 0, # paranoia
108                         rebuild => 0,
109                 },
110                 mtnrootdir => {
111                         type => "string",
112                         description => "path to your workspace (defaults to the srcdir; specify if the srcdir is a subdirectory of the workspace)",
113                         safe => 0, # path
114                         rebuild => 0,
115                 },
116 } #}}}
117
118 sub get_rev () { #{{{
119         my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
120
121         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
122         if (! $sha1) {
123                 debug("Unable to get base revision for '$config{srcdir}'.")
124         }
125
126         return $sha1;
127 } #}}}
128
129 sub get_rev_auto ($) { #{{{
130         my $automator=shift;
131
132         my @results = $automator->call("get_base_revision_id");
133
134         my $sha1 = $results[0];
135         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
136         if (! $sha1) {
137                 debug("Unable to get base revision for '$config{srcdir}'.")
138         }
139
140         return $sha1;
141 } #}}}
142
143 sub mtn_merge ($$$$) { #{{{
144         my $leftRev=shift;
145         my $rightRev=shift;
146         my $branch=shift;
147         my $author=shift;
148     
149         my $mergeRev;
150
151         my $child = open(MTNMERGE, "-|");
152         if (! $child) {
153                 open STDERR, ">&STDOUT";
154                 exec("mtn", "--root=$config{mtnrootdir}",
155                      "explicit_merge", $leftRev, $rightRev,
156                      $branch, "--author", $author, "--key", 
157                      $config{mtnkey}) || error("mtn merge failed to run");
158         }
159
160         while (<MTNMERGE>) {
161                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
162                         $mergeRev=$1;
163                 }
164         }
165         
166         close MTNMERGE || return undef;
167
168         debug("merged $leftRev, $rightRev to make $mergeRev");
169
170         return $mergeRev;
171 } #}}}
172
173 sub commit_file_to_new_rev ($$$$$$$$) { #{{{
174         my $automator=shift;
175         my $wsfilename=shift;
176         my $oldFileID=shift;
177         my $newFileContents=shift;
178         my $oldrev=shift;
179         my $branch=shift;
180         my $author=shift;
181         my $message=shift;
182         
183         #store the file
184         my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
185         my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
186         error("Failed to store file data for $wsfilename in repository")
187                 if (! defined $newFileID || length $newFileID != 40);
188
189         # get the mtn filename rather than the workspace filename
190         ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
191         my ($filename) = ($out =~ m/^file "(.*)"$/);
192         error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
193         debug("Converted ws filename of $wsfilename to repos filename of $filename");
194
195         # then stick in a new revision for this file
196         my $manifest = "format_version \"1\"\n\n".
197                        "new_manifest [0000000000000000000000000000000000000000]\n\n".
198                        "old_revision [$oldrev]\n\n".
199                        "patch \"$filename\"\n".
200                        " from [$oldFileID]\n".
201                        "   to [$newFileID]\n";
202         ($out, $err) = $automator->call("put_revision", $manifest);
203         my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
204         error("Unable to make new monotone repository revision")
205                 if (! defined $newRevID || length $newRevID != 40);
206         debug("put revision: $newRevID");
207         
208         # now we need to add certs for this revision...
209         # author, branch, changelog, date
210         $automator->call("cert", $newRevID, "author", $author);
211         $automator->call("cert", $newRevID, "branch", $branch);
212         $automator->call("cert", $newRevID, "changelog", $message);
213         $automator->call("cert", $newRevID, "date",
214                 time2str("%Y-%m-%dT%T", time, "UTC"));
215         
216         debug("Added certs for rev: $newRevID");
217         return $newRevID;
218 } #}}}
219
220 sub read_certs ($$) { #{{{
221         my $automator=shift;
222         my $rev=shift;
223         my @results = $automator->call("certs", $rev);
224         my @ret;
225
226         my $line = $results[0];
227         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) {
228                 push @ret, {
229                         key => $1,
230                         signature => $2,
231                         name => $3,
232                         value => $4,
233                         trust => $5,
234                 };
235         }
236
237         return @ret;
238 } #}}}
239
240 sub get_changed_files ($$) { #{{{
241         my $automator=shift;
242         my $rev=shift;
243         
244         my @results = $automator->call("get_revision", $rev);
245         my $changes=$results[0];
246
247         my @ret;
248         my %seen = ();
249         
250         while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
251                 my $file = $2;
252                 # don't add the same file multiple times
253                 if (! $seen{$file}) {
254                         push @ret, $file;
255                         $seen{$file} = 1;
256                 }
257         }
258         
259         return @ret;
260 } #}}}
261
262 sub rcs_update () { #{{{
263         chdir $config{srcdir}
264             or error("Cannot chdir to $config{srcdir}: $!");
265
266         if (defined($config{mtnsync}) && $config{mtnsync}) {
267                 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
268                            "--quiet", "--ticker=none", 
269                            "--key", $config{mtnkey}) != 0) {
270                         debug("monotone sync failed before update");
271                 }
272         }
273
274         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
275                 debug("monotone update failed");
276         }
277 } #}}}
278
279 sub rcs_prepedit ($) { #{{{
280         my $file=shift;
281
282         chdir $config{srcdir}
283             or error("Cannot chdir to $config{srcdir}: $!");
284
285         # For monotone, return the revision of the file when
286         # editing begins.
287         return get_rev();
288 } #}}}
289
290 sub rcs_commit ($$$;$$) { #{{{
291         # Tries to commit the page; returns undef on _success_ and
292         # a version of the page with the rcs's conflict markers on failure.
293         # The file is relative to the srcdir.
294         my $file=shift;
295         my $message=shift;
296         my $rcstoken=shift;
297         my $user=shift;
298         my $ipaddr=shift;
299         my $author;
300
301         if (defined $user) {
302                 $author="Web user: " . $user;
303         }
304         elsif (defined $ipaddr) {
305                 $author="Web IP: " . $ipaddr;
306         }
307         else {
308                 $author="Web: Anonymous";
309         }
310
311         chdir $config{srcdir}
312             or error("Cannot chdir to $config{srcdir}: $!");
313
314         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
315         my $rev = get_rev();
316         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
317                 my $automator = Monotone->new();
318                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
319
320                 # Something has been committed, has this file changed?
321                 my ($out, $err);
322                 $automator->setOpts("r", $oldrev, "r", $rev);
323                 ($out, $err) = $automator->call("content_diff", $file);
324                 debug("Problem committing $file") if ($err ne "");
325                 my $diff = $out;
326                 
327                 if ($diff) {
328                         # Commit a revision with just this file changed off
329                         # the old revision.
330                         #
331                         # first get the contents
332                         debug("File changed: forming branch");
333                         my $newfile=readfile("$config{srcdir}/$file");
334                         
335                         # then get the old content ID from the diff
336                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
337                                 error("Unable to find previous file ID for $file");
338                         }
339                         my $oldFileID = $1;
340
341                         # get the branch we're working in
342                         ($out, $err) = $automator->call("get_option", "branch");
343                         chomp $out;
344                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
345                         my $branch = $1;
346
347                         # then put the new content into the DB (and record the new content ID)
348                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
349
350                         $automator->close();
351
352                         # if we made it to here then the file has been committed... revert the local copy
353                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
354                                 debug("Unable to revert $file after merge on conflicted commit!");
355                         }
356                         debug("Divergence created! Attempting auto-merge.");
357
358                         # see if it will merge cleanly
359                         $ENV{MTN_MERGE}="fail";
360                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
361                         $ENV{MTN_MERGE}="";
362
363                         # push any changes so far
364                         if (defined($config{mtnsync}) && $config{mtnsync}) {
365                                 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
366                                         debug("monotone push failed");
367                                 }
368                         }
369                         
370                         if (defined($mergeResult)) {
371                                 # everything is merged - bring outselves up to date
372                                 if (system("mtn", "--root=$config{mtnrootdir}",
373                                            "update", "-r", $mergeResult) != 0) {
374                                         debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
375                                 }
376                         }
377                         else {
378                                 debug("Auto-merge failed.  Using diff-merge to add conflict markers.");
379                                 
380                                 $ENV{MTN_MERGE}="diffutils";
381                                 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
382                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
383                                 $ENV{MTN_MERGE}="";
384                                 $ENV{MTN_MERGE_DIFFUTILS}="";
385                                 
386                                 if (!defined($mergeResult)) {
387                                         debug("Unable to insert conflict markers!");
388                                         error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
389                                                 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
390                                                 "but at present the different versions cannot be reconciled through the web interface. ".
391                                                 "Please use the non-web interface to resolve the conflicts.");
392                                 }
393                                 
394                                 if (system("mtn", "--root=$config{mtnrootdir}",
395                                            "update", "-r", $mergeResult) != 0) {
396                                         debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
397                                 }
398                                 
399                                 # return "conflict enhanced" file to the user
400                                 # for cleanup note, this relies on the fact
401                                 # that ikiwiki seems to call rcs_prepedit()
402                                 # again after we return
403                                 return readfile("$config{srcdir}/$file");
404                         }
405                         return undef;
406                 }
407                 $automator->close();
408         }
409
410         # If we reached here then the file we're looking at hasn't changed
411         # since $oldrev. Commit it.
412
413         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
414                    "--author", $author, "--key", $config{mtnkey}, "-m",
415                    IkiWiki::possibly_foolish_untaint($message), $file) != 0) {
416                 debug("Traditional commit failed! Returning data as conflict.");
417                 my $conflict=readfile("$config{srcdir}/$file");
418                 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
419                            "--quiet", $file) != 0) {
420                         debug("monotone revert failed");
421                 }
422                 return $conflict;
423         }
424         if (defined($config{mtnsync}) && $config{mtnsync}) {
425                 if (system("mtn", "--root=$config{mtnrootdir}", "push",
426                            "--quiet", "--ticker=none", "--key",
427                            $config{mtnkey}) != 0) {
428                         debug("monotone push failed");
429                 }
430         }
431
432         return undef # success
433 } #}}}
434
435 sub rcs_commit_staged ($$$) {
436         # Commits all staged changes. Changes can be staged using rcs_add,
437         # rcs_remove, and rcs_rename.
438         my ($message, $user, $ipaddr)=@_;
439         
440         # Note - this will also commit any spurious changes that happen to be
441         # lying around in the working copy.  There shouldn't be any, but...
442         
443         chdir $config{srcdir}
444             or error("Cannot chdir to $config{srcdir}: $!");
445
446         my $author;
447
448         if (defined $user) {
449                 $author="Web user: " . $user;
450         }
451         elsif (defined $ipaddr) {
452                 $author="Web IP: " . $ipaddr;
453         }
454         else {
455                 $author="Web: Anonymous";
456         }
457
458         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
459                    "--author", $author, "--key", $config{mtnkey}, "-m",
460                    IkiWiki::possibly_foolish_untaint($message)) != 0) {
461                 error("Monotone commit failed");
462         }
463 }
464
465 sub rcs_add ($) { #{{{
466         my $file=shift;
467
468         chdir $config{srcdir}
469             or error("Cannot chdir to $config{srcdir}: $!");
470
471         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
472                    $file) != 0) {
473                 error("Monotone add failed");
474         }
475 } #}}}
476
477 sub rcs_remove ($) { # {{{
478         my $file = shift;
479
480         chdir $config{srcdir}
481             or error("Cannot chdir to $config{srcdir}: $!");
482
483         # Note: it is difficult to undo a remove in Monotone at the moment.
484         # Until this is fixed, it might be better to make 'rm' move things
485         # into an attic, rather than actually remove them.
486         # To resurrect a file, you currently add a new file with the contents
487         # you want it to have.  This loses all connectivity and automated
488         # merging with the 'pre-delete' versions of the file.
489
490         if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
491                    $file) != 0) {
492                 error("Monotone remove failed");
493         }
494 } #}}}
495
496 sub rcs_rename ($$) { # {{{
497         my ($src, $dest) = @_;
498
499         chdir $config{srcdir}
500             or error("Cannot chdir to $config{srcdir}: $!");
501
502         if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
503                    $src, $dest) != 0) {
504                 error("Monotone rename failed");
505         }
506 } #}}}
507
508 sub rcs_recentchanges ($) { #{{{
509         my $num=shift;
510         my @ret;
511
512         chdir $config{srcdir}
513             or error("Cannot chdir to $config{srcdir}: $!");
514
515         # use log --brief to get a list of revs, as this
516         # gives the results in a nice order
517         # (otherwise we'd have to do our own date sorting)
518
519         my @revs;
520
521         my $child = open(MTNLOG, "-|");
522         if (! $child) {
523                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
524                      "--brief") || error("mtn log failed to run");
525         }
526
527         while (($num >= 0) and (my $line = <MTNLOG>)) {
528                 if ($line =~ m/^($sha1_pattern)/) {
529                         push @revs, $1;
530                         $num -= 1;
531                 }
532         }
533         close MTNLOG || debug("mtn log exited $?");
534
535         my $automator = Monotone->new();
536         $automator->open(undef, $config{mtnrootdir});
537
538         while (@revs != 0) {
539                 my $rev = shift @revs;
540                 # first go through and figure out the messages, etc
541
542                 my $certs = [read_certs($automator, $rev)];
543                 
544                 my $user;
545                 my $when;
546                 my $committype;
547                 my (@pages, @message);
548                 
549                 foreach my $cert (@$certs) {
550                         if ($cert->{signature} eq "ok" &&
551                             $cert->{trust} eq "trusted") {
552                                 if ($cert->{name} eq "author") {
553                                         $user = $cert->{value};
554                                         # detect the source of the commit
555                                         # from the changelog
556                                         if ($cert->{key} eq $config{mtnkey}) {
557                                                 $committype = "web";
558                                         } else {
559                                                 $committype = "monotone";
560                                         }
561                                 } elsif ($cert->{name} eq "date") {
562                                         $when = str2time($cert->{value}, 'UTC');
563                                 } elsif ($cert->{name} eq "changelog") {
564                                         my $messageText = $cert->{value};
565                                         # split the changelog into multiple
566                                         # lines
567                                         foreach my $msgline (split(/\n/, $messageText)) {
568                                                 push @message, { line => $msgline };
569                                         }
570                                 }
571                         }
572                 }
573                 
574                 my @changed_files = get_changed_files($automator, $rev);
575                 my $file;
576                 
577                 my ($out, $err) = $automator->call("parents", $rev);
578                 my @parents = ($out =~ m/^($sha1_pattern)$/);
579                 my $parent = $parents[0];
580
581                 foreach $file (@changed_files) {
582                         next unless length $file;
583                         
584                         if (defined $config{diffurl} and (@parents == 1)) {
585                                 my $diffurl=$config{diffurl};
586                                 $diffurl=~s/\[\[r1\]\]/$parent/g;
587                                 $diffurl=~s/\[\[r2\]\]/$rev/g;
588                                 $diffurl=~s/\[\[file\]\]/$file/g;
589                                 push @pages, {
590                                         page => pagename($file),
591                                         diffurl => $diffurl,
592                                 };
593                         }
594                         else {
595                                 push @pages, {
596                                         page => pagename($file),
597                                 }
598                         }
599                 }
600                 
601                 push @ret, {
602                         rev => $rev,
603                         user => $user,
604                         committype => $committype,
605                         when => $when,
606                         message => [@message],
607                         pages => [@pages],
608                 } if @pages;
609         }
610
611         $automator->close();
612
613         return @ret;
614 } #}}}
615
616 sub rcs_diff ($) { #{{{
617         my $rev=shift;
618         my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
619         
620         chdir $config{srcdir}
621             or error("Cannot chdir to $config{srcdir}: $!");
622
623         my $child = open(MTNDIFF, "-|");
624         if (! $child) {
625                 exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
626         }
627
628         my (@lines) = <MTNDIFF>;
629
630         close MTNDIFF || debug("mtn diff $sha1 exited $?");
631
632         if (wantarray) {
633                 return @lines;
634         }
635         else {
636                 return join("", @lines);
637         }
638 } #}}}
639
640 sub rcs_getctime ($) { #{{{
641         my $file=shift;
642
643         chdir $config{srcdir}
644             or error("Cannot chdir to $config{srcdir}: $!");
645
646         my $child = open(MTNLOG, "-|");
647         if (! $child) {
648                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
649                      "--brief", $file) || error("mtn log $file failed to run");
650         }
651
652         my $firstRev;
653         while (<MTNLOG>) {
654                 if (/^($sha1_pattern)/) {
655                         $firstRev=$1;
656                 }
657         }
658         close MTNLOG || debug("mtn log $file exited $?");
659
660         if (! defined $firstRev) {
661                 debug "failed to parse mtn log for $file";
662                 return 0;
663         }
664
665         my $automator = Monotone->new();
666         $automator->open(undef, $config{mtnrootdir});
667
668         my $certs = [read_certs($automator, $firstRev)];
669
670         $automator->close();
671
672         my $date;
673
674         foreach my $cert (@$certs) {
675                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
676                         if ($cert->{name} eq "date") {
677                                 $date = $cert->{value};
678                         }
679                 }
680         }
681
682         if (! defined $date) {
683                 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
684                 return 0;
685         }
686
687         $date=str2time($date, 'UTC');
688         debug("found ctime ".localtime($date)." for $file");
689         return $date;
690 } #}}}
691
692 1