Commit | Line | Data |
0d2079fa |
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 | |
c38fcba2 |
88 | #ifdef VOID_CLOSEDIR |
89 | PerlDir_close(dir); |
90 | #else |
0d2079fa |
91 | if (PerlDir_close(dir) < 0) { |
92 | Safefree(names); |
93 | return FALSE; |
94 | } |
c38fcba2 |
95 | #endif |
0d2079fa |
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 | |
2ae52c40 |
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 | |
0d2079fa |
210 | |
211 | MODULE = Cwd PACKAGE = Cwd |
212 | |
acf4de66 |
213 | PROTOTYPES: ENABLE |
214 | |
0d2079fa |
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; |
2ae52c40 |
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; |