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