]> sipb.mit.edu Git - ikiwiki.git/blob - IkiWiki/Plugin/monotone.pm
* IkiWiki/Plugin/monotone.pm: implement rcs_getmtime
[ikiwiki.git] / IkiWiki / Plugin / monotone.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::monotone;
3
4 use warnings;
5 use strict;
6 use IkiWiki;
7 use Monotone;
8 use Date::Parse qw(str2time);
9 use Date::Format qw(time2str);
10
11 my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
12
13 sub import {
14         hook(type => "checkconfig", id => "monotone", call => \&checkconfig);
15         hook(type => "getsetup", id => "monotone", call => \&getsetup);
16         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
17         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
18         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
19         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
20         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
21         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
22         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
23         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
24         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
25         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
26         hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime);
27 }
28
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         }
42
43         my $version=undef;
44         while (<MTN>) {
45                 if (/^monotone (\d+\.\d+)(?:(?:\.\d+){0,2}|dev)? /) {
46                         $version=$1;
47                 }
48         }
49
50         close MTN || debug("mtn version exited $?");
51
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         }
58
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 }
66
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                 },
122 }
123
124 sub get_rev () {
125         my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
126
127         ($sha1) = $sha1 =~ m/($sha1_pattern)/; # sha1 is untainted now
128         if (! $sha1) {
129                 debug("Unable to get base revision for '$config{srcdir}'.")
130         }
131
132         return $sha1;
133 }
134
135 sub get_rev_auto ($) {
136         my $automator=shift;
137
138         my @results = $automator->call("get_base_revision_id");
139
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         }
145
146         return $sha1;
147 }
148
149 sub mtn_merge ($$$$) {
150         my $leftRev=shift;
151         my $rightRev=shift;
152         my $branch=shift;
153         my $author=shift;
154     
155         my $mergeRev;
156
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         }
165
166         while (<MTNMERGE>) {
167                 if (/^mtn.\s.merged.\s($sha1_pattern)$/) {
168                         $mergeRev=$1;
169                 }
170         }
171         
172         close MTNMERGE || return undef;
173
174         debug("merged $leftRev, $rightRev to make $mergeRev");
175
176         return $mergeRev;
177 }
178
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);
194
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");
200
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;
224 }
225
226 sub read_certs ($$) {
227         my $automator=shift;
228         my $rev=shift;
229         my @results = $automator->call("certs", $rev);
230         my @ret;
231
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         }
242
243         return @ret;
244 }
245
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];
252
253         my @ret;
254         my %seen = ();
255
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;
262
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;
277 }
278
279 sub rcs_update () {
280         chdir $config{srcdir}
281             or error("Cannot chdir to $config{srcdir}: $!");
282
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         }
290
291         if (system("mtn", "--root=$config{mtnrootdir}", "update", "--quiet") != 0) {
292                 debug("monotone update failed");
293         }
294 }
295
296 sub rcs_prepedit ($) {
297         my $file=shift;
298
299         chdir $config{srcdir}
300             or error("Cannot chdir to $config{srcdir}: $!");
301
302         # For monotone, return the revision of the file when
303         # editing begins.
304         return get_rev();
305 }
306
307 sub commitauthor (@) {
308         my %params=@_;
309
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";
319 }
320
321
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=@_;
327
328         my $author=IkiWiki::possibly_foolish_untaint(commitauthor(%params)),
329
330         chdir $config{srcdir}
331             or error("Cannot chdir to $config{srcdir}: $!");
332
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});
338
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;
359
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;
365
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});
368
369                         $automator->close();
370
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.");
376
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}="";
381
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         }
428
429         # If we reached here then the file we're looking at hasn't changed
430         # since $oldrev. Commit it.
431
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         }
451
452         return undef # success
453 }
454
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=@_;
459
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}: $!");
465
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         }
472 }
473
474 sub rcs_add ($) {
475         my $file=shift;
476
477         chdir $config{srcdir}
478             or error("Cannot chdir to $config{srcdir}: $!");
479
480         if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
481                    $file) != 0) {
482                 error("Monotone add failed");
483         }
484 }
485
486 sub rcs_remove ($) {
487         my $file = shift;
488
489         chdir $config{srcdir}
490             or error("Cannot chdir to $config{srcdir}: $!");
491
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.
498
499         if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
500                    $file) != 0) {
501                 error("Monotone remove failed");
502         }
503 }
504
505 sub rcs_rename ($$) {
506         my ($src, $dest) = @_;
507
508         chdir $config{srcdir}
509             or error("Cannot chdir to $config{srcdir}: $!");
510
511         if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
512                    $src, $dest) != 0) {
513                 error("Monotone rename failed");
514         }
515 }
516
517 sub rcs_recentchanges ($) {
518         my $num=shift;
519         my @ret;
520
521         chdir $config{srcdir}
522             or error("Cannot chdir to $config{srcdir}: $!");
523
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)
527
528         my @revs;
529
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         }
535
536         while (my $line = <MTNLOG>) {
537                 if ($line =~ m/^($sha1_pattern)/) {
538                         push @revs, $1;
539                 }
540         }
541         close MTNLOG || debug("mtn log exited $?");
542
543         my $automator = Monotone->new();
544         $automator->open(undef, $config{mtnrootdir});
545
546         while (@revs != 0) {
547                 my $rev = shift @revs;
548                 # first go through and figure out the messages, etc
549
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];
588
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         }
618
619         $automator->close();
620
621         return @ret;
622 }
623
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}: $!");
631
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         }
636
637         my @lines;
638         while (my $line=<MTNDIFF>) {
639                 last if defined $maxlines && @lines == $maxlines;
640                 push @lines, $line;
641         }
642
643         close MTNDIFF || debug("mtn diff $sha1 exited $?");
644
645         if (wantarray) {
646                 return @lines;
647         }
648         else {
649                 return join("", @lines);
650         }
651 }
652
653 sub rcs_getctime ($) {
654         my $file=shift;
655
656         chdir $config{srcdir}
657             or error("Cannot chdir to $config{srcdir}: $!");
658
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         }
664
665         my $firstRev;
666         while (<MTNLOG>) {
667                 if (/^($sha1_pattern)/) {
668                         $firstRev=$1;
669                 }
670         }
671         close MTNLOG || debug("mtn log $file exited $?");
672
673         if (! defined $firstRev) {
674                 debug "failed to parse mtn log for $file";
675                 return 0;
676         }
677
678         my $automator = Monotone->new();
679         $automator->open(undef, $config{mtnrootdir});
680
681         my $certs = [read_certs($automator, $firstRev)];
682
683         $automator->close();
684
685         my $date;
686
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         }
694
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         }
699
700         $date=str2time($date, 'UTC');
701         debug("found ctime ".localtime($date)." for $file");
702         return $date;
703 }
704
705 sub rcs_getmtime ($) {
706         my $file=shift;
707
708         chdir $config{srcdir}
709             or error("Cannot chdir to $config{srcdir}: $!");
710
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         }
716
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 $?");
724
725         if (! defined $lastRev) {
726                 debug "failed to parse mtn log for $file";
727                 return 0;
728         }
729
730         my $automator = Monotone->new();
731         $automator->open(undef, $config{mtnrootdir});
732
733         my $certs = [read_certs($automator, $lastRev)];
734
735         $automator->close();
736
737         my $date;
738
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         }
746
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         }
751
752         $date=str2time($date, 'UTC');
753         debug("found mtime ".localtime($date)." for $file");
754         return $date;
755 }
756
757 1