Re: Testing sub directories using perl AGAIN

[Joey Hess <joey@kitenet.net>]

Shao Zhang wrote:
>     But it is still not exactly what I want. All the answers used the
> idea to compare the string, but what about
> the following case:
> 
> dir1 = "/www/info/world";
> dir2 = "/www/info/world/usa/../../../."
> 
> Now, clearly dir1 is a sub directory of dir2. So how do I test. Since
> the security is a big concern of us, we cannot
> afford the case like above.

Here's a quick solution since I had some code that can do it lying around
from something else. Probably overkill or not ideal, but it should work.

if (GetAbsolutePath(DeSymlinkPath(GetAbsolutePath($dir1))) eq
    GetAbsolutePath(DeSymlinkPath(GetAbsolutePath($dir2)))) {
	# whatever
}

And have these functions defined:

# Passed a filename, find all elements of it that are symlinks, and replace 
# with the symlink destination directory names. Calls itself recursivly until
# no more symlinks are left in the filename.
# Note that the path this returns may be ugly and have lots of extra /'s and
# ..'s and .'s in it. Use GetAbsolutePath to clean it up. Also note that this 
# only works if it's passed an absulte path to begin with. Therefore, a 
# typical invocation will be something like:
# GetAbsolutePath(DeSymlinkPath(GetAbsolutePath(file)))
sub DeSymlinkPath { $_=shift;
	my $dirty=undef; # set to 1 if we encounter a symlink.
	my @list=split(m:/:, $_);

	my $a=undef;
	foreach $elt (@list) {
		if (-l "$a/$elt") {
			my $b=readlink("$a/$elt");
			$dirty=1;
			if ($b=~m:^/: eq undef) { # relative symlink, add to current pwd.
				$a.="/$b";
			}
			else { # absolute symlink, replaces current pwd.
				$a=$b;
			}
		}
		else { # normal directory or file, add to pwd.
			$a.="/$elt";
		}
	}

	if ($dirty) {
		return DeSymlinkPath($a);
	}
	else {
		return $a;
	}
}

# Passed a filname that may be relative, determine the absolute filename. 
# So we have to get rid of relative pathnames, and we even have to handle 
# things like ./../../../usr/X11R5/../X11R6/bin/./foo
sub GetAbsolutePath { $_=shift;
	if (m:^/: eq undef) { # doesn't start with / , so is a relative path.
		my $pwd=`pwd`; # isn't there a perl function for this?
		chomp $pwd;
		$_="$pwd/$_";
	}

	tr:/:/:s; # replace all // with /

	my @dirlist;
	foreach $dir (split(m:/:, $_)) {
		if ($dir eq '..') {
			pop @dirlist; # go down 1 directory.
		}
		elsif ($dir ne '.') {
			push (@dirlist,$dir);
		}
	}

	$_='/'. join('/',@dirlist);
	tr:/:/:s; # replace all // with /

	return $_;
}

-- 
see shy jo