# 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)
(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);
#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
#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
#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)
#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
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
#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)
# 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)
#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)
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);
projects / p5sagit/p5-mst-13.2.git / commitdiff