diff options
Diffstat (limited to 'contrib/perl5/ext/Socket')
| -rw-r--r-- | contrib/perl5/ext/Socket/Makefile.PL | 8 | ||||
| -rw-r--r-- | contrib/perl5/ext/Socket/Socket.pm | 141 | ||||
| -rw-r--r-- | contrib/perl5/ext/Socket/Socket.xs | 177 |
3 files changed, 287 insertions, 39 deletions
diff --git a/contrib/perl5/ext/Socket/Makefile.PL b/contrib/perl5/ext/Socket/Makefile.PL index 3819143..339c45a 100644 --- a/contrib/perl5/ext/Socket/Makefile.PL +++ b/contrib/perl5/ext/Socket/Makefile.PL @@ -1,7 +1,9 @@ use ExtUtils::MakeMaker; +use Config; WriteMakefile( - NAME => 'Socket', + NAME => 'Socket', VERSION_FROM => 'Socket.pm', - MAN3PODS => {}, # Pods will be built by installman. - XSPROTOARG => '-noprototypes', # XXX remove later? + ($Config{libs} =~ /(-lsocks\S*)/ ? (LIBS => [ "$1" ] ) : ()), + MAN3PODS => {}, # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? ); diff --git a/contrib/perl5/ext/Socket/Socket.pm b/contrib/perl5/ext/Socket/Socket.pm index 1ed19f7..02f098d 100644 --- a/contrib/perl5/ext/Socket/Socket.pm +++ b/contrib/perl5/ext/Socket/Socket.pm @@ -1,7 +1,7 @@ package Socket; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -$VERSION = "1.7"; +our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); +$VERSION = "1.72"; =head1 NAME @@ -160,10 +160,11 @@ have AF_UNIX in the right place. =cut use Carp; +use warnings::register; require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Exporter); @EXPORT = qw( inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in pack_sockaddr_un unpack_sockaddr_un @@ -193,6 +194,8 @@ require DynaLoader; AF_UNIX AF_UNSPEC AF_X25 + IOV_MAX + MSG_BCAST MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC @@ -203,6 +206,7 @@ require DynaLoader; MSG_ERRQUEUE MSG_FIN MSG_MAXIOVLEN + MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK @@ -241,6 +245,9 @@ require DynaLoader; SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP + SHUT_RD + SHUT_RDWR + SHUT_WR SOCK_DGRAM SOCK_RAW SOCK_RDM @@ -266,9 +273,17 @@ require DynaLoader; SO_SNDTIMEO SO_TYPE SO_USELOOPBACK + UIO_MAXIOV ); -@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF); +@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF + + IPPROTO_TCP + TCP_KEEPALIVE + TCP_MAXRT + TCP_MAXSEG + TCP_NODELAY + TCP_STDURG); %EXPORT_TAGS = ( crlf => [qw(CR LF CRLF $CR $LF $CRLF)], @@ -288,7 +303,8 @@ BEGIN { sub sockaddr_in { if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die my($af, $port, @quad) = @_; - carp "6-ARG sockaddr_in call is deprecated" if $^W; + warnings::warn "6-ARG sockaddr_in call is deprecated" + if warnings::enabled(); pack_sockaddr_in($port, inet_aton(join('.', @quad))); } elsif (wantarray) { croak "usage: (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1; @@ -309,6 +325,115 @@ sub sockaddr_un { } } +sub INADDR_ANY (); +sub INADDR_BROADCAST (); +sub INADDR_LOOPBACK (); +sub INADDR_LOOPBACK (); + +sub AF_802 (); +sub AF_APPLETALK (); +sub AF_CCITT (); +sub AF_CHAOS (); +sub AF_DATAKIT (); +sub AF_DECnet (); +sub AF_DLI (); +sub AF_ECMA (); +sub AF_GOSIP (); +sub AF_HYLINK (); +sub AF_IMPLINK (); +sub AF_INET (); +sub AF_LAT (); +sub AF_MAX (); +sub AF_NBS (); +sub AF_NIT (); +sub AF_NS (); +sub AF_OSI (); +sub AF_OSINET (); +sub AF_PUP (); +sub AF_SNA (); +sub AF_UNIX (); +sub AF_UNSPEC (); +sub AF_X25 (); +sub IOV_MAX (); +sub MSG_BCAST (); +sub MSG_CTLFLAGS (); +sub MSG_CTLIGNORE (); +sub MSG_CTRUNC (); +sub MSG_DONTROUTE (); +sub MSG_DONTWAIT (); +sub MSG_EOF (); +sub MSG_EOR (); +sub MSG_ERRQUEUE (); +sub MSG_FIN (); +sub MSG_MAXIOVLEN (); +sub MSG_MCAST (); +sub MSG_NOSIGNAL (); +sub MSG_OOB (); +sub MSG_PEEK (); +sub MSG_PROXY (); +sub MSG_RST (); +sub MSG_SYN (); +sub MSG_TRUNC (); +sub MSG_URG (); +sub MSG_WAITALL (); +sub PF_802 (); +sub PF_APPLETALK (); +sub PF_CCITT (); +sub PF_CHAOS (); +sub PF_DATAKIT (); +sub PF_DECnet (); +sub PF_DLI (); +sub PF_ECMA (); +sub PF_GOSIP (); +sub PF_HYLINK (); +sub PF_IMPLINK (); +sub PF_INET (); +sub PF_LAT (); +sub PF_MAX (); +sub PF_NBS (); +sub PF_NIT (); +sub PF_NS (); +sub PF_OSI (); +sub PF_OSINET (); +sub PF_PUP (); +sub PF_SNA (); +sub PF_UNIX (); +sub PF_UNSPEC (); +sub PF_X25 (); +sub SCM_CONNECT (); +sub SCM_CREDENTIALS (); +sub SCM_CREDS (); +sub SCM_RIGHTS (); +sub SCM_TIMESTAMP (); +sub SHUT_RD (); +sub SHUT_RDWR (); +sub SHUT_WR (); +sub SOCK_DGRAM (); +sub SOCK_RAW (); +sub SOCK_RDM (); +sub SOCK_SEQPACKET (); +sub SOCK_STREAM (); +sub SOL_SOCKET (); +sub SOMAXCONN (); +sub SO_ACCEPTCONN (); +sub SO_BROADCAST (); +sub SO_DEBUG (); +sub SO_DONTLINGER (); +sub SO_DONTROUTE (); +sub SO_ERROR (); +sub SO_KEEPALIVE (); +sub SO_LINGER (); +sub SO_OOBINLINE (); +sub SO_RCVBUF (); +sub SO_RCVLOWAT (); +sub SO_RCVTIMEO (); +sub SO_REUSEADDR (); +sub SO_SNDBUF (); +sub SO_SNDLOWAT (); +sub SO_SNDTIMEO (); +sub SO_TYPE (); +sub SO_USELOOPBACK (); +sub UIO_MAXIOV (); sub AUTOLOAD { my($constname); @@ -318,10 +443,10 @@ sub AUTOLOAD { my ($pack,$file,$line) = caller; croak "Your vendor has not defined Socket macro $constname, used"; } - eval "sub $AUTOLOAD { $val }"; + eval "sub $AUTOLOAD () { $val }"; goto &$AUTOLOAD; } -bootstrap Socket $VERSION; +XSLoader::load 'Socket', $VERSION; 1; diff --git a/contrib/perl5/ext/Socket/Socket.xs b/contrib/perl5/ext/Socket/Socket.xs index 0bd6e59..0584e78 100644 --- a/contrib/perl5/ext/Socket/Socket.xs +++ b/contrib/perl5/ext/Socket/Socket.xs @@ -1,3 +1,4 @@ +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -6,42 +7,58 @@ # ifdef I_SYS_TYPES # include <sys/types.h> # endif -#include <sys/socket.h> -#ifdef MPE -# define PF_INET AF_INET -# define PF_UNIX AF_UNIX -# define SOCK_RAW 3 -#endif -#ifdef I_SYS_UN -#include <sys/un.h> -#endif +# include <sys/socket.h> +# if defined(USE_SOCKS) && defined(I_SOCKS) +# include <socks.h> +# endif +# ifdef MPE +# define PF_INET AF_INET +# define PF_UNIX AF_UNIX +# define SOCK_RAW 3 +# endif +# ifdef I_SYS_UN +# include <sys/un.h> +# endif +/* XXX Configure test for <netinet/in_systm.h needed XXX */ +# if defined(NeXT) || defined(__NeXT__) +# include <netinet/in_systm.h> +# endif # ifdef I_NETINET_IN # include <netinet/in.h> # endif -#include <netdb.h> -#ifdef I_ARPA_INET -# include <arpa/inet.h> -#endif +# ifdef I_NETDB +# include <netdb.h> +# endif +# ifdef I_ARPA_INET +# include <arpa/inet.h> +# endif +# ifdef I_NETINET_TCP +# include <netinet/tcp.h> +# endif #else -#include "sockadapt.h" +# include "sockadapt.h" +#endif + +#ifdef I_SYSUIO +# include <sys/uio.h> #endif #ifndef AF_NBS -#undef PF_NBS +# undef PF_NBS #endif #ifndef AF_X25 -#undef PF_X25 +# undef PF_X25 #endif #ifndef INADDR_NONE -#define INADDR_NONE 0xffffffff +# define INADDR_NONE 0xffffffff #endif /* INADDR_NONE */ #ifndef INADDR_BROADCAST -#define INADDR_BROADCAST 0xffffffff +# define INADDR_BROADCAST 0xffffffff #endif /* INADDR_BROADCAST */ #ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK 0x7F000001 +# define INADDR_LOOPBACK 0x7F000001 #endif /* INADDR_LOOPBACK */ #ifndef HAS_INET_ATON @@ -56,6 +73,7 @@ static int my_inet_aton(register const char *cp, struct in_addr *addr) { + dTHX; register U32 val; register int base; register char c; @@ -322,6 +340,18 @@ constant(char *name, int arg) case 'H': break; case 'I': + if (strEQ(name, "IOV_MAX")) +#ifdef IOV_MAX + return IOV_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "IPPROTO_TCP")) +#ifdef IPPROTO_TCP + return IPPROTO_TCP; +#else + goto not_there; +#endif break; case 'J': break; @@ -330,6 +360,12 @@ constant(char *name, int arg) case 'L': break; case 'M': + if (strEQ(name, "MSG_BCAST")) +#ifdef MSG_BCAST + return MSG_BCAST; +#else + goto not_there; +#endif if (strEQ(name, "MSG_CTLFLAGS")) #ifdef MSG_CTLFLAGS return MSG_CTLFLAGS; @@ -390,6 +426,12 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "MSG_MCAST")) +#ifdef MSG_MCAST + return MSG_MCAST; +#else + goto not_there; +#endif if (strEQ(name, "MSG_NOSIGNAL")) #ifdef MSG_NOSIGNAL return MSG_NOSIGNAL; @@ -624,6 +666,24 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "SHUT_RD")) +#ifdef SHUT_RD + return SHUT_RD; +#else + return 0; +#endif + if (strEQ(name, "SHUT_RDWR")) +#ifdef SHUT_RDWR + return SHUT_RDWR; +#else + return 2; +#endif + if (strEQ(name, "SHUT_WR")) +#ifdef SHUT_WR + return SHUT_WR; +#else + return 1; +#endif if (strEQ(name, "SOCK_DGRAM")) #ifdef SOCK_DGRAM return SOCK_DGRAM; @@ -782,8 +842,44 @@ constant(char *name, int arg) #endif break; case 'T': + if (strEQ(name, "TCP_KEEPALIVE")) +#ifdef TCP_KEEPALIVE + return TCP_KEEPALIVE; +#else + goto not_there; +#endif + if (strEQ(name, "TCP_MAXRT")) +#ifdef TCP_MAXRT + return TCP_MAXRT; +#else + goto not_there; +#endif + if (strEQ(name, "TCP_MAXSEG")) +#ifdef TCP_MAXSEG + return TCP_MAXSEG; +#else + goto not_there; +#endif + if (strEQ(name, "TCP_NODELAY")) +#ifdef TCP_NODELAY + return TCP_NODELAY; +#else + goto not_there; +#endif + if (strEQ(name, "TCP_STDURG")) +#ifdef TCP_STDURG + return TCP_STDURG; +#else + goto not_there; +#endif break; case 'U': + if (strEQ(name, "UIO_MAXIOV")) +#ifdef UIO_MAXIOV + return UIO_MAXIOV; +#else + goto not_there; +#endif break; case 'V': break; @@ -851,7 +947,7 @@ inet_ntoa(ip_address_sv) Copy( ip_address, &addr, sizeof addr, char ); addr_str = inet_ntoa(addr); - ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str))); + ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str))); } void @@ -862,13 +958,38 @@ pack_sockaddr_un(pathname) #ifdef I_SYS_UN struct sockaddr_un sun_ad; /* fear using sun */ STRLEN len; + Zero( &sun_ad, sizeof sun_ad, char ); sun_ad.sun_family = AF_UNIX; len = strlen(pathname); if (len > sizeof(sun_ad.sun_path)) len = sizeof(sun_ad.sun_path); +# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */ + { + int off; + char *s, *e; + + if (pathname[0] != '/' && pathname[0] != '\\') + croak("Relative UNIX domain socket name '%s' unsupported", pathname); + else if (len < 8 + || pathname[7] != '/' && pathname[7] != '\\' + || !strnicmp(pathname + 1, "socket", 6)) + off = 7; + else + off = 0; /* Preserve names starting with \socket\ */ + Copy( "\\socket", sun_ad.sun_path, off, char); + Copy( pathname, sun_ad.sun_path + off, len, char ); + + s = sun_ad.sun_path + off - 1; + e = s + len + 1; + while (++s < e) + if (*s = '/') + *s = '\\'; + } +# else /* !( defined OS2 ) */ Copy( pathname, sun_ad.sun_path, len, char ); - ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad)); +# endif + ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad)); #else ST(0) = (SV *) not_here("pack_sockaddr_un"); #endif @@ -903,7 +1024,7 @@ unpack_sockaddr_un(sun_sv) e = addr.sun_path; while (*e && e < addr.sun_path + sizeof addr.sun_path) ++e; - ST(0) = sv_2mortal(newSVpv(addr.sun_path, e - addr.sun_path)); + ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - addr.sun_path)); #else ST(0) = (SV *) not_here("unpack_sockaddr_un"); #endif @@ -922,7 +1043,7 @@ pack_sockaddr_in(port,ip_address) sin.sin_port = htons(port); Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char ); - ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin)); + ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin)); } void @@ -952,7 +1073,7 @@ unpack_sockaddr_in(sin_sv) EXTEND(SP, 2); PUSHs(sv_2mortal(newSViv((IV) port))); - PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address))); + PUSHs(sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address))); } void @@ -961,7 +1082,7 @@ INADDR_ANY() { struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_ANY); - ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address )); + ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); } void @@ -970,7 +1091,7 @@ INADDR_LOOPBACK() { struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_LOOPBACK); - ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); } void @@ -979,7 +1100,7 @@ INADDR_NONE() { struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_NONE); - ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); } void @@ -988,5 +1109,5 @@ INADDR_BROADCAST() { struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_BROADCAST); - ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); } |
