#! /local/bin/perl
######################################################################
# $Header: /loc/adm/slink-1.0/src/RCS/slink,v 2.2 1995/03/24 01:32:21 couch Exp $
#  TRUENAME: generate the true name of a node in a UNIX filesystem. 
#  Revision 2.0
#  by 
#  Alva L. Couch, 			Greg Owen
#  Associate Prof. of EE/CS		Xerox Information Systems
#  Department of EE/CS			Peabody, MA 02146
#  Tufts University,			gowen@xis.xerox.com
#  Medford, Massachusetts, 02155.
#  couch@cs.tufts.edu
#
#  Copyright (C) 1995 by Alva L. Couch and Greg Owen
# 
#  This file is part of SLINK
#
#  SLINK is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
#
#  SLINK is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with GNU CC; see the file COPYING.  If not, write to
#  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
######################################################################
#  Truename computes the true absolute pathname of a file, 
#  which is an absolute pathname where no component is a 
#  symbolic link. It takes an arbitrary number of arguments
#  and computes the true name of each of them.
######################################################################

require "getcwd.pl"; 
require "newgetopt.pl"; 

# set this to a list of absolute paths that we should not expand links into. 
# This avoids problems with the automounter, which uses symbolic links as 
# virtual mounts. E.g. if /g is automounted, then /g -> /tmp_mnt/g, 
# but if /groups -> /g, truename should NOT expand this to 
# /groups -> /tmp_mnt/g.  Some people have several automount hierarchies 
# so I made it a list. 
@opt_dontresolve = ('/tmp_mnt'); 

$opt_debug = 0; 
if (!&NGetOpt('-','debug')) {
   print STDERR "truename usage:\n"; 
   print STDERR "truename [-debug] file1 file2 ...\n"; 
   exit(1); 
} 

$cwd = &getcwd; 
foreach $link (@ARGV) {
    $true = &truename($link,$cwd); 
    print "$true\n"; 
}

exit(0); 

######################################################################
# follow symbolic links to determine the true name of a file. 
# if an embedded symbolic link is absolute, then replace
#  the prefix before the link with the link value.
# if an embedded symbolic link is relative, sandwich
#  it between current prefix and suffix. 
# one exception: if a symbolic link references a reserved automount
#  tree as listed in @opt_dontresolve, do NOT resolve the link and 
#  keep it as part of the absolute pathname of the file. 
# Preconditions:
#  $base is the path to resolve, either absolute or relative. 
#  $cwd is a working directory to use as a current working directory. 
# Postconditions: 
# Either
#  the return value is the true absolute pathname of $base, 
# Or
#  $base refers to a nonexistent file and the return value is ''. 
######################################################################

sub truename {
    local($base,$cwd) = @_; 
    $base = &absolutize($base,$cwd); 
    local(@base) = split('/',$base); 
    local($i)=1; 
    while ($i<=$#base) {
	local($file) = join('/',@base[0..$i]); 
	local($suffix) = join('/',@base[$i+1..$#base]); 
	&log_debug("checking $file (/$suffix)"); 
	if (! -e $file) {
	    return ''; 
	} elsif (-l $file) {
	    local($new) = readlink($file); 
	    &log_debug("reading link $file -> $new");
	    local(@new) = split('/',$new); 
	    if ($new =~ /^\//) {
	    	if (!&dontresolve($new)) { 
		    &log_debug("following link $file -> $new"); 
		    @base = (@new,@base[$i+1..$#base]); 
		    $i = 1; 
		    next; 
		} else {
		    &log_debug("ignoring link $file -> $new"); 
		}
	    } else {
		&log_debug("following link $file -> $new"); 
		@base = (@base[0..$i-1],@new,@base[$i+1..$#base]);
		next; 
	    }
	} elsif ($base[$i] eq '.') {
	    splice(@base,$i,1); 
	    next; 
	} elsif ($base[$i] eq '..') {
	    if ($i>=2) {
		&log_debug("splice @base, $i-1, 2"); 
		splice(@base,$i-1,2);
		$i--; 
		next; 
	    } else {
		&log_debug("splice @base, $i"); 
		splice(@base,$i,1); 
		next; 
	    }
	}
	$i++;
    }
    return join('/',@base); 
}

######################################################################
# debug logger tells about internal operations
######################################################################

sub log_debug {
    local ($message) = @_; 
    print STDERR "truename: $message\n" if $opt_debug; 
    return 1; 
}

######################################################################
# determine whether a link should be resolved in determining 
# the true name of a path.  $target is the VALUE of the link.
# returns 0 if the link should be resolved normally. 
#	  1 if the link should be ignored because it points
#	    into an automount hierarchy,
######################################################################

sub dontresolve {
    local($target) = @_; 
    foreach $prefix (@opt_dontresolve) {
	return 1 if $target =~ /^$prefix/; 
    }
    return 0; 
}

######################################################################
# make relative addresses absolute using current working
# directory as a reference. Call getcwd once and store its result
# in a local package variable to save time.  Second argument is 
# an artificial cwd to use instead of the real one if set
######################################################################

package absolutize; 

$absolute_cwd = ''; 

sub main'absolutize {
    local ($base,$cwd) = @_; 
    return $base if $base =~ /^\//; 
    return $cwd . '/' . $base if $cwd ne '';
    $absolute_cwd = &main'getcwd if $absolute_cwd eq ''; 
    return $absolute_cwd . '/' . $base;
}