ext/Cwd/Cwd.xs

   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 {
  75 #ifdef VMS
  76        dTHX;
  77        return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
  78 #else
  79         int rootd, serrno;
  80         char *p, *q, wbuf[MAXPATHLEN];
  81         int symlinks = 0;
  82
  83         /* Save the starting point. */
  84 #ifdef HAS_FCHDIR
  85         int fd;
  86
  87         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         (void)strncpy(resolved, path, MAXPATHLEN - 1);
 109         resolved[MAXPATHLEN - 1] = '\0';
 110 loop:
 111         q = strrchr(resolved, '/');
 112         if (q != NULL) {
 113                 p = q + 1;
 114                 if (q == resolved)
 115                         q = "/";
 116                 else {
 117                         do {
 118                                 --q;
 119                         } while (q > resolved && *q == '/');
 120                         q[1] = '\0';
 121                         q = resolved;
 122                 }
 123                 if (chdir(q) < 0)
 124                         goto err1;
 125         } else
 126                 p = resolved;
 127
 128 #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
 129     {
 130         struct stat sb;
 131         /* Deal with the last component. */
 132         if (lstat(p, &sb) == 0) {
 133                 if (S_ISLNK(sb.st_mode)) {
 134                         int n;
 135                         if (++symlinks > MAXSYMLINKS) {
 136                                 errno = ELOOP;
 137                                 goto err1;
 138                         }
 139                         n = readlink(p, resolved, MAXPATHLEN-1);
 140                         if (n < 0)
 141                                 goto err1;
 142                         resolved[n] = '\0';
 143                         goto loop;
 144                 }
 145                 if (S_ISDIR(sb.st_mode)) {
 146                         if (chdir(p) < 0)
 147                                 goto err1;
 148                         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         (void)strcpy(wbuf, p);
 159         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         if (resolved[0] == '/' && resolved[1] == '\0')
 167                 rootd = 1;
 168         else
 169                 rootd = 0;
 170
 171         if (*wbuf) {
 172                 if (strlen(resolved) + strlen(wbuf) + (1 - rootd) + 1 > MAXPATHLEN) {
 173                         errno = ENAMETOOLONG;
 174                         goto err1;
 175                 }
 176                 if (rootd == 0)
 177                         (void)strcat(resolved, "/");
 178                 (void)strcat(resolved, wbuf);
 179         }
 180
 181         /* Go back to where we came from. */
 182 #ifdef HAS_FCHDIR
 183         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         (void)close(fd);
 197 #endif
 198         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 #endif
 384
 385 #else
 386     return FALSE;
 387 #endif
 388 }
 389
 390 #endif
 391
 392
 393 MODULE = Cwd            PACKAGE = Cwd
 394
 395 PROTOTYPES: ENABLE
 396
 397 void
 398 fastcwd()
 399 PROTOTYPE: DISABLE
 400 PPCODE:
 401 {
 402     dXSTARG;
 403     getcwd_sv(TARG);
 404     XSprePUSH; PUSHTARG;
 405 #ifndef INCOMPLETE_TAINTS
 406     SvTAINTED_on(TARG);
 407 #endif
 408 }
 409
 410 void
 411 abs_path(pathsv=Nullsv)
 412     SV *pathsv
 413 PROTOTYPE: DISABLE
 414 PPCODE:
 415 {
 416     dXSTARG;
 417     char *path;
 418     char buf[MAXPATHLEN];
 419
 420     path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
 421
 422     if (bsd_realpath(path, buf)) {
 423         sv_setpvn(TARG, buf, strlen(buf));
 424         SvPOK_only(TARG);
 425         SvTAINTED_on(TARG);
 426     }
 427     else
 428         sv_setsv(TARG, &PL_sv_undef);
 429
 430     XSprePUSH; PUSHTARG;
 431 #ifndef INCOMPLETE_TAINTS
 432     SvTAINTED_on(TARG);
 433 #endif
 434 }
 435
 436 #ifdef WIN32
 437
 438 void
 439 getdcwd(...)
 440 PPCODE:
 441 {
 442     dXSTARG;
 443     int drive;
 444     char *dir;
 445
 446     /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
 447     if ( items == 0 ||
 448         (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
 449         drive = 0;
 450     else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
 451              isALPHA(SvPVX(ST(0))[0]))
 452         drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
 453     else
 454         croak("Usage: getdcwd(DRIVE)");
 455
 456     New(0,dir,MAXPATHLEN,char);
 457     if (_getdcwd(drive, dir, MAXPATHLEN)) {
 458         sv_setpvn(TARG, dir, strlen(dir));
 459         SvPOK_only(TARG);
 460     }
 461     else
 462         sv_setsv(TARG, &PL_sv_undef);
 463
 464     Safefree(dir);
 465
 466     XSprePUSH; PUSHTARG;
 467 #ifndef INCOMPLETE_TAINTS
 468     SvTAINTED_on(TARG);
 469 #endif
 470 }
 471
 472 #endif