After some reading I don't think we can blindly

use systems' realpath().  Too many security problems,
too many buggy implementations.

TODO: the realpath() emulation code in util.c doesn't
seem fully operational?  (readlink(), for example?)

p4raw-id: //depot/perl@10744

1 files changed, 39 insertions, 48 deletions

diff --git a/util.c b/util.c
index 02c907d20c..1d69fe5602 100644
--- a/util.c
+++ b/util.c
@@ -3624,6 +3624,9 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 
     SvGROW(sv, 128);
     while ((getcwd(SvPVX(sv), SvLEN(sv)-1) == NULL) && errno == ERANGE) {
+        if (SvLEN(sv) + 128 >= MAXPATHLEN) {
+            SV_CWD_RETURN_UNDEF;
+	}
         SvGROW(sv, SvLEN(sv) + 128);
     }
     SvCUR_set(sv, strlen(SvPVX(sv)));
@@ -3687,6 +3690,10 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
             SV_CWD_RETURN_UNDEF;
         }
 
+        if (pathlen + namelen + 1 >= MAXPATHLEN) {
+            SV_CWD_RETURN_UNDEF;
+	}
+
         SvGROW(sv, pathlen + namelen + 1);
 
         if (pathlen) {
@@ -3737,62 +3744,44 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 /*
 =for apidoc sv_realpath
 
-Wrap or emulate realpath(3).
+Emulate realpath(3).
+
+The real realpath() is not used because it's a known can of worms.
+We may have bugs but hey, they are our very own.
 
 =cut
  */
 int
-Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
+Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN maxlen)
 {
 #ifndef PERL_MICRO
-    char name[MAXPATHLEN] = { 0 }, *s;
+    char name[MAXPATHLEN]    = { 0 };
+    char dotdots[MAXPATHLEN] = { 0 };
+    char *s;
     STRLEN pathlen, namelen;
+    DIR *parent;
+    Direntry_t *dp;
+    struct stat cst, pst, tst;
 
-    /* Don't use strlen() to avoid running off the end. */
-    s = memchr(path, '\0', MAXPATHLEN);
-    pathlen = s ? s - path : MAXPATHLEN;
-
-#ifdef HAS_REALPATH
-
-    /* Be paranoid about the use of realpath(),
-     * it is an infamous source of buffer overruns. */
-
-    /* Is the source buffer too long? */
-    if (pathlen == MAXPATHLEN) {
-        Perl_warn(aTHX_ "sv_realpath: realpath(\"%s\"): %c= (MAXPATHLEN = %d)",
-                  path, s ? '=' : '>', MAXPATHLEN);
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    /* Here goes nothing. */
-    if (realpath(path, name) == NULL) {
-        Perl_warn(aTHX_ "sv_realpath: realpath(\"%s\"): %s",
-                  path, Strerror(errno));
+    if (!sv || !path || !maxlen) {
+        Perl_warn(aTHX_ "sv_realpath: realpath(0x%x, 0x%x, "")",
+                  sv, path, maxlen);
         SV_CWD_RETURN_UNDEF;
     }
 
-    /* Is the destination buffer too long?
+    /* Is the source buffer too long?
      * Don't use strlen() to avoid running off the end. */
-    s = memchr(name, '\0', MAXPATHLEN);
-    namelen = s ? s - name : MAXPATHLEN;
-    if (namelen == MAXPATHLEN) {
-        Perl_warn(aTHX_ "sv_realpath: realpath(\"%s\"): %c= (MAXPATHLEN = %d)",
-                  path, s ? '=' : '>', MAXPATHLEN);
+    if (maxlen >= MAXPATHLEN)
+        pathlen = maxlen;
+    else {
+        s = memchr(path, '\0', MAXPATHLEN);
+	pathlen = s ? s - path : MAXPATHLEN;
+    }
+    if (pathlen >= MAXPATHLEN) {
+        Perl_warn(aTHX_ "sv_realpath: source too large");
         SV_CWD_RETURN_UNDEF;
     }
 
-    /* The coast is clear? */
-    sv_setpvn(sv, name, namelen);
-    SvPOK_only(sv);
-
-    return TRUE;
-#else
-    {
-    DIR *parent;
-    Direntry_t *dp;
-    char dotdots[MAXPATHLEN] = { 0 };
-    struct stat cst, pst, tst;
-
     if (PerlLIO_stat(path, &cst) < 0) {
         Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
                   path, Strerror(errno));
@@ -3801,10 +3790,9 @@ Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
 
     (void)SvUPGRADE(sv, SVt_PV);
 
-    if (!len) {
-        len = strlen(path);
-    }
-    Copy(path, dotdots, len, char);
+    Copy(path, dotdots, maxlen, char);
+
+    pathlen = 0;
 
     for (;;) {
         strcat(dotdots, "/..");
@@ -3864,6 +3852,11 @@ Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
                 SV_CWD_RETURN_UNDEF;
             }
 
+	    if (pathlen + namelen + 1 >= MAXPATHLEN) {
+	        Perl_warn(aTHX_ "sv_realpath: too long name");
+                SV_CWD_RETURN_UNDEF;
+	    }
+
             SvGROW(sv, pathlen + namelen + 1);
             if (pathlen) {
                 /* shift down */
@@ -3890,10 +3883,8 @@ Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
     SvPOK_only(sv);
 
     return TRUE;
-    }
-#endif
 #else
-    return FALSE;
+    return FALSE; /* MICROPERL */
 #endif
 }