Re: Conclusion of the absolute/relative links issue?

[Manoj Srivastava <srivasta@datasync.com>]

Hi,

	Why is it that one discovers a bug after sending the message?
 I left a spurios next in the lintian file after copying it from the
 test program (the test programs loops over a set of links, and on
 error one uses next.

	The linitan check would not have any such loop, of course, so
 one means to say break; the correct patch follows (the test program
 remains the same) 

	manoj
-- 
 Entropy has us outnumbered.  -- Solomon Short
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
+++ files	Fri Feb 27 13:38:03 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";
+	    break;
+	  }
+	  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";
	}
      }
    }
  }
}