change #22071 (taint bug in $^0) introduced a potential double
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 9dbc248..e8106d8 100644 (file)
--- a/perl.h
+++ b/perl.h
 
 /* Use the reentrant APIs like localtime_r and getpwent_r */
 /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
-#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(DARWIN)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
 #   define USE_REENTRANT_API
 #endif
 
 /* <--- here ends the logic shared by perl.h and makedef.pl */
 
 /*
- * DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
- * (The -DDARWIN comes from the hints/darwin.sh.)
+ * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
+ * (The -DPERL_DARWIN comes from the hints/darwin.sh.)
  * __bsdi__ for BSD/OS
  */
-#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
+#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
 #   ifndef BSDish
 #       define BSDish
 #   endif
 #endif
 
 #ifdef HASATTRIBUTE
-#  if defined(__GNUC__) && defined(__cplusplus)
+#  if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
 #    define PERL_UNUSED_DECL
 #  else
 #    define PERL_UNUSED_DECL __attribute__((unused))
@@ -207,6 +207,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #  endif
 #endif
 
+#if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
+#   define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+#endif
+
 /*
  * STMT_START { statements; } STMT_END;
  * can be used as a single statement, as in
@@ -215,7 +219,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
  * Trying to select a version that gives no warnings...
  */
 #if !(defined(STMT_START) && defined(STMT_END))
-# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) && !defined(__cplusplus)
+# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
 #   define STMT_START  (void)( /* gcc supports ``({ STATEMENTS; })'' */
 #   define STMT_END    )
 # else
@@ -275,7 +279,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 # define STANDARD_C 1
 #endif
 
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
 # define DONT_DECLARE_STD 1
 #endif
 
@@ -498,9 +502,8 @@ int usleep(unsigned int);
                if (newval) {                                   \
                  panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
                  exit(1); })
-extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
 #  define MALLOC_CHECK_TAINT(argc,argv,env)    STMT_START {    \
-       if (Perl_doing_taint(argc, argv, env))  {               \
+       if (doing_taint(argc,argv,env)) {                       \
                MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1;      \
     }} STMT_END;
 #else  /* MYMALLOC */
@@ -577,7 +580,7 @@ extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
 #    endif
 #  endif
 #  ifdef BUGGY_MSC
-  #  pragma function(memcmp)
+#    pragma function(memcmp)
 #  endif
 #else
 #   ifndef memcmp
@@ -597,11 +600,13 @@ extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
 #   endif
 #endif
 
+#ifndef PERL_MICRO
 #ifndef memchr
 #   ifndef HAS_MEMCHR
 #       define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
 #   endif
 #endif
+#endif
 
 #ifndef HAS_BCMP
 #   ifndef bcmp
@@ -673,9 +678,12 @@ extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
 #  define WIN32SCK_IS_STDSCK           /* don't pull in custom wsock layer */
 #endif
 
-/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one */
-#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN)
-#  define _SOCKADDR_LEN
+/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
+ * This is important for using IPv6. 
+ * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
+ * a bad idea since it breaks send() and recv(). */
+#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
+#   define _SOCKADDR_LEN
 #endif
 
 #if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */
@@ -705,9 +713,14 @@ extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
 #endif
 
 /* sockatmark() is so new (2001) that many places might have it hidden
- * behind some -D_BLAH_BLAH_SOURCE guard. */
+ * behind some -D_BLAH_BLAH_SOURCE guard.  The __THROW magic is required
+ * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */
 #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO)
+# if defined(__THROW) && defined(__GLIBC__)
+int sockatmark(int) __THROW;
+# else
 int sockatmark(int);
+# endif
 #endif
 
 #ifdef SETERRNO
@@ -1269,6 +1282,7 @@ typedef NVTYPE NV;
 #       define Perl_atan2 atan2l
 #       define Perl_pow powl
 #       define Perl_floor floorl
+#       define Perl_ceil ceill
 #       define Perl_fmod fmodl
 #   endif
 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
@@ -1339,6 +1353,7 @@ long double modfl(long double, long double *);
 #   define Perl_atan2 atan2
 #   define Perl_pow pow
 #   define Perl_floor floor
+#   define Perl_ceil ceil
 #   define Perl_fmod fmod
 #   define Perl_modf(x,y) modf(x,y)
 #   define Perl_frexp(x,y) frexp(x,y)
@@ -1935,13 +1950,20 @@ typedef struct clone_params CLONE_PARAMS;
 #    endif
 #    define PERL_FPU_INIT fpsetmask(0);
 #  else
-#    if defined(SIGFPE) && defined(SIG_IGN)
-#      define PERL_FPU_INIT signal(SIGFPE, SIG_IGN);
+#    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
+#      define PERL_FPU_INIT       PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
+#      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
+#      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
 #    else
 #      define PERL_FPU_INIT
+
 #    endif
 #  endif
 #endif
+#ifndef PERL_FPU_PRE_EXEC
+#  define PERL_FPU_PRE_EXEC   {
+#  define PERL_FPU_POST_EXEC  }
+#endif
 
 #ifndef PERL_SYS_INIT3
 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
@@ -2250,6 +2272,17 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #if !defined(OS2) && !defined(MACOS_TRADITIONAL)
 #  include "iperlsys.h"
 #endif
+
+/* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
+ * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
+ * defined by Configure, despite their names being similar to the
+ * other defines like USE_ITHREADS.  Configure in fact knows nothing
+ * about the randomised hashes.  Therefore to enable/disable the hash
+ * randomisation defines use the Configure -Accflags=... instead. */
+#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
+#  define USE_HASH_SEED
+#endif
+
 #include "regexp.h"
 #include "sv.h"
 #include "util.h"
@@ -2477,7 +2510,9 @@ Gid_t getegid (void);
 #define DEBUG_J_FLAG           0x00080000 /* 524288 */
 #define DEBUG_v_FLAG           0x00100000 /*1048576 */
 #define DEBUG_C_FLAG           0x00200000 /*2097152 */
-#define DEBUG_MASK             0x003FEFFF /* mask of all the standard flags */
+#define DEBUG_A_FLAG           0x00400000 /*4194304 */
+#define DEBUG_q_FLAG           0x00800000 /8388608*/
+#define DEBUG_MASK             0x00FFEFFF /* mask of all the standard flags */
 
 #define DEBUG_DB_RECURSE_FLAG  0x40000000
 #define DEBUG_TOP_FLAG         0x80000000 /* XXX what's this for ??? Signal
@@ -2504,6 +2539,8 @@ Gid_t getegid (void);
 #  define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
 #  define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
 #  define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
+#  define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
+#  define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
 #  define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
 
 #ifdef DEBUGGING
@@ -2533,9 +2570,11 @@ Gid_t getegid (void);
 #  define DEBUG_J_TEST DEBUG_J_TEST_
 #  define DEBUG_v_TEST DEBUG_v_TEST_
 #  define DEBUG_C_TEST DEBUG_C_TEST_
+#  define DEBUG_A_TEST DEBUG_A_TEST_
+#  define DEBUG_q_TEST DEBUG_A_TEST_
 
-#  define DEB(a)     a
-#  define DEBUG(a)   if (PL_debug)   a
+#  define PERL_DEB(a)                  a
+#  define PERL_DEBUG(a) if (PL_debug)  a
 #  define DEBUG_p(a) if (DEBUG_p_TEST) a
 #  define DEBUG_s(a) if (DEBUG_s_TEST) a
 #  define DEBUG_l(a) if (DEBUG_l_TEST) a
@@ -2571,6 +2610,8 @@ Gid_t getegid (void);
 #  define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
 #  define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
 #  define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a)
+#  define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
+#  define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
 
 #else /* DEBUGGING */
 
@@ -2596,9 +2637,11 @@ Gid_t getegid (void);
 #  define DEBUG_J_TEST (0)
 #  define DEBUG_v_TEST (0)
 #  define DEBUG_C_TEST (0)
+#  define DEBUG_A_TEST (0)
+#  define DEBUG_q_TEST (0)
 
-#  define DEB(a)
-#  define DEBUG(a)
+#  define PERL_DEB(a)
+#  define PERL_DEBUG(a)
 #  define DEBUG_p(a)
 #  define DEBUG_s(a)
 #  define DEBUG_l(a)
@@ -2620,9 +2663,18 @@ Gid_t getegid (void);
 #  define DEBUG_R(a)
 #  define DEBUG_v(a)
 #  define DEBUG_C(a)
+#  define DEBUG_A(a)
+#  define DEBUG_q(a)
 #endif /* DEBUGGING */
 
 
+#define DEBUG_SCOPE(where) \
+    DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \
+                   where, PL_scopestack_ix, __FILE__, __LINE__)));
+
+
+
+
 /* These constants should be used in preference to raw characters
  * when using magic. Note that some perl guts still assume
  * certain character properties of these constants, namely that
@@ -2678,14 +2730,14 @@ Gid_t getegid (void);
 
 #ifndef assert  /* <assert.h> might have been included somehow */
 #ifdef DEBUGGING
-#define assert(what)   DEB( {                                          \
+#define assert(what)   PERL_DEB( {                                     \
        if (!(what)) {                                                  \
            Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d",      \
                __FILE__, __LINE__);                                    \
            PerlProc_exit(1);                                           \
        }})
 #else
-#define assert(what)   DEB( {                                          \
+#define assert(what)   PERL_DEB( {                                     \
        if (!(what)) {                                                  \
            Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d",  \
                __FILE__, __LINE__);                                    \
@@ -2921,13 +2973,13 @@ typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
 
 /* NeXT has problems with crt0.o globals */
 #if defined(__DYNAMIC__) && \
-    (defined(NeXT) || defined(__NeXT__) || defined(DARWIN))
+    (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN))
 #  if defined(NeXT) || defined(__NeXT)
 #    include <mach-o/dyld.h>
 #    define environ (*environ_pointer)
 EXT char *** environ_pointer;
 #  else
-#    if defined(DARWIN) && defined(PERL_CORE)
+#    if defined(PERL_DARWIN) && defined(PERL_CORE)
 #      include <crt_externs.h> /* for the env array */
 #      define environ (*_NSGetEnviron())
 #    endif
@@ -3209,6 +3261,16 @@ END_EXTERN_C
 /*****************************************************************************/
 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
 
+#ifdef __Lynx__
+/* LynxOS defines these in scsi.h which is included via ioctl.h */
+#ifdef FORMAT
+#undef FORMAT
+#endif
+#ifdef SPACE
+#undef SPACE
+#endif
+#endif
+
 #include "perly.h"
 
 #define LEX_NOTPARSING         11      /* borrowed from toke.c */
@@ -3814,7 +3876,7 @@ typedef struct am_table_short AMTS;
 #define IN_LOCALE_COMPILETIME  (PL_hints & HINT_LOCALE)
 
 #define IN_LOCALE \
-       (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+       (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
 
 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \
        bool was_local = PL_numeric_local && IN_LOCALE; \
@@ -3896,6 +3958,9 @@ typedef struct am_table_short AMTS;
 #if !defined(Strtoul) && defined(HAS_STRTOUL)
 #   define Strtoul     strtoul
 #endif
+#if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */
+#   define Strtoul(s, e, b)    strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b))
+#endif
 #ifndef Atoul
 #   define Atoul(s)    Strtoul(s, (char **)NULL, 10)
 #endif
@@ -4091,6 +4156,10 @@ typedef struct am_table_short AMTS;
 #  include <fcntl.h>
 #endif
 
+#ifdef __Lynx__
+#  include <fcntl.h>
+#endif
+
 #ifdef I_SYS_FILE
 #  include <sys/file.h>
 #endif
@@ -4239,6 +4308,14 @@ extern void moncontrol(int);
 #  define PIPESOCK_MODE
 #endif
 
+#ifndef SOCKET_OPEN_MODE
+#  define SOCKET_OPEN_MODE     PIPESOCK_MODE
+#endif
+
+#ifndef PIPE_OPEN_MODE
+#  define PIPE_OPEN_MODE       PIPESOCK_MODE
+#endif
+
 #define PERL_MAGIC_UTF8_CACHESIZE      2
 
 #define PERL_UNICODE_STDIN_FLAG                        0x0001
@@ -4342,7 +4419,6 @@ extern void moncontrol(int);
 
    HAS_UALARM
    HAS_USLEEP
-   HAS_NANOSLEEP
 
    HAS_SETITIMER
    HAS_GETITIMER