ext/Cwd/Cwd.xs

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