4 #define NEED_my_strlcpy
5 #define NEED_my_strlcat
12 /* The realpath() implementation from OpenBSD 3.9 to 4.2 (realpath.c 1.13)
13 * Renamed here to bsd_realpath() to avoid library conflicts.
17 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-11/msg00979.html
18 * for the details of why the BSD license is compatible with the
19 * AL/GPL standard perl license.
23 * Copyright (c) 2003 Constantin S. Svintsoff <kostik@iclub.nsu.ru>
25 * Redistribution and use in source and binary forms, with or without
26 * modification, are permitted provided that the following conditions
28 * 1. Redistributions of source code must retain the above copyright
29 * notice, this list of conditions and the following disclaimer.
30 * 2. Redistributions in binary form must reproduce the above copyright
31 * notice, this list of conditions and the following disclaimer in the
32 * documentation and/or other materials provided with the distribution.
33 * 3. The names of the authors may not be used to endorse or promote
34 * products derived from this software without specific prior written
37 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
38 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
39 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
40 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
41 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
42 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
43 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
44 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
45 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
46 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
50 /* OpenBSD system #includes removed since the Perl ones should do. --jhi */
57 * char *realpath(const char *path, char resolved[MAXPATHLEN]);
59 * Find the real name of path, by removing all ".", ".." and symlink
60 * components. Returns (resolved) on success, or (NULL) on failure,
61 * in which case the path which caused trouble is left in (resolved).
65 bsd_realpath(const char *path, char resolved[MAXPATHLEN])
69 return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
72 size_t left_len, resolved_len;
75 char left[MAXPATHLEN], next_token[MAXPATHLEN], symlink[MAXPATHLEN];
85 left_len = my_strlcpy(left, path + 1, sizeof(left));
87 if (getcwd(resolved, MAXPATHLEN) == NULL) {
88 my_strlcpy(resolved, ".", MAXPATHLEN);
91 resolved_len = strlen(resolved);
92 left_len = my_strlcpy(left, path, sizeof(left));
94 if (left_len >= sizeof(left) || resolved_len >= MAXPATHLEN) {
100 * Iterate over path components in `left'.
102 while (left_len != 0) {
104 * Extract the next path component and adjust `left'
107 p = strchr(left, '/');
108 s = p ? p : left + left_len;
109 if (s - left >= sizeof(next_token)) {
110 errno = ENAMETOOLONG;
113 memcpy(next_token, left, s - left);
114 next_token[s - left] = '\0';
115 left_len -= s - left;
117 memmove(left, s + 1, left_len + 1);
118 if (resolved[resolved_len - 1] != '/') {
119 if (resolved_len + 1 >= MAXPATHLEN) {
120 errno = ENAMETOOLONG;
123 resolved[resolved_len++] = '/';
124 resolved[resolved_len] = '\0';
126 if (next_token[0] == '\0')
128 else if (strcmp(next_token, ".") == 0)
130 else if (strcmp(next_token, "..") == 0) {
132 * Strip the last path component except when we have
135 if (resolved_len > 1) {
136 resolved[resolved_len - 1] = '\0';
137 q = strrchr(resolved, '/') + 1;
139 resolved_len = q - resolved;
145 * Append the next path component and lstat() it. If
146 * lstat() fails we still can return successfully if
147 * there are no more path components left.
149 resolved_len = my_strlcat(resolved, next_token, MAXPATHLEN);
150 if (resolved_len >= MAXPATHLEN) {
151 errno = ENAMETOOLONG;
154 #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
157 if (lstat(resolved, &sb) != 0) {
158 if (errno == ENOENT && p == NULL) {
164 if (S_ISLNK(sb.st_mode)) {
167 if (symlinks++ > MAXSYMLINKS) {
171 slen = readlink(resolved, symlink, sizeof(symlink) - 1);
174 symlink[slen] = '\0';
175 if (symlink[0] == '/') {
178 } else if (resolved_len > 1) {
179 /* Strip the last path component. */
180 resolved[resolved_len - 1] = '\0';
181 q = strrchr(resolved, '/') + 1;
183 resolved_len = q - resolved;
187 * If there are any path components left, then
188 * append them to symlink. The result is placed
192 if (symlink[slen - 1] != '/') {
193 if (slen + 1 >= sizeof(symlink)) {
194 errno = ENAMETOOLONG;
198 symlink[slen + 1] = 0;
200 left_len = my_strlcat(symlink, left, sizeof(left));
201 if (left_len >= sizeof(left)) {
202 errno = ENAMETOOLONG;
206 left_len = my_strlcpy(left, symlink, sizeof(left));
213 * Remove trailing slash except when the resolved pathname
216 if (resolved_len > 1 && resolved[resolved_len - 1] == '/')
217 resolved[resolved_len - 1] = '\0';
222 #ifndef SV_CWD_RETURN_UNDEF
223 #define SV_CWD_RETURN_UNDEF \
224 sv_setsv(sv, &PL_sv_undef); \
228 #ifndef OPpENTERSUB_HASTARG
229 #define OPpENTERSUB_HASTARG 32 /* Called from OP tree. */
233 #define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
234 ? PAD_SV(PL_op->op_targ) : sv_newmortal())
238 #define XSprePUSH (sp = PL_stack_base + ax - 1)
242 #define SV_CWD_ISDOT(dp) \
243 (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \
244 (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
248 /* Taken from perl 5.8's util.c */
249 #define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
250 int Perl_getcwd_sv(pTHX_ register SV *sv)
254 #ifndef INCOMPLETE_TAINTS
260 char buf[MAXPATHLEN];
262 /* Some getcwd()s automatically allocate a buffer of the given
263 * size from the heap if they are given a NULL buffer pointer.
264 * The problem is that this behaviour is not portable. */
265 if (getcwd(buf, sizeof(buf) - 1)) {
266 STRLEN len = strlen(buf);
267 sv_setpvn(sv, buf, len);
271 sv_setsv(sv, &PL_sv_undef);
279 int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
280 int namelen, pathlen=0;
284 (void)SvUPGRADE(sv, SVt_PV);
286 if (PerlLIO_lstat(".", &statbuf) < 0) {
290 orig_cdev = statbuf.st_dev;
291 orig_cino = statbuf.st_ino;
299 if (PerlDir_chdir("..") < 0) {
302 if (PerlLIO_stat(".", &statbuf) < 0) {
306 cdev = statbuf.st_dev;
307 cino = statbuf.st_ino;
309 if (odev == cdev && oino == cino) {
312 if (!(dir = PerlDir_open("."))) {
316 while ((dp = PerlDir_read(dir)) != NULL) {
318 namelen = dp->d_namlen;
320 namelen = strlen(dp->d_name);
323 if (SV_CWD_ISDOT(dp)) {
327 if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
331 tdev = statbuf.st_dev;
332 tino = statbuf.st_ino;
333 if (tino == oino && tdev == odev) {
342 if (pathlen + namelen + 1 >= MAXPATHLEN) {
346 SvGROW(sv, pathlen + namelen + 1);
350 Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
353 /* prepend current directory to the front */
355 Move(dp->d_name, SvPVX(sv)+1, namelen, char);
356 pathlen += (namelen + 1);
361 if (PerlDir_close(dir) < 0) {
368 SvCUR_set(sv, pathlen);
372 if (PerlDir_chdir(SvPVX(sv)) < 0) {
376 if (PerlLIO_stat(".", &statbuf) < 0) {
380 cdev = statbuf.st_dev;
381 cino = statbuf.st_ino;
383 if (cdev != orig_cdev || cino != orig_cino) {
384 Perl_croak(aTHX_ "Unstable directory path, "
385 "current directory changed unexpectedly");
400 MODULE = Cwd PACKAGE = Cwd
412 #ifndef INCOMPLETE_TAINTS
425 #ifndef INCOMPLETE_TAINTS
431 abs_path(pathsv=Nullsv)
438 char buf[MAXPATHLEN];
440 path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
442 if (bsd_realpath(path, buf)) {
443 sv_setpvn(TARG, buf, strlen(buf));
448 sv_setsv(TARG, &PL_sv_undef);
451 #ifndef INCOMPLETE_TAINTS
456 #if defined(WIN32) && !defined(UNDER_CE)
466 /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
468 (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
470 else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
471 isALPHA(SvPVX(ST(0))[0]))
472 drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
474 croak("Usage: getdcwd(DRIVE)");
476 New(0,dir,MAXPATHLEN,char);
477 if (_getdcwd(drive, dir, MAXPATHLEN)) {
478 sv_setpvn(TARG, dir, strlen(dir));
482 sv_setsv(TARG, &PL_sv_undef);
487 #ifndef INCOMPLETE_TAINTS