diff options
| -rw-r--r-- | doio.c | 156 | ||||
| -rw-r--r-- | embed.h | 12 | ||||
| -rwxr-xr-x | embed.pl | 8 | ||||
| -rw-r--r-- | perlsdio.h | 30 | ||||
| -rw-r--r-- | proto.h | 8 |
5 files changed, 208 insertions, 6 deletions
@@ -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 @@ -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 @@ -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 4b866345ff..9e668f6184 100644 --- 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) @@ -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); |