Many kudos!
A lot of TCP/IP Perl code has now been potentially opened up to the OpenVMS!
This is a great day for VMSPERL.
Jordan Henderson
Compaq Services - Contracted to DAASC
Phone: (937) 656 3804
The surest way to corrupt a youth is to instruct him to hold in higher esteem
those who think alike than those who think differently.
--Friedrich Nietzsch
<<Jordan Henderson (E-mail).vcf>>
-----Original Message-----
From: lane @ DUPHY4.Physics.Drexel.Edu [mailto:lane @
DUPHY4.Physics.Drexel.Edu]
Sent: Thursday, April 27, 2000 3:29 PM
To: vmsperl @ perl.org
Subject: [PATCH] fix "print" to network socket
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]
begin 600 Jordan Henderson (E-mail).vcf
M0D5'24XZ5D-!4D0-"E9%4E-)3TXZ,BXQ#0I..DAE;F1E<G-O;CM*;W)D86X[
M.SL-"D9..DIO<F1A;B!(96YD97)S;VX@*$4M;6%I;"D-"D]21SI#;VUP87$[
M#0I4251,13H-"E1%3#M73U)+.U9/24-%.B@Y,S<I(#8U-BTS.#`T#0I414P[
M5T]22SM63TE#13HH.3,W*2`S,C`M,CDS-@T*5$5,.T-%3$P[5D])0T4Z#0I4
M14P[4$%'15([5D])0T4Z*#DS-RD@,C0P+3`R,S$-"E1%3#M73U)+.T9!6#HH
M.3,W*2`V-38M,S@P,`T*0412.U=/4DL[14Y#3T1)3D<]455/5$5$+5!224Y4
M04),13H[.T1E9F5N<V4@075T;VUA=&EC($%D9')E<W-I;F<@4WES=&5M($-E
M;G1E<CTP1#TP041!05-#+5-&/3!$/3!!-3(U,"!096%R<V]N/0T*(%)D($)L
M9&<N(#(P-STP1#TP04%R96$@0SM74$%&0CM/2#LT-30S,RTU,S(X.U5N:71E
M9"!3=&%T97,@;V8@06UE<FEC80T*3$%"14P[5T]22SM%3D-/1$E.1SU154]4
M140M4%))3E1!0DQ%.D1E9F5N<V4@075T;VUA=&EC($%D9')E<W-I;F<@4WES
M=&5M($-E;G1E<CTP1#TP041!05-#+5-&/3!$/3!!-3(U,"!096%R<V]N(%(]
M#0ID($)L9&<N(#(P-STP1#TP04%R96$@0STP1#TP05=0049"+"!/2"`T-30S
M,RTU,S(X/3!$/3!!56YI=&5D(%-T871E<R!O9B!!;65R/0T*:6-A#0I!1%([
M4$]35$%,.T5.0T]$24Y'/5%53U1%1"U04DE.5$%"3$4Z.SM#;VUP87$@1F5D
M97)A;"!3>7-T96US/3!$/3!!,30S,"!/86L@0V]U<G0L(%-U:71E(#$P,#M"
M96%V97)C<F5E:SM/2#LT-30S,#T-"CM5;FET960@4W1A=&5S(&]F($%M97)I
M8V$-"DQ!0D5,.U!/4U1!3#M%3D-/1$E.1SU154]4140M4%))3E1!0DQ%.D-O
M;7!A<2!&961E<F%L(%-Y<W1E;7,],$0],$$Q-#,P($]A:R!#;W5R="P@4W5I
M=&4@,3`P/3!$/3!!0F5A=F5R8W)E96LL($]((#0]#0HU-#,P/3!$/3!!56YI
M=&5D(%-T871E<R!O9B!!;65R:6-A#0I%34%)3#M04D5&.TE.5$523D54.FIH
M96YD97)S;VY`9&%A<RYD;&$N;6EL#0I2158Z,3DY.3$Q,3)4,C$R.#`T6@T*
+14Y$.E9#05)$#0H=
`
end
