Hi,
Did we ever reach a consensus about the relative vs absolute
links in packages? Was it decided that links between top level
directories should be absolute, whereas links within on should be
relative?
If so, here is a patch for lintian, and after the patch comes
a self sufficient test program for the patch.
It also adds a check for symlink-has-too-many-up-segments. It
can handle ../lib/test/../junk/.. kind of silliness.
manoj
--
"It's better to be silent and be thought a fool than to speak and
remove all doubt." Abraham Lincoln
Manoj Srivastava <[EMAIL PROTECTED]> <http://www.datasync.com/%7Esrivasta/>
Key C7261095 fingerprint = CB D9 F4 12 68 07 E4 05 CC 2D 27 12 1D F5 E8 6E
______________________________________________________________________
--- /usr/share/lintian/checks/files Sat Feb 21 15:00:34 1998
+++ /home/srivasta/files Fri Feb 27 13:12:49 1998
@@ -126,21 +126,38 @@
# link
($rest =~ m, \-\>\s+(\S+),o) or fail("syntax error in symlink description:
$_");
$link = $1;
-
+ my ($filetop) = $file =~ m|^/?([^/]+)|;
if ($link =~ m,^/([^/]+),o) {
+ ($linktop) = $link =~ m|^/?([^/]+)|;
# absolute link
- if (($1 eq 'etc') or ($1 eq 'var')) {
+ if (($linktop eq 'etc') or ($linktop eq 'var')) {
# ok
- } else {
+ }
+ else {
+ if ($filetop eq $linktop) {
print "W: $pkg: symlink-should-be-relative $file $link\n";
}
- } else {
+ }
+ }
+ else {
# relative link
- $link =~ m,^(?:\.*/)*([^\./]+),o;
- if (($1 eq 'etc') or ($1 eq 'var')) {
+ my $pathsep = '/';
+ my @pathcomponents = split ($pathsep, $file);
+ my @linksegments = split ($pathsep, $link);
+ while (@linksegments) {
+ my $segment = shift @linksegments;
+ if ($segment =~ m/^\.\.$/o) {
+ if ($#pathcomponents) {
+ pop @pathcomponents;
+ }
+ else {
+ print "W: $pkg: symlink-has-too-many-up-segments $file $link\n";
+ next;
+ }
+ if ($#pathcomponents == 0) {
print "W: $pkg: symlink-should-be-absolute $file $link\n";
- } else {
- # ok
+ }
+ }
}
}
______________________________________________________________________
#! /usr/bin/perl -w
# -*- Mode: Perl -*-
# junk.pl ---
# Author : Manoj Srivastava ( [EMAIL PROTECTED] )
# Created On : Wed Feb 25 02:46:22 1998
# Created On Node : tiamat.datasync.com
# Last Modified By : Manoj Srivastava
# Last Modified On : Fri Feb 27 13:09:20 1998
# Last Machine Used: tiamat.datasync.com
# Update Count : 31
# Status : Unknown, Use with caution!
# HISTORY :
# Description :
#
#
use strict;
use diagnostics;
use vars qw($linktop $link);
my $pkg = 'test';
my $file = '/usr/share/something/file';
my @link = ('link', '../link', '../../link', '../../../link',
'../../../../toplink', '../../../../../badlink',
'../../../../etc/link', '../../../../nothing/link',
'/usr/lib/link', '/home/lib/link');
my ($filetop) = $file =~ m|^/?([^/]+)|;
foreach $link (@link) {
if ($link =~ m,^/([^/]+),o) {
($linktop) = $link =~ m|^/?([^/]+)|;
# absolute link
if (($linktop eq 'etc') or ($linktop eq 'var')) {
# ok
}
else {
if ($filetop eq $linktop) {
print "W: $pkg: symlink-should-be-relative $file $link\n";
}
}
}
else {
# relative link
my $pathsep = '/';
my @pathcomponents = split ($pathsep, $file);
my @linksegments = split ($pathsep, $link);
while (@linksegments) {
my $segment = shift @linksegments;
if ($segment =~ m/^\.\.$/o) {
if ($#pathcomponents) {
pop @pathcomponents;
}
else {
print "W: $pkg: symlink-has-too-many-up-segments $file $link\n";
next;
}
if ($#pathcomponents == 0) {
print "W: $pkg: symlink-should-be-absolute $file $link\n";
}
}
}
}
}
