reentrant buffers

Message-ID: <20020926220856.GA339120@lyta.hut.fi>

p4raw-id: //depot/perl@17967

diff --git a/INSTALL b/INSTALL
index cb19946..13ec713 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -712,6 +712,14 @@ If you decide to use ithreads, the 'threads' module allows their use,
 and the 'Thread' module offers an interface to both 5005threads and
 ithreads (whichever has been configured).
 
+When building threaded for certain library calls like the getgr*() and
+the getpw*() there is a dynamically sized result buffer: the buffer
+starts small but Perl will keep growing the buffer until the result fits.
+To get a fixed upper limit you will have to recompile Perl with
+PERL_REENTRANT_MAXSIZE defined to be the number of bytes you want.
+One way to do this is to run Configure with
+C<-Accflags=-DPERL_REENTRANT_MAXSIZE=65536>
+
 =head2 Large file support.
 
 Since Perl 5.6.0, Perl has supported large files (files larger than

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 3da728d..40f9929 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3118,6 +3118,14 @@ signed integers.  See L<perlfunc/pack>.
 (F) You can't specify a repeat count so large that it overflows your
 signed integers.  See L<perlfunc/unpack>.
 
+=item Result from %s larger than %d bytes
+
+(W misc) A library call like getgrent() tried to return more results
+than Perl was willing to accept.  This happens only when Perl has been
+compiled to have threads and to have an upper limit on such calls
+(the default is to keep regrowing the result buffer until the result fits).
+However, now the results were truncated.
+
 =item Reversed %s= operator
 
 (W syntax) You wrote your assignment operator backwards.  The = must

diff --git a/pod/perlthrtut.pod b/pod/perlthrtut.pod
index cafcbb2..575ec27 100644 (file)
--- a/pod/perlthrtut.pod
+++ b/pod/perlthrtut.pod
@@ -1016,10 +1016,15 @@ calls, they will be used.  Beyond that, Perl is at the mercy of
 the thread-safety or -unsafety of the calls.  Please consult your
 C library call documentation.
 
-In some platforms the thread-safe interfaces may fail if the result
-buffer is too small (for example getgrent() may return quite large
-group member lists).  Perl will retry growing the result buffer
-a few times, but only up to 64k (for safety reasons).
+On some platforms the thread-safe library interfaces may fail if the
+result buffer is too small (for example the user group databases may
+be rather large, and the reentrant interfaces may have to carry around
+a full snapshot of those databases).  Perl will start with a small
+buffer, but keep retrying and growing the result buffer
+until the result fits.  If this limitless growing sounds bad for
+security or memory consumption reasons you can recompile Perl with
+PERL_REENTRANT_MAXSIZE defined to the maximum number of bytes you will
+allow.
 
 =head1 Conclusion
 

diff --git a/reentr.c b/reentr.c
index acbbac4..3d8cdf8 100644 (file)
--- a/reentr.c
+++ b/reentr.c
@@ -312,19 +312,24 @@ Perl_reentrant_retry(const char *f, ...)
 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
     int anint;
 #  endif
+#ifdef PERL_REENTRANT_MAXSIZE
+    static const char larger[] = "Result from %s larger than %d bytes";
+#endif
     va_list ap;
 
     va_start(ap, f);
 
-#define REENTRANTHALFMAXSIZE 32768 /* The maximum may end up twice this. */
-
     switch (PL_op->op_type) {
 #ifdef USE_HOSTENT_BUFFER
     case OP_GHBYADDR:
     case OP_GHBYNAME:
     case OP_GHOSTENT:
        {
-           if (PL_reentrant_buffer->_hostent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_hostent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                PL_reentrant_buffer->_hostent_size *= 2;
                Renew(PL_reentrant_buffer->_hostent_buffer,
                      PL_reentrant_buffer->_hostent_size, char);
@@ -351,7 +356,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GGRGID:
     case OP_GGRENT:
        {
-           if (PL_reentrant_buffer->_grent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_grent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                Gid_t gid;
                PL_reentrant_buffer->_grent_size *= 2;
                Renew(PL_reentrant_buffer->_grent_buffer,
@@ -377,7 +386,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GNBYNAME:
     case OP_GNETENT:
        {
-           if (PL_reentrant_buffer->_netent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_netent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                Netdb_net_t net;
                PL_reentrant_buffer->_netent_size *= 2;
                Renew(PL_reentrant_buffer->_netent_buffer,
@@ -396,6 +409,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif
@@ -404,7 +422,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GPWUID:
     case OP_GPWENT:
        {
-           if (PL_reentrant_buffer->_pwent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_pwent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                Uid_t uid;
                PL_reentrant_buffer->_pwent_size *= 2;
                Renew(PL_reentrant_buffer->_pwent_buffer,
@@ -422,6 +444,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif
@@ -430,7 +457,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GPBYNUMBER:
     case OP_GPROTOENT:
        {
-           if (PL_reentrant_buffer->_protoent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_protoent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                PL_reentrant_buffer->_protoent_size *= 2;
                Renew(PL_reentrant_buffer->_protoent_buffer,
                      PL_reentrant_buffer->_protoent_size, char);
@@ -447,6 +478,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif
@@ -455,7 +491,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GSBYPORT:
     case OP_GSERVENT:
        {
-           if (PL_reentrant_buffer->_servent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_servent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                PL_reentrant_buffer->_servent_size *= 2;
                Renew(PL_reentrant_buffer->_servent_buffer,
                      PL_reentrant_buffer->_servent_size, char);
@@ -474,6 +514,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif

diff --git a/reentr.pl b/reentr.pl
index b2a6b91..1f4e6ac 100644 (file)
--- a/reentr.pl
+++ b/reentr.pl
@@ -784,19 +784,24 @@ Perl_reentrant_retry(const char *f, ...)
 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
     int anint;
 #  endif
+#ifdef PERL_REENTRANT_MAXSIZE
+    static const char larger[] = "Result from %s larger than %d bytes";
+#endif
     va_list ap;
 
     va_start(ap, f);
 
-#define REENTRANTHALFMAXSIZE 32768 /* The maximum may end up twice this. */
-
     switch (PL_op->op_type) {
 #ifdef USE_HOSTENT_BUFFER
     case OP_GHBYADDR:
     case OP_GHBYNAME:
     case OP_GHOSTENT:
        {
-           if (PL_reentrant_buffer->_hostent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_hostent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                PL_reentrant_buffer->_hostent_size *= 2;
                Renew(PL_reentrant_buffer->_hostent_buffer,
                      PL_reentrant_buffer->_hostent_size, char);
@@ -823,7 +828,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GGRGID:
     case OP_GGRENT:
        {
-           if (PL_reentrant_buffer->_grent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_grent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                Gid_t gid;
                PL_reentrant_buffer->_grent_size *= 2;
                Renew(PL_reentrant_buffer->_grent_buffer,
@@ -849,7 +858,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GNBYNAME:
     case OP_GNETENT:
        {
-           if (PL_reentrant_buffer->_netent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_netent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                Netdb_net_t net;
                PL_reentrant_buffer->_netent_size *= 2;
                Renew(PL_reentrant_buffer->_netent_buffer,
@@ -868,6 +881,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif
@@ -876,7 +894,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GPWUID:
     case OP_GPWENT:
        {
-           if (PL_reentrant_buffer->_pwent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_pwent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                Uid_t uid;
                PL_reentrant_buffer->_pwent_size *= 2;
                Renew(PL_reentrant_buffer->_pwent_buffer,
@@ -894,6 +916,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif
@@ -902,7 +929,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GPBYNUMBER:
     case OP_GPROTOENT:
        {
-           if (PL_reentrant_buffer->_protoent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_protoent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                PL_reentrant_buffer->_protoent_size *= 2;
                Renew(PL_reentrant_buffer->_protoent_buffer,
                      PL_reentrant_buffer->_protoent_size, char);
@@ -919,6 +950,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif
@@ -927,7 +963,11 @@ Perl_reentrant_retry(const char *f, ...)
     case OP_GSBYPORT:
     case OP_GSERVENT:
        {
-           if (PL_reentrant_buffer->_servent_size <= REENTRANTHALFMAXSIZE) {
+#ifdef PERL_REENTRANT_MAXSIZE
+           if (PL_reentrant_buffer->_servent_size <=
+               PERL_REENTRANT_MAXSIZE / 2)
+#endif
+           {
                PL_reentrant_buffer->_servent_size *= 2;
                Renew(PL_reentrant_buffer->_servent_buffer,
                      PL_reentrant_buffer->_servent_size, char);
@@ -946,6 +986,11 @@ Perl_reentrant_retry(const char *f, ...)
                    break;
                }
            }
+#ifdef PERL_REENTRANT_MAXSIZE
+           else if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           larger, OP_NAME(PL_op), PERL_REENTRANT_MAXSIZE);
+#endif
        }
        break;
 #endif