This is a fix, somewhat ugly but working, to the problem mentioned
previously about doing "print"'s to a network socket.
The idea is that we flag file#'s as "sockets" in the few places where
socket filehandles are actually created, and then reset them when the
files are closed.
Then my_fwrite (in VMS.C) only has to check the file# and flag to see
if it should use "write" or "fputs" for output.
I used a fixed global array for this, for several reasons (a) speed
[it gets checked on each item of a print list] (b) simplicity (c)
thread-safety.
You run into problems if you have more than 256 i/o channels open; you'll
get a warning message for any sockets opened at beyond the 256 and you'll
get the "fputs" rather than "write". The 256 is #defined in vms/vmsish.h
so you can change it if you want.
After modification, all tests in the test suite pass...not surprising, I
don't think any of them use socket i/o at all. But the LIBWWW test for
local/http.t also passes all tests after doing the usual VMSish patchup
of file/directory names.
Patch follows:
--- doio.c-orig Thu Apr 27 09:16:26 2000
+++ doio.c Thu Apr 27 13:12:49 2000
@@ -327,7 +327,18 @@
fd = -1;
}
if (dodup)
+#ifdef VMS_DO_SOCKETS
+ {
+ char o = 0;
+ if (fd >= 0 && fd <= MAX_FILEISSOCKET)
+ o = PL_VMS_file_is_socket[fd];
+#endif
fd = PerlLIO_dup(fd);
+#ifdef VMS_DO_SOCKETS
+ if (fd >= 0 && fd <= MAX_FILEISSOCKET)
+ PL_VMS_file_is_socket[fd] = o;
+ }
+#endif
else
was_fdopen = TRUE;
if (!(fp = PerlIO_fdopen(fd,mode))) {
@@ -830,6 +841,20 @@
{
bool retval = FALSE;
int status;
+
+#ifdef VMS_DO_SOCKETS
+ int fd;
+ if (IoIFP(io)) {
+ fd = fileno(IoIFP(io));
+ if (fd >= 0 && fd <= MAX_FILEISSOCKET)
+ PL_VMS_file_is_socket[fd] = 0 ;
+ }
+ if (IoOFP(io)) {
+ fd = fileno(IoOFP(io));
+ if (fd >= 0 && fd <= MAX_FILEISSOCKET)
+ PL_VMS_file_is_socket[fd] = 0 ;
+ }
+#endif
if (IoIFP(io)) {
if (IoTYPE(io) == '|') {
--- pp_sys.c-orig Thu Apr 27 08:55:28 2000
+++ pp_sys.c Thu Apr 27 13:12:49 2000
@@ -2045,6 +2045,11 @@
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
RETPUSHUNDEF;
+#ifdef VMS_DO_SOCKETS
+ if (fd <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd]=1;
+ else if (ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");
+#endif
IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */
IoOFP(io) = PerlIO_fdopen(fd, "w");
IoTYPE(io) = 's';
@@ -2092,6 +2097,14 @@
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
+#ifdef VMS_DO_SOCKETS
+ if (fd[0] <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd[0]]=1;
+ else if (ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");
+ if (fd[1] <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd[1]]=1;
+ else if (ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");
+#endif
IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
IoTYPE(io1) = 's';
@@ -2264,6 +2277,11 @@
fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr,
&len);
if (fd < 0)
goto badexit;
+#ifdef VMS_DO_SOCKETS
+ if (fd <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd]=1;
+ else if (ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");
+#endif
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
IoOFP(nstio) = PerlIO_fdopen(fd, "w");
IoTYPE(nstio) = 's';
--- vms/vms.c-pre_socket Thu Apr 27 09:24:32 2000
+++ vms/vms.c Thu Apr 27 09:47:41 2000
@@ -4639,6 +4639,10 @@
} /* end of do_spawn() */
/*}}}*/
+#ifdef VMS_DO_SOCKETS
+char PL_VMS_file_is_socket[MAX_FILEISSOCKET+1];
+#endif
+
/*
* A simple fwrite replacement which outputs itmsz*nitm chars without
* introducing record boundaries every itmsz chars.
@@ -4648,7 +4652,13 @@
my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)
{
register char *cp, *end;
-
+#ifdef VMS_DO_SOCKETS
+ int fd = fileno(dest);
+ if (fd >= 0 && fd <= MAX_FILEISSOCKET && PL_VMS_file_is_socket[fd]) {
+ if (write(fd,src,itmsz*nitm) == EOF) return EOF;
+ return 1;
+ }
+#endif
end = (char *)src + itmsz * nitm;
while ((char *)src <= end) {
@@ -6168,6 +6178,13 @@
store_pipelocs();
+#ifdef VMS_DO_SOCKETS
+ {
+ int j;
+ for (j = 0; j <= MAX_FILEISSOCKET; j++)
+ PL_VMS_file_is_socket[j] = 0;
+ }
+#endif
return;
}
--- vms/vmsish.h-orig Fri Apr 21 07:37:23 2000
+++ vms/vmsish.h Thu Apr 27 12:25:48 2000
@@ -721,5 +724,12 @@
#if defined(fileno) && defined(__DECC_VER) && __DECC_VER < 50300000
# undef fileno
#endif
+
+/* fixup i/o to sockets, flag which file#'s are sockets */
+#ifdef VMS_DO_SOCKETS
+#define MAX_FILEISSOCKET 256
+extern char PL_VMS_file_is_socket[MAX_FILEISSOCKET+1];
+#endif
+
#endif /* __vmsish_h_included */
--
Drexel University \V --Chuck Lane
----------------->--------*------------<[EMAIL PROTECTED]
(215) 895-1545 / \ Particle Physics [EMAIL PROTECTED]
FAX: (215) 895-5934 /~~~~~~~~~~~ [EMAIL PROTECTED]
