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