← Back to branch summary

~ubuntu-branches/ubuntu/natty/lxr-cvs/natty

« back to all changes in this revision

Viewing changes to lib/LXR/Files/CVS.pm

  • Committer: Bazaar Package Importer
  • Author(s): Giacomo Catenazzi
  • Date: 2006-02-24 07:52:13 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060224075213-2fn6kna2y9p3l65m
Tags: 0.9.4-1
http://bugs.debian.org/310729
http://bugs.debian.org/326467
* WARNING: see /usr/share/doc/lxr-cvs/README.Debian if you upgrade
  from an old verion (0.9.2 and previous), because of some changes
  in configuration and structure
* New upstream release (Closes: #310729)
* Moved configuration files in /etc/lxr and binary files in /usr/bin
  (Closes: #326467).
* Some small updates (policy, debhelper, ...)
* Support for mysql 5.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/LXR/Files/CVS.pm
1
1
# -*- tab-width: 4 -*- ###############################################
2
2
#
3
 
# $Id: CVS.pm,v 1.17 2002/02/03 08:22:08 mbox Exp $
 
3
# $Id: CVS.pm,v 1.33 2005/05/04 23:21:09 mbox Exp $
4
4
 
5
5
# This program is free software; you can redistribute it and/or modify
6
6
# it under the terms of the GNU General Public License as published by
11
11
# but WITHOUT ANY WARRANTY; without even the implied warranty of
12
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
13
# GNU General Public License for more details.
14
 
# 
 
14
#
15
15
# You should have received a copy of the GNU General Public License
16
16
# along with this program; if not, write to the Free Software
17
17
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18
18
 
19
19
package LXR::Files::CVS;
20
20
 
21
 
$CVSID = '$Id: CVS.pm,v 1.17 2002/02/03 08:22:08 mbox Exp $ ';
 
21
$CVSID = '$Id: CVS.pm,v 1.33 2005/05/04 23:21:09 mbox Exp $ ';
22
22
 
23
23
use strict;
24
24
use FileHandle;
25
25
use Time::Local;
26
26
use LXR::Common;
27
27
 
28
 
use vars qw(%cvs $cache_filename);
 
28
use vars qw(%cvs $cache_filename $gnu_diff);
 
29
 
 
30
$cache_filename = '';
29
31
 
30
32
sub new {
31
33
        my ($self, $rootpath) = @_;
33
35
        $self = bless({}, $self);
34
36
        $self->{'rootpath'} = $rootpath;
35
37
        $self->{'rootpath'} =~ s@/*$@/@;
 
38
        $self->{'path'} = $config->cvspath;
 
39
        
 
40
        unless (defined $gnu_diff) {
 
41
 
 
42
                # the rcsdiff command (used in getdiff) uses parameters only supported by GNU diff
 
43
                $ENV{'PATH'} = $self->{'path'};
 
44
                if (`diff --version 2>/dev/null` =~ /GNU/) {
 
45
                        $gnu_diff = 1;
 
46
                } else {
 
47
                        $gnu_diff = 0;
 
48
                }
 
49
        }
36
50
 
37
51
        return $self;
38
52
}
42
56
 
43
57
        if ($release =~ /rev_([\d\.]+)/) {
44
58
                return $1;
45
 
        }
46
 
        elsif ($release =~ /^([\d\.]+)$/) {
 
59
        } elsif ($release =~ /^([\d\.]+)$/) {
47
60
                return $1;
48
 
        }
49
 
        else {
 
61
        } else {
50
62
                $self->parsecvs($filename);
51
63
                return $cvs{'header'}{'symbols'}{$release};
52
64
        }
53
 
}                                                               
 
65
}
54
66
 
55
67
sub getfiletime {
56
68
        my ($self, $filename, $release) = @_;
91
103
        $self->parsecvs($filename);
92
104
 
93
105
        my $rev = $self->filerev($filename, $release);
94
 
        return undef unless defined($rev);
 
106
        return () unless defined($rev);
95
107
 
96
108
        my $hrev = $cvs{'header'}{'head'};
97
109
        my $lrev;
98
110
        my @anno;
99
111
        my $headfh = $self->getfilehandle($filename, $release);
100
 
        my @head = $headfh->getlines;
 
112
        my @head   = $headfh->getlines;
101
113
 
102
114
        while (1) {
103
115
                if ($rev eq $hrev) {
104
 
                        @head = 0..$#head;
 
116
                        @head = 0 .. $#head;
105
117
                }
106
 
                
 
118
 
107
119
                $lrev = $hrev;
108
120
                $hrev = $cvs{'branch'}{$hrev}{'next'} || last;
109
 
                
 
121
 
110
122
                my @diff = $self->getdiff($filename, $lrev, $hrev);
111
 
                my $off = 0;
112
 
                
 
123
                my $off  = 0;
 
124
 
113
125
                while (@diff) {
114
126
                        my $dir = shift(@diff);
115
 
                        
 
127
 
116
128
                        if ($dir =~ /^a(\d+)\s+(\d+)/) {
117
129
                                splice(@diff, 0, $2);
118
 
                                splice(@head, $1-$off, 0, ('') x $2);
 
130
                                splice(@head, $1 - $off, 0, ('') x $2);
119
131
                                $off -= $2;
120
 
                        }
121
 
                        elsif ($dir =~ /^d(\d+)\s+(\d+)/) {
122
 
                                map {
123
 
                                        $anno[$_] = $lrev if $_ ne '';
124
 
                                } splice(@head, $1-$off-1, $2);
125
 
                                
 
132
                        } elsif ($dir =~ /^d(\d+)\s+(\d+)/) {
 
133
                                map { $anno[$_] = $lrev if $_ ne ''; } splice(@head, $1 - $off - 1, $2);
 
134
 
126
135
                                $off += $2;
127
 
                        }
128
 
                        else {
 
136
                        } else {
129
137
                                warn("Oops! Out of sync!");
130
138
                        }
131
139
                }
132
140
        }
133
141
 
134
 
        map {
135
 
                $anno[$_] = $lrev if $_ ne '';
136
 
        } @head;
 
142
        if (@anno) {
 
143
                map { $anno[$_] = $lrev if $_ ne ''; } @head;
 
144
        }
137
145
 
138
 
#       print(STDERR "** Anno: ".scalar(@anno).join("\n", '', @anno, ''));
 
146
        #       print(STDERR "** Anno: ".scalar(@anno).join("\n", '', @anno, ''));
139
147
        return @anno;
140
148
}
141
149
 
156
164
        my $rev = $self->filerev($filename, $release);
157
165
        return undef unless defined($rev);
158
166
 
159
 
        $fileh = new FileHandle("co -q -p$rev ".
160
 
                                                        $self->toreal($filename, $release).
161
 
                                                        " |"); # FIXME: Exploitable?
162
 
        die("Error execting \"co\", rcs not installed?") unless $fileh;
 
167
        return undef unless defined($self->toreal($filename, $release));
 
168
 
 
169
        $rev =~ /([\d\.]*)/;
 
170
        $rev = $1;    # untaint
 
171
        my $clean_filename = $self->cleanstring($self->toreal($filename, $release));
 
172
        $clean_filename =~ /(.*)/;
 
173
        $clean_filename = $1;    # technically untaint here (cleanstring did the real untainting)
 
174
 
 
175
        $ENV{'PATH'} = $self->{'path'};
 
176
        open($fileh, "-|", "co -q -p$rev $clean_filename");
 
177
 
 
178
        die("Error executing \"co\"; rcs not installed?") unless $fileh;
163
179
        return $fileh;
164
180
}
165
181
 
167
183
        my ($self, $filename, $release1, $release2) = @_;
168
184
        my ($fileh);
169
185
 
 
186
        return () if $gnu_diff == 0;
 
187
 
170
188
        $self->parsecvs($filename);
171
189
 
172
190
        my $rev1 = $self->filerev($filename, $release1);
173
 
        return undef unless defined($rev1);
 
191
        return () unless defined($rev1);
174
192
 
175
193
        my $rev2 = $self->filerev($filename, $release2);
176
 
        return undef unless defined($rev2);
177
 
 
178
 
        $fileh = new FileHandle("rcsdiff -q -a -n -r$rev1 -r$rev2 ".
179
 
                                                        $self->toreal($filename, $release1).
180
 
                                                        " |"); # FIXME: Exploitable?
181
 
        die("Error execting \"rcsdiff\", rcs not installed?") unless $fileh;
 
194
        return () unless defined($rev2);
 
195
 
 
196
        $rev1 =~ /([\d\.]*)/;
 
197
        $rev1 = $1;    # untaint
 
198
        $rev2 =~ /([\d\.]*)/;
 
199
        $rev2 = $1;    # untaint
 
200
        my $clean_filename = $self->cleanstring($self->toreal($filename, $release1));
 
201
        $clean_filename =~ /(.*)/;
 
202
        $clean_filename = $1;    # technically untaint here (cleanstring did the real untainting)
 
203
 
 
204
        $ENV{'PATH'} = $self->{'path'};
 
205
        open($fileh, "-|", "rcsdiff -q -a -n -r$rev1 -r$rev2 $clean_filename");
 
206
 
 
207
        die("Error executing \"rcsdiff\"; rcs not installed?") unless $fileh;
182
208
        return $fileh->getlines;
183
209
}
184
210
 
185
211
sub tmpfile {
186
212
        my ($self, $filename, $release) = @_;
187
 
        my ($tmp, $buf);
 
213
        my ($tmp,  $buf);
188
214
 
189
215
        $buf = $self->getfile($filename, $release);
190
216
        return undef unless defined($buf);
191
 
        
192
 
        $tmp = $config->tmpdir.'/lxrtmp.'.time.'.'.$$.'.'.&LXR::Common::tmpcounter;
 
217
 
 
218
        $tmp = $config->tmpdir . '/lxrtmp.' . time . '.' . $$ . '.' . &LXR::Common::tmpcounter;
193
219
        open(TMP, "> $tmp") || return undef;
194
220
        print(TMP $buf);
195
221
        close(TMP);
196
 
        
 
222
 
197
223
        return $tmp;
198
224
}
199
225
 
208
234
                next if $node =~ /^\.|~$|\.orig$/;
209
235
                next if $node eq 'CVS';
210
236
 
211
 
                if (-d $real.$node) {
212
 
                        push(@dirs, $node.'/'); 
213
 
                }
214
 
                elsif ($node =~ /(.*),v$/) {
 
237
                if (-d $real . $node) {
 
238
                        push(@dirs, $node . '/');
 
239
                } elsif ($node =~ /(.*),v$/) {
215
240
                        push(@files, $1);
216
241
                }
217
242
        }
218
243
        closedir($DIRH);
219
244
 
220
245
        foreach $node (@files) {
221
 
                return 0 if $self->filerev($pathname.$node, $release);
 
246
                return 0 if $self->filerev($pathname . $node, $release);
222
247
        }
223
248
 
224
249
        foreach $node (@dirs) {
225
 
                return 0 unless $self->dirempty($pathname.$node, $release);
 
250
                return 0 unless $self->dirempty($pathname . $node, $release);
226
251
        }
227
252
        return 1;
228
253
}
234
259
        my $real = $self->toreal($pathname, $release);
235
260
 
236
261
        opendir($DIRH, $real) || return ();
237
 
        while (defined($node = readdir($DIRH))) {
 
262
  FILE: while (defined($node = readdir($DIRH))) {
238
263
                next if $node =~ /^\.|~$|\.orig$/;
239
264
                next if $node eq 'CVS';
240
 
 
241
 
                if (-d $real.$node) {
 
265
                if (-d $real . $node) {
 
266
                        foreach my $ignoredir ($config->ignoredirs) {
 
267
                                next FILE if $node eq $ignoredir;
 
268
                        }
242
269
                        if ($node eq 'Attic') {
243
 
                                push(@files, $self->getdir($pathname.$node.'/', $release));
244
 
                        }
245
 
                        else {
246
 
                                push(@dirs, $node.'/') 
247
 
                                        unless defined($release) 
248
 
                                                && $self->dirempty($pathname.$node.'/', $release);
249
 
                        }
250
 
                }
251
 
                elsif ($node =~ /(.*),v$/) {
252
 
                        push(@files, $1) 
253
 
                                if ! defined($release) 
254
 
                                        || $self->getfiletime($pathname.$1, $release);
 
270
                                push(@files, $self->getdir($pathname . $node . '/', $release));
 
271
                        } else {
 
272
                                push(@dirs, $node . '/')
 
273
                                  unless defined($release)
 
274
                                  && $self->dirempty($pathname . $node . '/', $release);
 
275
                        }
 
276
                } elsif ($node =~ /(.*),v$/) {
 
277
                        if (!$$LXR::Common::HTTP{'param'}{'showattic'}) {
 
278
 
 
279
  # you can't just check for 'Attic' because for certain versions the file is alive even if in Attic
 
280
                                $self->parsecvs($pathname . substr($node, 0, length($node) - 2))
 
281
                                  ;    # substr is to remove the ',v'
 
282
                                my $rev = $cvs{'header'}{'symbols'}{$release};
 
283
                                if ($cvs{'branch'}{$rev}{'state'} eq "dead") {
 
284
                                        next;
 
285
                                }
 
286
                        }
 
287
                        push(@files, $1)
 
288
                          if !defined($release)
 
289
                          || $self->getfiletime($pathname . $1, $release);
255
290
                }
256
291
        }
257
292
        closedir($DIRH);
261
296
 
262
297
sub toreal {
263
298
        my ($self, $pathname, $release) = @_;
264
 
        my $real = $self->{'rootpath'}.$pathname;
 
299
        my $real = $self->{'rootpath'} . $pathname;
 
300
 
 
301
# nearly all (if not all) method calls eventually call toreal(), so this is a good place to block file access
 
302
        foreach my $ignoredir ($config->ignoredirs) {
 
303
                return undef if $real =~ m|/$ignoredir/|;
 
304
        }
265
305
 
266
306
        return $real if -d $real;
267
 
        return $real.',v' if -f $real.',v';
268
 
        
 
307
 
 
308
        if (!$$LXR::Common::HTTP{'param'}{'showattic'}) {
 
309
 
 
310
  # you can't just check for 'Attic' because for certain versions the file is alive even if in Attic
 
311
                $self->parsecvs($pathname);
 
312
                my $rev = $cvs{'header'}{'symbols'}{$release};
 
313
                if ($cvs{'branch'}{$rev}{'state'} eq "dead") {
 
314
                        return undef;
 
315
                }
 
316
        }
 
317
 
 
318
        return $real . ',v' if -f $real . ',v';
 
319
 
269
320
        $real =~ s|(/[^/]+/?)$|/Attic$1|;
270
321
 
271
 
        return $real if -d $real;
272
 
        return $real.',v' if -f $real.',v';
 
322
        return $real        if -d $real;
 
323
        return $real . ',v' if -f $real . ',v';
273
324
 
274
325
        return undef;
275
326
}
276
327
 
 
328
sub cleanstring {
 
329
        my ($self, $in) = @_;
 
330
 
 
331
        my $out = '';
 
332
 
 
333
        for (split('', $in)) {
 
334
                s/[|&!`;\$%<>[:cntrl:]]//  ||    # drop these in particular
 
335
                  /[\w\/,.-_+=]/           ||    # keep these intact
 
336
                  s/([ '"\x20-\x7E])/\\$1/ ||    # escape these out
 
337
                  s/.//;                         # drop everything else
 
338
 
 
339
                $out .= $_;
 
340
        }
 
341
 
 
342
        return $out;
 
343
}
 
344
 
277
345
sub isdir {
278
346
        my ($self, $pathname, $release) = @_;
279
347
 
299
367
 
300
368
        $self->parsecvs($filename);
301
369
 
302
 
        return sort(keys(%{$cvs{'header'}{'symbols'}}));
 
370
        # no header symbols for a directory, so we use the default and the current release
 
371
        if (defined %{ $cvs{'header'}{'symbols'} }) {
 
372
                return sort keys %{ $cvs{'header'}{'symbols'} };
 
373
        } else {
 
374
                my @releases;
 
375
                push @releases, $$LXR::Common::HTTP{'param'}{'v'} if $$LXR::Common::HTTP{'param'}{'v'};
 
376
                push @releases, $config->vardefault('v');
 
377
                return @releases;
 
378
        }
 
379
}
 
380
 
 
381
# sort by CVS version
 
382
#   split rev numbers into arrays
 
383
#   compare each array element, returning as soon as we find a difference
 
384
sub byrevision {
 
385
        my @one = split /\./, $a;
 
386
        my @two = split /\./, $b;
 
387
        for (my $i = 0; $i <= $#one; $i++) {
 
388
                my $ret = $one[$i] <=> $two[$i];
 
389
                return $ret if $ret;
 
390
        }
 
391
 
 
392
 # if still no difference after we ran through all elements of @one, compare the length of the array
 
393
        return $#one <=> $#two;
303
394
}
304
395
 
305
396
sub allrevisions {
307
398
 
308
399
        $self->parsecvs($filename);
309
400
 
310
 
        return sort(keys(%{$cvs{'branch'}}));
 
401
        return sort byrevision keys(%{ $cvs{'branch'} });
311
402
}
312
403
 
313
404
sub parsecvs {
 
405
 
314
406
        # Actually, these days it just parses the header.
315
407
        # RCS tools are much better at parsing RCS files.
316
408
        # -pok
319
411
        return if $cache_filename eq $filename;
320
412
        $cache_filename = $filename;
321
413
 
322
 
        %cvs = ();
 
414
        undef %cvs;
323
415
 
324
416
        my $file = '';
325
 
        open (CVS, $self->toreal($filename, undef));
 
417
        open(CVS, $self->toreal($filename, undef));
 
418
        close CVS and return if -d CVS;    # we can't parse a directory
326
419
        while (<CVS>) {
327
420
                if (/^text\s*$/) {
 
421
 
328
422
                        # stop reading when we hit the text.
329
423
                        last;
330
424
                }
331
425
                $file .= $_;
332
426
        }
333
 
        close (CVS);
 
427
        close(CVS);
334
428
 
335
429
        my @cvs = $file =~ /((?:(?:[^\n@]+|@[^@]*@)\n?)+)/gs;
336
430
 
337
 
        $cvs{'header'} = { map { s/@@/@/gs;
338
 
                                                         /^@/s && substr($_, 1, -1) || $_ }
339
 
                                           shift(@cvs) =~ /(\w+)\s*((?:[^;@]+|@[^@]*@)*);/gs };
340
 
 
341
 
        $cvs{'header'}{'symbols'}
342
 
        = { $cvs{'header'}{'symbols'} =~ /(\S+?):(\S+)/g };
343
 
        
 
431
        $cvs{'header'} = {
 
432
                map {
 
433
                        s/@@/@/gs;
 
434
                        /^@/s && substr($_, 1, -1) || $_
 
435
                  } shift(@cvs) =~ /(\w+)\s*((?:[^;@]+|@[^@]*@)*);/gs
 
436
        };
 
437
 
 
438
        $cvs{'header'}{'symbols'} = { $cvs{'header'}{'symbols'} =~ /(\S+?):(\S+)/g };
 
439
 
344
440
        my ($orel, $nrel, $rev);
345
 
        while (($orel, $rev) = each %{$cvs{'header'}{'symbols'}}) {
 
441
        while (($orel, $rev) = each %{ $cvs{'header'}{'symbols'} }) {
346
442
                $nrel = $config->cvsversion($orel);
347
443
                next unless defined($nrel);
348
444
 
356
452
 
357
453
        while (@cvs && $cvs[0] !~ /\s*desc/s) {
358
454
                my ($r, $v) = shift(@cvs) =~ /\s*(\S+)\s*(.*)/s;
359
 
                $cvs{'branch'}{$r} = { map { s/@@/@/gs;
360
 
                                                                         /^@/s && substr($_, 1, -1) || $_ }
361
 
                                                           $v =~ /(\w+)\s*((?:[^;@]+|@[^@]*@)*);/gs };
 
455
                $cvs{'branch'}{$r} = {
 
456
                        map {
 
457
                                s/@@/@/gs;
 
458
                                /^@/s && substr($_, 1, -1) || $_
 
459
                          } $v =~ /(\w+)\s*((?:[^;@]+|@[^@]*@)*);/gs
 
460
                };
362
461
        }
363
 
        
 
462
        delete $cvs{'branch'}{''};    # somehow an empty branch name gets in; delete it
 
463
 
364
464
        $cvs{'desc'} = shift(@cvs) =~ /\s*desc\s+((?:[^\n@]+|@[^@]*@)*)\n/s;
365
465
        $cvs{'desc'} =~ s/^@|@($|@)/$1/gs;
366
466