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