ext/Cwd/Cwd.xs

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