]> git.vanrenterghem.biz Git - git.ikiwiki.info.git/blob - IkiWiki/Rcs/monotone.pm
web commit by https://noone.org/openid//: Added note about license (GPL)
[git.ikiwiki.info.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);
9 package IkiWiki;
11 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
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         chdir $config{srcdir}
22             or error("Cannot chdir to $config{srcdir}: $!");
24         my $child = open(MTN, "-|");
25         if (! $child) {
26                 open STDERR, ">/dev/null";
27                 exec("mtn", "version") || error("mtn version failed to run");
28         }
30         my $version=undef;
31         while (<MTN>) {
32                 if (/^monotone (\d+\.\d+) /) {
33                         $version=$1;
34                 }
35         }
37         close MTN || debug("mtn version exited $?");
39         if (!defined($version)) {
40                 error("Cannot determine monotone version");
41         }
42         if ($version < 0.38) {
43                 error("Monotone version too old, is $version but required 0.38");
44         }
45 } #}}}
47 sub get_rev () { #{{{
48         my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
50         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
51         if (! $sha1) {
52                 debug("Unable to get base revision for '$config{srcdir}'.")
53         }
55         return $sha1;
56 } #}}}
58 sub get_rev_auto ($) { #{{{
59         my $automator=shift;
61         my @results = $automator->call("get_base_revision_id");
63         my $sha1 = $results[0];
64         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
65         if (! $sha1) {
66                 debug("Unable to get base revision for '$config{srcdir}'.")
67         }
69         return $sha1;
70 } #}}}
72 sub mtn_merge ($$$$) { #{{{
73         my $leftRev=shift;
74         my $rightRev=shift;
75         my $branch=shift;
76         my $author=shift;
77     
78         my $mergeRev;
80         my $child = open(MTNMERGE, "-|");
81         if (! $child) {
82                 open STDERR, ">&STDOUT";
83                 exec("mtn", "--root=$config{mtnrootdir}",
84                      "explicit_merge", $leftRev, $rightRev,
85                      $branch, "--author", $author, "--key", 
86                      $config{mtnkey}) || error("mtn merge failed to run");
87         }
89         while (<MTNMERGE>) {
90                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
91                         $mergeRev=$1;
92                 }
93         }
94         
95         close MTNMERGE || return undef;
97         debug("merged $leftRev, $rightRev to make $mergeRev");
99         return $mergeRev;
100 } #}}}
102 sub commit_file_to_new_rev($$$$$$$$) { #{{{
103         my $automator=shift;
104         my $wsfilename=shift;
105         my $oldFileID=shift;
106         my $newFileContents=shift;
107         my $oldrev=shift;
108         my $branch=shift;
109         my $author=shift;
110         my $message=shift;
111         
112         #store the file
113         my ($out, $err) = $automator->call("put_file", $oldFileID, $newFileContents);
114         my ($newFileID) = ($out =~ m/^($sha1_pattern)$/);
115         error("Failed to store file data for $wsfilename in repository")
116                 if (! defined $newFileID || length $newFileID != 40);
118         # get the mtn filename rather than the workspace filename
119         ($out, $err) = $automator->call("get_corresponding_path", $oldrev, $wsfilename, $oldrev);
120         my ($filename) = ($out =~ m/^file "(.*)"$/);
121         error("Couldn't find monotone repository path for file $wsfilename") if (! $filename);
122         debug("Converted ws filename of $wsfilename to repos filename of $filename");
124         # then stick in a new revision for this file
125         my $manifest = "format_version \"1\"\n\n".
126                        "new_manifest [0000000000000000000000000000000000000000]\n\n".
127                        "old_revision [$oldrev]\n\n".
128                        "patch \"$filename\"\n".
129                        " from [$oldFileID]\n".
130                        "   to [$newFileID]\n";
131         ($out, $err) = $automator->call("put_revision", $manifest);
132         my ($newRevID) = ($out =~ m/^($sha1_pattern)$/);
133         error("Unable to make new monotone repository revision")
134                 if (! defined $newRevID || length $newRevID != 40);
135         debug("put revision: $newRevID");
136         
137         # now we need to add certs for this revision...
138         # author, branch, changelog, date
139         $automator->call("cert", $newRevID, "author", $author);
140         $automator->call("cert", $newRevID, "branch", $branch);
141         $automator->call("cert", $newRevID, "changelog", $message);
142         $automator->call("cert", $newRevID, "date",
143                 time2str("%Y-%m-%dT%T", time, "UTC"));
144         
145         debug("Added certs for rev: $newRevID");
146         return $newRevID;
147 } #}}}
149 sub read_certs ($$) { #{{{
150         my $automator=shift;
151         my $rev=shift;
152         my @results = $automator->call("certs", $rev);
153         my @ret;
155         my $line = $results[0];
156         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) {
157                 push @ret, {
158                         key => $1,
159                         signature => $2,
160                         name => $3,
161                         value => $4,
162                         trust => $5,
163                 };
164         }
166         return @ret;
167 } #}}}
169 sub get_changed_files ($$) { #{{{
170         my $automator=shift;
171         my $rev=shift;
172         
173         my @results = $automator->call("get_revision", $rev);
174         my $changes=$results[0];
176         my @ret;
177         my %seen = ();
178         
179         while ($changes =~ m/\s*(add_file|patch|delete|rename)\s"(.*?)(?<!\\)"\n/sg) {
180                 my $file = $2;
181                 # don't add the same file multiple times
182                 if (! $seen{$file}) {
183                         push @ret, $file;
184                         $seen{$file} = 1;
185                 }
186         }
187         
188         return @ret;
189 } #}}}
191 sub rcs_update () { #{{{
192         check_config();
194         if (defined($config{mtnsync}) && $config{mtnsync}) {
195                 if (system("mtn", "--root=$config{mtnrootdir}", "sync",
196                            "--quiet", "--ticker=none", 
197                            "--key", $config{mtnkey}) != 0) {
198                         debug("monotone sync failed before update");
199                 }
200         }
202         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
203                 debug("monotone update failed");
204         }
205 } #}}}
207 sub rcs_prepedit ($) { #{{{
208         my $file=shift;
210         check_config();
212         # For monotone, return the revision of the file when
213         # editing begins.
214         return get_rev();
215 } #}}}
217 sub rcs_commit ($$$;$$) { #{{{
218         # Tries to commit the page; returns undef on _success_ and
219         # a version of the page with the rcs's conflict markers on failure.
220         # The file is relative to the srcdir.
221         my $file=shift;
222         my $message=shift;
223         my $rcstoken=shift;
224         my $user=shift;
225         my $ipaddr=shift;
226         my $author;
228         if (defined $user) {
229                 $author="Web user: " . $user;
230         }
231         elsif (defined $ipaddr) {
232                 $author="Web IP: " . $ipaddr;
233         }
234         else {
235                 $author="Web: Anonymous";
236         }
238         check_config();
240         my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
241         my $rev = get_rev();
242         if (defined $rev && defined $oldrev && $rev ne $oldrev) {
243                 my $automator = Monotone->new();
244                 $automator->open_args("--root", $config{mtnrootdir}, "--key", $config{mtnkey});
246                 # Something has been committed, has this file changed?
247                 my ($out, $err);
248                 $automator->setOpts("r", $oldrev, "r", $rev);
249                 ($out, $err) = $automator->call("content_diff", $file);
250                 debug("Problem committing $file") if ($err ne "");
251                 my $diff = $out;
252                 
253                 if ($diff) {
254                         # Commit a revision with just this file changed off
255                         # the old revision.
256                         #
257                         # first get the contents
258                         debug("File changed: forming branch");
259                         my $newfile=readfile("$config{srcdir}/$file");
260                         
261                         # then get the old content ID from the diff
262                         if ($diff !~ m/^---\s$file\s+($sha1_pattern)$/m) {
263                                 error("Unable to find previous file ID for $file");
264                         }
265                         my $oldFileID = $1;
267                         # get the branch we're working in
268                         ($out, $err) = $automator->call("get_option", "branch");
269                         chomp $out;
270                         error("Illegal branch name in monotone workspace") if ($out !~ m/^([-\@\w\.]+)$/);
271                         my $branch = $1;
273                         # then put the new content into the DB (and record the new content ID)
274                         my $newRevID = commit_file_to_new_rev($automator, $file, $oldFileID, $newfile, $oldrev, $branch, $author, $message);
276                         $automator->close();
278                         # if we made it to here then the file has been committed... revert the local copy
279                         if (system("mtn", "--root=$config{mtnrootdir}", "revert", $file) != 0) {
280                                 debug("Unable to revert $file after merge on conflicted commit!");
281                         }
282                         debug("Divergence created! Attempting auto-merge.");
284                         # see if it will merge cleanly
285                         $ENV{MTN_MERGE}="fail";
286                         my $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
287                         $ENV{MTN_MERGE}="";
289                         # push any changes so far
290                         if (defined($config{mtnsync}) && $config{mtnsync}) {
291                                 if (system("mtn", "--root=$config{mtnrootdir}", "push", "--quiet", "--ticker=none", "--key", $config{mtnkey}) != 0) {
292                                         debug("monotone push failed");
293                                 }
294                         }
295                         
296                         if (defined($mergeResult)) {
297                                 # everything is merged - bring outselves up to date
298                                 if (system("mtn", "--root=$config{mtnrootdir}",
299                                            "update", "-r", $mergeResult) != 0) {
300                                         debug("Unable to update to rev $mergeResult after merge on conflicted commit!");
301                                 }
302                         }
303                         else {
304                                 debug("Auto-merge failed.  Using diff-merge to add conflict markers.");
305                                 
306                                 $ENV{MTN_MERGE}="diffutils";
307                                 $ENV{MTN_MERGE_DIFFUTILS}="partial=true";
308                                 $mergeResult = mtn_merge($newRevID, $rev, $branch, $author);
309                                 $ENV{MTN_MERGE}="";
310                                 $ENV{MTN_MERGE_DIFFUTILS}="";
311                                 
312                                 if (!defined($mergeResult)) {
313                                         debug("Unable to insert conflict markers!");
314                                         error("Your commit succeeded. Unfortunately, someone else committed something to the same ".
315                                                 "part of the wiki at the same time. Both versions are stored in the monotone repository, ".
316                                                 "but at present the different versions cannot be reconciled through the web interface. ".
317                                                 "Please use the non-web interface to resolve the conflicts.");
318                                 }
319                                 
320                                 if (system("mtn", "--root=$config{mtnrootdir}",
321                                            "update", "-r", $mergeResult) != 0) {
322                                         debug("Unable to update to rev $mergeResult after conflict-enhanced merge on conflicted commit!");
323                                 }
324                                 
325                                 # return "conflict enhanced" file to the user
326                                 # for cleanup note, this relies on the fact
327                                 # that ikiwiki seems to call rcs_prepedit()
328                                 # again after we return
329                                 return readfile("$config{srcdir}/$file");
330                         }
331                         return undef;
332                 }
333                 $automator->close();
334         }
336         # If we reached here then the file we're looking at hasn't changed
337         # since $oldrev. Commit it.
339         if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
340                    "--author", $author, "--key", $config{mtnkey}, "-m",
341                    possibly_foolish_untaint($message), $file) != 0) {
342                 debug("Traditional commit failed! Returning data as conflict.");
343                 my $conflict=readfile("$config{srcdir}/$file");
344                 if (system("mtn", "--root=$config{mtnrootdir}", "revert",
345                            "--quiet", $file) != 0) {
346                         debug("monotone revert failed");
347                 }
348                 return $conflict;
349         }
350         if (defined($config{mtnsync}) && $config{mtnsync}) {
351                 if (system("mtn", "--root=$config{mtnrootdir}", "push",
352                            "--quiet", "--ticker=none", "--key",
353                            $config{mtnkey}) != 0) {
354                         debug("monotone push failed");
355                 }
356         }
358         return undef # success
359 } #}}}
361 sub rcs_add ($) { #{{{
362         my $file=shift;
364         check_config();
366         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
367                    $file) != 0) {
368                 error("Monotone add failed");
369         }
370 } #}}}
372 sub rcs_recentchanges ($) { #{{{
373         my $num=shift;
374         my @ret;
376         check_config();
378         # use log --brief to get a list of revs, as this
379         # gives the results in a nice order
380         # (otherwise we'd have to do our own date sorting)
382         my @revs;
384         my $child = open(MTNLOG, "-|");
385         if (! $child) {
386                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
387                      "--brief") || error("mtn log failed to run");
388         }
390         while (($num >= 0) and (my $line = <MTNLOG>)) {
391                 if ($line =~ m/^($sha1_pattern)/) {
392                         push @revs, $1;
393                         $num -= 1;
394                 }
395         }
396         close MTNLOG || debug("mtn log exited $?");
398         my $automator = Monotone->new();
399         $automator->open(undef, $config{mtnrootdir});
401         while (@revs != 0) {
402                 my $rev = shift @revs;
403                 # first go through and figure out the messages, etc
405                 my $certs = [read_certs($automator, $rev)];
406                 
407                 my $user;
408                 my $when;
409                 my $committype;
410                 my (@pages, @message);
411                 
412                 foreach my $cert (@$certs) {
413                         if ($cert->{signature} eq "ok" &&
414                             $cert->{trust} eq "trusted") {
415                                 if ($cert->{name} eq "author") {
416                                         $user = $cert->{value};
417                                         # detect the source of the commit
418                                         # from the changelog
419                                         if ($cert->{key} eq $config{mtnkey}) {
420                                                 $committype = "web";
421                                         } else {
422                                                 $committype = "monotone";
423                                         }
424                                 } elsif ($cert->{name} eq "date") {
425                                         $when = str2time($cert->{value}, 'UTC');
426                                 } elsif ($cert->{name} eq "changelog") {
427                                         my $messageText = $cert->{value};
428                                         # split the changelog into multiple
429                                         # lines
430                                         foreach my $msgline (split(/\n/, $messageText)) {
431                                                 push @message, { line => $msgline };
432                                         }
433                                 }
434                         }
435                 }
436                 
437                 my @changed_files = get_changed_files($automator, $rev);
438                 my $file;
439                 
440                 my ($out, $err) = $automator->call("parents", $rev);
441                 my @parents = ($out =~ m/^($sha1_pattern)$/);
442                 my $parent = $parents[0];
444                 foreach $file (@changed_files) {
445                         next unless length $file;
446                         
447                         if (defined $config{diffurl} and (@parents == 1)) {
448                                 my $diffurl=$config{diffurl};
449                                 $diffurl=~s/\[\[r1\]\]/$parent/g;
450                                 $diffurl=~s/\[\[r2\]\]/$rev/g;
451                                 $diffurl=~s/\[\[file\]\]/$file/g;
452                                 push @pages, {
453                                         page => pagename($file),
454                                         diffurl => $diffurl,
455                                 };
456                         }
457                         else {
458                                 push @pages, {
459                                         page => pagename($file),
460                                 }
461                         }
462                 }
463                 
464                 push @ret, {
465                         rev => $rev,
466                         user => $user,
467                         committype => $committype,
468                         when => $when,
469                         message => [@message],
470                         pages => [@pages],
471                 } if @pages;
472         }
474         $automator->close();
476         return @ret;
477 } #}}}
479 sub rcs_diff ($) { #{{{
480         # TODO
481 } #}}}
483 sub rcs_getctime ($) { #{{{
484         my $file=shift;
486         check_config();
488         my $child = open(MTNLOG, "-|");
489         if (! $child) {
490                 exec("mtn", "log", "--root=$config{mtnrootdir}", "--no-graph",
491                      "--brief", $file) || error("mtn log $file failed to run");
492         }
494         my $firstRev;
495         while (<MTNLOG>) {
496                 if (/^($sha1_pattern)/) {
497                         $firstRev=$1;
498                 }
499         }
500         close MTNLOG || debug("mtn log $file exited $?");
502         if (! defined $firstRev) {
503                 debug "failed to parse mtn log for $file";
504                 return 0;
505         }
507         my $automator = Monotone->new();
508         $automator->open(undef, $config{mtnrootdir});
510         my $certs = [read_certs($automator, $firstRev)];
512         $automator->close();
514         my $date;
516         foreach my $cert (@$certs) {
517                 if ($cert->{signature} eq "ok" && $cert->{trust} eq "trusted") {
518                         if ($cert->{name} eq "date") {
519                                 $date = $cert->{value};
520                         }
521                 }
522         }
524         if (! defined $date) {
525                 debug "failed to find date cert for revision $firstRev when looking for creation time of $file";
526                 return 0;
527         }
529         $date=str2time($date, 'UTC');
530         debug("found ctime ".localtime($date)." for $file");
531         return $date;
532 } #}}}