Conclusion of the absolute/relative links issu?

[Manoj Srivastava <srivasta@datasync.com>]

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  <srivasta@acm.org> <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 ( srivasta@tiamat.datasync.com ) 
# 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";
	}
      }
    }
  }
}