move enormous data block to __DATA__
[ikiwiki.git] / IkiWiki / Rcs / monotone.pm
1 #!/usr/bin/perl
2 use warnings;
3 use strict;
4 use IkiWiki;
5 use Monotone;
6 use Date::Parse qw(str2time);
7 use Date::Format qw(time2str);
8
9 package IkiWiki;
10
11 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
12
13 sub check_config() {
14         if (!defined($config{mtnrootdir})) {
15                 $config{mtnrootdir} = $config{srcdir};
16         }
17         if (! -d "$config{mtnrootdir}/_MTN") {
18                 error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
19         }
20         
21         if (!defined($config{mtnmergerc})) {
22                 $config{mtnmergerc} = "$config{mtnrootdir}/_MTN/mergerc";
23         }
24         
25         chdir $config{srcdir}
26             or error("Cannot chdir to $config{srcdir}: $!");
27 }
28
29 sub get_rev () {
30         my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
31
32         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
33         if (! $sha1) {
34                 warn("Unable to get base revision for '$config{srcdir}'.")
35         }
36
37         return $sha1;
38 }
39
40 sub get_rev_auto ($) {
41         my $automator=shift;
42
43         my @results = $automator->call("get_base_revision_id");
44
45         my $sha1 = $results[0];
46         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
47         if (! $sha1) {
48                 warn("Unable to get base revision for '$config{srcdir}'.")
49         }
50
51         return $sha1;
52 }
53
54 sub mtn_merge ($$$$$) {
55     my $leftRev=shift;
56     my $rightRev=shift;
57     my $branch=shift;
58     my $author=shift;
59     my $message=shift;  # ignored for the moment because mtn doesn't support it
60     
61     my $mergeRev;
62
63         my $mergerc = $config{mtnmergerc};
64     
65         my $child = open(MTNMERGE, "-|");
66         if (! $child) {
67                 open STDERR, ">&STDOUT";
68                 exec("mtn", "--root=$config{mtnrootdir}", "--rcfile", $mergerc, "explicit_merge", $leftRev, $rightRev, $branch, "--author", $author, "--key", $config{mtnkey}) || error("mtn merge failed to run");
69         }
70
71         while (<MTNMERGE>) {
72                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
73                         $mergeRev=$1;
74                 }
75         }
76         
77         close MTNMERGE || return undef;
78
79         warn("merged $leftRev, $rightRev to make $mergeRev");
80
81         return $mergeRev;
82 }
83
84 sub commit_file_to_new_rev($$$$$$$$) {
85         my $automator=shift;
86         my $wsfilename=shift;
87         my $oldFileID=shift;
88         my $newFileContents=shift;
89         my $oldrev=shift;
90         my $branch=shift;
91         my $author=shift;
92         my $message=shift;
93         
94         #store the file
95         my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
96         my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
97         error("Failed to store file data for $wsfilename in repository") if (!defined($newFileID) || 40 != length $newFileID);
98
99         # get the mtn filename rather than the workspace filename
100         ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
101         my ($filename) = ($out =~ m/^file "(.*)"$/);
102         error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
103         warn("Converted ws filename of $wsfilename to repos filename of $filename");
104
105         # then stick in a new revision for this file
106         my $manifest =  "format_version \"1\"\n\n".
107                                         "new_manifest [0000000000000000000000000000000000000000]\n\n".
108                                         "old_revision [$oldrev]\n\n".
109                                         "patch \"$filename\"\n".
110                                         " from [$oldFileID]\n".
111                                         "   to [$newFileID]\n";
112         ($out, $err) = $automator->call("put_revision", $manifest);
113         my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
114         error("Unable to make new monotone repository revision") if (!defined($newRevID) || 40 != length $newRevID);
115         warn("put revision: $newRevID");
116         
117         # now we need to add certs for this revision...
118         # author, branch, changelog, date
119         $automator->call("cert", $newRevID, "author", $author);
120         $automator->call("cert", $newRevID, "branch", $branch);
121         $automator->call("cert", $newRevID, "changelog", $message);
122         $automator->call("cert", $newRevID, "date", time2str("%Y-%m-%dT%T", time, "UTC"));
123         
124         warn("Added certs for rev: $newRevID");
125         return $newRevID;
126 }
127
128 sub check_mergerc() {
129         my $mergerc = $config{mtnmergerc};
130         if (! -r $mergerc ) {
131                 warn("$mergerc doesn't exist.  Creating file with default mergers.");
132                 open(my $out, ">$mergerc") or error("can't open $mergerc: $!");
133                 print $out <DATA>;
134                 close $out;
135         }
136 }
137
138 sub read_certs ($$) {
139         my $automator=shift;
140         my $rev=shift;
141         my @results = $automator->call("certs", $rev);
142         my @ret;
143
144         my $line = $results[0];
145         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) {
146                 push @ret, {
147                         key => $1,
148                         signature => $2,
149                         name => $3,
150                         value => $4,
151                         trust => $5,
152                 };
153         }
154
155         return @ret;
156 }
157
158 sub get_changed_files ($$) {
159         my $automator=shift;
160         my $rev=shift;
161         
162         my @results = $automator->call("get_revision", $rev);
163         my $changes=$results[0];
164
165         my @ret;
166         my %seen = ();
167         
168         while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
169                 my $file = $2;
170                 if (! $seen{$file}) {   # don't add the same file multiple times
171                         push @ret, $file;
172                         $seen{$file} = 1;
173                 }
174         }
175         
176         return @ret;
177 }
178
179 # The following functions are the ones actually called by Ikiwiki
180
181 sub rcs_update () {
182         # Update working directory to current version.
183
184         check_config();
185
186         if (defined($config{mtnsync}) && $config{mtnsync}) {
187                 if (system("mtn", "--root=$config{mtnrootdir}", "sync", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
188                         warn("monotone sync failed before update\n");
189                 }
190         }
191
192         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
193                 warn("monotone update failed\n");
194         }
195 }
196
197 sub rcs_prepedit ($) {
198         # Prepares to edit a file under revision control. Returns a token
199         # that must be passed into rcs_commit when the file is ready
200         # for committing.
201         # The file is relative to the srcdir.
202         my $file=shift;
203
204         check_config();
205
206         # For monotone, return the revision of the file when
207         # editing begins.
208         return get_rev();
209 }
210
211 sub rcs_commit ($$$;$$) {
212         # Tries to commit the page; returns undef on _success_ and
213         # a version of the page with the rcs's conflict markers on failure.
214         # The file is relative to the srcdir.
215         my $file=shift;
216         my $message=shift;
217         my $rcstoken=shift;
218         my $user=shift;
219         my $ipaddr=shift;
220         my $author;
221
222         if (defined $user) {
223                 $author="Web user: " . $user;
224         }
225         elsif (defined $ipaddr) {
226                 $author="Web IP: " . $ipaddr;
227         }
228         else {
229                 $author="Web: Anonymous";
230         }
231
232         check_config();
233
234         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
235         my $rev = get_rev();
236         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
237                 my $automator = Monotone->new();
238                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
239
240                 # Something has been committed, has this file changed?
241                 my ($out, $err);
242                 #$automator->setOpts("-r", $oldrev, "-r", $rev);
243                 #my ($out, $err) = $automator->call("content_diff", $file);
244                 #debug("Problem committing $file") if ($err ne "");
245                 # FIXME: use of $file in these backticks is not wise from a
246                 # security POV. Probably safe, but should be avoided
247                 # anyway.
248                 my $diff = `mtn --root=$config{mtnrootdir} au content_diff -r $oldrev -r $rev $file`; # was just $out;
249
250                 if ($diff) {
251                         # this file has changed
252                         # commit a revision with just this file changed off
253                         # the old revision
254                         # first get the contents
255                         warn("File changed: forming branch\n");
256                         my $newfile=readfile("$config{srcdir}/$file");
257                         
258                         # then get the old content ID from the diff
259                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
260                                 error("Unable to find previous file ID for $file");
261                         }
262                         my $oldFileID = $1;
263
264                         # get the branch we're working in
265                         ($out, $err) = $automator->call("get_option", "branch");
266                         chomp $out;
267                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
268                         my $branch = $1;
269
270                         # then put the new content into the DB (and record the new content ID)
271                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
272
273                         $automator->close();
274
275                         # if we made it to here then the file has been committed... revert the local copy
276                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
277                                 warn("Unable to revert $file after merge on conflicted commit!");
278                         }
279                         warn("Divergence created!  Attempting auto-merge.");
280
281                         check_mergerc();
282
283                         # see if it will merge cleanly
284                         $ENV{MTN_MERGE}="fail";
285                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author, "Auto-merging parallel web edits.");
286                         $ENV{MTN_MERGE}="";
287
288                         # push any changes so far
289                         if (defined($config{mtnsync}) && $config{mtnsync}) {
290                                 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
291                                         warn("monotone push failed\n");
292                                 }
293                         }
294                         
295                         if (defined($mergeResult)) {
296                                 # everything is merged - bring outselves up to date
297                                 if (system("mtn", "--root=$config{mtnrootdir}", "update", "-r", $mergeResult) != 0) {
298                                         warn("Unable to update to rev $mergeResult after merge on conflicted commit!");
299                                 }
300                         } else {
301                                 warn("Auto-merge failed.  Using diff-merge to add conflict markers.");
302                                 
303                                 $ENV{MTN_MERGE}="diffutils_force";
304                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author, "Merge parallel conflicting web edits (adding inline conflict markers).\nThis revision should be cleaned up manually.");
305                                 $ENV{MTN_MERGE}="";
306                                 
307                                 if (!defined($mergeResult)) {
308                                         warn("Unable to insert conflict markers!");
309                                         error("Your commit succeeded.  Unfortunately, someone else committed something to the same\n".
310                                                 "part of the wiki at the same time.  Both versions are stored in the monotone repository,\n".
311                                                 "but at present the different versions cannot be reconciled through the web interface.\n\n".
312                                                 "Please use the non-web interface to resolve the conflicts.\n");
313                                 }
314                                 
315                                 # suspend this revision because it has conflict markers...
316                                 if (system("mtn", "--root=$config{mtnrootdir}", "update", "-r", $mergeResult) != 0) {
317                                         warn("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
318                                 }
319                                 
320                                 # return "conflict enhanced" file to the user for cleanup
321                                 # note, this relies on the fact that ikiwiki seems to call rcs_prepedit() again
322                                 # after we return
323                                 return readfile("$config{srcdir}/$file");
324                         }
325                         return undef;
326                 }
327                 $automator->close();
328         }
329
330         # if we reached here then the file we're looking at hasn't changed since $oldrev.  Commit it.
331
332         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet", "--author", $author, "--key", $config{mtnkey},
333                                 "-m", possibly_foolish_untaint($message), $file) != 0) {
334                 warn("Traditional commit failed!\nReturning data as conflict.\n");
335                 my $conflict=readfile("$config{srcdir}/$file");
336                 if (system("mtn", "--root=$config{mtnrootdir}", "revert", "--quiet", $file) != 0) {
337                         warn("monotone revert failed\n");
338                 }
339                 return $conflict;
340         }
341         if (defined($config{mtnsync}) && $config{mtnsync}) {
342                 if (system("mtn", "--root=$config{mtnrootdir}", "sync", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
343                         warn("monotone sync failed\n");
344                 }
345         }
346
347         return undef # success
348 }
349
350 sub rcs_add ($) {
351         # Add a file. The filename is relative to the root of the srcdir.
352         my $file=shift;
353
354         check_config();
355
356         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet", "$config{srcdir}/$file") != 0) {
357                 error("Monotone add failed");
358         }
359 }
360
361 sub rcs_recentchanges ($) {
362         # Examine the RCS history and generate a list of recent changes.
363         # The data structure returned for each change is:
364         # {
365         #       user => # name of user who made the change,
366         #       committype => # either "web" or the name of the rcs,
367         #       when => # time when the change was made,
368         #       message => [
369         #               { line => "commit message line" },
370         #               { line => "commit message line" },
371         #               # etc,
372         #       ],
373         #       pages => [
374         #               {
375         #                       page => # name of page changed,
376         #                       diffurl => # optional url to a diff showing 
377         #                                  # the changes,
378         #               },
379         #               # repeat for each page changed in this commit,
380         #       ],
381         # }
382
383         my $num=shift;
384         my @ret;
385
386         check_config();
387
388         # use log --brief to get a list of revs, as this
389         # gives the results in a nice order
390         # (otherwise we'd have to do our own date sorting)
391
392         my @revs;
393
394         my $child = open(MTNLOG, "-|");
395         if (! $child) {
396                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", "--brief") || error("mtn log failed to run");
397         }
398
399         my $line;
400
401         while (($num >= 0) and ($line = <MTNLOG>)) {
402                 if ($line =~ m/^($sha1_pattern)/) {
403                         push @revs, $1;
404                         $num -= 1;
405                 }
406         }
407         close MTNLOG || warn "mtn log exited $?";
408
409         my $automator = Monotone->new();
410         $automator->open(undef, $config{mtnrootdir});
411
412         while (@revs != 0) {
413                 my $rev = shift @revs;
414                 # first go through and figure out the messages, etc
415
416                 my $certs = [read_certs($automator, $rev)];
417                 
418                 my $user;
419                 my $when;
420                 my $committype;
421                 my (@pages, @message);
422                 
423                 foreach my $cert (@$certs) {
424                         if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
425                                 if ($cert->{name} eq "author") {
426                                         $user = $cert->{value};
427                                         # detect the source of the commit from the changelog
428                                         if ($cert->{key} eq $config{mtnkey}) {
429                                                 $committype = "web";
430                                         } else {
431                                                 $committype = "monotone";
432                                         }
433                                 } elsif ($cert->{name} eq "date") {
434                                         $when = time - str2time($cert->{value}, 'UTC');
435                                 } elsif ($cert->{name} eq "changelog") {
436                                         my $messageText = $cert->{value};
437                                         # split the changelog into multiple lines
438                                         foreach my $msgline (split(/\n/, $messageText)) {
439                                                 push @message, { line => $msgline };
440                                         }
441                                 }
442                         }
443                 }
444                 
445                 my @changed_files = get_changed_files($automator, $rev);
446                 my $file;
447                 
448                 foreach $file (@changed_files) {
449                         push @pages, {
450                                 page => pagename($file),
451                         } if length $file;
452                 }
453                 
454                 push @ret, {
455                         rev => $rev,
456                         user => $user,
457                         committype => $committype,
458                         when => $when,
459                         message => [@message],
460                         pages => [@pages],
461                 } if @pages;
462         }
463
464         $automator->close();
465
466         return @ret;
467 }
468
469 sub rcs_notify () {
470         # This function is called when a change is committed to the wiki,
471         # and ikiwiki is running as a post-commit hook from the RCS.
472         # It should examine the repository to somehow determine what pages
473         # changed, and then send emails to users subscribed to those pages.
474         
475         warn("The monotone rcs_notify function is currently untested.  Use at own risk!");
476         
477         if (! exists $ENV{REV}) {
478                 error(gettext("REV is not set, not running from mtn post-commit hook, cannot send notifications"));
479         }
480         if ($ENV{REV} !~ m/($sha1_pattern)/) { # sha1 is untainted now
481                 error(gettext("REV is not a valid revision identifier, cannot send notifications"));
482         }
483         my $rev = $1;
484         
485         check_config();
486
487         my $automator = Monotone->new();
488         $automator->open(undef, $config{mtnrootdir});
489
490         my $certs = [read_certs($automator, $rev)];
491         my $user;
492         my $message;
493         my $when;
494
495         foreach my $cert (@$certs) {
496                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
497                         if ($cert->{name} eq "author") {
498                                 $user = $cert->{value};
499                         } elsif ($cert->{name} eq "date") {
500                                 $when = $cert->{value};
501                         } elsif ($cert->{name} eq "changelog") {
502                                 $message = $cert->{value};
503                         }
504                 }
505         }
506                 
507         my @changed_pages = get_changed_files($automator, $rev);
508         
509         $automator->close();
510         
511         require IkiWiki::UserInfo;
512         send_commit_mails(
513                 sub {
514                         return $message;
515                 },
516                 sub {
517                         `mtn --root=$config{mtnrootdir} au content_diff -r $rev`;
518                 }, $user, @changed_pages);
519 }
520
521 sub rcs_getctime ($) {
522         # Optional, used to get the page creation time from the RCS.
523         # error gettext("getctime not implemented");
524         my $file=shift;
525
526         check_config();
527
528         my $child = open(MTNLOG, "-|");
529         if (! $child) {
530                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph", "--brief", $file) || error("mtn log $file failed to run");
531         }
532
533         my $firstRev;
534         while (<MTNLOG>) {
535                 if (/^($sha1_pattern)/) {
536                         $firstRev=$1;
537                 }
538         }
539         close MTNLOG || warn "mtn log $file exited $?";
540
541         if (! defined $firstRev) {
542                 warn "failed to parse mtn log for $file\n";
543                 return 0;
544         }
545
546         my $automator = Monotone->new();
547         $automator->open(undef, $config{mtnrootdir});
548
549         my $certs = [read_certs($automator, $firstRev)];
550
551         $automator->close();
552
553         my $date;
554
555         foreach my $cert (@$certs) {
556                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
557                         if ($cert->{name} eq "date") {
558                                 $date = $cert->{value};
559                         }
560                 }
561         }
562
563         if (! defined $date) {
564                 warn "failed to find date cert for revision $firstRev when looking for creation time of $file\n";
565                 return 0;
566         }
567
568         $date=str2time($date, 'UTC');
569         debug("found ctime ".localtime($date)." for $file");
570         return $date;
571 }
572
573 1
574
575 # default mergerc content
576 __DATA__
577         function local_execute_redirected(stdin, stdout, stderr, path, ...)
578            local pid
579            local ret = -1
580            io.flush();
581            pid = spawn_redirected(stdin, stdout, stderr, path, unpack(arg))
582            if (pid ~= -1) then ret, pid = wait(pid) end
583            return ret
584         end
585         if (not execute_redirected) then -- use standard function if available
586            execute_redirected = local_execute_redirected
587         end
588         if (not mergers.fail) then -- use standard merger if available
589            mergers.fail = {
590               cmd = function (tbl) return false end,
591               available = function () return true end,
592               wanted = function () return true end
593            }
594         end
595         mergers.diffutils_force = {
596            cmd = function (tbl)
597               local ret = execute_redirected(
598                   "",
599                   tbl.outfile,
600                   "",
601                   "diff3",
602                   "--merge",
603                   "--show-overlap",
604                   "--label", string.format("[Yours]",     tbl.left_path ),
605                   "--label", string.format("[Original]",  tbl.anc_path  ),
606                   "--label", string.format("[Theirs]",    tbl.right_path),
607                   tbl.lfile,
608                   tbl.afile,
609                   tbl.rfile
610               )
611               if (ret > 1) then
612                  io.write(gettext("Error running GNU diffutils 3-way difference tool 'diff3'"))
613                  return false
614               end
615               return tbl.outfile
616            end,
617            available =
618               function ()
619                   return program_exists_in_path("diff3");
620               end,
621            wanted =
622               function ()
623                    return true
624               end
625         }
626 EOF