MPE/iX fix from Mark Bixby: fcntl() on sockets on works.

p4raw-id: //depot/perl@20327

diff --git a/README.mpeix b/README.mpeix
index 8203741..6fc853f 100644 (file)
--- 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 52ddae7..c278850 100755 (executable)
--- 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 b230c50..4805426 100644 (file)
--- 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 8fc055a..658e72e 100644 (file)
--- 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