Ticket #1538: Cwd.c

File Cwd.c, 11.6 KB (added by kaliber, 16 years ago)
Line 
1/*
2 * This file was generated automatically by xsubpp version 1.9508 from the
3 * contents of Cwd.xs. Do not edit this file, edit Cwd.xs instead.
4 *
5 * ANY CHANGES MADE HERE WILL BE LOST!
6 *
7 */
8
9#line 1 "Cwd.xs"
10#include "EXTERN.h"
11#include "perl.h"
12#include "XSUB.h"
13#define NEED_sv_2pv_nolen
14#include "ppport.h"
15
16#ifdef I_UNISTD
17# include <unistd.h>
18#endif
19
20/* The realpath() implementation from OpenBSD 2.9 (realpath.c 1.4)
21 * Renamed here to bsd_realpath() to avoid library conflicts.
22 * --jhi 2000-06-20
23 */
24
25/* See
26 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-11/msg00979.html
27 * for the details of why the BSD license is compatible with the
28 * AL/GPL standard perl license.
29 */
30
31/*
32 * Copyright (c) 1994
33 * The Regents of the University of California. All rights reserved.
34 *
35 * This code is derived from software contributed to Berkeley by
36 * Jan-Simon Pendry.
37 *
38 * Redistribution and use in source and binary forms, with or without
39 * modification, are permitted provided that the following conditions
40 * are met:
41 * 1. Redistributions of source code must retain the above copyright
42 * notice, this list of conditions and the following disclaimer.
43 * 2. Redistributions in binary form must reproduce the above copyright
44 * notice, this list of conditions and the following disclaimer in the
45 * documentation and/or other materials provided with the distribution.
46 * 3. Neither the name of the University nor the names of its contributors
47 * may be used to endorse or promote products derived from this software
48 * without specific prior written permission.
49 *
50 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
51 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
52 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
53 * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
54 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
55 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
56 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
57 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
58 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
59 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
60 * SUCH DAMAGE.
61 */
62
63#if defined(LIBC_SCCS) && !defined(lint)
64static char *rcsid = "$OpenBSD: realpath.c,v 1.4 1998/05/18 09:55:19 deraadt Exp $";
65#endif /* LIBC_SCCS and not lint */
66
67/* OpenBSD system #includes removed since the Perl ones should do. --jhi */
68
69#ifndef MAXSYMLINKS
70#define MAXSYMLINKS 8
71#endif
72
73/*
74 * char *realpath(const char *path, char resolved_path[MAXPATHLEN]);
75 *
76 * Find the real name of path, by removing all ".", ".." and symlink
77 * components. Returns (resolved) on success, or (NULL) on failure,
78 * in which case the path which caused trouble is left in (resolved).
79 */
80static
81char *
82bsd_realpath(const char *path, char *resolved)
83{
84#ifdef VMS
85 dTHX;
86 return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
87#else
88 int rootd, serrno;
89 char *p, *q, wbuf[MAXPATHLEN];
90 int symlinks = 0;
91
92 /* Save the starting point. */
93#ifdef HAS_FCHDIR
94 int fd;
95
96 if ((fd = open(".", O_RDONLY)) < 0) {
97 (void)strcpy(resolved, ".");
98 return (NULL);
99 }
100#else
101 char wd[MAXPATHLEN];
102
103 if (getcwd(wd, MAXPATHLEN - 1) == NULL) {
104 (void)strcpy(resolved, ".");
105 return (NULL);
106 }
107#endif
108
109 /*
110 * Find the dirname and basename from the path to be resolved.
111 * Change directory to the dirname component.
112 * lstat the basename part.
113 * if it is a symlink, read in the value and loop.
114 * if it is a directory, then change to that directory.
115 * get the current directory name and append the basename.
116 */
117 (void)strncpy(resolved, path, MAXPATHLEN - 1);
118 resolved[MAXPATHLEN - 1] = '\0';
119loop:
120 q = strrchr(resolved, '/');
121 if (q != NULL) {
122 p = q + 1;
123 if (q == resolved)
124 q = "/";
125 else {
126 do {
127 --q;
128 } while (q > resolved && *q == '/');
129 q[1] = '\0';
130 q = resolved;
131 }
132 if (chdir(q) < 0)
133 goto err1;
134 } else
135 p = resolved;
136
137#if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
138 {
139 struct stat sb;
140 /* Deal with the last component. */
141 if (lstat(p, &sb) == 0) {
142 if (S_ISLNK(sb.st_mode)) {
143 int n;
144 if (++symlinks > MAXSYMLINKS) {
145 errno = ELOOP;
146 goto err1;
147 }
148 n = readlink(p, resolved, MAXPATHLEN-1);
149 if (n < 0)
150 goto err1;
151 resolved[n] = '\0';
152 goto loop;
153 }
154 if (S_ISDIR(sb.st_mode)) {
155 if (chdir(p) < 0)
156 goto err1;
157 p = "";
158 }
159 }
160 }
161#endif
162
163 /*
164 * Save the last component name and get the full pathname of
165 * the current directory.
166 */
167 (void)strcpy(wbuf, p);
168 if (getcwd(resolved, MAXPATHLEN) == 0)
169 goto err1;
170
171 /*
172 * Join the two strings together, ensuring that the right thing
173 * happens if the last component is empty, or the dirname is root.
174 */
175 if (resolved[0] == '/' && resolved[1] == '\0')
176 rootd = 1;
177 else
178 rootd = 0;
179
180 if (*wbuf) {
181 if (strlen(resolved) + strlen(wbuf) + (1 - rootd) + 1 > MAXPATHLEN) {
182 errno = ENAMETOOLONG;
183 goto err1;
184 }
185 if (rootd == 0)
186 (void)strcat(resolved, "/");
187 (void)strcat(resolved, wbuf);
188 }
189
190 /* Go back to where we came from. */
191#ifdef HAS_FCHDIR
192 if (fchdir(fd) < 0) {
193 serrno = errno;
194 goto err2;
195 }
196#else
197 if (chdir(wd) < 0) {
198 serrno = errno;
199 goto err2;
200 }
201#endif
202
203 /* It's okay if the close fails, what's an fd more or less? */
204#ifdef HAS_FCHDIR
205 (void)close(fd);
206#endif
207 return (resolved);
208
209err1: serrno = errno;
210#ifdef HAS_FCHDIR
211 (void)fchdir(fd);
212#else
213 (void)chdir(wd);
214#endif
215
216err2:
217#ifdef HAS_FCHDIR
218 (void)close(fd);
219#endif
220 errno = serrno;
221 return (NULL);
222#endif
223}
224
225#ifndef SV_CWD_RETURN_UNDEF
226#define SV_CWD_RETURN_UNDEF \
227sv_setsv(sv, &PL_sv_undef); \
228return FALSE
229#endif
230
231#ifndef OPpENTERSUB_HASTARG
232#define OPpENTERSUB_HASTARG 32 /* Called from OP tree. */
233#endif
234
235#ifndef dXSTARG
236#define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
237 ? PAD_SV(PL_op->op_targ) : sv_newmortal())
238#endif
239
240#ifndef XSprePUSH
241#define XSprePUSH (sp = PL_stack_base + ax - 1)
242#endif
243
244#ifndef SV_CWD_ISDOT
245#define SV_CWD_ISDOT(dp) \
246 (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \
247 (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
248#endif
249
250#ifndef getcwd_sv
251/* Taken from perl 5.8's util.c */
252#define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
253int Perl_getcwd_sv(pTHX_ register SV *sv)
254{
255#ifndef PERL_MICRO
256
257#ifndef INCOMPLETE_TAINTS
258 SvTAINTED_on(sv);
259#endif
260
261#ifdef HAS_GETCWD
262 {
263 char buf[MAXPATHLEN];
264
265 /* Some getcwd()s automatically allocate a buffer of the given
266 * size from the heap if they are given a NULL buffer pointer.
267 * The problem is that this behaviour is not portable. */
268 if (getcwd(buf, sizeof(buf) - 1)) {
269 STRLEN len = strlen(buf);
270 sv_setpvn(sv, buf, len);
271 return TRUE;
272 }
273 else {
274 sv_setsv(sv, &PL_sv_undef);
275 return FALSE;
276 }
277 }
278
279#else
280 {
281 Stat_t statbuf;
282 int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
283 int namelen, pathlen=0;
284 DIR *dir;
285 Direntry_t *dp;
286
287 (void)SvUPGRADE(sv, SVt_PV);
288
289 if (PerlLIO_lstat(".", &statbuf) < 0) {
290 SV_CWD_RETURN_UNDEF;
291 }
292
293 orig_cdev = statbuf.st_dev;
294 orig_cino = statbuf.st_ino;
295 cdev = orig_cdev;
296 cino = orig_cino;
297
298 for (;;) {
299 odev = cdev;
300 oino = cino;
301
302 if (PerlDir_chdir("..") < 0) {
303 SV_CWD_RETURN_UNDEF;
304 }
305 if (PerlLIO_stat(".", &statbuf) < 0) {
306 SV_CWD_RETURN_UNDEF;
307 }
308
309 cdev = statbuf.st_dev;
310 cino = statbuf.st_ino;
311
312 if (odev == cdev && oino == cino) {
313 break;
314 }
315 if (!(dir = PerlDir_open("."))) {
316 SV_CWD_RETURN_UNDEF;
317 }
318
319 while ((dp = PerlDir_read(dir)) != NULL) {
320#ifdef DIRNAMLEN
321 namelen = dp->d_namlen;
322#else
323 namelen = strlen(dp->d_name);
324#endif
325 /* skip . and .. */
326 if (SV_CWD_ISDOT(dp)) {
327 continue;
328 }
329
330 if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
331 SV_CWD_RETURN_UNDEF;
332 }
333
334 tdev = statbuf.st_dev;
335 tino = statbuf.st_ino;
336 if (tino == oino && tdev == odev) {
337 break;
338 }
339 }
340
341 if (!dp) {
342 SV_CWD_RETURN_UNDEF;
343 }
344
345 if (pathlen + namelen + 1 >= MAXPATHLEN) {
346 SV_CWD_RETURN_UNDEF;
347 }
348
349 SvGROW(sv, pathlen + namelen + 1);
350
351 if (pathlen) {
352 /* shift down */
353 Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
354 }
355
356 /* prepend current directory to the front */
357 *SvPVX(sv) = '/';
358 Move(dp->d_name, SvPVX(sv)+1, namelen, char);
359 pathlen += (namelen + 1);
360
361#ifdef VOID_CLOSEDIR
362 PerlDir_close(dir);
363#else
364 if (PerlDir_close(dir) < 0) {
365 SV_CWD_RETURN_UNDEF;
366 }
367#endif
368 }
369
370 if (pathlen) {
371 SvCUR_set(sv, pathlen);
372 *SvEND(sv) = '\0';
373 SvPOK_only(sv);
374
375 if (PerlDir_chdir(SvPVX(sv)) < 0) {
376 SV_CWD_RETURN_UNDEF;
377 }
378 }
379 if (PerlLIO_stat(".", &statbuf) < 0) {
380 SV_CWD_RETURN_UNDEF;
381 }
382
383 cdev = statbuf.st_dev;
384 cino = statbuf.st_ino;
385
386 if (cdev != orig_cdev || cino != orig_cino) {
387 Perl_croak(aTHX_ "Unstable directory path, "
388 "current directory changed unexpectedly");
389 }
390
391 return TRUE;
392 }
393#endif
394
395#else
396 return FALSE;
397#endif
398}
399
400#endif
401
402
403#line 404 "Cwd.c"
404
405XS(XS_Cwd_fastcwd); /* prototype to pass -Wmissing-prototypes */
406XS(XS_Cwd_fastcwd)
407{
408 dXSARGS;
409 if (items != 0)
410 Perl_croak(aTHX_ "Usage: Cwd::fastcwd()");
411 PERL_UNUSED_VAR(ax); /* -Wall */
412 SP -= items;
413 {
414#line 402 "Cwd.xs"
415{
416 dXSTARG;
417 getcwd_sv(TARG);
418 XSprePUSH; PUSHTARG;
419#ifndef INCOMPLETE_TAINTS
420 SvTAINTED_on(TARG);
421#endif
422}
423#line 424 "Cwd.c"
424 PUTBACK;
425 return;
426 }
427}
428
429
430XS(XS_Cwd_abs_path); /* prototype to pass -Wmissing-prototypes */
431XS(XS_Cwd_abs_path)
432{
433 dXSARGS;
434 if (items < 0 || items > 1)
435 Perl_croak(aTHX_ "Usage: Cwd::abs_path(pathsv=Nullsv)");
436 SP -= items;
437 {
438 SV * pathsv;
439
440 if (items < 1)
441 pathsv = Nullsv;
442 else {
443 pathsv = ST(0);
444 }
445#line 416 "Cwd.xs"
446{
447 dXSTARG;
448 char *path;
449 char buf[MAXPATHLEN];
450
451 path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
452
453 if (bsd_realpath(path, buf)) {
454 sv_setpvn(TARG, buf, strlen(buf));
455 SvPOK_only(TARG);
456 SvTAINTED_on(TARG);
457 }
458 else
459 sv_setsv(TARG, &PL_sv_undef);
460
461 XSprePUSH; PUSHTARG;
462#ifndef INCOMPLETE_TAINTS
463 SvTAINTED_on(TARG);
464#endif
465}
466#line 467 "Cwd.c"
467 PUTBACK;
468 return;
469 }
470}
471
472#ifdef WIN32
473#define XSubPPtmpAAAA 1
474
475
476XS(XS_Cwd_getdcwd); /* prototype to pass -Wmissing-prototypes */
477XS(XS_Cwd_getdcwd)
478{
479 dXSARGS;
480 PERL_UNUSED_VAR(ax); /* -Wall */
481 SP -= items;
482 {
483#line 442 "Cwd.xs"
484{
485 dXSTARG;
486 int drive;
487 char *dir;
488
489 /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
490 if ( items == 0 ||
491 (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
492 drive = 0;
493 else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
494 isALPHA(SvPVX(ST(0))[0]))
495 drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
496 else
497 croak("Usage: getdcwd(DRIVE)");
498
499 New(0,dir,MAXPATHLEN,char);
500 if (_getdcwd(drive, dir, MAXPATHLEN)) {
501 sv_setpvn(TARG, dir, strlen(dir));
502 SvPOK_only(TARG);
503 }
504 else
505 sv_setsv(TARG, &PL_sv_undef);
506
507 Safefree(dir);
508
509 XSprePUSH; PUSHTARG;
510#ifndef INCOMPLETE_TAINTS
511 SvTAINTED_on(TARG);
512#endif
513}
514#line 515 "Cwd.c"
515 PUTBACK;
516 return;
517 }
518}
519
520#endif
521#ifdef __cplusplus
522extern "C"
523#endif
524XS(boot_Cwd); /* prototype to pass -Wmissing-prototypes */
525XS(boot_Cwd)
526{
527 dXSARGS;
528 char* file = __FILE__;
529
530 XS_VERSION_BOOTCHECK ;
531
532 newXS("Cwd::fastcwd", XS_Cwd_fastcwd, file);
533 newXS("Cwd::abs_path", XS_Cwd_abs_path, file);
534#if XSubPPtmpAAAA
535 newXSproto("Cwd::getdcwd", XS_Cwd_getdcwd, file, ";@");
536#endif
537
538 /* Initialisation Section */
539
540#if XSubPPtmpAAAA
541#endif
542#line 543 "Cwd.c"
543
544 /* End of Initialisation Section */
545
546 XSRETURN_YES;
547}
548