ext/Socket/Socket.xs

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <stddef.h>

#ifndef VMS
# ifdef I_SYS_TYPES
#  include <sys/types.h>
# endif
# if !defined(ultrix) /* Avoid double definition. */
#   include <sys/socket.h>
# endif
# 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
# if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
#  undef PF_LINK
# endif
# if defined(I_NETINET_IN) || defined(__ultrix__)
#  include <netinet/in.h>
# endif
# ifdef I_NETDB
#  if !defined(ultrix)  /* Avoid double definition. */
#   include <netdb.h>
#  endif
# endif
# ifdef I_ARPA_INET
#  include <arpa/inet.h>
# endif
# ifdef I_NETINET_TCP
#  include <netinet/tcp.h>
# endif
#else
# include "sockadapt.h"
#endif

#ifdef NETWARE
NETDB_DEFINE_CONTEXT
NETINET_DEFINE_CONTEXT
#endif

#ifdef I_SYSUIO
# include <sys/uio.h>
#endif

#ifndef AF_NBS
# undef PF_NBS
#endif

#ifndef AF_X25
# undef PF_X25
#endif

#ifndef INADDR_NONE
# define INADDR_NONE    0xffffffff
#endif /* INADDR_NONE */
#ifndef INADDR_BROADCAST
# define INADDR_BROADCAST       0xffffffff
#endif /* INADDR_BROADCAST */
#ifndef INADDR_LOOPBACK
# define INADDR_LOOPBACK         0x7F000001
#endif /* INADDR_LOOPBACK */

#ifndef HAS_INET_ATON

/*
 * Check whether "cp" is a valid ascii representation
 * of an Internet address and convert to a binary address.
 * Returns 1 if the address is valid, 0 if not.
 * This replaces inet_addr, the return value from which
 * cannot distinguish between failure and a local broadcast address.
 */
static int
my_inet_aton(register const char *cp, struct in_addr *addr)
{
        dTHX;
        register U32 val;
        register int base;
        register char c;
        int nparts;
        const char *s;
        unsigned int parts[4];
        register unsigned int *pp = parts;

       if (!cp || !*cp)
                return 0;
        for (;;) {
                /*
                 * Collect number up to ``.''.
                 * Values are specified as for C:
                 * 0x=hex, 0=octal, other=decimal.
                 */
                val = 0; base = 10;
                if (*cp == '0') {
                        if (*++cp == 'x' || *cp == 'X')
                                base = 16, cp++;
                        else
                                base = 8;
                }
                while ((c = *cp) != '\0') {
                        if (isDIGIT(c)) {
                                val = (val * base) + (c - '0');
                                cp++;
                                continue;
                        }
                        if (base == 16 && (s=strchr(PL_hexdigit,c))) {
                                val = (val << 4) +
                                        ((s - PL_hexdigit) & 15);
                                cp++;
                                continue;
                        }
                        break;
                }
                if (*cp == '.') {
                        /*
                         * Internet format:
                         *      a.b.c.d
                         *      a.b.c   (with c treated as 16-bits)
                         *      a.b     (with b treated as 24 bits)
                         */
                        if (pp >= parts + 3 || val > 0xff)
                                return 0;
                        *pp++ = val, cp++;
                } else
                        break;
        }
        /*
         * Check for trailing characters.
         */
        if (*cp && !isSPACE(*cp))
                return 0;
        /*
         * Concoct the address according to
         * the number of parts specified.
         */
        nparts = pp - parts + 1;        /* force to an int for switch() */
        switch (nparts) {

        case 1:                         /* a -- 32 bits */
                break;

        case 2:                         /* a.b -- 8.24 bits */
                if (val > 0xffffff)
                        return 0;
                val |= parts[0] << 24;
                break;

        case 3:                         /* a.b.c -- 8.8.16 bits */
                if (val > 0xffff)
                        return 0;
                val |= (parts[0] << 24) | (parts[1] << 16);
                break;

        case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
                if (val > 0xff)
                        return 0;
                val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
                break;
        }
        addr->s_addr = htonl(val);
        return 1;
}

#undef inet_aton
#define inet_aton my_inet_aton

#endif /* ! HAS_INET_ATON */


static int
not_here(char *s)
{
    croak("Socket::%s not implemented on this architecture", s);
    return -1;
}

#define PERL_IN_ADDR_S_ADDR_SIZE 4

/*
* Bad assumptions possible here.
*
* Bad Assumption 1: struct in_addr has no other fields
* than the s_addr (which is the field we care about
* in here, really). However, we can be fed either 4-byte
* addresses (from pack("N", ...), or va.b.c.d, or ...),
* or full struct in_addrs (from e.g. pack_sockaddr_in()),
* which may or may not be 4 bytes in size.
*
* Bad Assumption 2: the s_addr field is a simple type
* (such as an int, u_int32_t).  It can be a bit field,
* in which case using & (address-of) on it or taking sizeof()
* wouldn't go over too well.  (Those are not attempted
* now but in case someone thinks to change the below code
* to use addr.s_addr instead of addr, you have been warned.)
*
* Bad Assumption 3: the s_addr is the first field in
* an in_addr, or that its bytes are the first bytes in
* an in_addr.
*
* These bad assumptions are wrong in UNICOS which has
* struct in_addr { struct { u_long  st_addr:32; } s_da };
* #define s_addr s_da.st_addr
* and u_long is 64 bits.
*
* --jhi */

#include "const-c.inc"

MODULE = Socket         PACKAGE = Socket

INCLUDE: const-xs.inc

void
inet_aton(host)
        char *  host
        CODE:
        {
        struct in_addr ip_address;
        struct hostent * phe;
        int ok =
                (host != NULL) &&
                (*host != '\0') &&
                inet_aton(host, &ip_address);

        if (!ok && (phe = gethostbyname(host))) {
                Copy( phe->h_addr, &ip_address, phe->h_length, char );
                ok = 1;
        }

        ST(0) = sv_newmortal();
        if (ok)
                sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
        }

void
inet_ntoa(ip_address_sv)
        SV *    ip_address_sv
        CODE:
        {
        STRLEN addrlen;
        struct in_addr addr;
        char * addr_str;
        char * ip_address;
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
             croak("Wide character in Socket::inet_ntoa");
        ip_address = SvPVbyte(ip_address_sv, addrlen);
        if (addrlen == sizeof(addr) || addrlen == 4)
                addr.s_addr =
                    (ip_address[0] & 0xFF) << 24 |
                    (ip_address[1] & 0xFF) << 16 |
                    (ip_address[2] & 0xFF) <<  8 |
                    (ip_address[3] & 0xFF);
        else
                croak("Bad arg length for %s, length is %d, should be %d",
                      "Socket::inet_ntoa",
                      addrlen, sizeof(addr));
        /* We could use inet_ntoa() but that is broken
         * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
         * so let's use this sprintf() workaround everywhere.
         * This is also more threadsafe than using inet_ntoa(). */
        New(1138, addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */
        sprintf(addr_str, "%d.%d.%d.%d",
                ((addr.s_addr >> 24) & 0xFF),
                ((addr.s_addr >> 16) & 0xFF),
                ((addr.s_addr >>  8) & 0xFF),
                ( addr.s_addr        & 0xFF));
        ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
        Safefree(addr_str);
        }

void
sockaddr_family(sockaddr)
        SV *    sockaddr
        PREINIT:
        STRLEN sockaddr_len;
        char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
        CODE:
        if (sockaddr_len < offsetof(struct sockaddr, sa_data)) {
            croak("Bad arg length for %s, length is %d, should be at least %d",
                  "Socket::sockaddr_family", sockaddr_len,
                  offsetof(struct sockaddr, sa_data));
        }
        ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));

void
pack_sockaddr_un(pathname)
        SV *    pathname
        CODE:
        {
#ifdef I_SYS_UN
        struct sockaddr_un sun_ad; /* fear using sun */
        STRLEN len;
        char * pathname_pv;

        Zero( &sun_ad, sizeof sun_ad, char );
        sun_ad.sun_family = AF_UNIX;
        pathname_pv = SvPV(pathname,len);
        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_pv[0] != '/' && pathname_pv[0] != '\\')
                croak("Relative UNIX domain socket name '%s' unsupported",
                        pathname_pv);
            else if (len < 8
                     || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
                     || !strnicmp(pathname_pv + 1, "socket", 6))
                off = 7;
            else
                off = 0;                /* Preserve names starting with \socket\ */
            Copy( "\\socket", sun_ad.sun_path, off, char);
            Copy( pathname_pv, 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_pv, sun_ad.sun_path, len, char );
#  endif
        if (0) not_here("dummy");
        ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
#else
        ST(0) = (SV *) not_here("pack_sockaddr_un");
#endif
        
        }

void
unpack_sockaddr_un(sun_sv)
        SV *    sun_sv
        CODE:
        {
#ifdef I_SYS_UN
        struct sockaddr_un addr;
        STRLEN sockaddrlen;
        char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
        char * e;
#   ifndef __linux__
        /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
           getpeername and getsockname is not equal to sizeof(addr). */
        if (sockaddrlen != sizeof(addr)) {
            croak("Bad arg length for %s, length is %d, should be %d",
                        "Socket::unpack_sockaddr_un",
                        sockaddrlen, sizeof(addr));
        }
#   endif

        Copy( sun_ad, &addr, sizeof addr, char );

        if ( addr.sun_family != AF_UNIX ) {
            croak("Bad address family for %s, got %d, should be %d",
                        "Socket::unpack_sockaddr_un",
                        addr.sun_family,
                        AF_UNIX);
        }
        e = (char*)addr.sun_path;
        /* On Linux, the name of abstract unix domain sockets begins
         * with a '\0', so allow this. */
        while ((*e || (e == addr.sun_path && e[1] && sockaddrlen > 1))
                && e < (char*)addr.sun_path + sizeof addr.sun_path)
            ++e;
        ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - (char*)addr.sun_path));
#else
        ST(0) = (SV *) not_here("unpack_sockaddr_un");
#endif
        }

void
pack_sockaddr_in(port, ip_address_sv)
        unsigned short  port
        SV *    ip_address_sv
        CODE:
        {
        struct sockaddr_in sin;
        struct in_addr addr;
        STRLEN addrlen;
        char * ip_address;
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
             croak("Wide character in Socket::pack_sockaddr_in");
        ip_address = SvPVbyte(ip_address_sv, addrlen);
        if (addrlen == sizeof(addr) || addrlen == 4)
                addr.s_addr =
                    (ip_address[0] & 0xFF) << 24 |
                    (ip_address[1] & 0xFF) << 16 |
                    (ip_address[2] & 0xFF) <<  8 |
                    (ip_address[3] & 0xFF);
        else
                croak("Bad arg length for %s, length is %d, should be %d",
                      "Socket::pack_sockaddr_in",
                      addrlen, sizeof(addr));
        Zero( &sin, sizeof sin, char );
        sin.sin_family = AF_INET;
        sin.sin_port = htons(port);
        sin.sin_addr.s_addr = htonl(addr.s_addr);
        ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
        }

void
unpack_sockaddr_in(sin_sv)
        SV *    sin_sv
        PPCODE:
        {
        STRLEN sockaddrlen;
        struct sockaddr_in addr;
        unsigned short  port;
        struct in_addr  ip_address;
        char *  sin = SvPVbyte(sin_sv,sockaddrlen);
        if (sockaddrlen != sizeof(addr)) {
            croak("Bad arg length for %s, length is %d, should be %d",
                        "Socket::unpack_sockaddr_in",
                        sockaddrlen, sizeof(addr));
        }
        Copy( sin, &addr,sizeof addr, char );
        if ( addr.sin_family != AF_INET ) {
            croak("Bad address family for %s, got %d, should be %d",
                        "Socket::unpack_sockaddr_in",
                        addr.sin_family,
                        AF_INET);
        }
        port = ntohs(addr.sin_port);
        ip_address = addr.sin_addr;

        EXTEND(SP, 2);
        PUSHs(sv_2mortal(newSViv((IV) port)));
        PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof ip_address)));
        }
Revision:	1.1
Committed:	Thu Jun 30 14:27:04 2005 UTC (21 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#define PERL_NO_GET_CONTEXT
2			#include "EXTERN.h"
3			#include "perl.h"
4			#include "XSUB.h"
5
6			#include <stddef.h>
7
8			#ifndef VMS
9			# ifdef I_SYS_TYPES
10			# include <sys/types.h>
11			# endif
12			# if !defined(ultrix) /* Avoid double definition. */
13			# include <sys/socket.h>
14			# endif
15			# if defined(USE_SOCKS) && defined(I_SOCKS)
16			# include <socks.h>
17			# endif
18			# ifdef MPE
19			# define PF_INET AF_INET
20			# define PF_UNIX AF_UNIX
21			# define SOCK_RAW 3
22			# endif
23			# ifdef I_SYS_UN
24			# include <sys/un.h>
25			# endif
26			/* XXX Configure test for <netinet/in_systm.h needed XXX */
27			# if defined(NeXT) \|\| defined(__NeXT__)
28			# include <netinet/in_systm.h>
29			# endif
30			# if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
31			# undef PF_LINK
32			# endif
33			# if defined(I_NETINET_IN) \|\| defined(__ultrix__)
34			# include <netinet/in.h>
35			# endif
36			# ifdef I_NETDB
37			# if !defined(ultrix) /* Avoid double definition. */
38			# include <netdb.h>
39			# endif
40			# endif
41			# ifdef I_ARPA_INET
42			# include <arpa/inet.h>
43			# endif
44			# ifdef I_NETINET_TCP
45			# include <netinet/tcp.h>
46			# endif
47			#else
48			# include "sockadapt.h"
49			#endif
50
51			#ifdef NETWARE
52			NETDB_DEFINE_CONTEXT
53			NETINET_DEFINE_CONTEXT
54			#endif
55
56			#ifdef I_SYSUIO
57			# include <sys/uio.h>
58			#endif
59
60			#ifndef AF_NBS
61			# undef PF_NBS
62			#endif
63
64			#ifndef AF_X25
65			# undef PF_X25
66			#endif
67
68			#ifndef INADDR_NONE
69			# define INADDR_NONE 0xffffffff
70			#endif /* INADDR_NONE */
71			#ifndef INADDR_BROADCAST
72			# define INADDR_BROADCAST 0xffffffff
73			#endif /* INADDR_BROADCAST */
74			#ifndef INADDR_LOOPBACK
75			# define INADDR_LOOPBACK 0x7F000001
76			#endif /* INADDR_LOOPBACK */
77
78			#ifndef HAS_INET_ATON
79
80			/*
81			* Check whether "cp" is a valid ascii representation
82			* of an Internet address and convert to a binary address.
83			* Returns 1 if the address is valid, 0 if not.
84			* This replaces inet_addr, the return value from which
85			* cannot distinguish between failure and a local broadcast address.
86			*/
87			static int
88			my_inet_aton(register const char cp, struct in_addr addr)
89			{
90			dTHX;
91			register U32 val;
92			register int base;
93			register char c;
94			int nparts;
95			const char *s;
96			unsigned int parts[4];
97			register unsigned int *pp = parts;
98
99			if (!cp \|\| !*cp)
100			return 0;
101			for (;;) {
102			/*
103			* Collect number up to ``.''.
104			* Values are specified as for C:
105			* 0x=hex, 0=octal, other=decimal.
106			*/
107			val = 0; base = 10;
108			if (*cp == '0') {
109			if (++cp == 'x' \|\| cp == 'X')
110			base = 16, cp++;
111			else
112			base = 8;
113			}
114			while ((c = *cp) != '\0') {
115			if (isDIGIT(c)) {
116			val = (val * base) + (c - '0');
117			cp++;
118			continue;
119			}
120			if (base == 16 && (s=strchr(PL_hexdigit,c))) {
121			val = (val << 4) +
122			((s - PL_hexdigit) & 15);
123			cp++;
124			continue;
125			}
126			break;
127			}
128			if (*cp == '.') {
129			/*
130			* Internet format:
131			* a.b.c.d
132			* a.b.c (with c treated as 16-bits)
133			* a.b (with b treated as 24 bits)
134			*/
135			if (pp >= parts + 3 \|\| val > 0xff)
136			return 0;
137			*pp++ = val, cp++;
138			} else
139			break;
140			}
141			/*
142			* Check for trailing characters.
143			*/
144			if (cp && !isSPACE(cp))
145			return 0;
146			/*
147			* Concoct the address according to
148			* the number of parts specified.
149			*/
150			nparts = pp - parts + 1; /* force to an int for switch() */
151			switch (nparts) {
152
153			case 1: /* a -- 32 bits */
154			break;
155
156			case 2: /* a.b -- 8.24 bits */
157			if (val > 0xffffff)
158			return 0;
159			val \|= parts[0] << 24;
160			break;
161
162			case 3: /* a.b.c -- 8.8.16 bits */
163			if (val > 0xffff)
164			return 0;
165			val \|= (parts[0] << 24) \| (parts[1] << 16);
166			break;
167
168			case 4: /* a.b.c.d -- 8.8.8.8 bits */
169			if (val > 0xff)
170			return 0;
171			val \|= (parts[0] << 24) \| (parts[1] << 16) \| (parts[2] << 8);
172			break;
173			}
174			addr->s_addr = htonl(val);
175			return 1;
176			}
177
178			#undef inet_aton
179			#define inet_aton my_inet_aton
180
181			#endif /* ! HAS_INET_ATON */
182
183
184			static int
185			not_here(char *s)
186			{
187			croak("Socket::%s not implemented on this architecture", s);
188			return -1;
189			}
190
191			#define PERL_IN_ADDR_S_ADDR_SIZE 4
192
193			/*
194			* Bad assumptions possible here.
195			*
196			* Bad Assumption 1: struct in_addr has no other fields
197			* than the s_addr (which is the field we care about
198			* in here, really). However, we can be fed either 4-byte
199			* addresses (from pack("N", ...), or va.b.c.d, or ...),
200			* or full struct in_addrs (from e.g. pack_sockaddr_in()),
201			* which may or may not be 4 bytes in size.
202			*
203			* Bad Assumption 2: the s_addr field is a simple type
204			* (such as an int, u_int32_t). It can be a bit field,
205			* in which case using & (address-of) on it or taking sizeof()
206			* wouldn't go over too well. (Those are not attempted
207			* now but in case someone thinks to change the below code
208			* to use addr.s_addr instead of addr, you have been warned.)
209			*
210			* Bad Assumption 3: the s_addr is the first field in
211			* an in_addr, or that its bytes are the first bytes in
212			* an in_addr.
213			*
214			* These bad assumptions are wrong in UNICOS which has
215			* struct in_addr { struct { u_long st_addr:32; } s_da };
216			* #define s_addr s_da.st_addr
217			* and u_long is 64 bits.
218			*
219			* --jhi */
220
221			#include "const-c.inc"
222
223			MODULE = Socket PACKAGE = Socket
224
225			INCLUDE: const-xs.inc
226
227			void
228			inet_aton(host)
229			char * host
230			CODE:
231			{
232			struct in_addr ip_address;
233			struct hostent * phe;
234			int ok =
235			(host != NULL) &&
236			(*host != '\0') &&
237			inet_aton(host, &ip_address);
238
239			if (!ok && (phe = gethostbyname(host))) {
240			Copy( phe->h_addr, &ip_address, phe->h_length, char );
241			ok = 1;
242			}
243
244			ST(0) = sv_newmortal();
245			if (ok)
246			sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
247			}
248
249			void
250			inet_ntoa(ip_address_sv)
251			SV * ip_address_sv
252			CODE:
253			{
254			STRLEN addrlen;
255			struct in_addr addr;
256			char * addr_str;
257			char * ip_address;
258			if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
259			croak("Wide character in Socket::inet_ntoa");
260			ip_address = SvPVbyte(ip_address_sv, addrlen);
261			if (addrlen == sizeof(addr) \|\| addrlen == 4)
262			addr.s_addr =
263			(ip_address[0] & 0xFF) << 24 \|
264			(ip_address[1] & 0xFF) << 16 \|
265			(ip_address[2] & 0xFF) << 8 \|
266			(ip_address[3] & 0xFF);
267			else
268			croak("Bad arg length for %s, length is %d, should be %d",
269			"Socket::inet_ntoa",
270			addrlen, sizeof(addr));
271			/* We could use inet_ntoa() but that is broken
272			* in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
273			* so let's use this sprintf() workaround everywhere.
274			* This is also more threadsafe than using inet_ntoa(). */
275			New(1138, addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */
276			sprintf(addr_str, "%d.%d.%d.%d",
277			((addr.s_addr >> 24) & 0xFF),
278			((addr.s_addr >> 16) & 0xFF),
279			((addr.s_addr >> 8) & 0xFF),
280			( addr.s_addr & 0xFF));
281			ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
282			Safefree(addr_str);
283			}
284
285			void
286			sockaddr_family(sockaddr)
287			SV * sockaddr
288			PREINIT:
289			STRLEN sockaddr_len;
290			char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
291			CODE:
292			if (sockaddr_len < offsetof(struct sockaddr, sa_data)) {
293			croak("Bad arg length for %s, length is %d, should be at least %d",
294			"Socket::sockaddr_family", sockaddr_len,
295			offsetof(struct sockaddr, sa_data));
296			}
297			ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
298
299			void
300			pack_sockaddr_un(pathname)
301			SV * pathname
302			CODE:
303			{
304			#ifdef I_SYS_UN
305			struct sockaddr_un sun_ad; /* fear using sun */
306			STRLEN len;
307			char * pathname_pv;
308
309			Zero( &sun_ad, sizeof sun_ad, char );
310			sun_ad.sun_family = AF_UNIX;
311			pathname_pv = SvPV(pathname,len);
312			if (len > sizeof(sun_ad.sun_path))
313			len = sizeof(sun_ad.sun_path);
314			# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
315			{
316			int off;
317			char s, e;
318
319			if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
320			croak("Relative UNIX domain socket name '%s' unsupported",
321			pathname_pv);
322			else if (len < 8
323			\|\| pathname_pv[7] != '/' && pathname_pv[7] != '\\'
324			\|\| !strnicmp(pathname_pv + 1, "socket", 6))
325			off = 7;
326			else
327			off = 0; /* Preserve names starting with \socket\ */
328			Copy( "\\socket", sun_ad.sun_path, off, char);
329			Copy( pathname_pv, sun_ad.sun_path + off, len, char );
330
331			s = sun_ad.sun_path + off - 1;
332			e = s + len + 1;
333			while (++s < e)
334			if (*s = '/')
335			*s = '\\';
336			}
337			# else /* !( defined OS2 ) */
338			Copy( pathname_pv, sun_ad.sun_path, len, char );
339			# endif
340			if (0) not_here("dummy");
341			ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
342			#else
343			ST(0) = (SV *) not_here("pack_sockaddr_un");
344			#endif
345
346			}
347
348			void
349			unpack_sockaddr_un(sun_sv)
350			SV * sun_sv
351			CODE:
352			{
353			#ifdef I_SYS_UN
354			struct sockaddr_un addr;
355			STRLEN sockaddrlen;
356			char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
357			char * e;
358			# ifndef __linux__
359			/* On Linux sockaddrlen on sockets returned by accept, recvfrom,
360			getpeername and getsockname is not equal to sizeof(addr). */
361			if (sockaddrlen != sizeof(addr)) {
362			croak("Bad arg length for %s, length is %d, should be %d",
363			"Socket::unpack_sockaddr_un",
364			sockaddrlen, sizeof(addr));
365			}
366			# endif
367
368			Copy( sun_ad, &addr, sizeof addr, char );
369
370			if ( addr.sun_family != AF_UNIX ) {
371			croak("Bad address family for %s, got %d, should be %d",
372			"Socket::unpack_sockaddr_un",
373			addr.sun_family,
374			AF_UNIX);
375			}
376			e = (char*)addr.sun_path;
377			/* On Linux, the name of abstract unix domain sockets begins
378			* with a '\0', so allow this. */
379			while ((*e \|\| (e == addr.sun_path && e[1] && sockaddrlen > 1))
380			&& e < (char*)addr.sun_path + sizeof addr.sun_path)
381			++e;
382			ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - (char*)addr.sun_path));
383			#else
384			ST(0) = (SV *) not_here("unpack_sockaddr_un");
385			#endif
386			}
387
388			void
389			pack_sockaddr_in(port, ip_address_sv)
390			unsigned short port
391			SV * ip_address_sv
392			CODE:
393			{
394			struct sockaddr_in sin;
395			struct in_addr addr;
396			STRLEN addrlen;
397			char * ip_address;
398			if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
399			croak("Wide character in Socket::pack_sockaddr_in");
400			ip_address = SvPVbyte(ip_address_sv, addrlen);
401			if (addrlen == sizeof(addr) \|\| addrlen == 4)
402			addr.s_addr =
403			(ip_address[0] & 0xFF) << 24 \|
404			(ip_address[1] & 0xFF) << 16 \|
405			(ip_address[2] & 0xFF) << 8 \|
406			(ip_address[3] & 0xFF);
407			else
408			croak("Bad arg length for %s, length is %d, should be %d",
409			"Socket::pack_sockaddr_in",
410			addrlen, sizeof(addr));
411			Zero( &sin, sizeof sin, char );
412			sin.sin_family = AF_INET;
413			sin.sin_port = htons(port);
414			sin.sin_addr.s_addr = htonl(addr.s_addr);
415			ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
416			}
417
418			void
419			unpack_sockaddr_in(sin_sv)
420			SV * sin_sv
421			PPCODE:
422			{
423			STRLEN sockaddrlen;
424			struct sockaddr_in addr;
425			unsigned short port;
426			struct in_addr ip_address;
427			char * sin = SvPVbyte(sin_sv,sockaddrlen);
428			if (sockaddrlen != sizeof(addr)) {
429			croak("Bad arg length for %s, length is %d, should be %d",
430			"Socket::unpack_sockaddr_in",
431			sockaddrlen, sizeof(addr));
432			}
433			Copy( sin, &addr,sizeof addr, char );
434			if ( addr.sin_family != AF_INET ) {
435			croak("Bad address family for %s, got %d, should be %d",
436			"Socket::unpack_sockaddr_in",
437			addr.sin_family,
438			AF_INET);
439			}
440			port = ntohs(addr.sin_port);
441			ip_address = addr.sin_addr;
442
443			EXTEND(SP, 2);
444			PUSHs(sv_2mortal(newSViv((IV) port)));
445			PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof ip_address)));
446			}