X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=1fdedc2f073f73174be1b6f0b796ea8c423a67e8;hb=0154485940d6191adcfa079e1ddd517d4fb5d4e8;hp=de613f486df6c4b4bc3f6e0134bcdc1827f132f3;hpb=0759c90792f97a8e1b3dac33afb03f43cdff1b86;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index de613f4..1fdedc2 100644
--- a/doio.c
+++ b/doio.c
@@ -56,19 +56,18 @@
 #  include <unistd.h>
 #endif
 
-#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
-# include <sys/socket.h>
-# if defined(USE_SOCKS) && defined(I_SOCKS)
-#   include <socks.h>
-# endif 
-# ifdef I_NETBSD
-#  include <netdb.h>
-# endif
-# ifndef ENOTSOCK
-#  ifdef I_NET_ERRNO
-#   include <net/errno.h>
-#  endif
-# 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
@@ -87,16 +86,21 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
-    char savetype = ' ';
+    char savetype = IoTYPE_CLOSED;
     int writing = 0;
     PerlIO *fp;
     int fd;
     int result;
     bool was_fdopen = FALSE;
     bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
+    char *type  = NULL;
+    char *deftype = NULL;
+    char mode[4];		/* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
 
+    Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;		/* assume true if no fork */
 
+    /* Collect default raw/crlf info from the op */
     if (PL_op && PL_op->op_type == OP_OPEN) {
 	/* set up disciplines */
 	U8 flags = PL_op->op_private;
@@ -106,6 +110,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	out_crlf = (flags & OPpOPEN_OUT_CRLF);
     }
 
+    /* If currently open - close before we re-open */
     if (IoIFP(io)) {
 	fd = PerlIO_fileno(IoIFP(io));
 	if (IoTYPE(io) == IoTYPE_STD)
@@ -136,6 +141,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
 
     if (as_raw) {
+        /* sysopen style args, i.e. integer mode and permissions */
+
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
 	rawmode |= O_LARGEFILE;
 #endif
@@ -163,75 +170,79 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	if (fd == -1)
 	    fp = NULL;
 	else {
-	    char fpmode[4];
 	    STRLEN ix = 0;
-	    if (result == O_RDONLY)
-		fpmode[ix++] = 'r';
+	    if (result == O_RDONLY) {
+		mode[ix++] = 'r';
+	    }
 #ifdef O_APPEND
 	    else if (rawmode & O_APPEND) {
-		fpmode[ix++] = 'a';
+		mode[ix++] = 'a';
 		if (result != O_WRONLY)
-		    fpmode[ix++] = '+';
+		    mode[ix++] = '+';
 	    }
 #endif
 	    else {
 		if (result == O_WRONLY)
-		    fpmode[ix++] = 'w';
+		    mode[ix++] = 'w';
 		else {
-		    fpmode[ix++] = 'r';
-		    fpmode[ix++] = '+';
+		    mode[ix++] = 'r';
+		    mode[ix++] = '+';
 		}
 	    }
 	    if (rawmode & O_BINARY)
-		fpmode[ix++] = 'b';
-	    fpmode[ix] = '\0';
-	    fp = PerlIO_fdopen(fd, fpmode);
+		mode[ix++] = 'b';
+	    mode[ix] = '\0';
+	    fp = PerlIO_fdopen(fd, mode);
 	    if (!fp)
 		PerlLIO_close(fd);
 	}
     }
     else {
-	char *type;
+	/* Regular (non-sys) open */
 	char *oname = name;
-	STRLEN tlen;
 	STRLEN olen = len;
-	char mode[4];		/* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
-	int dodup;
+	char *tend;
+	int dodup = 0;
 
 	type = savepvn(name, len);
-	tlen = len;
+	tend = type+len;
 	SAVEFREEPV(type);
+	/* Loose trailing white space */
+	while (tend > type && isSPACE(tend[-1]))
+	    *tend-- = '\0';
 	if (num_svs) {
+	    /* New style explict name, type is just mode and discipline/layer info */
 	    STRLEN l;
 	    name = SvPV(svs, l) ;
 	    len = (I32)l;
 	    name = savepvn(name, len);
 	    SAVEFREEPV(name);
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*type); type++) ;
 	}
 	else {
-	    while (tlen && isSPACE(type[tlen-1]))
-		type[--tlen] = '\0';
 	    name = type;
-	    len = tlen;
+	    len  = tend-type;
 	}
-	mode[0] = mode[1] = mode[2] = mode[3] = '\0';
 	IoTYPE(io) = *type;
-	if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */
+	if (*type == IoTYPE_RDWR && (!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE)) { /* scary */
 	    mode[1] = *type++;
-	    --tlen;
 	    writing = 1;
 	}
 
-	if (*type == '|') {
-	    if (num_svs && (tlen != 2 || type[1] != '-')) {
-	      unknown_desr:
-		Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname);
+	if (*type == IoTYPE_PIPE) {
+	    if (num_svs) {
+		if (type[1] != IoTYPE_STD) {
+	          unknown_desr:
+		    Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname);
+		}
+		type++;
 	    }
 	    /*SUPPRESS 530*/
-	    for (type++, tlen--; isSPACE(*type); type++, tlen--) ;
+	    for (type++; isSPACE(*type); type++) ;
 	    if (!num_svs) {
 		name = type;
-		len = tlen;
+		len = tend-type;
 	    }
 	    if (*name == '\0') { /* command is missing 19990114 */
 		dTHR;
@@ -243,31 +254,27 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    if (strNE(name,"-") || num_svs)
 		TAINT_ENV();
 	    TAINT_PROPER("piped open");
-	    if (name[len-1] == '|') {
+	    if (!num_svs && name[len-1] == '|') {
 		dTHR;
 		name[--len] = '\0' ;
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe");
 	    }
-	    {
-		char *mode;
-		if (out_raw)
-		    mode = "wb";
-		else if (out_crlf)
-		    mode = "wt";
-		else
-		    mode = "w";
-		fp = PerlProc_popen(name,mode);
-	    }
+	    mode[0] = 'w';
 	    writing = 1;
+	    if (out_raw)
+		strcat(mode, "b");
+	    else if (out_crlf)
+		strcat(mode, "t");
+	    fp = PerlProc_popen(name,mode);
 	}
-	else if (*type == '>') {
+	else if (*type == IoTYPE_WRONLY) {
 	    TAINT_PROPER("open");
 	    type++;
-	    if (*type == '>') {
+	    if (*type == IoTYPE_WRONLY) {
+		/* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */
 		mode[0] = IoTYPE(io) = IoTYPE_APPEND;
 		type++;
-		tlen--;
 	    }
 	    else
 		mode[0] = 'w';
@@ -278,11 +285,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    else if (out_crlf)
 		strcat(mode, "t");
 
-	    if (num_svs && tlen != 1)
-	        goto unknown_desr;
 	    if (*type == '&') {
 		name = type;
 	      duplicity:
+		if (num_svs)
+		    goto unknown_desr;
 		dodup = 1;
 		name++;
 		if (*name == '=') {
@@ -313,7 +320,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 			     * be optimized away on most platforms;
 			     * only Solaris and Linux seem to flush
 			     * on that. --jhi */
-			    PerlIO_seek(fp, 0, SEEK_CUR);
+#ifdef USE_SFIO
+			    /* sfio fails to clear error on next
+			       sfwrite, contrary to documentation.
+			       -- Nick Clark */
+			    if (PerlIO_seek(fp, 0, SEEK_CUR) == -1)
+				PerlIO_clearerr(fp);
+#endif
 			    /* On the other hand, do all platforms
 			     * take gracefully to flushing a read-only
 			     * filehandle?  Perhaps we should do
@@ -348,7 +361,9 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    else {
 		/*SUPPRESS 530*/
 		for (; isSPACE(*type); type++) ;
-		if (strEQ(type,"-")) {
+		if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
+		    /*SUPPRESS 530*/
+		    type++;
 		    fp = PerlIO_stdout();
 		    IoTYPE(io) = IoTYPE_STD;
 		}
@@ -357,9 +372,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		}
 	    }
 	}
-	else if (*type == '<') {
-	    if (num_svs && tlen != 1)
-	        goto unknown_desr;
+	else if (*type == IoTYPE_RDONLY) {
 	    /*SUPPRESS 530*/
 	    for (type++; isSPACE(*type); type++) ;
 	    mode[0] = 'r';
@@ -372,25 +385,28 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		name = type;
 		goto duplicity;
 	    }
-	    if (strEQ(type,"-")) {
+	    if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
+		/*SUPPRESS 530*/
+		type++;
 		fp = PerlIO_stdin();
 		IoTYPE(io) = IoTYPE_STD;
 	    }
 	    else
 		fp = PerlIO_open((num_svs ? name : type), mode);
 	}
-	else if (tlen > 1 && type[tlen-1] == '|') {
+	else if ((num_svs && type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) ||
+	         (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) {
 	    if (num_svs) {
-		if (tlen != 2 || type[0] != '-')
-		    goto unknown_desr;
+		type += 2;   /* skip over '-|' */
 	    }
 	    else {
-		type[--tlen] = '\0';
-		while (tlen && isSPACE(type[tlen-1]))
-		    type[--tlen] = '\0';
+		*--tend = '\0';
+		while (tend > type && isSPACE(tend[-1]))
+		    *--tend = '\0';
 		/*SUPPRESS 530*/
 		for (; isSPACE(*type); type++) ;
 		name = type;
+	        len  = tend-type;
 	    }
 	    if (*name == '\0') { /* command is missing 19990114 */
 		dTHR;
@@ -402,16 +418,12 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    if (strNE(name,"-") || num_svs)
 		TAINT_ENV();
 	    TAINT_PROPER("piped open");
-	    {
-		char *mode;
-		if (in_raw)
-		    mode = "rb";
-		else if (in_crlf)
-		    mode = "rt";
-		else
-		    mode = "r";
-		fp = PerlProc_popen(name,mode);
-	    }
+	    mode[0] = 'r';
+	    if (in_raw)
+		strcat(mode, "b");
+	    else if (in_crlf)
+		strcat(mode, "t");
+	    fp = PerlProc_popen(name,mode);
 	    IoTYPE(io) = IoTYPE_PIPE;
 	}
 	else {
@@ -421,18 +433,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    IoTYPE(io) = IoTYPE_RDONLY;
 	    /*SUPPRESS 530*/
 	    for (; isSPACE(*name); name++) ;
+	    mode[0] = 'r';
+	    if (in_raw)
+		strcat(mode, "b");
+	    else if (in_crlf)
+		strcat(mode, "t");
 	    if (strEQ(name,"-")) {
 		fp = PerlIO_stdin();
 		IoTYPE(io) = IoTYPE_STD;
 	    }
 	    else {
-		char *mode;
-		if (in_raw)
-		    mode = "rb";
-		else if (in_crlf)
-		    mode = "rt";
-		else
-		    mode = "r";
 		fp = PerlIO_open(name,mode);
 	    }
 	}
@@ -443,8 +453,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
 	goto say_false;
     }
-    if (IoTYPE(io) &&
-      IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
+    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
 	dTHR;
 	if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
 	    (void)PerlIO_close(fp);
@@ -512,25 +521,55 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
 #endif
     IoIFP(io) = fp;
+    if (!num_svs) {
+	/* Need to supply default type info from open.pm */
+	SV *layers = PL_curcop->cop_io;
+	type = NULL;
+	if (layers) {
+	    STRLEN len;
+	    type = SvPV(layers,len);
+	    if (type && mode[0] != 'r') {
+		/* Skip to write part */
+		char *s = strchr(type,0);
+		if (s && (s-type) < len) {
+		    type = s+1;
+		}
+	    }
+	}
+	else if (O_BINARY != O_TEXT) {
+	    type = ":crlf";
+	}
+    }
+    if (type) {
+	while (isSPACE(*type)) type++;
+	if (*type) {
+	   if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
+		goto say_false;
+	   }
+	}
+    }
+
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
 	dTHR;
 	if (IoTYPE(io) == IoTYPE_SOCKET
 	    || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
 	{
-	    char *mode;
-	    if (out_raw)
-		mode = "wb";
-	    else if (out_crlf)
-		mode = "wt";
-	    else
-		mode = "w";
-
+	    mode[0] = 'w';
 	    if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) {
 		PerlIO_close(fp);
 		IoIFP(io) = Nullfp;
 		goto say_false;
 	    }
+	    if (type && *type) {
+		if (PerlIO_apply_layers(aTHX_ IoOFP(io),mode,type) != 0) {
+		    PerlIO_close(IoOFP(io));
+		    PerlIO_close(fp);
+		    IoIFP(io) = Nullfp;
+		    IoOFP(io) = Nullfp;
+		    goto say_false;
+		}
+	    }
 	}
 	else
 	    IoOFP(io) = fp;
@@ -642,7 +681,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 #if !defined(DOSISH) && !defined(__CYGWIN__)
 		    if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
 		        if (ckWARN_d(WARN_INPLACE))	
-			    Perl_warner(aTHX_ WARN_INPLACE, 
+			    Perl_warner(aTHX_ WARN_INPLACE,
 			      "Can't rename %s to %s: %s, skipping file",
 			      PL_oldname, SvPVX(sv), Strerror(errno) );
 			do_close(gv,FALSE);
@@ -889,7 +928,7 @@ Perl_do_eof(pTHX_ GV *gv)
 		 || IoIFP(io) == PerlIO_stderr()))
     {
 	/* integrate to report_evil_fh()? */
-        char *name = NULL; 
+        char *name = NULL;
 	if (isGV(gv)) {
 	    SV* sv = sv_newmortal();
 	    gv_efullname4(sv, gv, Nullch, FALSE);
@@ -915,6 +954,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);
@@ -1179,6 +1219,11 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 	}
 	/* FALL THROUGH */
     default:
+#if 0
+	/* XXX Fix this when the I/O disciplines arrive. XXX */
+	if (DO_UTF8(sv))
+	    sv_utf8_downgrade(sv, FALSE);
+#endif
 	tmps = SvPV(sv, len);
 	break;
     }
@@ -1188,7 +1233,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
      * but only until the system hard limit/the filesystem limit,
      * at which we would get EPERM.  Note that when using buffered
      * io the write failure can be delayed until the flush/close. --jhi */
-    if (len && (PerlIO_write(fp,tmps,len) == 0 || PerlIO_error(fp)))
+    if (len && (PerlIO_write(fp,tmps,len) == 0))
 	return FALSE;
     return !PerlIO_error(fp);
 }
@@ -1308,7 +1353,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	else
 	    PerlProc_execvp(PL_Argv[0],PL_Argv);
 	if (ckWARN(WARN_EXEC))
-	    Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", 
+	    Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s",
 		PL_Argv[0], Strerror(errno));
 	if (do_report) {
 	    int e = errno;
@@ -1443,7 +1488,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 	    int e = errno;
 
 	    if (ckWARN(WARN_EXEC))
-		Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", 
+		Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s",
 		    PL_Argv[0], Strerror(errno));
 	    if (do_report) {
 		PerlLIO_write(fd, (void*)&e, sizeof(int));
@@ -1518,7 +1563,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 	}
 	break;
 #endif
-/* 
+/*
 XXX Should we make lchown() directly available from perl?
 For now, we'll let Configure test for HAS_LCHOWN, but do
 nothing in the core.
@@ -1943,7 +1988,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     flags = SvIVx(*++mark);
     SvPV_force(mstr, len);
     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
-    
+
     SETERRNO(0,0);
     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
     if (ret >= 0) {
@@ -2044,3 +2089,146 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 
 #endif /* SYSV IPC */
 
+#ifdef SOCKS_64BIT_BUG
+
+/**
+ ** 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.
+ **/
+
+static S64_IOB *s64_buffer = (S64_IOB *) NULL;
+
+/* get a buffered stream pointer */
+static S64_IOB *S_s64_get_buffer( PerlIO *fp) {
+    S64_IOB *ptr = s64_buffer;
+    while( ptr && ptr->fp != fp)
+	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