ext/Cwd/Cwd.xs

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