Add a workaround to SOCKS 64-bit problems.

p4raw-id: //depot/perl@7774

diff --git a/doio.c b/doio.c
index 14e48b2..e4d26eb 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -56,6 +56,20 @@
 #  include <unistd.h>
 #endif
 
+#ifdef SOCKS_64BIT_BUG
+typedef struct __s64_iobuffer {
+    struct __s64_iobuffer *next, *last;                /* Queue pointer */
+    PerlIO *fp;                                        /* assigned file pointer */
+    int cnt;                                   /* Buffer counter */
+    int size;                                  /* Buffer size */
+    int *buffer;                               /* the buffer */
+} S64_IOB;
+
+static S64_IOB *_s64_get_buffer( PerlIO *f);
+static S64_IOB *_s64_create_buffer( PerlIO *f);
+static int _s64_malloc( S64_IOB *ptr);
+#endif
+
 bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
@@ -941,6 +955,7 @@ Perl_do_eof(pTHX_ GV *gv)
            (void)PerlIO_ungetc(IoIFP(io),ch);
            return FALSE;
        }
+
         if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) {
            if (PerlIO_get_cnt(IoIFP(io)) < -1)
                PerlIO_set_cnt(IoIFP(io),-1);
@@ -2075,3 +2090,144 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 
 #endif /* SYSV IPC */
 
+/**
+ ** getc and ungetc wrappers for the 64 bit problems with SOCKS 5 support
+ ** Workaround to the problem, that SOCKS maps a socket 'getc' to revc
+ ** without checking the ungetc buffer.
+ **/
+#ifdef SOCKS_64BIT_BUG
+static S64_IOB *s64_buffer = (S64_IOB *) NULL;
+
+/* get a buffered stream pointer */
+static S64_IOB *_s64_get_buffer( PerlIO *f) {
+    S64_IOB *ptr = s64_buffer;
+    while( ptr && ptr->fp != f)
+       ptr = ptr->next;
+    return( ptr);
+}
+
+/* create a buffered stream pointer */
+static S64_IOB *_s64_create_buffer( PerlIO *f) {
+    S64_IOB *ptr = malloc( sizeof( S64_IOB));
+    if( ptr) {
+       ptr->fp = f;
+       ptr->cnt = ptr->size = 0;
+       ptr->buffer = (int *) NULL;
+       ptr->next = s64_buffer;
+       ptr->last = (S64_IOB *) NULL;
+       if( s64_buffer) s64_buffer->last = ptr;
+       s64_buffer = ptr;
+    }
+    return( ptr);
+}
+
+/* delete a buffered stream pointer */
+void Perl_do_s64_delete_buffer( PerlIO *f) {
+    S64_IOB *ptr = _s64_get_buffer(f);
+    if( ptr) {
+       /* fix the stream pointer according to the bytes buffered */
+       /* required, if this is called in a seek-context */
+       if( ptr->cnt) fseek(f,-ptr->cnt,SEEK_CUR);
+       if( ptr->buffer) free( ptr->buffer);
+       if( ptr->last)
+           ptr->last->next = ptr->next;
+       else
+           s64_buffer = ptr->next;
+       free( ptr);
+    }
+}
+
+/* internal buffer management */
+#define _S64_BUFFER_SIZE 32
+static int _s64_malloc( S64_IOB *ptr) {
+    if( ptr) {
+       if( !ptr->buffer) {
+           ptr->buffer = (int *) calloc( _S64_BUFFER_SIZE, sizeof( int));
+           ptr->size = ptr->cnt = 0;
+       } else {
+           ptr->buffer = (int *) realloc( ptr->buffer, ptr->size + _S64_BUFFER_SIZE);
+       }
+       
+       if( !ptr->buffer)
+           return( 0);
+       
+       ptr->size += _S64_BUFFER_SIZE;
+        
+       return( 1);
+    }
+
+    return( 0);
+}
+
+/* SOCKS 64 bit getc replacement */
+int Perl_do_s64_getc( PerlIO *f) {
+    S64_IOB *ptr = _s64_get_buffer(f);
+    if( ptr) {
+       if( ptr->cnt) 
+           return( ptr->buffer[--ptr->cnt]);
+    }
+    return( getc(f));
+}
+
+/* SOCKS 64 bit ungetc replacement */
+int Perl_do_s64_ungetc( int ch, PerlIO *f) {
+    S64_IOB *ptr = _s64_get_buffer(f);
+
+    if( !ptr) ptr=_s64_create_buffer(f);
+    if( !ptr) return( EOF);
+    if( !ptr->buffer || (ptr->buffer && ptr->cnt >= ptr->size)) 
+       if( !_s64_malloc( ptr)) return( EOF);
+    ptr->buffer[ptr->cnt++] = ch;
+
+    return( ch);
+}
+
+/* SOCKS 64 bit fread replacement */
+SSize_t        Perl_do_s64_fread(void *buf, SSize_t count, PerlIO* f) {
+    SSize_t len = 0;
+    char *bufptr = (char *) buf;
+    S64_IOB *ptr = _s64_get_buffer(f);
+    if( ptr) {
+       while( ptr->cnt && count) {
+           *bufptr++ = ptr->buffer[--ptr->cnt];
+           count--, len++;
+       }
+    }
+    if( count)
+       len += (SSize_t)fread(bufptr,1,count,f);
+
+    return( len);
+}
+
+/* SOCKS 64 bit fseek replacement */
+int    Perl_do_s64_seek(PerlIO* f, Off_t offset, int whence) {
+    S64_IOB *ptr = _s64_get_buffer(f);
+
+    /* Simply clear the buffer and seek if the position is absolute */
+    if( SEEK_SET == whence || SEEK_END == whence) {
+       if( ptr) ptr->cnt = 0;
+
+    /* In case of relative positioning clear the buffer and calculate */
+    /* a fixed offset */
+    } else if( SEEK_CUR == whence) {
+       if( ptr) {
+           offset -= (Off_t)ptr->cnt;
+           ptr->cnt = 0;
+       }
+    }
+
+    /* leave out buffer untouched otherwise, because fseek will fail */
+    /* seek now */
+    return( fseeko( f, offset, whence));
+}
+
+/* SOCKS 64 bit ftell replacement */
+Off_t  Perl_do_s64_tell(PerlIO* f) {
+    Off_t offset = 0;
+    S64_IOB *ptr = _s64_get_buffer(f);
+    if( ptr)
+       offset = ptr->cnt;
+    return( ftello(f) - offset);
+}
+
+#endif

diff --git a/embed.h b/embed.h
index 1301e3e..27f5fd2 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -193,6 +193,8 @@
 #define do_vecget              Perl_do_vecget
 #define do_vecset              Perl_do_vecset
 #define do_vop                 Perl_do_vop
+#ifdef SOCKS_64BIT_BUG
+#endif
 #define dofile                 Perl_dofile
 #define dowantarray            Perl_dowantarray
 #define dump_all               Perl_dump_all
@@ -1661,6 +1663,8 @@
 #define do_vecget(a,b,c)       Perl_do_vecget(aTHX_ a,b,c)
 #define do_vecset(a)           Perl_do_vecset(aTHX_ a)
 #define do_vop(a,b,c,d)                Perl_do_vop(aTHX_ a,b,c,d)
+#ifdef SOCKS_64BIT_BUG
+#endif
 #define dofile(a)              Perl_dofile(aTHX_ a)
 #define dowantarray()          Perl_dowantarray(aTHX)
 #define dump_all()             Perl_dump_all(aTHX)
@@ -3255,6 +3259,14 @@
 #define do_vecset              Perl_do_vecset
 #define Perl_do_vop            CPerlObj::Perl_do_vop
 #define do_vop                 Perl_do_vop
+#ifdef SOCKS_64BIT_BUG
+#define do_getc                        Perl_do_getc
+#define do_ungetc              Perl_do_ungetc
+#define do_fread               Perl_do_fread
+#define do_s64_delete_buffer   Perl_do_s64_delete_buffer
+#define do_s64_tell            Perl_do_s64_tell
+#define do_s64_seek            Perl_do_s64_seek
+#endif
 #define Perl_dofile            CPerlObj::Perl_dofile
 #define dofile                 Perl_dofile
 #define Perl_dowantarray       CPerlObj::Perl_dowantarray

diff --git a/embed.pl b/embed.pl
index b8abef3..d1c31f2 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1505,6 +1505,14 @@ p        |I32    |do_trans       |SV* sv
 p      |UV     |do_vecget      |SV* sv|I32 offset|I32 size
 p      |void   |do_vecset      |SV* sv
 p      |void   |do_vop         |I32 optype|SV* sv|SV* left|SV* right
+#ifdef SOCKS_64BIT_BUG
+Ajnop  |int    |do_getc        |PerlIO* fp
+Ajnop  |int    |do_ungetc      |int ch|PerlIO* fp
+Ajnop  |SSize_t|do_fread       |void *buf|SSize_t count|PerlIO* fp
+Ajnop  |void   |do_s64_delete_buffer|PerlIO* fp
+Ajnop  |Off_t  |do_s64_tell    |PerlIO* fp
+Ajnop  |int    |do_s64_seek    |PerlIO* fp|Off_t pos|int whence
+#endif
 p      |OP*    |dofile         |OP* term
 Ap     |I32    |dowantarray
 Ap     |void   |dump_all

diff --git a/perlsdio.h b/perlsdio.h
index 4b86634..9e668f6 100644 (file)
--- a/perlsdio.h
+++ b/perlsdio.h
@@ -18,7 +18,11 @@
 #define PerlIO_open                    fopen
 #define PerlIO_fdopen                  fdopen
 #define PerlIO_reopen                  freopen
-#define PerlIO_close(f)                        fclose(f)
+#ifdef SOCKS_64BIT_BUG
+#  define PerlIO_close(f)              (Perl_do_s64_delete_buffer(f), fclose(f))
+#else
+#  define PerlIO_close(f)              fclose(f)
+#endif
 #define PerlIO_puts(f,s)               fputs(s,f)
 #define PerlIO_putc(f,c)               fputc(c,f)
 #if defined(VMS)
@@ -42,9 +46,15 @@
 #  define PerlIO_read(f,buf,count) \
                (feof(f) ? 0 : (SSize_t)fread(buf,1,count,f))
 #else
-#  define PerlIO_ungetc(f,c)           ungetc(c,f)
-#  define PerlIO_getc(f)               getc(f)
-#  define PerlIO_read(f,buf,count)     (SSize_t)fread(buf,1,count,f)
+#  ifdef SOCKS_64BIT_BUG
+#    define PerlIO_getc(f)             Perl_do_s64_getc(f)
+#    define PerlIO_ungetc(f,c) Perl_do_s64_ungetc(c,f)
+#    define PerlIO_read(f,buf,count)   Perl_do_s64_fread(buf,count,f)
+#  else
+#    define PerlIO_getc(f)             getc(f)
+#    define PerlIO_ungetc(f,c)         ungetc(c,f)
+#    define PerlIO_read(f,buf,count)   (SSize_t)fread(buf,1,count,f)
+#  endif /* SOCKS_64BIT_BUG */
 #endif
 #define PerlIO_eof(f)                  feof(f)
 #define PerlIO_getname(f,b)            fgetname(f,b)
@@ -52,12 +62,20 @@
 #define PerlIO_fileno(f)               fileno(f)
 #define PerlIO_clearerr(f)             clearerr(f)
 #define PerlIO_flush(f)                        Fflush(f)
-#define PerlIO_tell(f)                 ftell(f)
+#ifdef SOCKS_64BIT_BUG
+#  define PerlIO_tell(f)               Perl_do_s64_tell(f)
+#else
+#  define PerlIO_tell(f)               ftell(f)
+#endif
 #if defined(VMS) && !defined(__DECC)
    /* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */
 #  define PerlIO_seek(f,o,w)   (((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w))
 #else
-#  define PerlIO_seek(f,o,w)           fseek(f,o,w)
+#  ifdef SOCKS_64BIT_BUG
+#    define PerlIO_seek(f,o,w)         Perl_do_s64_seek(f,o,w)
+#  else
+#    define PerlIO_seek(f,o,w)         fseek(f,o,w)
+#  endif
 #endif
 #ifdef HAS_FGETPOS
 #define PerlIO_getpos(f,p)             fgetpos(f,p)

diff --git a/proto.h b/proto.h
index 91b7f86..02c4bfd 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -247,6 +247,14 @@ PERL_CALLCONV I32  Perl_do_trans(pTHX_ SV* sv);
 PERL_CALLCONV UV       Perl_do_vecget(pTHX_ SV* sv, I32 offset, I32 size);
 PERL_CALLCONV void     Perl_do_vecset(pTHX_ SV* sv);
 PERL_CALLCONV void     Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right);
+#ifdef SOCKS_64BIT_BUG
+PERL_CALLCONV int      Perl_do_getc(PerlIO* fp);
+PERL_CALLCONV int      Perl_do_ungetc(int ch, PerlIO* fp);
+PERL_CALLCONV SSize_t  Perl_do_fread(void *buf, SSize_t count, PerlIO* fp);
+PERL_CALLCONV void     Perl_do_s64_delete_buffer(PerlIO* fp);
+PERL_CALLCONV Off_t    Perl_do_s64_tell(PerlIO* fp);
+PERL_CALLCONV int      Perl_do_s64_seek(PerlIO* fp, Off_t pos, int whence);
+#endif
 PERL_CALLCONV OP*      Perl_dofile(pTHX_ OP* term);
 PERL_CALLCONV I32      Perl_dowantarray(pTHX);
 PERL_CALLCONV void     Perl_dump_all(pTHX);