ext/Cwd/Cwd.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 /* Originally written in Perl by John Bazik; rewritten in C by Ben Sugars.
   6  * Comments from the orignal:
   7  *     This is a faster version of getcwd.  It's also more dangerous
   8  *     because you might chdir out of a directory that you can't chdir
   9  *     back into. */
  10 char *
  11 _cwdxs_fastcwd(void)
  12 {
  13 /* XXX Should we just use getcwd(3) if available? */
  14   struct stat statbuf;
  15   int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
  16   int i = 0, j = 0, k = 0, ndirs = 16, pathlen = 0, namelen;
  17   DIR *dir;
  18   Direntry_t *dp;
  19   char **names, *path;
  20
  21   Newz(0, names, ndirs, char*);
  22
  23   if (PerlLIO_lstat(".", &statbuf) < 0) {
  24     Safefree(names);
  25     return FALSE;
  26   }
  27   orig_cdev = statbuf.st_dev;
  28   orig_cino = statbuf.st_ino;
  29   cdev = orig_cdev;
  30   cino = orig_cino;
  31   for (;;) {
  32     odev = cdev;
  33     oino = cino;
  34
  35     if (PerlDir_chdir("..") < 0) {
  36       Safefree(names);
  37       return FALSE;
  38     }
  39     if (PerlLIO_stat(".", &statbuf) < 0) {
  40       Safefree(names);
  41       return FALSE;
  42     }
  43     cdev = statbuf.st_dev;
  44     cino = statbuf.st_ino;
  45     if (odev == cdev && oino == cino)
  46       break;
  47
  48     if (!(dir = PerlDir_open("."))) {
  49       Safefree(names);
  50       return FALSE;
  51     }
  52
  53     while ((dp = PerlDir_read(dir)) != NULL) {
  54       if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
  55         Safefree(names);
  56         return FALSE;
  57       }
  58       if (strEQ(dp->d_name, "."))
  59         continue;
  60       if (strEQ(dp->d_name, ".."))
  61         continue;
  62       tdev = statbuf.st_dev;
  63       tino = statbuf.st_ino;
  64       if (tino == oino && tdev == odev)
  65         break;
  66     }
  67
  68     if (!dp) {
  69       Safefree(names);
  70       return FALSE;
  71     }
  72
  73     if (i >= ndirs) {
  74       ndirs += 16;
  75       Renew(names, ndirs, char*);
  76     }
  77 #ifdef DIRNAMLEN
  78     namelen = dp->d_namlen;
  79 #else
  80     namelen = strlen(dp->d_name);
  81 #endif
  82     Newz(0, *(names + i), namelen + 1, char);
  83     Copy(dp->d_name, *(names + i), namelen, char);
  84     *(names[i] + namelen) = '\0';
  85     pathlen += (namelen + 1);
  86     ++i;
  87
  88 #ifdef VOID_CLOSEDIR
  89     PerlDir_close(dir);
  90 #else
  91     if (PerlDir_close(dir) < 0) {
  92       Safefree(names);
  93       return FALSE;
  94     }
  95 #endif
  96   }
  97
  98   Newz(0, path, pathlen + 1, char);
  99   for (j = i - 1; j >= 0; j--) {
 100     *(path + k) = '/';
 101     Copy(names[j], path + k + 1, strlen(names[j]) + 1, char);
 102     k = k + strlen(names[j]) + 1;
 103     Safefree(names[j]);
 104   }
 105
 106   if (PerlDir_chdir(path) < 0) {
 107     Safefree(names);
 108     Safefree(path);
 109     return FALSE;
 110   }
 111   if (PerlLIO_stat(".", &statbuf) < 0) {
 112     Safefree(names);
 113     Safefree(path);
 114     return FALSE;
 115   }
 116   cdev = statbuf.st_dev;
 117   cino = statbuf.st_ino;
 118   if (cdev != orig_cdev || cino != orig_cino)
 119     Perl_croak(aTHX_ "Unstable directory path, current directory changed unexpectedly");
 120
 121   Safefree(names);
 122   return(path);
 123 }
 124
 125 char *
 126 _cwdxs_abs_path(char *start)
 127 {
 128   DIR *parent;
 129   Direntry_t *dp;
 130   char dotdots[MAXPATHLEN] = "", dir[MAXPATHLEN] = "";
 131   char name[FILENAME_MAX] = "";
 132   char *cwd;
 133   int namelen;
 134   struct stat cst, pst, tst;
 135
 136   if (PerlLIO_stat(start, &cst) < 0) {
 137     warn("stat(%s): %s", start, Strerror(errno));
 138     return FALSE;
 139   }
 140
 141   Newz(0, cwd, MAXPATHLEN, char);
 142   Copy(start, dotdots, strlen(start), char);
 143
 144   for (;;) {
 145     strcat(dotdots, "/..");
 146     StructCopy(&cst, &pst, struct stat);
 147
 148     if (PerlLIO_stat(dotdots, &cst) < 0) {
 149       Safefree(cwd);
 150       warn("stat(%s): %s", dotdots, Strerror(errno));
 151       return FALSE;
 152     }
 153
 154     if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) {
 155       /* We've reached the root: previous is same as current */
 156       break;
 157     } else {
 158       /* Scan through the dir looking for name of previous */
 159       if (!(parent = PerlDir_open(dotdots))) {
 160         Safefree(cwd);
 161         warn("opendir(%s): %s", dotdots, Strerror(errno));
 162         return FALSE;
 163       }
 164
 165       while ((dp = PerlDir_read(parent)) != NULL) {
 166         if (strEQ(dp->d_name, "."))
 167           continue;
 168         if (strEQ(dp->d_name, ".."))
 169           continue;
 170
 171         Zero(name, FILENAME_MAX, char);
 172         Copy(dotdots, name, strlen(dotdots), char);
 173         *(name + strlen(dotdots)) = '/';
 174         strcat(name, dp->d_name);
 175
 176         if (PerlLIO_lstat(name, &tst) < 0) {
 177           Safefree(cwd);
 178           PerlDir_close(parent);
 179           warn("lstat(%s): %s", name, Strerror(errno));
 180           return FALSE;
 181         }
 182
 183         if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino)
 184           break;
 185       }
 186
 187 #ifdef DIRNAMLEN
 188       namelen = dp->d_namlen;
 189 #else
 190       namelen = strlen(dp->d_name);
 191 #endif
 192       Move(cwd, cwd + namelen + 1, strlen(cwd), char);
 193       Copy(dp->d_name, cwd + 1, namelen, char);
 194 #ifdef VOID_CLOSEDIR
 195       PerlDir_close(dir);
 196 #else
 197       if (PerlDir_close(parent) < 0) {
 198         warn("closedir(%s): %s", dotdots, Strerror(errno));
 199         Safefree(cwd);
 200         return FALSE;
 201       }
 202 #endif
 203       *cwd = '/';
 204     }
 205   }
 206
 207   return cwd;
 208 }
 209
 210
 211 MODULE = Cwd            PACKAGE = Cwd
 212
 213 PROTOTYPES: ENABLE
 214
 215 char *
 216 _fastcwd()
 217 PPCODE:
 218     char * buf;
 219     buf = _cwdxs_fastcwd();
 220     if (buf) {
 221         PUSHs(sv_2mortal(newSVpv(buf, 0)));
 222         Safefree(buf);
 223     }
 224     else
 225         XSRETURN_UNDEF;
 226
 227 char *
 228 _abs_path(start = ".")
 229     char * start
 230 PREINIT:
 231     char * buf;
 232 PPCODE:
 233     buf = _cwdxs_abs_path(start);
 234     if (buf) {
 235         PUSHs(sv_2mortal(newSVpv(buf, 0)));
 236         Safefree(buf);
 237     }
 238     else
 239         XSRETURN_UNDEF;