# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Tue Nov 21 20:33:35 EET 2000 [metaconfig 3.0 PL70]
+# Generated on Sat Nov 25 20:16:14 EET 2000 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.org)
cat >/tmp/c1$$ <<EOF
cat <<EOM
Perl can be built to use the SOCKS proxy protocol library. To do so,
-Configure must be run with -Dusesocks.
+Configure must be run with -Dusesocks. If you use SOCKS you also need
+to use the PerlIO abstraction layer, this will be implicitly selected.
If this doesn't make any sense to you, just accept the default '$dflt'.
EOM
set usesocks
eval $setvar
+case "$usesocks" in
+$define|true|[yY]*) useperlio="$define";;
+esac
+
: Looking for optional libraries
echo " "
echo "Checking for optional libraries..." >&4
esac
cat <<EOM
-Previous version of $package used the standard IO mechanisms as defined
-in <stdio.h>. Versions 5.003_02 and later of perl allow alternate IO
-mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still
-the default. This abstraction layer can use AT&T's sfio (if you already
-have sfio installed) or regular stdio. Using PerlIO with sfio may cause
-problems with some extension modules. Using PerlIO with stdio is safe,
-but it is slower than plain stdio and therefore is not the default.
+Previous version of $package used the standard IO mechanisms as
+defined in <stdio.h>. Versions 5.003_02 and later of perl allow
+alternate IO mechanisms via the PerlIO abstraction layer, but the
+stdio mechanism is still the default. This abstraction layer can
+use AT&T's sfio (if you already have sfio installed) or regular stdio.
+Using PerlIO with sfio may cause problems with some extension modules.
If this doesn't make any sense to you, just accept the default '$dflt'.
EOM
val="$define"
;;
*)
- echo "Ok, doing things the stdio way"
+ echo "Ok, doing things the stdio way."
val="$undef"
;;
esac
set useperlio
eval $setvar
+case "$usesocks" in
+$define|true|[yY]*)
+ case "$useperlio" in
+ $define|true|[yY]*) ;;
+ *) cat >&4 <<EOM
+
+You are using the SOCKS proxy protocol library which means that you
+should also use the PerlIO layer. You may be headed for trouble.
+
+EOM
+ ;;
+ esac
+ ;;
+esac
+
+
case "$vendorprefix" in
'') d_vendorbin="$undef"
vendorbin=''
#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.
- **/
-
-/* Not threadsafe? */
-static S64_IOB *s64_buffer = (S64_IOB *) NULL;
-
-/* initialize the buffer area */
-/* required after a fork(2) call in order to remove side effects */
-void
-Perl_do_s64_init_buffer(void)
-{
- s64_buffer = (S64_IOB *) NULL;
-}
-
-/* get a buffered stream pointer */
-STATIC S64_IOB*
-S_s64_get_buffer(pTHX_ 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*
-S_s64_create_buffer(pTHX_ 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(pTHX_ PerlIO *f)
-{
- S64_IOB *ptr = S_s64_get_buffer(aTHX_ 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
-S_s64_malloc(pTHX_ 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(pTHX_ PerlIO *f)
-{
- S64_IOB *ptr = S_s64_get_buffer(aTHX_ f);
- if( ptr) {
- if( ptr->cnt)
- return( ptr->buffer[--ptr->cnt]);
- }
- return( getc(f));
-}
-
-/* SOCKS 64 bit ungetc replacement */
-int
-Perl_do_s64_ungetc(pTHX_ int ch, PerlIO *f)
-{
- S64_IOB *ptr = S_s64_get_buffer(aTHX_ f);
-
- if( !ptr) ptr = S_s64_create_buffer(aTHX_ f);
- if( !ptr) return( EOF);
- if( !ptr->buffer || (ptr->buffer && ptr->cnt >= ptr->size))
- if( !S_s64_malloc(aTHX_ ptr)) return( EOF);
- ptr->buffer[ptr->cnt++] = ch;
-
- return( ch);
-}
-
-/* SOCKS 64 bit fread replacement */
-SSize_t
-Perl_do_s64_fread(pTHX_ void *buf, SSize_t count, PerlIO* f)
-{
- SSize_t len = 0;
- char *bufptr = (char *) buf;
- S64_IOB *ptr = S_s64_get_buffer(aTHX_ 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(pTHX_ PerlIO* f, Off_t offset, int whence)
-{
- S64_IOB *ptr = S_s64_get_buffer(aTHX_ 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(pTHX_ PerlIO* f)
-{
- Off_t offset = 0;
- S64_IOB *ptr = S_s64_get_buffer(aTHX_ f);
- if( ptr)
- offset = ptr->cnt;
- return( ftello(f) - offset);
-}
-
-#endif /* SOCKS_64BIT_BUG */
-
#define do_vecget Perl_do_vecget
#define do_vecset Perl_do_vecset
#define do_vop Perl_do_vop
-#if defined(SOCKS_64BIT_BUG)
-#define do_s64_tell Perl_do_s64_tell
-#define do_s64_fread Perl_do_s64_fread
-#define do_s64_getc Perl_do_s64_getc
-#define do_s64_seek Perl_do_s64_seek
-#define do_s64_ungetc Perl_do_s64_ungetc
-#define do_s64_delete_buffer Perl_do_s64_delete_buffer
-#define s64_get_buffer S_s64_get_buffer
-#define s64_create_buffer S_s64_create_buffer
-#define s64_malloc S_s64_malloc
-#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)
-#if defined(SOCKS_64BIT_BUG)
-#define do_s64_tell(a) Perl_do_s64_tell(aTHX_ a)
-#define do_s64_fread(a,b,c) Perl_do_s64_fread(aTHX_ a,b,c)
-#define do_s64_getc(a) Perl_do_s64_getc(aTHX_ a)
-#define do_s64_seek(a,b,c) Perl_do_s64_seek(aTHX_ a,b,c)
-#define do_s64_ungetc(a,b) Perl_do_s64_ungetc(aTHX_ a,b)
-#define do_s64_delete_buffer(a) Perl_do_s64_delete_buffer(aTHX_ a)
-#define s64_get_buffer(a) S_s64_get_buffer(aTHX_ a)
-#define s64_create_buffer(a) S_s64_create_buffer(aTHX_ a)
-#define s64_malloc(a) S_s64_malloc(aTHX_ a)
-#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
-#if defined(SOCKS_64BIT_BUG)
-#define Perl_do_s64_tell CPerlObj::Perl_do_s64_tell
-#define do_s64_tell Perl_do_s64_tell
-#define Perl_do_s64_fread CPerlObj::Perl_do_s64_fread
-#define do_s64_fread Perl_do_s64_fread
-#define Perl_do_s64_getc CPerlObj::Perl_do_s64_getc
-#define do_s64_getc Perl_do_s64_getc
-#define Perl_do_s64_seek CPerlObj::Perl_do_s64_seek
-#define do_s64_seek Perl_do_s64_seek
-#define Perl_do_s64_ungetc CPerlObj::Perl_do_s64_ungetc
-#define do_s64_ungetc Perl_do_s64_ungetc
-#define Perl_do_s64_delete_buffer CPerlObj::Perl_do_s64_delete_buffer
-#define do_s64_delete_buffer Perl_do_s64_delete_buffer
-#define do_s64_init_buffer Perl_do_s64_init_buffer
-#define S_s64_get_buffer CPerlObj::S_s64_get_buffer
-#define s64_get_buffer S_s64_get_buffer
-#define S_s64_create_buffer CPerlObj::S_s64_create_buffer
-#define s64_create_buffer S_s64_create_buffer
-#define S_s64_malloc CPerlObj::S_s64_malloc
-#define s64_malloc S_s64_malloc
-#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
-#if defined(SOCKS_64BIT_BUG)
-p |Off_t |do_s64_tell |PerlIO* fp
-p |SSize_t|do_s64_fread |void *buf|SSize_t count|PerlIO* fp
-p |int |do_s64_getc |PerlIO* fp
-p |int |do_s64_seek |PerlIO* fp|Off_t pos|int whence
-p |int |do_s64_ungetc |int ch|PerlIO* fp
-p |void |do_s64_delete_buffer|PerlIO* fp
-Ajnop |void |do_s64_init_buffer
-s |S64_IOB * |s64_get_buffer |PerlIO *f
-s |S64_IOB * |s64_create_buffer |PerlIO *f
-s |int |s64_malloc |S64_IOB *ptr
-#endif
p |OP* |dofile |OP* term
Ap |I32 |dowantarray
Ap |void |dump_all
skip_symbols [qw(PL_curthr)];
}
-# All quad int platforms are assumed to have broken SOCKS
-unless ($define{USE_SOCKS} && $define{USE_64_BIT_ALL}) {
- skip_symbols [qw(
- Perl_do_s64_delete_buffer
- Perl_do_s64_fread
- Perl_do_s64_getc
- Perl_do_s64_init_buffer
- Perl_do_s64_seek
- Perl_do_s64_tell
- Perl_do_s64_ungetc
- )];
-}
-
sub readvar {
my $file = shift;
my $proc = shift || sub { "PL_$_[2]" };
# undef INCLUDE_PROTOTYPES
# undef PERL_SOCKS_NEED_PROTOTYPES
# endif
-# ifdef USE_64_BIT_ALL
-# define SOCKS_64BIT_BUG /* until proven otherwise */
-# endif
# endif
# ifdef I_NETDB
# include <netdb.h>
#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
#define PERL_PPDEF(s) OP *s (pTHX);
-#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;
-#endif
-
#include "proto.h"
#ifdef PERL_OBJECT
IV
PerlIOStdio_close(PerlIO *f)
{
+ int optval, optlen = sizeof(int);
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return fclose(stdio);
+ return(
+ (getsockopt(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (char *)&optval, &optlen) < 0) ?
+ fclose(stdio) :
+ close(PerlIO_fileno(f)));
}
IV
extern int PerlIO_setpos (PerlIO *,const Fpos_t *);
#endif
#ifndef PerlIO_fdupopen
-extern PerlIO * PerlIO_fdupopen (PerlIO *);
+#define PerlIO_fdupopen(f) (f)
+/* extern PerlIO * PerlIO_fdupopen (PerlIO *); */
#endif
#ifndef PerlIO_isutf8
extern int PerlIO_isutf8 (PerlIO *);
#define PerlIO_open fopen
#define PerlIO_fdopen fdopen
#define PerlIO_reopen freopen
-#ifdef SOCKS_64BIT_BUG
-# define PerlIO_close(f) (Perl_do_s64_delete_buffer(aTHX_ f), fclose(f))
-#else
-# define PerlIO_close(f) fclose(f)
-#endif
+#define PerlIO_close(f) fclose(f)
#define PerlIO_puts(f,s) fputs(s,f)
#define PerlIO_putc(f,c) fputc(c,f)
#if defined(VMS)
(feof(f) ? 0 : (SSize_t)fread(buf,1,count,f))
# define PerlIO_tell(f) ftell(f)
#else
-# ifdef SOCKS_64BIT_BUG
-# define PerlIO_getc(f) Perl_do_s64_getc(aTHX_ f)
-# define PerlIO_ungetc(f,c) Perl_do_s64_ungetc(aTHX_ c,f)
-# define PerlIO_read(f,buf,count) Perl_do_s64_fread(aTHX_ buf,count,f)
-# define PerlIO_tell(f) Perl_do_s64_tell(aTHX_ 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)
-# define PerlIO_tell(f) ftell(f)
-# endif /* SOCKS_64BIT_BUG */
+# 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)
+# define PerlIO_tell(f) ftell(f)
#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)
-#ifdef SOCKS_64BIT_BUG
-# define PerlIO_seek(f,o,w) Perl_do_s64_seek(aTHX_ f,o,w)
+#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
-# 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)
-# endif
+# define PerlIO_seek(f,o,w) fseek(f,o,w)
#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);
-#if defined(SOCKS_64BIT_BUG)
-PERL_CALLCONV Off_t Perl_do_s64_tell(pTHX_ PerlIO* fp);
-PERL_CALLCONV SSize_t Perl_do_s64_fread(pTHX_ void *buf, SSize_t count, PerlIO* fp);
-PERL_CALLCONV int Perl_do_s64_getc(pTHX_ PerlIO* fp);
-PERL_CALLCONV int Perl_do_s64_seek(pTHX_ PerlIO* fp, Off_t pos, int whence);
-PERL_CALLCONV int Perl_do_s64_ungetc(pTHX_ int ch, PerlIO* fp);
-PERL_CALLCONV void Perl_do_s64_delete_buffer(pTHX_ PerlIO* fp);
-PERL_CALLCONV void Perl_do_s64_init_buffer(void);
-STATIC S64_IOB * S_s64_get_buffer(pTHX_ PerlIO *f);
-STATIC S64_IOB * S_s64_create_buffer(pTHX_ PerlIO *f);
-STATIC int S_s64_malloc(pTHX_ S64_IOB *ptr);
-#endif
PERL_CALLCONV OP* Perl_dofile(pTHX_ OP* term);
PERL_CALLCONV I32 Perl_dowantarray(pTHX);
PERL_CALLCONV void Perl_dump_all(pTHX);
}
$| = 1;
-print "1..14\n";
+print "1..20\n";
use IO::Socket;
$server->blocking(0);
print "not " if $server->blocking;
print "ok 14\n";
+
+### TEST 15
+### Set up some data to be transfered between the server and
+### the client. We'll use own source code ...
+#
+local @data;
+if( !open( SRC, "< $0")) {
+ print "not ok 15 - $!";
+} else {
+ @data = <SRC>;
+ close( SRC);
+}
+print "ok 15\n";
+
+### TEST 16
+### Start the server
+#
+my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
+ print "not ";
+print "ok 16\n";
+die if( !defined( $listen));
+my $serverport = $listen->sockport;
+
+my $server_pid = fork();
+if( $server_pid) {
+
+ ### TEST 17 Client/Server establishment
+ #
+ print "ok 17\n";
+
+ ### TEST 18
+ ### Get data from the server using a single stream
+ #
+ $sock = IO::Socket::INET->new("localhost:$serverport")
+ || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+ if ($sock) {
+ $sock->print("send\n");
+
+ my @array = ();
+ while( <$sock>) {
+ push( @array, $_);
+ }
+
+ $sock->print("done\n");
+ $sock->close;
+
+ print "not " if( @array != @data);
+ } else {
+ print "not ";
+ }
+ print "ok 18\n";
+
+ ### TEST 19
+ ### Get data from the server using a stream, which is
+ ### interrupted by eof calls.
+ ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
+ ### did an getc followed by an ungetc in order to check for the streams
+ ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
+ ### a recv(2) call on the socket, while ungetc(3) put back a character
+ ### to an IO buffer, which never again was read.
+ #
+ $sock = IO::Socket::INET->new("localhost:$serverport")
+ || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+ if ($sock) {
+ $sock->print("send\n");
+
+ my @array = ();
+ while( !eof( $sock ) ){
+ while( <$sock>) {
+ push( @array, $_);
+ last;
+ }
+ }
+
+ $sock->print("done\n");
+ $sock->close;
+
+ print "not " if( @array != @data);
+ } else {
+ print "not ";
+ }
+ print "ok 19\n";
+
+ ### TEST 20
+ ### Stop the server
+ #
+ $sock = IO::Socket::INET->new("localhost:$serverport")
+ || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+ if ($sock) {
+ $sock->print("done\n");
+ $sock->close;
+
+ print "not " if( 1 != kill 0, $server_pid);
+ } else {
+ print "not ";
+ }
+ print "ok 20\n";
+
+} elsif( defined( $server_pid)) {
+
+ ### Child
+ #
+ SERVER_LOOP: while (1) {
+ last SERVER_LOOP unless $sock = $listen->accept;
+ while (<$sock>) {
+ last SERVER_LOOP if /^quit/;
+ last if /^done/;
+ if( /^send/) {
+ print $sock @data;
+ last;
+ }
+ print;
+ }
+ $sock = undef;
+ }
+ $listen->close;
+
+} else {
+
+ ### Fork failed
+ #
+ print "not ok 17\n";
+ die;
+}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff