Replace our implementation of realpath() with OpenBSD's

(src/lib/libc/stdlib/realpath.c 1.4).

p4raw-id: //depot/perl@10750

8 files changed, 189 insertions, 179 deletions

diff --git a/embed.h b/embed.h
index fe61bc8e50..7424976b13 100644
--- a/embed.h
+++ b/embed.h
@@ -695,7 +695,6 @@
 #define sv_pos_b2u		Perl_sv_pos_b2u
 #define sv_pvutf8n_force	Perl_sv_pvutf8n_force
 #define sv_pvbyten_force	Perl_sv_pvbyten_force
-#define sv_realpath		Perl_sv_realpath
 #define sv_reftype		Perl_sv_reftype
 #define sv_replace		Perl_sv_replace
 #define sv_report_used		Perl_sv_report_used
@@ -2203,7 +2202,6 @@
 #define sv_pos_b2u(a,b)		Perl_sv_pos_b2u(aTHX_ a,b)
 #define sv_pvutf8n_force(a,b)	Perl_sv_pvutf8n_force(aTHX_ a,b)
 #define sv_pvbyten_force(a,b)	Perl_sv_pvbyten_force(aTHX_ a,b)
-#define sv_realpath(a,b,c)	Perl_sv_realpath(aTHX_ a,b,c)
 #define sv_reftype(a,b)		Perl_sv_reftype(aTHX_ a,b)
 #define sv_replace(a,b)		Perl_sv_replace(aTHX_ a,b)
 #define sv_report_used()	Perl_sv_report_used(aTHX)
@@ -4331,8 +4329,6 @@
 #define sv_pvutf8n_force	Perl_sv_pvutf8n_force
 #define Perl_sv_pvbyten_force	CPerlObj::Perl_sv_pvbyten_force
 #define sv_pvbyten_force	Perl_sv_pvbyten_force
-#define Perl_sv_realpath	CPerlObj::Perl_sv_realpath
-#define sv_realpath		Perl_sv_realpath
 #define Perl_sv_reftype		CPerlObj::Perl_sv_reftype
 #define sv_reftype		Perl_sv_reftype
 #define Perl_sv_replace		CPerlObj::Perl_sv_replace
diff --git a/embed.pl b/embed.pl
index 64e0e5ba3f..f43b9fdbea 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2058,7 +2058,6 @@ Apd	|void	|sv_pos_b2u	|SV* sv|I32* offsetp
 Aopd	|char*	|sv_pvn_force	|SV* sv|STRLEN* lp
 Apd	|char*	|sv_pvutf8n_force|SV* sv|STRLEN* lp
 Apd	|char*	|sv_pvbyten_force|SV* sv|STRLEN* lp
-Apd	|int	|sv_realpath	|SV* sv|char *path|STRLEN maxlen
 Apd	|char*	|sv_reftype	|SV* sv|int ob
 Apd	|void	|sv_replace	|SV* sv|SV* nsv
 Apd	|void	|sv_report_used
diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs
index 7b367168f8..f163368d3d 100644
--- a/ext/Cwd/Cwd.xs
+++ b/ext/Cwd/Cwd.xs
@@ -2,6 +2,172 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* The realpath() implementation from OpenBSD 2.9 (realpath.c 1.4)
+ * Renamed here to bsd_realpath() to avoid library conflicts.
+ * --jhi 2000-06-20 */
+
+/*
+ * Copyright (c) 1994
+ *	The Regents of the University of California.  All rights reserved.
+ *
+ * This code is derived from software contributed to Berkeley by
+ * Jan-Simon Pendry.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *	This product includes software developed by the University of
+ *	California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#if defined(LIBC_SCCS) && !defined(lint)
+static char *rcsid = "$OpenBSD: realpath.c,v 1.4 1998/05/18 09:55:19 deraadt Exp $";
+#endif /* LIBC_SCCS and not lint */
+
+/* OpenBSD system #includes removed since the Perl ones should do. --jhi */
+
+#ifndef MAXSYMLINKS
+#define MAXSYMLINKS 8
+#endif
+
+/*
+ * char *realpath(const char *path, char resolved_path[MAXPATHLEN]);
+ *
+ * Find the real name of path, by removing all ".", ".." and symlink
+ * components.  Returns (resolved) on success, or (NULL) on failure,
+ * in which case the path which caused trouble is left in (resolved).
+ */
+static
+char *
+bsd_realpath(path, resolved)
+	const char *path;
+	char *resolved;
+{
+	struct stat sb;
+	int fd, n, rootd, serrno;
+	char *p, *q, wbuf[MAXPATHLEN];
+	int symlinks = 0;
+
+	/* Save the starting point. */
+	if ((fd = open(".", O_RDONLY)) < 0) {
+		(void)strcpy(resolved, ".");
+		return (NULL);
+	}
+
+	/*
+	 * Find the dirname and basename from the path to be resolved.
+	 * Change directory to the dirname component.
+	 * lstat the basename part.
+	 *     if it is a symlink, read in the value and loop.
+	 *     if it is a directory, then change to that directory.
+	 * get the current directory name and append the basename.
+	 */
+	(void)strncpy(resolved, path, MAXPATHLEN - 1);
+	resolved[MAXPATHLEN - 1] = '\0';
+loop:
+	q = strrchr(resolved, '/');
+	if (q != NULL) {
+		p = q + 1;
+		if (q == resolved)
+			q = "/";
+		else {
+			do {
+				--q;
+			} while (q > resolved && *q == '/');
+			q[1] = '\0';
+			q = resolved;
+		}
+		if (chdir(q) < 0)
+			goto err1;
+	} else
+		p = resolved;
+
+	/* Deal with the last component. */
+	if (lstat(p, &sb) == 0) {
+		if (S_ISLNK(sb.st_mode)) {
+			if (++symlinks > MAXSYMLINKS) {
+				errno = ELOOP;
+				goto err1;
+			}
+			n = readlink(p, resolved, MAXPATHLEN-1);
+			if (n < 0)
+				goto err1;
+			resolved[n] = '\0';
+			goto loop;
+		}
+		if (S_ISDIR(sb.st_mode)) {
+			if (chdir(p) < 0)
+				goto err1;
+			p = "";
+		}
+	}
+
+	/*
+	 * Save the last component name and get the full pathname of
+	 * the current directory.
+	 */
+	(void)strcpy(wbuf, p);
+	if (getcwd(resolved, MAXPATHLEN) == 0)
+		goto err1;
+
+	/*
+	 * Join the two strings together, ensuring that the right thing
+	 * happens if the last component is empty, or the dirname is root.
+	 */
+	if (resolved[0] == '/' && resolved[1] == '\0')
+		rootd = 1;
+	else
+		rootd = 0;
+
+	if (*wbuf) {
+		if (strlen(resolved) + strlen(wbuf) + rootd + 1 > MAXPATHLEN) {
+			errno = ENAMETOOLONG;
+			goto err1;
+		}
+		if (rootd == 0)
+			(void)strcat(resolved, "/");
+		(void)strcat(resolved, wbuf);
+	}
+
+	/* Go back to where we came from. */
+	if (fchdir(fd) < 0) {
+		serrno = errno;
+		goto err2;
+	}
+
+	/* It's okay if the close fails, what's an fd more or less? */
+	(void)close(fd);
+	return (resolved);
+
+err1:	serrno = errno;
+	(void)fchdir(fd);
+err2:	(void)close(fd);
+	errno = serrno;
+	return (NULL);
+}
+
 MODULE = Cwd		PACKAGE = Cwd
 
 PROTOTYPES: ENABLE
@@ -16,22 +182,36 @@ PPCODE:
 }
 
 void
-abs_path(svpath=Nullsv)
-    SV *svpath
+abs_path(pathsv=Nullsv)
+    SV *pathsv
 PPCODE:
 {
     dXSTARG;
     char *path;
     STRLEN len;
+    char *buf;
 
-    if (svpath) {
-        path = SvPV(svpath, len);
-    }
-    else {
-        path = ".";
-        len = 1;
+    New(0, buf, MAXPATHLEN, char);
+    if (buf) {
+        buf[MAXPATHLEN] = 0;
+        if (pathsv)
+	    path = SvPV(pathsv, len);
+	else {
+	    path = ".";
+	    len  = 1;
+	}
+
+	if (bsd_realpath(path, buf)) {
+	    sv_setpvn(TARG, buf, strlen(buf));
+	    SvPOK_only(TARG);
+	}
+	else
+	    sv_setsv(TARG, &PL_sv_undef);
+
+	Safefree(buf);
     }
+    else
+        sv_setsv(TARG, &PL_sv_undef);
 
-    sv_realpath(TARG, path, len);
     XSprePUSH; PUSHTARG;
 }
diff --git a/objXSUB.h b/objXSUB.h
index 984376c086..6c7dcdd65e 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1753,10 +1753,6 @@
 #define Perl_sv_pvbyten_force	pPerl->Perl_sv_pvbyten_force
 #undef  sv_pvbyten_force
 #define sv_pvbyten_force	Perl_sv_pvbyten_force
-#undef  Perl_sv_realpath
-#define Perl_sv_realpath	pPerl->Perl_sv_realpath
-#undef  sv_realpath
-#define sv_realpath		Perl_sv_realpath
 #undef  Perl_sv_reftype
 #define Perl_sv_reftype		pPerl->Perl_sv_reftype
 #undef  sv_reftype
diff --git a/perlapi.c b/perlapi.c
index 8c5901c3a2..73f0108999 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -3170,13 +3170,6 @@ Perl_sv_pvbyten_force(pTHXo_ SV* sv, STRLEN* lp)
     return ((CPerlObj*)pPerl)->Perl_sv_pvbyten_force(sv, lp);
 }
 
-#undef  Perl_sv_realpath
-int
-Perl_sv_realpath(pTHXo_ SV* sv, char *path, STRLEN maxlen)
-{
-    return ((CPerlObj*)pPerl)->Perl_sv_realpath(sv, path, maxlen);
-}
-
 #undef  Perl_sv_reftype
 char*
 Perl_sv_reftype(pTHXo_ SV* sv, int ob)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 75f9ec08a1..de8956be94 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3286,12 +3286,6 @@ assignment or as a subroutine argument for example).
 (F) Your Perl was compiled with B<-D>SETUID_SCRIPTS_ARE_SECURE_NOW, but
 a version of the setuid emulator somehow got run anyway.
 
-=item sv_realpath: %s
-
-(S) You probably used some form of getcwd.  The implementation of
-that functionality detected something odd in your filesystem
-environment and gave up (returning undef).
-
 =item Switch (?(condition)... contains too many branches in regex;
 
 marked by <-- HERE in m/%s/
diff --git a/proto.h b/proto.h
index eaa6ed7c4f..05e2da8108 100644
--- a/proto.h
+++ b/proto.h
@@ -780,7 +780,6 @@ PERL_CALLCONV void	Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp);
 PERL_CALLCONV char*	Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp);
 PERL_CALLCONV char*	Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp);
 PERL_CALLCONV char*	Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp);
-PERL_CALLCONV int	Perl_sv_realpath(pTHX_ SV* sv, char *path, STRLEN maxlen);
 PERL_CALLCONV char*	Perl_sv_reftype(pTHX_ SV* sv, int ob);
 PERL_CALLCONV void	Perl_sv_replace(pTHX_ SV* sv, SV* nsv);
 PERL_CALLCONV void	Perl_sv_report_used(pTHX);
diff --git a/util.c b/util.c
index 838c3620fb..d0d8454b86 100644
--- a/util.c
+++ b/util.c
@@ -3753,150 +3753,3 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 #endif
 }
 
-/*
-=for apidoc sv_realpath
-
-Emulate realpath(3).
-
-The real realpath() is not used because it's a known can of worms.
-We may have bugs but hey, they are our very own.
-
-=cut
- */
-int
-Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN maxlen)
-{
-#ifndef PERL_MICRO
-    char name[MAXPATHLEN]    = { 0 };
-    char dotdots[MAXPATHLEN] = { 0 };
-    char *s;
-    STRLEN pathlen, namelen;
-    DIR *parent;
-    Direntry_t *dp;
-    struct stat cst, pst, tst;
-
-    if (!sv || !path || !maxlen) {
-        Perl_warn(aTHX_ "sv_realpath: realpath(0x%x, 0x%x, "")",
-                  sv, path, maxlen);
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    /* Is the source buffer too long?
-     * Don't use strlen() to avoid running off the end. */
-    if (maxlen >= MAXPATHLEN)
-        pathlen = maxlen;
-    else {
-        s = memchr(path, '\0', MAXPATHLEN);
-	pathlen = s ? s - path : MAXPATHLEN;
-    }
-    if (pathlen >= MAXPATHLEN) {
-        Perl_warn(aTHX_ "sv_realpath: source too large");
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    if (PerlLIO_stat(path, &cst) < 0) {
-        Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
-                  path, Strerror(errno));
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    (void)SvUPGRADE(sv, SVt_PV);
-
-    Copy(path, dotdots, maxlen, char);
-
-    pathlen = 0;
-
-    for (;;) {
-        strcat(dotdots, "/..");
-        StructCopy(&cst, &pst, struct stat);
-
-        if (PerlLIO_stat(dotdots, &cst) < 0) {
-            Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
-                      dotdots, Strerror(errno));
-            SV_CWD_RETURN_UNDEF;
-        }
-
-        if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) {
-            /* We've reached the root: previous is same as current */
-            break;
-        } else {
-            STRLEN dotdotslen = strlen(dotdots);
-
-            /* Scan through the dir looking for name of previous */
-            if (!(parent = PerlDir_open(dotdots))) {
-                Perl_warn(aTHX_ "sv_realpath: opendir(\"%s\"): %s",
-                          dotdots, Strerror(errno));
-                SV_CWD_RETURN_UNDEF;
-            }
-
-            SETERRNO(0,SS$_NORMAL); /* for readdir() */
-            while ((dp = PerlDir_read(parent)) != NULL) {
-                if (SV_CWD_ISDOT(dp)) {
-                    continue;
-                }
-
-                Copy(dotdots, name, dotdotslen, char);
-                name[dotdotslen] = '/';
-#ifdef DIRNAMLEN
-                namelen = dp->d_namlen;
-#else
-                namelen = strlen(dp->d_name);
-#endif
-                Copy(dp->d_name, name + dotdotslen + 1, namelen, char);
-                name[dotdotslen + 1 + namelen] = 0;
-
-                if (PerlLIO_lstat(name, &tst) < 0) {
-                    PerlDir_close(parent);
-                    Perl_warn(aTHX_ "sv_realpath: lstat(\"%s\"): %s",
-                              name, Strerror(errno));
-                    SV_CWD_RETURN_UNDEF;
-                }
-
-                if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino)
-                    break;
-
-                SETERRNO(0,SS$_NORMAL); /* for readdir() */
-            }
-
-            if (!dp && errno) {
-                Perl_warn(aTHX_ "sv_realpath: readdir(\"%s\"): %s",
-                          dotdots, Strerror(errno));
-                SV_CWD_RETURN_UNDEF;
-            }
-
-	    if (pathlen + namelen + 1 >= MAXPATHLEN) {
-	        Perl_warn(aTHX_ "sv_realpath: too long name");
-                SV_CWD_RETURN_UNDEF;
-	    }
-
-            SvGROW(sv, pathlen + namelen + 1);
-            if (pathlen) {
-                /* shift down */
-                Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
-            }
-
-            *SvPVX(sv) = '/';
-            Move(dp->d_name, SvPVX(sv)+1, namelen, char);
-            pathlen += (namelen + 1);
-
-#ifdef VOID_CLOSEDIR
-            PerlDir_close(parent);
-#else
-            if (PerlDir_close(parent) < 0) {
-                Perl_warn(aTHX_ "sv_realpath: closedir(\"%s\"): %s",
-                          dotdots, Strerror(errno));
-                SV_CWD_RETURN_UNDEF;
-            }
-#endif
-        }
-    }
-
-    SvCUR_set(sv, pathlen);
-    SvPOK_only(sv);
-
-    return TRUE;
-#else
-    return FALSE; /* MICROPERL */
-#endif
-}
-