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; |
045b4140 |
130 | char dotdots[MAXPATHLEN] = { 0 }; |
131 | char dir[MAXPATHLEN] = { 0 }; |
132 | char name[MAXPATHLEN] = { 0 }; |
2ae52c40 |
133 | char *cwd; |
134 | int namelen; |
135 | struct stat cst, pst, tst; |
136 | |
137 | if (PerlLIO_stat(start, &cst) < 0) { |
045b4140 |
138 | warn("abs_path: stat(\"%s\"): %s", start, Strerror(errno)); |
2ae52c40 |
139 | return FALSE; |
140 | } |
141 | |
142 | Newz(0, cwd, MAXPATHLEN, char); |
143 | Copy(start, dotdots, strlen(start), char); |
144 | |
145 | for (;;) { |
146 | strcat(dotdots, "/.."); |
147 | StructCopy(&cst, &pst, struct stat); |
148 | |
149 | if (PerlLIO_stat(dotdots, &cst) < 0) { |
150 | Safefree(cwd); |
045b4140 |
151 | warn("abs_path: stat(\"%s\"): %s", dotdots, Strerror(errno)); |
2ae52c40 |
152 | return FALSE; |
153 | } |
154 | |
155 | if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) { |
156 | /* We've reached the root: previous is same as current */ |
157 | break; |
158 | } else { |
045b4140 |
159 | STRLEN dotdotslen = strlen(dotdots); |
160 | |
2ae52c40 |
161 | /* Scan through the dir looking for name of previous */ |
162 | if (!(parent = PerlDir_open(dotdots))) { |
163 | Safefree(cwd); |
045b4140 |
164 | warn("abs_path: opendir(\"%s\"): %s", dotdots, Strerror(errno)); |
2ae52c40 |
165 | return FALSE; |
166 | } |
167 | |
045b4140 |
168 | SETERRNO(0,SS$_NORMAL); /* for readdir() */ |
2ae52c40 |
169 | while ((dp = PerlDir_read(parent)) != NULL) { |
170 | if (strEQ(dp->d_name, ".")) |
171 | continue; |
172 | if (strEQ(dp->d_name, "..")) |
173 | continue; |
174 | |
045b4140 |
175 | Copy(dotdots, name, dotdotslen, char); |
176 | name[dotdotslen] = '/'; |
177 | #ifdef DIRNAMLEN |
178 | namelen = dp->d_namlen; |
179 | #else |
180 | namelen = strlen(dp->d_name); |
181 | #endif |
182 | Copy(dp->d_name, name + dotdotslen + 1, namelen, char); |
183 | name[dotdotslen + 1 + namelen] = 0; |
2ae52c40 |
184 | |
185 | if (PerlLIO_lstat(name, &tst) < 0) { |
186 | Safefree(cwd); |
187 | PerlDir_close(parent); |
045b4140 |
188 | warn("abs_path: lstat(\"%s\"): %s", name, Strerror(errno)); |
2ae52c40 |
189 | return FALSE; |
190 | } |
191 | |
192 | if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino) |
193 | break; |
045b4140 |
194 | |
195 | SETERRNO(0,SS$_NORMAL); /* for readdir() */ |
2ae52c40 |
196 | } |
197 | |
045b4140 |
198 | |
199 | if (!dp && errno) { |
200 | warn("abs_path: readdir(\"%s\"): %s", dotdots, Strerror(errno)); |
201 | Safefree(cwd); |
202 | return FALSE; |
203 | } |
204 | |
2ae52c40 |
205 | Move(cwd, cwd + namelen + 1, strlen(cwd), char); |
206 | Copy(dp->d_name, cwd + 1, namelen, char); |
207 | #ifdef VOID_CLOSEDIR |
208 | PerlDir_close(dir); |
209 | #else |
210 | if (PerlDir_close(parent) < 0) { |
045b4140 |
211 | warn("abs_path: closedir(\"%s\"): %s", dotdots, Strerror(errno)); |
2ae52c40 |
212 | Safefree(cwd); |
213 | return FALSE; |
214 | } |
215 | #endif |
216 | *cwd = '/'; |
217 | } |
218 | } |
219 | |
220 | return cwd; |
221 | } |
222 | |
0d2079fa |
223 | |
224 | MODULE = Cwd PACKAGE = Cwd |
225 | |
acf4de66 |
226 | PROTOTYPES: ENABLE |
227 | |
0d2079fa |
228 | char * |
229 | _fastcwd() |
230 | PPCODE: |
231 | char * buf; |
232 | buf = _cwdxs_fastcwd(); |
233 | if (buf) { |
234 | PUSHs(sv_2mortal(newSVpv(buf, 0))); |
235 | Safefree(buf); |
236 | } |
237 | else |
238 | XSRETURN_UNDEF; |
2ae52c40 |
239 | |
240 | char * |
241 | _abs_path(start = ".") |
242 | char * start |
243 | PREINIT: |
244 | char * buf; |
245 | PPCODE: |
246 | buf = _cwdxs_abs_path(start); |
247 | if (buf) { |
248 | PUSHs(sv_2mortal(newSVpv(buf, 0))); |
249 | Safefree(buf); |
250 | } |
251 | else |
252 | XSRETURN_UNDEF; |