diff options
-rw-r--r-- | README.mpeix | 8 | ||||
-rwxr-xr-x | ext/IO/t/io_sock.t | 38 | ||||
-rw-r--r-- | mpeix/mpeix.c | 53 | ||||
-rw-r--r-- | mpeix/mpeixish.h | 2 |
4 files changed, 71 insertions, 30 deletions
diff --git a/README.mpeix b/README.mpeix index 8203741d2f..6fc853fc44 100644 --- a/README.mpeix +++ b/README.mpeix @@ -11,7 +11,7 @@ README.mpeix - Perl/iX for HP e3000 MPE http://www.bixby.org/mark/perlix.html http://jazz.external.hp.com/src/hp_freeware/perl/ Perl language for MPE - Last updated June 2, 2000 @ 0400 UTC + Last updated July 29, 2003 @ 2100 UTC =head1 NOTE @@ -433,12 +433,6 @@ a zero. =item * -If you use Perl/iX fcntl() against a socket it will fail, because MPE -requires that you use sfcntl() instead. Perl/iX does not presently -support sfcntl(). - -=item * - MPE requires GETPRIVMODE() in order to setuid(). There are too many calls to setuid() within Perl/iX, so I have not attempted an automatic GETPRIVMODE() solution similar to bind(). diff --git a/ext/IO/t/io_sock.t b/ext/IO/t/io_sock.t index 52ddae788e..c278850d07 100755 --- a/ext/IO/t/io_sock.t +++ b/ext/IO/t/io_sock.t @@ -181,26 +181,22 @@ $server = IO::Socket->new(Domain => AF_INET, LocalAddr => '127.0.0.1'); $port = $server->sockport; -if ($^O eq 'mpeix') { - print("ok 12 # skipped\n") +if ($pid = fork()) { + my $buf; + $server->recv($buf, 100); + print $buf; +} elsif (defined($pid)) { + #child + $sock = IO::Socket::INET->new(Proto => 'udp', + PeerAddr => "localhost:$port") + || IO::Socket::INET->new(Proto => 'udp', + PeerAddr => "127.0.0.1:$port"); + $sock->send("ok 12\n"); + sleep(1); + $sock->send("ok 12\n"); # send another one to be sure + exit; } else { - if ($pid = fork()) { - my $buf; - $server->recv($buf, 100); - print $buf; - } elsif (defined($pid)) { - #child - $sock = IO::Socket::INET->new(Proto => 'udp', - PeerAddr => "localhost:$port") - || IO::Socket::INET->new(Proto => 'udp', - PeerAddr => "127.0.0.1:$port"); - $sock->send("ok 12\n"); - sleep(1); - $sock->send("ok 12\n"); # send another one to be sure - exit; - } else { - die; - } + die; } print "not " unless $server->blocking; @@ -279,9 +275,6 @@ if( $server_pid) { ### TESTS 19,20,21,22 ### Try to ping-pong some Unicode. # - if ($^O eq 'mpeix') { - print "ok 19 # skipped: broken on MPE/iX\n"; - } else { $sock = IO::Socket::INET->new("localhost:$serverport") || IO::Socket::INET->new("127.0.0.1:$serverport"); @@ -330,7 +323,6 @@ if( $server_pid) { print "not "; } print "ok 23\n"; - } ### TEST 24 ### Stop the server diff --git a/mpeix/mpeix.c b/mpeix/mpeix.c index b230c50ac2..4805426a9e 100644 --- a/mpeix/mpeix.c +++ b/mpeix/mpeix.c @@ -451,3 +451,56 @@ struct timezone *tpz; return 0; } /* gettimeofday() */ + +/* +** MPE_FCNTL -- shadow function for fcntl() +** +** MPE requires sfcntl() for sockets, and fcntl() for everything +** else. This shadow routine determines the descriptor type and +** makes the appropriate call. +** +** Parameters: +** same as fcntl(). +** +** Returns: +** same as fcntl(). +*/ + +#include <stdarg.h> +#include <sys/socket.h> + +int +mpe_fcntl(int fildes, int cmd, ...) +{ + int len, result; + struct sockaddr sa; + + void *arg; + va_list ap; + + va_start(ap, cmd); + arg = va_arg(ap, void *); + va_end(ap); + + len = sizeof sa; + if (getsockname(fildes, &sa, &len) == -1) + { + if (errno == EAFNOSUPPORT) + /* AF_UNIX socket */ + return sfcntl(fildes, cmd, arg); + + if (errno == ENOTSOCK) + /* file or pipe */ + return fcntl(fildes, cmd, arg); + + /* unknown getsockname() failure */ + return (-1); + } + else + { + /* AF_INET socket */ + if ((result = sfcntl(fildes, cmd, arg)) != -1 && cmd == F_GETFL) + result |= O_RDWR; /* fill in some missing flags */ + return result; + } +} diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h index 8fc055a9a1..658e72ef87 100644 --- a/mpeix/mpeixish.h +++ b/mpeix/mpeixish.h @@ -153,3 +153,5 @@ extern void srand48(long int seedval); extern int ftruncate(int fd, long wantsize); extern int gettimeofday( struct timeval *tp, struct timezone *tpz ); extern int truncate(const char *pathname, off_t length); + +#define fcntl mpe_fcntl |