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