vsh@etnibsd.UUCP (Steve Harris) (08/08/90)
Here is a simple-minded implementation of pwd in perl.
It's not too fast, but neither is "chop($cwd = `pwd`);"
The path to the current directory is returned in an array,
which is passed by reference.
Any critiques of the algorithm (essentially, walk up the
directory tree till you reach the root) will be appreciated.
Steve Harris - Eaton Corp. - Beverly, MA - uunet!etnibsd!vsh
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-
;# pwd.pl -- perl library function
;#
;# usage:
;# die "error in pwd" unless &pwd(*path);
;# print "/", join('/',@path), "\n";
sub pwd {
local(*path) = @_; # array to hold path (return value)
local($dc,$ic); # dev, ino for parent dir
local($dp,$ip); # dev, ino for child dir
local($d,$i,$f); # tmp: dev, ino, file name
@path = (); # init path
($dc,$ic) = stat('.'); # get initial child_dir info
outerloop:
for (;;) {
;# chdir to parent_dir
unless (chdir('..')) {
warn "cannot chdir .., path = ", join('/', @path);
return 0;
}
;# get parent_dir info
($dp,$ip) = stat('.');
unless (opendir(D,'.')) {
warn "cannot opendir ., path = ", join('/', @path);
return 0;
}
;# look for entry in parent_dir with same dev, ino as child
while ($f = readdir(D)) {
next if $f eq '..'; # skip '..'
next if -l $f; # skip links (but do lstat!)
next unless -d _; # skip non-dirs
($d,$i) = stat(_); # get dev, ino for dir
next unless ($d == $dc && $i == $ic); # match?
last outerloop if ($f eq '.'); # root dir?
unshift(@path,$f); # add dir to path
($dc,$ic) = ($dp,$ip); # parent becomes next child
last; # exit readdir loop
}
closedir(D);
}
1;
}
--
Steve Harris - Eaton Corp. - Beverly, MA - uunet!etnibsd!vshjsb@no.cs.brown.edu (John Bazik) (08/09/90)
In article <1141@etnibsd.UUCP>, vsh@etnibsd.UUCP (Steve Harris) writes: |> Here is a simple-minded implementation of pwd in perl. [stuff deleted] Yeah, I did that, too. It was significantly faster than `pwd`, but, unfortunately, breaks under SunOS 4.1. The latter has "virtual filesystems" (or whatever they call it), which reside in memory rather than on disk. By default /tmp is one. For some braindead reason, the inode number of /tmp matches that of /. Actually, I suppose if ($dinode == $pinode && $dname eq $pname) { would do it...hmmm. Anyway, I guess the moral is that any algorithm has to anticipate weirdness but a getwd built-in would just always work. John
allbery@NCoast.ORG (Brandon S. Allbery KB8JRR/KT) (08/10/90)
As quoted from <1141@etnibsd.UUCP> by vsh@etnibsd.UUCP (Steve Harris): +--------------- | while ($f = readdir(D)) { | next if $f eq '..'; # skip '..' | next if -l $f; # skip links (but do lstat!) | next unless -d _; # skip non-dirs | ($d,$i) = stat(_); # get dev, ino for dir | next unless ($d == $dc && $i == $ic); # match? | last outerloop if ($f eq '.'); # root dir? | unshift(@path,$f); # add dir to path | ($dc,$ic) = ($dp,$ip); # parent becomes next child | last; # exit readdir loop | } +--------------- How about mount points? I'm almost *never* in the root file system. You should also provide a way to get back where you were before you started; preferably, opendir() a string which is built incrementally ("../../.."...). I just use chop($cwd = `pwd`); myself. If it ever bothers me, I'll port Doug Gwyn's getcwd() to Perl. ++Brandon -- Me: Brandon S. Allbery VHF: KB8JRR/KT on 220 (soon others) Internet: allbery@NCoast.ORG Delphi: ALLBERY uunet!usenet.ins.cwru.edu!ncoast!allbery America OnLine: KB8JRR
meissner@osf.org (Michael Meissner) (08/10/90)
In article <1990Aug9.225658.11586@NCoast.ORG> allbery@NCoast.ORG (Brandon S. Allbery KB8JRR/KT) writes: | As quoted from <1141@etnibsd.UUCP> by vsh@etnibsd.UUCP (Steve Harris): | +--------------- | | while ($f = readdir(D)) { | | next if $f eq '..'; # skip '..' | | next if -l $f; # skip links (but do lstat!) | | next unless -d _; # skip non-dirs | | ($d,$i) = stat(_); # get dev, ino for dir | | next unless ($d == $dc && $i == $ic); # match? | | last outerloop if ($f eq '.'); # root dir? | | unshift(@path,$f); # add dir to path | | ($dc,$ic) = ($dp,$ip); # parent becomes next child | | last; # exit readdir loop | | } | +--------------- | | How about mount points? I'm almost *never* in the root file system. | You should also provide a way to get back where you were before you started; | preferably, opendir() a string which is built incrementally ("../../.."...). | | I just use chop($cwd = `pwd`); myself. If it ever bothers me, I'll port Doug | Gwyn's getcwd() to Perl. | | ++Brandon Another thing that I don't think has been mentioned, is that you might be in a directory whose parent directory you have no access to. In this case reading ..'s files until you find . will not work. This is why pwd must be setuid root, so that it can do the appropriate checks. -- Michael Meissner email: meissner@osf.org phone: 617-621-8861 Open Software Foundation, 11 Cambridge Center, Cambridge, MA, 02142 Do apple growers tell their kids money doesn't grow on bushes?
marc@mit.edu (08/11/90)
|> Another thing that I don't think has been mentioned, is that you might |> be in a directory whose parent directory you have no access to. In |> this case reading ..'s files until you find . will not work. This is |> why pwd must be setuid root, so that it can do the appropriate checks. If you have no access to the parent, how did you get to where you are now? I think it's a safe assumption that you can read all the directories up to the root. My system makes this assumption; /bin/pwd is not setuid root. I think a lot of programs probably depend on getwd() working. Here, if getwd ()doesn't work, the shell won't even do the right thing. I agree that perl should have a portable getwd() function. I think it's clear that there is no straightforward way to do what needs to be done portably, so each port must figure out what is right. The case of the PC was brought up, and the same issue applies to the Amiga, and any other non-unix box perl is ported to. IMHO, this is a useful enough feature that it should be a builtin. My $0.02. Marc
merlyn@iwarp.intel.com (Randal Schwartz) (08/11/90)
In article <1990Aug10.205437.21409@uvaarpa.Virginia.EDU>, marc@mit writes: | |> Another thing that I don't think has been mentioned, is that you might | |> be in a directory whose parent directory you have no access to. In | |> this case reading ..'s files until you find . will not work. This is | |> why pwd must be setuid root, so that it can do the appropriate checks. | | If you have no access to the parent, how did you get to where you are | now? I think it's a safe assumption that you can read all the | directories up to the root. My system makes this assumption; /bin/pwd | is not setuid root. I think a lot of programs probably depend on | getwd() working. Here, if getwd ()doesn't work, the shell won't even | do the right thing. You can have 'x' access and no 'r' access. On your system, /bin/pwd would fail in this case, and so would any call to getwd() or the Perl routine that's been published (or anything from user-level non-setuid code). I think that's why /bin/pwd is setuid on some machines. (Interesting... it's not setuid on Sunos4.1 either) I agree with Larry, though. chop($pwd = `pwd`) is portable and fast, and there are more important features for Larry to add (I know, I've been writing about them for a week now :-). print "Just another Perl hacker," -- /=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\ | on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III | | merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn | \=Cute Quote: "Welcome to Portland, Oregon, home of the California Raisins!"=/
marc@athena.mit.edu (08/11/90)
You can have 'x' access and no 'r' access. On your system, /bin/pwd
would fail in this case, and so would any call to getwd() or the Perl
routine that's been published (or anything from user-level non-setuid
code). I think that's why /bin/pwd is setuid on some machines.
(Interesting... it's not setuid on Sunos4.1 either)
Ok, I did that, and I'm convinced. However, our version of tcsh doesn't
like it very much (although perl doesn't need tcsh) :
<57> portnoy:/tmp# cd /tmp/foo/bar/baz
<58> portnoy:/tmp/foo/bar/baz# su marc
getwd: can't open ..
(Did you su in a fascist directory?)
I still think creating a directory like this is a bad idea, but I'll
stop flaming about it. So, I propose as an implementation for (a
default implementation of) a builtin getwd():
1) call libc's getwd(). If you get an error,
2) fork /bin/pwd. If you get an error from that,
3) return false and set $@
This has the advantage of only forking if necessary.
I agree with Larry, though. chop($pwd = `pwd`) is portable and fast,
and there are more important features for Larry to add (I know, I've
been writing about them for a week now :-).
That's not portable to my IBM PC, and I don't consider forking "fast."
We're still using VS2's some places around here, and what's fast on a
Sparc may not be elsewhere. Of course, someone would write a version
which would work on a PC, and my scripts would run merrily along.
Marc