]> sipb.mit.edu Git - ikiwiki.git/blob - IkiWiki/Rcs/monotone.pm
* Remove locking code in git rcs_commit. I'm not sure if this was ever
[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                 debug("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                 debug("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     
60         my $mergeRev;
61
62         my $mergerc = $config{mtnmergerc};
63     
64         my $child = open(MTNMERGE, "-|");
65         if (! $child) {
66                 open STDERR, ">&STDOUT";
67                 exec("mtn", "--root=$config{mtnrootdir}", "--rcfile",
68                      $mergerc, "explicit_merge", $leftRev, $rightRev,
69                      $branch, "--author", $author, "--key", 
70                      $config{mtnkey}) || error("mtn merge failed to run");
71         }
72
73         while (<MTNMERGE>) {
74                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
75                         $mergeRev=$1;
76                 }
77         }
78         
79         close MTNMERGE || return undef;
80
81         debug("merged $leftRev, $rightRev to make $mergeRev");
82
83         return $mergeRev;
84 } #}}}
85
86 sub commit_file_to_new_rev($$$$$$$$) { #{{{
87         my $automator=shift;
88         my $wsfilename=shift;
89         my $oldFileID=shift;
90         my $newFileContents=shift;
91         my $oldrev=shift;
92         my $branch=shift;
93         my $author=shift;
94         my $message=shift;
95         
96         #store the file
97         my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
98         my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
99         error("Failed to store file data for $wsfilename in repository")
100                 if (! defined $newFileID || length $newFileID != 40);
101
102         # get the mtn filename rather than the workspace filename
103         ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
104         my ($filename) = ($out =~ m/^file "(.*)"$/);
105         error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
106         debug("Converted ws filename of $wsfilename to repos filename of $filename");
107
108         # then stick in a new revision for this file
109         my $manifest = "format_version \"1\"\n\n".
110                        "new_manifest [0000000000000000000000000000000000000000]\n\n".
111                        "old_revision [$oldrev]\n\n".
112                        "patch \"$filename\"\n".
113                        " from [$oldFileID]\n".
114                        "   to [$newFileID]\n";
115         ($out, $err) = $automator->call("put_revision", $manifest);
116         my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
117         error("Unable to make new monotone repository revision")
118                 if (! defined $newRevID || length $newRevID != 40);
119         debug("put revision: $newRevID");
120         
121         # now we need to add certs for this revision...
122         # author, branch, changelog, date
123         $automator->call("cert", $newRevID, "author", $author);
124         $automator->call("cert", $newRevID, "branch", $branch);
125         $automator->call("cert", $newRevID, "changelog", $message);
126         $automator->call("cert", $newRevID, "date",
127                 time2str("%Y-%m-%dT%T", time, "UTC"));
128         
129         debug("Added certs for rev: $newRevID");
130         return $newRevID;
131 } #}}}
132
133 sub check_mergerc () { #{{{
134         my $mergerc = $config{mtnmergerc};
135         if (! -r $mergerc ) {
136                 debug("$mergerc doesn't exist. Creating file with default mergers.");
137                 open (my $out, ">", $mergerc) or error("can't open $mergerc: $!");
138                 print $out <DATA>;
139                 print $out <<"EOF";
140         function note_netsync_revision_received(new_id, revision, certs, session_id)
141                 execute("$config{mtnrootdir}/_MTN/ikiwiki-netsync-hook", new_id)
142         end
143 EOF
144                 close $out;
145         }
146 } #}}}
147
148 sub read_certs ($$) { #{{{
149         my $automator=shift;
150         my $rev=shift;
151         my @results = $automator->call("certs", $rev);
152         my @ret;
153
154         my $line = $results[0];
155         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) {
156                 push @ret, {
157                         key => $1,
158                         signature => $2,
159                         name => $3,
160                         value => $4,
161                         trust => $5,
162                 };
163         }
164
165         return @ret;
166 } #}}}
167
168 sub get_changed_files ($$) { #{{{
169         my $automator=shift;
170         my $rev=shift;
171         
172         my @results = $automator->call("get_revision", $rev);
173         my $changes=$results[0];
174
175         my @ret;
176         my %seen = ();
177         
178         while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
179                 my $file = $2;
180                 # don't add the same file multiple times
181                 if (! $seen{$file}) {
182                         push @ret, $file;
183                         $seen{$file} = 1;
184                 }
185         }
186         
187         return @ret;
188 } #}}}
189
190 sub rcs_update () { #{{{
191         check_config();
192
193         if (defined($config{mtnsync}) && $config{mtnsync}) {
194                 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
195                            "--quiet", "--ticker=none", 
196                            "--key", $config{mtnkey}) != 0) {
197                         debug("monotone sync failed before update");
198                 }
199         }
200
201         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
202                 debug("monotone update failed");
203         }
204 } #}}}
205
206 sub rcs_prepedit ($) { #{{{
207         my $file=shift;
208
209         check_config();
210
211         # For monotone, return the revision of the file when
212         # editing begins.
213         return get_rev();
214 } #}}}
215
216 sub rcs_commit ($$$;$$) { #{{{
217         # Tries to commit the page; returns undef on _success_ and
218         # a version of the page with the rcs's conflict markers on failure.
219         # The file is relative to the srcdir.
220         my $file=shift;
221         my $message=shift;
222         my $rcstoken=shift;
223         my $user=shift;
224         my $ipaddr=shift;
225         my $author;
226
227         if (defined $user) {
228                 $author="Web user: " . $user;
229         }
230         elsif (defined $ipaddr) {
231                 $author="Web IP: " . $ipaddr;
232         }
233         else {
234                 $author="Web: Anonymous";
235         }
236
237         check_config();
238
239         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
240         my $rev = get_rev();
241         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
242                 my $automator = Monotone->new();
243                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
244
245                 # Something has been committed, has this file changed?
246                 my ($out, $err);
247                 $automator->setOpts("r", $oldrev, "r", $rev);
248                 ($out, $err) = $automator->call("content_diff", $file);
249                 debug("Problem committing $file") if ($err ne "");
250                 my $diff = $out;
251                 
252                 if ($diff) {
253                         # Commit a revision with just this file changed off
254                         # the old revision.
255                         #
256                         # first get the contents
257                         debug("File changed: forming branch");
258                         my $newfile=readfile("$config{srcdir}/$file");
259                         
260                         # then get the old content ID from the diff
261                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
262                                 error("Unable to find previous file ID for $file");
263                         }
264                         my $oldFileID = $1;
265
266                         # get the branch we're working in
267                         ($out, $err) = $automator->call("get_option", "branch");
268                         chomp $out;
269                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
270                         my $branch = $1;
271
272                         # then put the new content into the DB (and record the new content ID)
273                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
274
275                         $automator->close();
276
277                         # if we made it to here then the file has been committed... revert the local copy
278                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
279                                 debug("Unable to revert $file after merge on conflicted commit!");
280                         }
281                         debug("Divergence created! Attempting auto-merge.");
282
283                         check_mergerc();
284
285                         # see if it will merge cleanly
286                         $ENV{MTN_MERGE}="fail";
287                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
288                         $ENV{MTN_MERGE}="";
289
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");
294                                 }
295                         }
296                         
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!");
302                                 }
303                         }
304                         else {
305                                 debug("Auto-merge failed.  Using diff-merge to add conflict markers.");
306                                 
307                                 $ENV{MTN_MERGE}="diffutils_force";
308                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
309                                 $ENV{MTN_MERGE}="";
310                                 
311                                 if (!defined($mergeResult)) {
312                                         debug("Unable to insert conflict markers!");
313                                         error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
314                                                 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
315                                                 "but at present the different versions cannot be reconciled through the web interface. ".
316                                                 "Please use the non-web interface to resolve the conflicts.");
317                                 }
318                                 
319                                 if (system("mtn", "--root=$config{mtnrootdir}",
320                                            "update", "-r", $mergeResult) != 0) {
321                                         debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
322                                 }
323                                 
324                                 # return "conflict enhanced" file to the user
325                                 # for cleanup note, this relies on the fact
326                                 # that ikiwiki seems to call rcs_prepedit()
327                                 # again after we return
328                                 return readfile("$config{srcdir}/$file");
329                         }
330                         return undef;
331                 }
332                 $automator->close();
333         }
334
335         # If we reached here then the file we're looking at hasn't changed
336         # since $oldrev. Commit it.
337
338         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
339                    "--author", $author, "--key", $config{mtnkey}, "-m",
340                    possibly_foolish_untaint($message), $file) != 0) {
341                 debug("Traditional commit failed! Returning data as conflict.");
342                 my $conflict=readfile("$config{srcdir}/$file");
343                 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
344                            "--quiet", $file) != 0) {
345                         debug("monotone revert failed");
346                 }
347                 return $conflict;
348         }
349         if (defined($config{mtnsync}) && $config{mtnsync}) {
350                 if (system("mtn", "--root=$config{mtnrootdir}", "push",
351                            "--quiet", "--ticker=none", "--key",
352                            $config{mtnkey}) != 0) {
353                         debug("monotone push failed");
354                 }
355         }
356
357         return undef # success
358 } #}}}
359
360 sub rcs_add ($) { #{{{
361         my $file=shift;
362
363         check_config();
364
365         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
366                    $file) != 0) {
367                 error("Monotone add failed");
368         }
369 } #}}}
370
371 sub rcs_recentchanges ($) { #{{{
372         my $num=shift;
373         my @ret;
374
375         check_config();
376
377         # use log --brief to get a list of revs, as this
378         # gives the results in a nice order
379         # (otherwise we'd have to do our own date sorting)
380
381         my @revs;
382
383         my $child = open(MTNLOG, "-|");
384         if (! $child) {
385                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
386                      "--brief") || error("mtn log failed to run");
387         }
388
389         while (($num >= 0) and (my $line = <MTNLOG>)) {
390                 if ($line =~ m/^($sha1_pattern)/) {
391                         push @revs, $1;
392                         $num -= 1;
393                 }
394         }
395         close MTNLOG || debug("mtn log exited $?");
396
397         my $automator = Monotone->new();
398         $automator->open(undef, $config{mtnrootdir});
399
400         while (@revs != 0) {
401                 my $rev = shift @revs;
402                 # first go through and figure out the messages, etc
403
404                 my $certs = [read_certs($automator, $rev)];
405                 
406                 my $user;
407                 my $when;
408                 my $committype;
409                 my (@pages, @message);
410                 
411                 foreach my $cert (@$certs) {
412                         if ($cert->{signature} eq "ok" &&
413                             $cert->{trust} eq "trusted") {
414                                 if ($cert->{name} eq "author") {
415                                         $user = $cert->{value};
416                                         # detect the source of the commit
417                                         # from the changelog
418                                         if ($cert->{key} eq $config{mtnkey}) {
419                                                 $committype = "web";
420                                         } else {
421                                                 $committype = "monotone";
422                                         }
423                                 } elsif ($cert->{name} eq "date") {
424                                         $when = str2time($cert->{value}, 'UTC');
425                                 } elsif ($cert->{name} eq "changelog") {
426                                         my $messageText = $cert->{value};
427                                         # split the changelog into multiple
428                                         # lines
429                                         foreach my $msgline (split(/\n/, $messageText)) {
430                                                 push @message, { line => $msgline };
431                                         }
432                                 }
433                         }
434                 }
435                 
436                 my @changed_files = get_changed_files($automator, $rev);
437                 my $file;
438                 
439                 my ($out, $err) = $automator->call("parents", $rev);
440                 my @parents = ($out =~ m/^($sha1_pattern)$/);
441                 my $parent = $parents[0];
442
443                 foreach $file (@changed_files) {
444                         next unless length $file;
445                         
446                         if (defined $config{diffurl} and (@parents == 1)) {
447                                 my $diffurl=$config{diffurl};
448                                 $diffurl=~s/\[\[r1\]\]/$parent/g;
449                                 $diffurl=~s/\[\[r2\]\]/$rev/g;
450                                 $diffurl=~s/\[\[file\]\]/$file/g;
451                                 push @pages, {
452                                         page => pagename($file),
453                                         diffurl => $diffurl,
454                                 };
455                         }
456                         else {
457                                 push @pages, {
458                                         page => pagename($file),
459                                 }
460                         }
461                 }
462                 
463                 push @ret, {
464                         rev => $rev,
465                         user => $user,
466                         committype => $committype,
467                         when => $when,
468                         message => [@message],
469                         pages => [@pages],
470                 } if @pages;
471         }
472
473         $automator->close();
474
475         return @ret;
476 } #}}}
477
478 sub rcs_diff ($) { #{{{
479         # TODO
480 } #}}}
481
482 sub rcs_getctime ($) { #{{{
483         my $file=shift;
484
485         check_config();
486
487         my $child = open(MTNLOG, "-|");
488         if (! $child) {
489                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
490                      "--brief", $file) || error("mtn log $file failed to run");
491         }
492
493         my $firstRev;
494         while (<MTNLOG>) {
495                 if (/^($sha1_pattern)/) {
496                         $firstRev=$1;
497                 }
498         }
499         close MTNLOG || debug("mtn log $file exited $?");
500
501         if (! defined $firstRev) {
502                 debug "failed to parse mtn log for $file";
503                 return 0;
504         }
505
506         my $automator = Monotone->new();
507         $automator->open(undef, $config{mtnrootdir});
508
509         my $certs = [read_certs($automator, $firstRev)];
510
511         $automator->close();
512
513         my $date;
514
515         foreach my $cert (@$certs) {
516                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
517                         if ($cert->{name} eq "date") {
518                                 $date = $cert->{value};
519                         }
520                 }
521         }
522
523         if (! defined $date) {
524                 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
525                 return 0;
526         }
527
528         $date=str2time($date, 'UTC');
529         debug("found ctime ".localtime($date)." for $file");
530         return $date;
531 } #}}}
532
533 1
534
535 # default mergerc content
536 __DATA__
537         function local_execute_redirected(stdin, stdout, stderr, path, ...)
538            local pid
539            local ret = -1
540            io.flush();
541            pid = spawn_redirected(stdin, stdout, stderr, path, unpack(arg))
542            if (pid ~= -1) then ret, pid = wait(pid) end
543            return ret
544         end
545         if (not execute_redirected) then -- use standard function if available
546            execute_redirected = local_execute_redirected
547         end
548         if (not mergers.fail) then -- use standard merger if available
549            mergers.fail = {
550               cmd = function (tbl) return false end,
551               available = function () return true end,
552               wanted = function () return true end
553            }
554         end
555         mergers.diffutils_force = {
556            cmd = function (tbl)
557               local ret = execute_redirected(
558                   "",
559                   tbl.outfile,
560                   "",
561                   "diff3",
562                   "--merge",
563                   "--show-overlap",
564                   "--label", string.format("[Yours]",     tbl.left_path ),
565                   "--label", string.format("[Original]",  tbl.anc_path  ),
566                   "--label", string.format("[Theirs]",    tbl.right_path),
567                   tbl.lfile,
568                   tbl.afile,
569                   tbl.rfile
570               )
571               if (ret > 1) then
572                  io.write(gettext("Error running GNU diffutils 3-way difference tool 'diff3'"))
573                  return false
574               end
575               return tbl.outfile
576            end,
577            available =
578               function ()
579                   return program_exists_in_path("diff3");
580               end,
581            wanted =
582               function ()
583                    return true
584               end
585         }