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         const char *p;
  83         char *q, wbuf[MAXPATHLEN];
  84         int symlinks = 0;
  85
  86         /* Save the starting point. */
  87 #ifdef HAS_FCHDIR
  88         int fd;
  89
  90         if ((fd = open(".", O_RDONLY)) < 0) {
  91                 (void)strcpy(resolved, ".");
  92                 return (NULL);
  93         }
  94 #else
  95         char wd[MAXPATHLEN];
  96
  97         if (getcwd(wd, MAXPATHLEN - 1) == NULL) {
  98                 (void)strcpy(resolved, ".");
  99                 return (NULL);
 100         }
 101 #endif
 102
 103         /*
 104          * Find the dirname and basename from the path to be resolved.
 105          * Change directory to the dirname component.
 106          * lstat the basename part.
 107          *     if it is a symlink, read in the value and loop.
 108          *     if it is a directory, then change to that directory.
 109          * get the current directory name and append the basename.
 110          */
 111         (void)strncpy(resolved, path, MAXPATHLEN - 1);
 112         resolved[MAXPATHLEN - 1] = '\0';
 113 loop:
 114         q = strrchr(resolved, '/');
 115         if (q != NULL) {
 116                 const char *dir;
 117                 p = q + 1;
 118                 if (q == resolved)
 119                         dir = "/";
 120                 else {
 121                         do {
 122                                 --q;
 123                         } while (q > resolved && *q == '/');
 124                         q[1] = '\0';
 125                         dir = resolved;
 126                 }
 127                 if (chdir(dir) < 0)
 128                         goto err1;
 129         } else
 130                 p = resolved;
 131
 132 #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
 133     {
 134         struct stat sb;
 135         /* Deal with the last component. */
 136         if (lstat(p, &sb) == 0) {
 137                 if (S_ISLNK(sb.st_mode)) {
 138                         int n;
 139                         if (++symlinks > MAXSYMLINKS) {
 140                                 errno = ELOOP;
 141                                 goto err1;
 142                         }
 143                         n = readlink(p, resolved, MAXPATHLEN-1);
 144                         if (n < 0)
 145                                 goto err1;
 146                         resolved[n] = '\0';
 147                         goto loop;
 148                 }
 149                 if (S_ISDIR(sb.st_mode)) {
 150                         if (chdir(p) < 0)
 151                                 goto err1;
 152                         p = "";
 153                 }
 154         }
 155     }
 156 #endif
 157
 158         /*
 159          * Save the last component name and get the full pathname of
 160          * the current directory.
 161          */
 162         (void)strcpy(wbuf, p);
 163         if (getcwd(resolved, MAXPATHLEN) == 0)
 164                 goto err1;
 165
 166         /*
 167          * Join the two strings together, ensuring that the right thing
 168          * happens if the last component is empty, or the dirname is root.
 169          */
 170         if (resolved[0] == '/' && resolved[1] == '\0')
 171                 rootd = 1;
 172         else
 173                 rootd = 0;
 174
 175         if (*wbuf) {
 176                 if (strlen(resolved) + strlen(wbuf) + (1 - rootd) + 1 > MAXPATHLEN) {
 177                         errno = ENAMETOOLONG;
 178                         goto err1;
 179                 }
 180                 if (rootd == 0)
 181                         (void)strcat(resolved, "/");
 182                 (void)strcat(resolved, wbuf);
 183         }
 184
 185         /* Go back to where we came from. */
 186 #ifdef HAS_FCHDIR
 187         if (fchdir(fd) < 0) {
 188                 serrno = errno;
 189                 goto err2;
 190         }
 191 #else
 192         if (chdir(wd) < 0) {
 193                 serrno = errno;
 194                 goto err2;
 195         }
 196 #endif
 197
 198         /* It's okay if the close fails, what's an fd more or less? */
 199 #ifdef HAS_FCHDIR
 200         (void)close(fd);
 201 #endif
 202         return (resolved);
 203
 204 err1:   serrno = errno;
 205 #ifdef HAS_FCHDIR
 206         (void)fchdir(fd);
 207 #else
 208         (void)chdir(wd);
 209 #endif
 210
 211 err2:
 212 #ifdef HAS_FCHDIR
 213         (void)close(fd);
 214 #endif
 215         errno = serrno;
 216         return (NULL);
 217 #endif
 218 }
 219
 220 #ifndef SV_CWD_RETURN_UNDEF
 221 #define SV_CWD_RETURN_UNDEF \
 222 sv_setsv(sv, &PL_sv_undef); \
 223 return FALSE
 224 #endif
 225
 226 #ifndef OPpENTERSUB_HASTARG
 227 #define OPpENTERSUB_HASTARG     32      /* Called from OP tree. */
 228 #endif
 229
 230 #ifndef dXSTARG
 231 #define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
 232                              ? PAD_SV(PL_op->op_targ) : sv_newmortal())
 233 #endif
 234
 235 #ifndef XSprePUSH
 236 #define XSprePUSH (sp = PL_stack_base + ax - 1)
 237 #endif
 238
 239 #ifndef SV_CWD_ISDOT
 240 #define SV_CWD_ISDOT(dp) \
 241     (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \
 242         (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
 243 #endif
 244
 245 #ifndef getcwd_sv
 246 /* Taken from perl 5.8's util.c */
 247 #define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
 248 int Perl_getcwd_sv(pTHX_ register SV *sv)
 249 {
 250 #ifndef PERL_MICRO
 251
 252 #ifndef INCOMPLETE_TAINTS
 253     SvTAINTED_on(sv);
 254 #endif
 255
 256 #ifdef HAS_GETCWD
 257     {
 258         char buf[MAXPATHLEN];
 259
 260         /* Some getcwd()s automatically allocate a buffer of the given
 261          * size from the heap if they are given a NULL buffer pointer.
 262          * The problem is that this behaviour is not portable. */
 263         if (getcwd(buf, sizeof(buf) - 1)) {
 264             STRLEN len = strlen(buf);
 265             sv_setpvn(sv, buf, len);
 266             return TRUE;
 267         }
 268         else {
 269             sv_setsv(sv, &PL_sv_undef);
 270             return FALSE;
 271         }
 272     }
 273
 274 #else
 275   {
 276     Stat_t statbuf;
 277     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
 278     int namelen, pathlen=0;
 279     DIR *dir;
 280     Direntry_t *dp;
 281
 282     (void)SvUPGRADE(sv, SVt_PV);
 283
 284     if (PerlLIO_lstat(".", &statbuf) < 0) {
 285         SV_CWD_RETURN_UNDEF;
 286     }
 287
 288     orig_cdev = statbuf.st_dev;
 289     orig_cino = statbuf.st_ino;
 290     cdev = orig_cdev;
 291     cino = orig_cino;
 292
 293     for (;;) {
 294         odev = cdev;
 295         oino = cino;
 296
 297         if (PerlDir_chdir("..") < 0) {
 298             SV_CWD_RETURN_UNDEF;
 299         }
 300         if (PerlLIO_stat(".", &statbuf) < 0) {
 301             SV_CWD_RETURN_UNDEF;
 302         }
 303
 304         cdev = statbuf.st_dev;
 305         cino = statbuf.st_ino;
 306
 307         if (odev == cdev && oino == cino) {
 308             break;
 309         }
 310         if (!(dir = PerlDir_open("."))) {
 311             SV_CWD_RETURN_UNDEF;
 312         }
 313
 314         while ((dp = PerlDir_read(dir)) != NULL) {
 315 #ifdef DIRNAMLEN
 316             namelen = dp->d_namlen;
 317 #else
 318             namelen = strlen(dp->d_name);
 319 #endif
 320             /* skip . and .. */
 321             if (SV_CWD_ISDOT(dp)) {
 322                 continue;
 323             }
 324
 325             if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
 326                 SV_CWD_RETURN_UNDEF;
 327             }
 328
 329             tdev = statbuf.st_dev;
 330             tino = statbuf.st_ino;
 331             if (tino == oino && tdev == odev) {
 332                 break;
 333             }
 334         }
 335
 336         if (!dp) {
 337             SV_CWD_RETURN_UNDEF;
 338         }
 339
 340         if (pathlen + namelen + 1 >= MAXPATHLEN) {
 341             SV_CWD_RETURN_UNDEF;
 342         }
 343
 344         SvGROW(sv, pathlen + namelen + 1);
 345
 346         if (pathlen) {
 347             /* shift down */
 348             Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
 349         }
 350
 351         /* prepend current directory to the front */
 352         *SvPVX(sv) = '/';
 353         Move(dp->d_name, SvPVX(sv)+1, namelen, char);
 354         pathlen += (namelen + 1);
 355
 356 #ifdef VOID_CLOSEDIR
 357         PerlDir_close(dir);
 358 #else
 359         if (PerlDir_close(dir) < 0) {
 360             SV_CWD_RETURN_UNDEF;
 361         }
 362 #endif
 363     }
 364
 365     if (pathlen) {
 366         SvCUR_set(sv, pathlen);
 367         *SvEND(sv) = '\0';
 368         SvPOK_only(sv);
 369
 370         if (PerlDir_chdir(SvPVX(sv)) < 0) {
 371             SV_CWD_RETURN_UNDEF;
 372         }
 373     }
 374     if (PerlLIO_stat(".", &statbuf) < 0) {
 375         SV_CWD_RETURN_UNDEF;
 376     }
 377
 378     cdev = statbuf.st_dev;
 379     cino = statbuf.st_ino;
 380
 381     if (cdev != orig_cdev || cino != orig_cino) {
 382         Perl_croak(aTHX_ "Unstable directory path, "
 383                    "current directory changed unexpectedly");
 384     }
 385
 386     return TRUE;
 387   }
 388 #endif
 389
 390 #else
 391     return FALSE;
 392 #endif
 393 }
 394
 395 #endif
 396
 397
 398 MODULE = Cwd            PACKAGE = Cwd
 399
 400 PROTOTYPES: ENABLE
 401
 402 void
 403 fastcwd()
 404 PROTOTYPE: DISABLE
 405 PPCODE:
 406 {
 407     dXSTARG;
 408     getcwd_sv(TARG);
 409     XSprePUSH; PUSHTARG;
 410 #ifndef INCOMPLETE_TAINTS
 411     SvTAINTED_on(TARG);
 412 #endif
 413 }
 414
 415 void
 416 getcwd(...)
 417 PROTOTYPE: DISABLE
 418 PPCODE:
 419 {
 420     dXSTARG;
 421     getcwd_sv(TARG);
 422     XSprePUSH; PUSHTARG;
 423 #ifndef INCOMPLETE_TAINTS
 424     SvTAINTED_on(TARG);
 425 #endif
 426 }
 427
 428 void
 429 abs_path(pathsv=Nullsv)
 430     SV *pathsv
 431 PROTOTYPE: DISABLE
 432 PPCODE:
 433 {
 434     dXSTARG;
 435     char *path;
 436     char buf[MAXPATHLEN];
 437
 438     path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
 439
 440     if (bsd_realpath(path, buf)) {
 441         sv_setpvn(TARG, buf, strlen(buf));
 442         SvPOK_only(TARG);
 443         SvTAINTED_on(TARG);
 444     }
 445     else
 446         sv_setsv(TARG, &PL_sv_undef);
 447
 448     XSprePUSH; PUSHTARG;
 449 #ifndef INCOMPLETE_TAINTS
 450     SvTAINTED_on(TARG);
 451 #endif
 452 }
 453
 454 #if defined(WIN32) && !defined(UNDER_CE)
 455
 456 void
 457 getdcwd(...)
 458 PPCODE:
 459 {
 460     dXSTARG;
 461     int drive;
 462     char *dir;
 463
 464     /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
 465     if ( items == 0 ||
 466         (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
 467         drive = 0;
 468     else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
 469              isALPHA(SvPVX(ST(0))[0]))
 470         drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
 471     else
 472         croak("Usage: getdcwd(DRIVE)");
 473
 474     New(0,dir,MAXPATHLEN,char);
 475     if (_getdcwd(drive, dir, MAXPATHLEN)) {
 476         sv_setpvn(TARG, dir, strlen(dir));
 477         SvPOK_only(TARG);
 478     }
 479     else
 480         sv_setsv(TARG, &PL_sv_undef);
 481
 482     Safefree(dir);
 483
 484     XSprePUSH; PUSHTARG;
 485 #ifndef INCOMPLETE_TAINTS
 486     SvTAINTED_on(TARG);
 487 #endif
 488 }
 489
 490 #endif