avoid tempfile warning
[ikiwiki.git] / IkiWiki / Plugin / cvs.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::cvs;
3
4 # Copyright (c) 2009 Amitai Schlair
5 # All rights reserved.
6 #
7 # This code is derived from software contributed to ikiwiki
8 # by Amitai Schlair.
9 #
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
12 # are met:
13 # 1. Redistributions of source code must retain the above copyright
14 #    notice, this list of conditions and the following disclaimer.
15 # 2. Redistributions in binary form must reproduce the above copyright
16 #    notice, this list of conditions and the following disclaimer in the
17 #    documentation and/or other materials provided with the distribution.
18 #
19 # THIS SOFTWARE IS PROVIDED BY IKIWIKI AND CONTRIBUTORS ``AS IS''
20 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
21 # TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
22 # PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION
23 # OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
24 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
25 # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
26 # USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
27 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
29 # OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
30 # SUCH DAMAGE.
31
32 use warnings;
33 use strict;
34 use IkiWiki;
35
36 use File::chdir;
37
38 sub import {
39         hook(type => "genwrapper", id => "cvs", call => \&genwrapper);
40         hook(type => "checkconfig", id => "cvs", call => \&checkconfig);
41         hook(type => "getsetup", id => "cvs", call => \&getsetup);
42         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
43         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
44         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
45         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
46         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
47         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
48         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
49         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
50         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
51         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
52 }
53
54 sub genwrapper () {
55         return <<EOF;
56         {
57                 int j;
58                 for (j = 1; j < argc; j++)
59                         if (strstr(argv[j], "New directory") != NULL)
60                                 exit(0);
61         }
62 EOF
63 }
64
65 sub checkconfig () {
66         if (! defined $config{cvspath}) {
67                 $config{cvspath}="ikiwiki";
68         }
69         if (exists $config{cvspath}) {
70                 # code depends on the path not having extraneous slashes
71                 $config{cvspath}=~tr#/#/#s;
72                 $config{cvspath}=~s/\/$//;
73                 $config{cvspath}=~s/^\///;
74         }
75         if (defined $config{cvs_wrapper} && length $config{cvs_wrapper}) {
76                 push @{$config{wrappers}}, {
77                         wrapper => $config{cvs_wrapper},
78                         wrappermode => (defined $config{cvs_wrappermode} ? $config{cvs_wrappermode} : "04755"),
79                 };
80         }
81 }
82
83 sub getsetup () {
84         return
85                 plugin => {
86                         safe => 0, # rcs plugin
87                         rebuild => undef,
88                 },
89                 cvsrepo => {
90                         type => "string",
91                         example => "/cvs/wikirepo",
92                         description => "cvs repository location",
93                         safe => 0, # path
94                         rebuild => 0,
95                 },
96                 cvspath => {
97                         type => "string",
98                         example => "ikiwiki",
99                         description => "path inside repository where the wiki is located",
100                         safe => 0, # paranoia
101                         rebuild => 0,
102                 },
103                 cvs_wrapper => {
104                         type => "string",
105                         example => "/cvs/wikirepo/CVSROOT/post-commit",
106                         description => "cvs post-commit hook to generate (triggered by CVSROOT/loginfo entry)",
107                         safe => 0, # file
108                         rebuild => 0,
109                 },
110                 cvs_wrappermode => {
111                         type => "string",
112                         example => '04755',
113                         description => "mode for cvs_wrapper (can safely be made suid)",
114                         safe => 0,
115                         rebuild => 0,
116                 },
117                 historyurl => {
118                         type => "string",
119                         example => "http://cvs.example.org/cvsweb.cgi/ikiwiki/[[file]]",
120                         description => "cvsweb url to show file history ([[file]] substituted)",
121                         safe => 1,
122                         rebuild => 1,
123                 },
124                 diffurl => {
125                         type => "string",
126                         example => "http://cvs.example.org/cvsweb.cgi/ikiwiki/[[file]].diff?r1=text&amp;tr1=[[r1]]&amp;r2=text&amp;tr2=[[r2]]",
127                         description => "cvsweb url to show a diff ([[file]], [[r1]], and [[r2]] substituted)",
128                         safe => 1,
129                         rebuild => 1,
130                 },
131 }
132
133 sub cvs_info ($$) {
134         my $field=shift;
135         my $file=shift;
136
137         local $CWD = $config{srcdir};
138
139         my $info=`cvs status $file`;
140         my ($ret)=$info=~/^\s*$field:\s*(\S+)/m;
141         return $ret;
142 }
143
144 sub cvs_runcvs(@) {
145         my @cmd = @_;
146         unshift @cmd, 'cvs', '-Q';
147
148         local $CWD = $config{srcdir};
149
150         open(my $savedout, ">&STDOUT");
151         open(STDOUT, ">", "/dev/null");
152         my $ret = system(@cmd);
153         open(STDOUT, ">&", $savedout);
154
155         return ($ret == 0) ? 1 : 0;
156 }
157
158 sub cvs_is_controlling {
159         my $dir=shift;
160         $dir=$config{srcdir} unless defined($dir);
161         return (-d "$dir/CVS") ? 1 : 0;
162 }
163
164 sub rcs_update () {
165         return unless cvs_is_controlling;
166         cvs_runcvs('update', '-dP');
167 }
168
169 sub rcs_prepedit ($) {
170         # Prepares to edit a file under revision control. Returns a token
171         # that must be passed into rcs_commit when the file is ready
172         # for committing.
173         # The file is relative to the srcdir.
174         my $file=shift;
175
176         return unless cvs_is_controlling;
177
178         # For cvs, return the revision of the file when
179         # editing begins.
180         my $rev=cvs_info("Repository revision", "$file");
181         return defined $rev ? $rev : "";
182 }
183
184 sub rcs_commit ($$$;$$) {
185         # Tries to commit the page; returns undef on _success_ and
186         # a version of the page with the rcs's conflict markers on failure.
187         # The file is relative to the srcdir.
188         my $file=shift;
189         my $message=shift;
190         my $rcstoken=shift;
191         my $user=shift;
192         my $ipaddr=shift;
193
194         return unless cvs_is_controlling;
195
196         if (defined $user) {
197                 $message="web commit by $user".(length $message ? ": $message" : "");
198         }
199         elsif (defined $ipaddr) {
200                 $message="web commit from $ipaddr".(length $message ? ": $message" : "");
201         }
202
203         # Check to see if the page has been changed by someone
204         # else since rcs_prepedit was called.
205         my ($oldrev)=$rcstoken=~/^([0-9]+)$/; # untaint
206         my $rev=cvs_info("Repository revision", "$config{srcdir}/$file");
207         if (defined $rev && defined $oldrev && $rev != $oldrev) {
208                 # Merge their changes into the file that we've
209                 # changed.
210                 cvs_runcvs('update', $file) ||
211                         warn("cvs merge from $oldrev to $rev failed\n");
212         }
213
214         if (! cvs_runcvs('commit', '-m',
215                          IkiWiki::possibly_foolish_untaint $message)) {
216                 my $conflict=readfile("$config{srcdir}/$file");
217                 cvs_runcvs('update', '-C', $file) ||
218                         warn("cvs revert failed\n");
219                 return $conflict;
220         }
221
222         return undef # success
223 }
224
225 sub rcs_commit_staged ($$$) {
226         # Commits all staged changes. Changes can be staged using rcs_add,
227         # rcs_remove, and rcs_rename.
228         my ($message, $user, $ipaddr)=@_;
229
230         if (defined $user) {
231                 $message="web commit by $user".(length $message ? ": $message" : "");
232         }
233         elsif (defined $ipaddr) {
234                 $message="web commit from $ipaddr".(length $message ? ": $message" : "");
235         }
236
237         if (! cvs_runcvs('commit', '-m',
238                          IkiWiki::possibly_foolish_untaint $message)) {
239                 warn "cvs staged commit failed\n";
240                 return 1; # failure
241         }
242         return undef # success
243 }
244
245 sub rcs_add ($) {
246         # filename is relative to the root of the srcdir
247         my $file=shift;
248         my $parent=IkiWiki::dirname($file);
249         my @files_to_add = ($file);
250
251         eval q{use File::MimeInfo};
252         error($@) if $@;
253
254         until ((length($parent) == 0) || cvs_is_controlling("$config{srcdir}/$parent")){
255                 push @files_to_add, $parent;
256                 $parent = IkiWiki::dirname($parent);
257         }
258
259         while ($file = pop @files_to_add) {
260                 if (@files_to_add == 0) {
261                         # file
262                         my $filemime = File::MimeInfo::default($file);
263                         if (defined($filemime) && $filemime eq 'text/plain') {
264                                 cvs_runcvs('add', $file) ||
265                                         warn("cvs add $file failed\n");
266                         }
267                         else {
268                                 cvs_runcvs('add', '-kb', $file) ||
269                                         warn("cvs add binary $file failed\n");
270                         }
271                 }
272                 else {
273                         # directory
274                         cvs_runcvs('add', $file) ||
275                                 warn("cvs add $file failed\n");
276                 }
277         }
278 }
279
280 sub rcs_remove ($) {
281         # filename is relative to the root of the srcdir
282         my $file=shift;
283
284         return unless cvs_is_controlling;
285
286         cvs_runcvs('rm', '-f', $file) ||
287                 warn("cvs rm $file failed\n");
288 }
289
290 sub rcs_rename ($$) {
291         # filenames relative to the root of the srcdir
292         my ($src, $dest)=@_;
293
294         return unless cvs_is_controlling;
295
296         local $CWD = $config{srcdir};
297
298         if (system("mv", "$src", "$dest") != 0) {
299                 warn("filesystem rename failed\n");
300         }
301
302         rcs_add($dest);
303         rcs_remove($src);
304 }
305
306 sub rcs_recentchanges($) {
307         my $num = shift;
308         my @ret;
309
310         return unless cvs_is_controlling;
311
312         eval q{use Date::Parse};
313         error($@) if $@;
314
315         local $CWD = $config{srcdir};
316
317         # There's no cvsps option to get the last N changesets.
318         # Write full output to a temp file and read backwards.
319
320         eval q{use File::Temp qw/tempfile/};
321         error($@) if $@;
322         eval q{use File::ReadBackwards};
323         error($@) if $@;
324
325         my ($tmphandle, $tmpfile) = tempfile();
326         system("env TZ=UTC cvsps -q --cvs-direct -z 30 -x >$tmpfile");
327         if ($? == -1) {
328                 error "couldn't run cvsps: $!\n";
329         }
330         elsif (($? >> 8) != 0) {
331                 error "cvsps exited " . ($? >> 8) . ": $!\n";
332         }
333
334         tie(*SPSVC, 'File::ReadBackwards', $tmpfile)
335                 || error "couldn't open $tmpfile for read: $!\n";
336
337         while (my $line = <SPSVC>) {
338                 $line =~ /^$/ || error "expected blank line, got $line";
339
340                 my ($rev, $user, $committype, $when);
341                 my (@message, @pages);
342
343                 # We're reading backwards.
344                 # Forwards, an entry looks like so:
345                 # ---------------------
346                 # PatchSet $rev
347                 # Date: $when
348                 # Author: $user (or user CGI runs as, for web commits)
349                 # Branch: branch
350                 # Tag: tag
351                 # Log:
352                 # @message_lines
353                 # Members:
354                 #       @pages (and revisions)
355                 #
356
357                 while ($line = <SPSVC>) {
358                         last if ($line =~ /^Members:/);
359                         for ($line) {
360                                 s/^\s+//;
361                                 s/\s+$//;
362                         }
363                         my ($page, $revs) = split(/:/, $line);
364                         my ($oldrev, $newrev) = split(/->/, $revs);
365                         $oldrev =~ s/INITIAL/0/;
366                         $newrev =~ s/\(DEAD\)//;
367                         my $diffurl = defined $config{diffurl} ? $config{diffurl} : "";
368                         $diffurl=~s/\[\[file\]\]/$page/g;
369                         $diffurl=~s/\[\[r1\]\]/$oldrev/g;
370                         $diffurl=~s/\[\[r2\]\]/$newrev/g;
371                         unshift @pages, {
372                                 page => pagename($page),
373                                 diffurl => $diffurl,
374                         } if length $page;
375                 }
376
377                 while ($line = <SPSVC>) {
378                         last if ($line =~ /^Log:$/);
379                         chomp $line;
380                         unshift @message, { line => $line };
381                 }
382                 $committype = "web";
383                 if (defined $message[0] &&
384                     $message[0]->{line}=~/$config{web_commit_regexp}/) {
385                         $user=defined $2 ? "$2" : "$3";
386                         $message[0]->{line}=$4;
387                 }
388                 else {
389                         $committype="cvs";
390                 }
391
392                 $line = <SPSVC>;        # Tag
393                 $line = <SPSVC>;        # Branch
394
395                 $line = <SPSVC>;
396                 if ($line =~ /^Author: (.*)$/) {
397                         $user = $1 unless defined $user && length $user;
398                 }
399                 else {
400                         error "expected Author, got $line";
401                 }
402
403                 $line = <SPSVC>;
404                 if ($line =~ /^Date: (.*)$/) {
405                         $when = str2time($1, 'UTC');
406                 }
407                 else {
408                         error "expected Date, got $line";
409                 }
410
411                 $line = <SPSVC>;
412                 if ($line =~ /^PatchSet (.*)$/) {
413                         $rev = $1;
414                 }
415                 else {
416                         error "expected PatchSet, got $line";
417                 }
418
419                 $line = <SPSVC>;        # ---------------------
420
421                 push @ret, {
422                         rev => $rev,
423                         user => $user,
424                         committype => $committype,
425                         when => $when,
426                         message => [@message],
427                         pages => [@pages],
428                 } if @pages;
429                 last if @ret >= $num;
430         }
431
432         unlink($tmpfile) || error "couldn't unlink $tmpfile: $!\n";
433
434         return @ret;
435 }
436
437 sub rcs_diff ($) {
438         my $rev=IkiWiki::possibly_foolish_untaint(int(shift));
439
440         local $CWD = $config{srcdir};
441
442         # diff output is unavoidably preceded by the cvsps PatchSet entry
443         my @cvsps = `env TZ=UTC cvsps -q --cvs-direct -z 30 -g -s $rev`;
444         my $blank_lines_seen = 0;
445
446         while (my $line = shift @cvsps) {
447                 $blank_lines_seen++ if ($line =~ /^$/);
448                 last if $blank_lines_seen == 2;
449         }
450
451         if (wantarray) {
452                 return @cvsps;
453         }
454         else {
455                 return join("", @cvsps);
456         }
457 }
458
459 sub rcs_getctime ($) {
460         my $file=shift;
461
462         my $cvs_log_infoline=qr/^date: (.+);\s+author/;
463
464         open CVSLOG, "cvs -Q log -r1.1 '$file' |"
465                 || error "couldn't get cvs log output: $!\n";
466
467         my $date;
468         while (<CVSLOG>) {
469                 if (/$cvs_log_infoline/) {
470                         $date=$1;
471                 }
472         }
473         close CVSLOG || warn "cvs log $file exited $?";
474
475         if (! defined $date) {
476                 warn "failed to parse cvs log for $file\n";
477                 return 0;
478         }
479
480         eval q{use Date::Parse};
481         error($@) if $@;
482         $date=str2time($date, 'UTC');
483         debug("found ctime ".localtime($date)." for $file");
484         return $date;
485 }
486
487 1