From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 29 Jul 2003 20:09:15 +0000 (+0000)
Subject: MPE/iX fix from Mark Bixby: fcntl() on sockets on works.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b606c5253377393d8487073ab479f363dd13f330;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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