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 int getcwd_sv(pTHX_ register SV *sv)
 216 {
 217 #ifndef PERL_MICRO
 218
 219 #ifndef INCOMPLETE_TAINTS
 220     SvTAINTED_on(sv);
 221 #endif
 222
 223 #ifdef HAS_GETCWD
 224     {
 225         char buf[MAXPATHLEN];
 226
 227         /* Some getcwd()s automatically allocate a buffer of the given
 228          * size from the heap if they are given a NULL buffer pointer.
 229          * The problem is that this behaviour is not portable. */
 230         if (getcwd(buf, sizeof(buf) - 1)) {
 231             STRLEN len = strlen(buf);
 232             sv_setpvn(sv, buf, len);
 233             return TRUE;
 234         }
 235         else {
 236             sv_setsv(sv, &PL_sv_undef);
 237             return FALSE;
 238         }
 239     }
 240
 241 #else
 242
 243     Stat_t statbuf;
 244     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
 245     int namelen, pathlen=0;
 246     DIR *dir;
 247     Direntry_t *dp;
 248
 249     (void)SvUPGRADE(sv, SVt_PV);
 250
 251     if (PerlLIO_lstat(".", &statbuf) < 0) {
 252         SV_CWD_RETURN_UNDEF;
 253     }
 254
 255     orig_cdev = statbuf.st_dev;
 256     orig_cino = statbuf.st_ino;
 257     cdev = orig_cdev;
 258     cino = orig_cino;
 259
 260     for (;;) {
 261         odev = cdev;
 262         oino = cino;
 263
 264         if (PerlDir_chdir("..") < 0) {
 265             SV_CWD_RETURN_UNDEF;
 266         }
 267         if (PerlLIO_stat(".", &statbuf) < 0) {
 268             SV_CWD_RETURN_UNDEF;
 269         }
 270
 271         cdev = statbuf.st_dev;
 272         cino = statbuf.st_ino;
 273
 274         if (odev == cdev && oino == cino) {
 275             break;
 276         }
 277         if (!(dir = PerlDir_open("."))) {
 278             SV_CWD_RETURN_UNDEF;
 279         }
 280
 281         while ((dp = PerlDir_read(dir)) != NULL) {
 282 #ifdef DIRNAMLEN
 283             namelen = dp->d_namlen;
 284 #else
 285             namelen = strlen(dp->d_name);
 286 #endif
 287             /* skip . and .. */
 288             if (SV_CWD_ISDOT(dp)) {
 289                 continue;
 290             }
 291
 292             if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
 293                 SV_CWD_RETURN_UNDEF;
 294             }
 295
 296             tdev = statbuf.st_dev;
 297             tino = statbuf.st_ino;
 298             if (tino == oino && tdev == odev) {
 299                 break;
 300             }
 301         }
 302
 303         if (!dp) {
 304             SV_CWD_RETURN_UNDEF;
 305         }
 306
 307         if (pathlen + namelen + 1 >= MAXPATHLEN) {
 308             SV_CWD_RETURN_UNDEF;
 309         }
 310
 311         SvGROW(sv, pathlen + namelen + 1);
 312
 313         if (pathlen) {
 314             /* shift down */
 315             Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
 316         }
 317
 318         /* prepend current directory to the front */
 319         *SvPVX(sv) = '/';
 320         Move(dp->d_name, SvPVX(sv)+1, namelen, char);
 321         pathlen += (namelen + 1);
 322
 323 #ifdef VOID_CLOSEDIR
 324         PerlDir_close(dir);
 325 #else
 326         if (PerlDir_close(dir) < 0) {
 327             SV_CWD_RETURN_UNDEF;
 328         }
 329 #endif
 330     }
 331
 332     if (pathlen) {
 333         SvCUR_set(sv, pathlen);
 334         *SvEND(sv) = '\0';
 335         SvPOK_only(sv);
 336
 337         if (PerlDir_chdir(SvPVX(sv)) < 0) {
 338             SV_CWD_RETURN_UNDEF;
 339         }
 340     }
 341     if (PerlLIO_stat(".", &statbuf) < 0) {
 342         SV_CWD_RETURN_UNDEF;
 343     }
 344
 345     cdev = statbuf.st_dev;
 346     cino = statbuf.st_ino;
 347
 348     if (cdev != orig_cdev || cino != orig_cino) {
 349         Perl_croak(aTHX_ "Unstable directory path, "
 350                    "current directory changed unexpectedly");
 351     }
 352
 353     return TRUE;
 354 #endif
 355
 356 #else
 357     return FALSE;
 358 #endif
 359 }
 360
 361 #endif
 362
 363
 364 MODULE = Cwd            PACKAGE = Cwd
 365
 366 PROTOTYPES: ENABLE
 367
 368 void
 369 fastcwd()
 370 PROTOTYPE: DISABLE
 371 PPCODE:
 372 {
 373     dXSTARG;
 374     getcwd_sv(TARG);
 375     XSprePUSH; PUSHTARG;
 376 #ifndef INCOMPLETE_TAINTS
 377     SvTAINTED_on(TARG);
 378 #endif
 379 }
 380
 381 void
 382 abs_path(pathsv=Nullsv)
 383     SV *pathsv
 384 PPCODE:
 385 {
 386     dXSTARG;
 387     char *path;
 388     char buf[MAXPATHLEN];
 389
 390     path = pathsv ? SvPV_nolen(pathsv) : ".";
 391
 392     if (bsd_realpath(path, buf)) {
 393         sv_setpvn(TARG, buf, strlen(buf));
 394         SvPOK_only(TARG);
 395         SvTAINTED_on(TARG);
 396     }
 397     else
 398         sv_setsv(TARG, &PL_sv_undef);
 399
 400     XSprePUSH; PUSHTARG;
 401 #ifndef INCOMPLETE_TAINTS
 402     SvTAINTED_on(TARG);
 403 #endif
 404 }