[perl5.git] / ext / Cwd / Cwd.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef I_UNISTD
#   include <unistd.h>
#endif

/* 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;
{
#ifdef VMS
       dTHX;
       return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
#else
	int rootd, serrno;
	char *p, *q, wbuf[MAXPATHLEN];
	int symlinks = 0;

	/* Save the starting point. */
#ifdef HAS_FCHDIR
	int fd;

	if ((fd = open(".", O_RDONLY)) < 0) {
		(void)strcpy(resolved, ".");
		return (NULL);
	}
#else
	char wd[MAXPATHLEN];

	if (getcwd(wd, MAXPATHLEN - 1) == NULL) {
		(void)strcpy(resolved, ".");
		return (NULL);
	}
#endif

	/*
	 * 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;

#if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
    {
	struct stat sb;
	/* Deal with the last component. */
	if (lstat(p, &sb) == 0) {
		if (S_ISLNK(sb.st_mode)) {
			int n;
			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 = "";
		}
	}
    }
#endif

	/*
	 * 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) + (1 - rootd) + 1 > MAXPATHLEN) {
			errno = ENAMETOOLONG;
			goto err1;
		}
		if (rootd == 0)
			(void)strcat(resolved, "/");
		(void)strcat(resolved, wbuf);
	}

	/* Go back to where we came from. */
#ifdef HAS_FCHDIR
	if (fchdir(fd) < 0) {
		serrno = errno;
		goto err2;
	}
#else
	if (chdir(wd) < 0) {
		serrno = errno;
		goto err2;
	}
#endif

	/* It's okay if the close fails, what's an fd more or less? */
#ifdef HAS_FCHDIR
	(void)close(fd);
#endif
	return (resolved);

err1:	serrno = errno;
#ifdef HAS_FCHDIR
	(void)fchdir(fd);
#else
	(void)chdir(wd);
#endif

err2:
#ifdef HAS_FCHDIR
	(void)close(fd);
#endif
	errno = serrno;
	return (NULL);
#endif
}

#ifndef getcwd_sv
/* Taken from perl 5.8's util.c */
int getcwd_sv(pTHX_ register SV *sv)
{
#ifndef PERL_MICRO

#ifndef INCOMPLETE_TAINTS
    SvTAINTED_on(sv);
#endif

#ifdef HAS_GETCWD
    {
	char buf[MAXPATHLEN];

	/* Some getcwd()s automatically allocate a buffer of the given
	 * size from the heap if they are given a NULL buffer pointer.
	 * The problem is that this behaviour is not portable. */
	if (getcwd(buf, sizeof(buf) - 1)) {
	    STRLEN len = strlen(buf);
	    sv_setpvn(sv, buf, len);
	    return TRUE;
	}
	else {
	    sv_setsv(sv, &PL_sv_undef);
	    return FALSE;
	}
    }

#else

    Stat_t statbuf;
    int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
    int namelen, pathlen=0;
    DIR *dir;
    Direntry_t *dp;

    (void)SvUPGRADE(sv, SVt_PV);

    if (PerlLIO_lstat(".", &statbuf) < 0) {
	SV_CWD_RETURN_UNDEF;
    }

    orig_cdev = statbuf.st_dev;
    orig_cino = statbuf.st_ino;
    cdev = orig_cdev;
    cino = orig_cino;

    for (;;) {
	odev = cdev;
	oino = cino;

	if (PerlDir_chdir("..") < 0) {
	    SV_CWD_RETURN_UNDEF;
	}
	if (PerlLIO_stat(".", &statbuf) < 0) {
	    SV_CWD_RETURN_UNDEF;
	}

	cdev = statbuf.st_dev;
	cino = statbuf.st_ino;

	if (odev == cdev && oino == cino) {
	    break;
	}
	if (!(dir = PerlDir_open("."))) {
	    SV_CWD_RETURN_UNDEF;
	}

	while ((dp = PerlDir_read(dir)) != NULL) {
#ifdef DIRNAMLEN
	    namelen = dp->d_namlen;
#else
	    namelen = strlen(dp->d_name);
#endif
	    /* skip . and .. */
	    if (SV_CWD_ISDOT(dp)) {
		continue;
	    }

	    if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
		SV_CWD_RETURN_UNDEF;
	    }

	    tdev = statbuf.st_dev;
	    tino = statbuf.st_ino;
	    if (tino == oino && tdev == odev) {
		break;
	    }
	}

	if (!dp) {
	    SV_CWD_RETURN_UNDEF;
	}

	if (pathlen + namelen + 1 >= MAXPATHLEN) {
	    SV_CWD_RETURN_UNDEF;
	}

	SvGROW(sv, pathlen + namelen + 1);

	if (pathlen) {
	    /* shift down */
	    Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
	}

	/* prepend current directory to the front */
	*SvPVX(sv) = '/';
	Move(dp->d_name, SvPVX(sv)+1, namelen, char);
	pathlen += (namelen + 1);

#ifdef VOID_CLOSEDIR
	PerlDir_close(dir);
#else
	if (PerlDir_close(dir) < 0) {
	    SV_CWD_RETURN_UNDEF;
	}
#endif
    }

    if (pathlen) {
	SvCUR_set(sv, pathlen);
	*SvEND(sv) = '\0';
	SvPOK_only(sv);

	if (PerlDir_chdir(SvPVX(sv)) < 0) {
	    SV_CWD_RETURN_UNDEF;
	}
    }
    if (PerlLIO_stat(".", &statbuf) < 0) {
	SV_CWD_RETURN_UNDEF;
    }

    cdev = statbuf.st_dev;
    cino = statbuf.st_ino;

    if (cdev != orig_cdev || cino != orig_cino) {
	Perl_croak(aTHX_ "Unstable directory path, "
		   "current directory changed unexpectedly");
    }

    return TRUE;
#endif

#else
    return FALSE;
#endif
}

#endif


MODULE = Cwd		PACKAGE = Cwd

PROTOTYPES: ENABLE

void
fastcwd()
PROTOTYPE: DISABLE
PPCODE:
{
    dXSTARG;
    getcwd_sv(TARG);
    XSprePUSH; PUSHTARG;
#ifndef INCOMPLETE_TAINTS
    SvTAINTED_on(TARG);
#endif
}

void
abs_path(pathsv=Nullsv)
    SV *pathsv
PPCODE:
{
    dXSTARG;
    char *path;
    char buf[MAXPATHLEN];

    path = pathsv ? SvPV_nolen(pathsv) : ".";

    if (bsd_realpath(path, buf)) {
        sv_setpvn(TARG, buf, strlen(buf));
        SvPOK_only(TARG);
	SvTAINTED_on(TARG);
    }
    else
        sv_setsv(TARG, &PL_sv_undef);

    XSprePUSH; PUSHTARG;
#ifndef INCOMPLETE_TAINTS
    SvTAINTED_on(TARG);
#endif
}
Commit	Line	Data
0d2079fa BS	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
	4
c70498c1 JH	5	#ifdef I_UNISTD
	6	# include <unistd.h>
	7	#endif
	8
03d70c89 JH	9	/* The realpath() implementation from OpenBSD 2.9 (realpath.c 1.4)
	10	* Renamed here to bsd_realpath() to avoid library conflicts.
	11	* --jhi 2000-06-20 */
	12
	13	/*
	14	* Copyright (c) 1994
	15	* The Regents of the University of California. All rights reserved.
	16	*
	17	* This code is derived from software contributed to Berkeley by
	18	* Jan-Simon Pendry.
	19	*
	20	* Redistribution and use in source and binary forms, with or without
	21	* modification, are permitted provided that the following conditions
	22	* are met:
	23	* 1. Redistributions of source code must retain the above copyright
	24	* notice, this list of conditions and the following disclaimer.
	25	* 2. Redistributions in binary form must reproduce the above copyright
	26	* notice, this list of conditions and the following disclaimer in the
	27	* documentation and/or other materials provided with the distribution.
	28	* 3. All advertising materials mentioning features or use of this software
	29	* must display the following acknowledgement:
	30	* This product includes software developed by the University of
	31	* California, Berkeley and its contributors.
	32	* 4. Neither the name of the University nor the names of its contributors
	33	* may be used to endorse or promote products derived from this software
	34	* without specific prior written permission.
	35	*
	36	* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
	37	* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	38	* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	39	* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
	40	* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
	41	* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
	42	* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
	43	* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	44	* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
	45	* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
	46	* SUCH DAMAGE.
	47	*/
	48
	49	#if defined(LIBC_SCCS) && !defined(lint)
	50	static char *rcsid = "$OpenBSD: realpath.c,v 1.4 1998/05/18 09:55:19 deraadt Exp $";
	51	#endif /* LIBC_SCCS and not lint */
	52
	53	/* OpenBSD system #includes removed since the Perl ones should do. --jhi */
	54
	55	#ifndef MAXSYMLINKS
	56	#define MAXSYMLINKS 8
	57	#endif
	58
	59	/*
	60	* char realpath(const char path, char resolved_path[MAXPATHLEN]);
	61	*
	62	* Find the real name of path, by removing all ".", ".." and symlink
	63	* components. Returns (resolved) on success, or (NULL) on failure,
	64	* in which case the path which caused trouble is left in (resolved).
	65	*/
	66	static
	67	char *
	68	bsd_realpath(path, resolved)
	69	const char *path;
	70	char *resolved;
	71	{
e3d944f4	72	#ifdef VMS
32af7c23 CL	73	dTHX;
32af7c23 CL	74	return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
e3d944f4	75	#else
91f3b821	76	int rootd, serrno;
03d70c89 JH	77	char p, q, wbuf[MAXPATHLEN];
	78	int symlinks = 0;
	79
	80	/* Save the starting point. */
e3d944f4	81	#ifdef HAS_FCHDIR
bae06e14 JH	82	int fd;
bae06e14 JH	83
03d70c89 JH	84	if ((fd = open(".", O_RDONLY)) < 0) {
	85	(void)strcpy(resolved, ".");
	86	return (NULL);
	87	}
e3d944f4 JH	88	#else
	89	char wd[MAXPATHLEN];
	90
	91	if (getcwd(wd, MAXPATHLEN - 1) == NULL) {
	92	(void)strcpy(resolved, ".");
	93	return (NULL);
	94	}
	95	#endif
03d70c89 JH	96
	97	/*
	98	* Find the dirname and basename from the path to be resolved.
	99	* Change directory to the dirname component.
	100	* lstat the basename part.
	101	* if it is a symlink, read in the value and loop.
	102	* if it is a directory, then change to that directory.
	103	* get the current directory name and append the basename.
	104	*/
	105	(void)strncpy(resolved, path, MAXPATHLEN - 1);
	106	resolved[MAXPATHLEN - 1] = '\0';
	107	loop:
	108	q = strrchr(resolved, '/');
	109	if (q != NULL) {
	110	p = q + 1;
	111	if (q == resolved)
	112	q = "/";
	113	else {
	114	do {
	115	--q;
	116	} while (q > resolved && *q == '/');
	117	q[1] = '\0';
	118	q = resolved;
	119	}
	120	if (chdir(q) < 0)
	121	goto err1;
	122	} else
	123	p = resolved;
	124
bae06e14	125	#if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
91f3b821 GS	126	{
91f3b821 GS	127	struct stat sb;
03d70c89 JH	128	/* Deal with the last component. */
	129	if (lstat(p, &sb) == 0) {
	130	if (S_ISLNK(sb.st_mode)) {
91f3b821	131	int n;
03d70c89 JH	132	if (++symlinks > MAXSYMLINKS) {
	133	errno = ELOOP;
	134	goto err1;
	135	}
	136	n = readlink(p, resolved, MAXPATHLEN-1);
	137	if (n < 0)
	138	goto err1;
	139	resolved[n] = '\0';
	140	goto loop;
	141	}
	142	if (S_ISDIR(sb.st_mode)) {
	143	if (chdir(p) < 0)
	144	goto err1;
	145	p = "";
	146	}
	147	}
91f3b821	148	}
e3d944f4	149	#endif
03d70c89 JH	150
	151	/*
	152	* Save the last component name and get the full pathname of
	153	* the current directory.
	154	*/
	155	(void)strcpy(wbuf, p);
	156	if (getcwd(resolved, MAXPATHLEN) == 0)
	157	goto err1;
	158
	159	/*
	160	* Join the two strings together, ensuring that the right thing
	161	* happens if the last component is empty, or the dirname is root.
	162	*/
	163	if (resolved[0] == '/' && resolved[1] == '\0')
	164	rootd = 1;
	165	else
	166	rootd = 0;
	167
	168	if (*wbuf) {
7f6e23a8	169	if (strlen(resolved) + strlen(wbuf) + (1 - rootd) + 1 > MAXPATHLEN) {
03d70c89 JH	170	errno = ENAMETOOLONG;
	171	goto err1;
	172	}
	173	if (rootd == 0)
	174	(void)strcat(resolved, "/");
	175	(void)strcat(resolved, wbuf);
	176	}
	177
	178	/* Go back to where we came from. */
e3d944f4	179	#ifdef HAS_FCHDIR
03d70c89 JH	180	if (fchdir(fd) < 0) {
	181	serrno = errno;
	182	goto err2;
	183	}
e3d944f4 JH	184	#else
	185	if (chdir(wd) < 0) {
	186	serrno = errno;
	187	goto err2;
	188	}
	189	#endif
03d70c89 JH	190
03d70c89 JH	191	/* It's okay if the close fails, what's an fd more or less? */
9cad6237	192	#ifdef HAS_FCHDIR
03d70c89	193	(void)close(fd);
9cad6237	194	#endif
03d70c89 JH	195	return (resolved);
	196
	197	err1: serrno = errno;
29ab7413	198	#ifdef HAS_FCHDIR
03d70c89	199	(void)fchdir(fd);
29ab7413 JH	200	#else
	201	(void)chdir(wd);
	202	#endif
89423764 GS	203
	204	err2:
	205	#ifdef HAS_FCHDIR
	206	(void)close(fd);
	207	#endif
03d70c89 JH	208	errno = serrno;
03d70c89 JH	209	return (NULL);
e3d944f4	210	#endif
03d70c89 JH	211	}
03d70c89 JH	212
a9939470	213	#ifndef getcwd_sv
1955c8df	214	/* Taken from perl 5.8's util.c */
a9939470 NC	215	int getcwd_sv(pTHX_ register SV *sv)
	216	{
	217	#ifndef PERL_MICRO
	218
	219	#ifndef INCOMPLETE_TAINTS
	220	SvTAINTED_on(sv);
	221	#endif
	222
	223	#ifdef HAS_GETCWD
	224	{
	225	char buf[MAXPATHLEN];
	226
	227	/* Some getcwd()s automatically allocate a buffer of the given
	228	* size from the heap if they are given a NULL buffer pointer.
	229	* The problem is that this behaviour is not portable. */
	230	if (getcwd(buf, sizeof(buf) - 1)) {
	231	STRLEN len = strlen(buf);
	232	sv_setpvn(sv, buf, len);
	233	return TRUE;
	234	}
	235	else {
	236	sv_setsv(sv, &PL_sv_undef);
	237	return FALSE;
	238	}
	239	}
	240
	241	#else
	242
	243	Stat_t statbuf;
	244	int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
	245	int namelen, pathlen=0;
	246	DIR *dir;
	247	Direntry_t *dp;
	248
	249	(void)SvUPGRADE(sv, SVt_PV);
	250
	251	if (PerlLIO_lstat(".", &statbuf) < 0) {
	252	SV_CWD_RETURN_UNDEF;
	253	}
	254
	255	orig_cdev = statbuf.st_dev;
	256	orig_cino = statbuf.st_ino;
	257	cdev = orig_cdev;
	258	cino = orig_cino;
	259
	260	for (;;) {
	261	odev = cdev;
	262	oino = cino;
	263
	264	if (PerlDir_chdir("..") < 0) {
	265	SV_CWD_RETURN_UNDEF;
	266	}
	267	if (PerlLIO_stat(".", &statbuf) < 0) {
	268	SV_CWD_RETURN_UNDEF;
	269	}
	270
	271	cdev = statbuf.st_dev;
	272	cino = statbuf.st_ino;
	273
	274	if (odev == cdev && oino == cino) {
	275	break;
	276	}
	277	if (!(dir = PerlDir_open("."))) {
	278	SV_CWD_RETURN_UNDEF;
279	}
280
281	while ((dp = PerlDir_read(dir)) != NULL) {
282	#ifdef DIRNAMLEN
283	namelen = dp->d_namlen;
284	#else
285	namelen = strlen(dp->d_name);
286	#endif
287	/* skip . and .. */
288	if (SV_CWD_ISDOT(dp)) {
289	continue;
290	}
291
292	if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
293	SV_CWD_RETURN_UNDEF;
294	}
295
296	tdev = statbuf.st_dev;
297	tino = statbuf.st_ino;
298	if (tino == oino && tdev == odev) {
299	break;
300	}
301	}
302
303	if (!dp) {
304	SV_CWD_RETURN_UNDEF;
305	}
306
307	if (pathlen + namelen + 1 >= MAXPATHLEN) {
308	SV_CWD_RETURN_UNDEF;
309	}
310
311	SvGROW(sv, pathlen + namelen + 1);
312
313	if (pathlen) {
314	/* shift down */
315	Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
316	}
317
318	/* prepend current directory to the front */
319	*SvPVX(sv) = '/';
320	Move(dp->d_name, SvPVX(sv)+1, namelen, char);
321	pathlen += (namelen + 1);
322
323	#ifdef VOID_CLOSEDIR
324	PerlDir_close(dir);
325	#else
326	if (PerlDir_close(dir) < 0) {
327	SV_CWD_RETURN_UNDEF;
328	}
329	#endif
330	}
331
332	if (pathlen) {
333	SvCUR_set(sv, pathlen);
334	*SvEND(sv) = '\0';
335	SvPOK_only(sv);
336
337	if (PerlDir_chdir(SvPVX(sv)) < 0) {
338	SV_CWD_RETURN_UNDEF;
339	}
340	}
341	if (PerlLIO_stat(".", &statbuf) < 0) {
342	SV_CWD_RETURN_UNDEF;
343	}
344
345	cdev = statbuf.st_dev;
346	cino = statbuf.st_ino;
347
348	if (cdev != orig_cdev \|\| cino != orig_cino) {
349	Perl_croak(aTHX_ "Unstable directory path, "
350	"current directory changed unexpectedly");
351	}
352
353	return TRUE;
354	#endif
355
356	#else
357	return FALSE;
358	#endif
359	}
360
361	#endif
362
363
f22d8e4b	364	MODULE = Cwd PACKAGE = Cwd
0d2079fa	365
f22d8e4b	366	PROTOTYPES: ENABLE
0d2079fa	367
f22d8e4b DM	368	void
f22d8e4b DM	369	fastcwd()
7ddb28a3	370	PROTOTYPE: DISABLE
f22d8e4b DM	371	PPCODE:
	372	{
	373	dXSTARG;
89423764	374	getcwd_sv(TARG);
f22d8e4b	375	XSprePUSH; PUSHTARG;
248785eb RGS	376	#ifndef INCOMPLETE_TAINTS
	377	SvTAINTED_on(TARG);
	378	#endif
0d2079fa BS	379	}
0d2079fa BS	380
f22d8e4b	381	void
03d70c89 JH	382	abs_path(pathsv=Nullsv)
03d70c89 JH	383	SV *pathsv
f22d8e4b	384	PPCODE:
2ae52c40	385	{
f22d8e4b DM	386	dXSTARG;
f22d8e4b DM	387	char *path;
00536bfc	388	char buf[MAXPATHLEN];
03d70c89	389
ea715489	390	path = pathsv ? SvPV_nolen(pathsv) : ".";
03d70c89	391
00536bfc JH	392	if (bsd_realpath(path, buf)) {
	393	sv_setpvn(TARG, buf, strlen(buf));
	394	SvPOK_only(TARG);
ea715489	395	SvTAINTED_on(TARG);
2ae52c40	396	}
03d70c89	397	else
ea715489	398	sv_setsv(TARG, &PL_sv_undef);
2ae52c40	399
f22d8e4b	400	XSprePUSH; PUSHTARG;
ea715489 JH	401	#ifndef INCOMPLETE_TAINTS
	402	SvTAINTED_on(TARG);
	403	#endif
2ae52c40	404	}