X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FSocket%2FSocket.xs;h=504cbd1ed17eb71066d9f51fc0302324478825d3;hb=68795e9367de98482c4a5830e6e94b51bd60f4e3;hp=30dd0f2e224c20398920919e836e7a98c7cba5f5;hpb=d05c1ba08d199ec5bed1e39e74e1c4c0f8d726b6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index 30dd0f2..504cbd1 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -3,6 +3,8 @@ #include "perl.h" #include "XSUB.h" +#include + #ifndef VMS # ifdef I_SYS_TYPES # include @@ -10,7 +12,7 @@ # include # if defined(USE_SOCKS) && defined(I_SOCKS) # include -# endif +# endif # ifdef MPE # define PF_INET AF_INET # define PF_UNIX AF_UNIX @@ -39,6 +41,11 @@ # include "sockadapt.h" #endif +#ifdef NETWARE +NETDB_DEFINE_CONTEXT +NETINET_DEFINE_CONTEXT +#endif + #ifdef I_SYSUIO # include #endif @@ -63,7 +70,7 @@ #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. @@ -82,7 +89,7 @@ my_inet_aton(register const char *cp, struct in_addr *addr) unsigned int parts[4]; register unsigned int *pp = parts; - if (!cp) + if (!cp || !*cp) return 0; for (;;) { /* @@ -104,7 +111,7 @@ my_inet_aton(register const char *cp, struct in_addr *addr) continue; } if (base == 16 && (s=strchr(PL_hexdigit,c))) { - val = (val << 4) + + val = (val << 4) + ((s - PL_hexdigit) & 15); cp++; continue; @@ -174,1444 +181,41 @@ not_here(char *s) return -1; } -#define PERL_constant_NOTFOUND 1 -#define PERL_constant_NOTDEF 2 -#define PERL_constant_ISIV 3 -#define PERL_constant_ISNV 4 -#define PERL_constant_ISPV 5 -#define PERL_constant_ISPVN 6 -#define PERL_constant_ISUV 7 - -#ifndef NVTYPE -typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ -#endif - -static int -constant_5 (const char *name, IV *iv_return) { - /* Names all of length 5. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_NS PF_NS */ - /* Offset 0 gives the best switch position. */ - switch (name[0]) { - case 'A': - if (memEQ(name, "AF_NS", 5)) { - /* ^ */ -#ifdef AF_NS - *iv_return = AF_NS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "PF_NS", 5)) { - /* ^ */ -#ifdef PF_NS - *iv_return = PF_NS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_6 (const char *name, IV *iv_return) { - /* Names all of length 6. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_802 AF_DLI AF_LAT AF_MAX AF_NBS AF_NIT AF_OSI AF_PUP AF_SNA AF_X25 - PF_802 PF_DLI PF_LAT PF_MAX PF_NBS PF_NIT PF_OSI PF_PUP PF_SNA PF_X25 */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case '8': - if (memEQ(name, "AF_802", 6)) { - /* ^ */ -#ifdef AF_802 - *iv_return = AF_802; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_802", 6)) { - /* ^ */ -#ifdef PF_802 - *iv_return = PF_802; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "AF_DLI", 6)) { - /* ^ */ -#ifdef AF_DLI - *iv_return = AF_DLI; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_DLI", 6)) { - /* ^ */ -#ifdef PF_DLI - *iv_return = PF_DLI; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "AF_LAT", 6)) { - /* ^ */ -#ifdef AF_LAT - *iv_return = AF_LAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_LAT", 6)) { - /* ^ */ -#ifdef PF_LAT - *iv_return = PF_LAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'M': - if (memEQ(name, "AF_MAX", 6)) { - /* ^ */ -#ifdef AF_MAX - *iv_return = AF_MAX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_MAX", 6)) { - /* ^ */ -#ifdef PF_MAX - *iv_return = PF_MAX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "AF_NBS", 6)) { - /* ^ */ -#ifdef AF_NBS - *iv_return = AF_NBS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "AF_NIT", 6)) { - /* ^ */ -#ifdef AF_NIT - *iv_return = AF_NIT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_NBS", 6)) { - /* ^ */ -#ifdef PF_NBS - *iv_return = PF_NBS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_NIT", 6)) { - /* ^ */ -#ifdef PF_NIT - *iv_return = PF_NIT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "AF_OSI", 6)) { - /* ^ */ -#ifdef AF_OSI - *iv_return = AF_OSI; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_OSI", 6)) { - /* ^ */ -#ifdef PF_OSI - *iv_return = PF_OSI; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "AF_PUP", 6)) { - /* ^ */ -#ifdef AF_PUP - *iv_return = AF_PUP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_PUP", 6)) { - /* ^ */ -#ifdef PF_PUP - *iv_return = PF_PUP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "AF_SNA", 6)) { - /* ^ */ -#ifdef AF_SNA - *iv_return = AF_SNA; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_SNA", 6)) { - /* ^ */ -#ifdef PF_SNA - *iv_return = PF_SNA; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "AF_X25", 6)) { - /* ^ */ -#ifdef AF_X25 - *iv_return = AF_X25; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_X25", 6)) { - /* ^ */ -#ifdef PF_X25 - *iv_return = PF_X25; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_7 (const char *name, IV *iv_return) { - /* Names all of length 7. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_ECMA AF_INET AF_UNIX IOV_MAX MSG_EOF MSG_EOR MSG_FIN MSG_OOB MSG_RST - MSG_SYN MSG_URG PF_ECMA PF_INET PF_UNIX SHUT_RD SHUT_WR SO_TYPE */ - /* Offset 4 gives the best switch position. */ - switch (name[4]) { - case 'C': - if (memEQ(name, "AF_ECMA", 7)) { - /* ^ */ -#ifdef AF_ECMA - *iv_return = AF_ECMA; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_ECMA", 7)) { - /* ^ */ -#ifdef PF_ECMA - *iv_return = PF_ECMA; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "MSG_EOF", 7)) { - /* ^ */ -#ifdef MSG_EOF - *iv_return = MSG_EOF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "MSG_EOR", 7)) { - /* ^ */ -#ifdef MSG_EOR - *iv_return = MSG_EOR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "MSG_FIN", 7)) { - /* ^ */ -#ifdef MSG_FIN - *iv_return = MSG_FIN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'M': - if (memEQ(name, "IOV_MAX", 7)) { - /* ^ */ -#ifdef IOV_MAX - *iv_return = IOV_MAX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "AF_INET", 7)) { - /* ^ */ -#ifdef AF_INET - *iv_return = AF_INET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "AF_UNIX", 7)) { - /* ^ */ -#ifdef AF_UNIX - *iv_return = AF_UNIX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_INET", 7)) { - /* ^ */ -#ifdef PF_INET - *iv_return = PF_INET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_UNIX", 7)) { - /* ^ */ -#ifdef PF_UNIX - *iv_return = PF_UNIX; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "MSG_OOB", 7)) { - /* ^ */ -#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */ - *iv_return = MSG_OOB; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "MSG_RST", 7)) { - /* ^ */ -#ifdef MSG_RST - *iv_return = MSG_RST; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "MSG_SYN", 7)) { - /* ^ */ -#ifdef MSG_SYN - *iv_return = MSG_SYN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "MSG_URG", 7)) { - /* ^ */ -#ifdef MSG_URG - *iv_return = MSG_URG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'Y': - if (memEQ(name, "SO_TYPE", 7)) { - /* ^ */ -#ifdef SO_TYPE - *iv_return = SO_TYPE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case '_': - if (memEQ(name, "SHUT_RD", 7)) { - /* ^ */ -#ifdef SHUT_RD - *iv_return = SHUT_RD; - return PERL_constant_ISIV; -#else - *iv_return = 0; - return PERL_constant_ISIV; -#endif - } - if (memEQ(name, "SHUT_WR", 7)) { - /* ^ */ -#ifdef SHUT_WR - *iv_return = SHUT_WR; - return PERL_constant_ISIV; -#else - *iv_return = 1; - return PERL_constant_ISIV; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_8 (const char *name, IV *iv_return) { - /* Names all of length 8. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_CCITT AF_CHAOS AF_GOSIP MSG_PEEK PF_CCITT PF_CHAOS PF_GOSIP SOCK_RAW - SOCK_RDM SO_DEBUG SO_ERROR */ - /* Offset 7 gives the best switch position. */ - switch (name[7]) { - case 'G': - if (memEQ(name, "SO_DEBUG", 8)) { - /* ^ */ -#ifdef SO_DEBUG - *iv_return = SO_DEBUG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'K': - if (memEQ(name, "MSG_PEEK", 8)) { - /* ^ */ -#if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /* might be an enum */ - *iv_return = MSG_PEEK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'M': - if (memEQ(name, "SOCK_RDM", 8)) { - /* ^ */ -#ifdef SOCK_RDM - *iv_return = SOCK_RDM; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "AF_GOSIP", 8)) { - /* ^ */ -#ifdef AF_GOSIP - *iv_return = AF_GOSIP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_GOSIP", 8)) { - /* ^ */ -#ifdef PF_GOSIP - *iv_return = PF_GOSIP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SO_ERROR", 8)) { - /* ^ */ -#ifdef SO_ERROR - *iv_return = SO_ERROR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "AF_CHAOS", 8)) { - /* ^ */ -#ifdef AF_CHAOS - *iv_return = AF_CHAOS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_CHAOS", 8)) { - /* ^ */ -#ifdef PF_CHAOS - *iv_return = PF_CHAOS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "AF_CCITT", 8)) { - /* ^ */ -#ifdef AF_CCITT - *iv_return = AF_CCITT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_CCITT", 8)) { - /* ^ */ -#ifdef PF_CCITT - *iv_return = PF_CCITT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'W': - if (memEQ(name, "SOCK_RAW", 8)) { - /* ^ */ -#ifdef SOCK_RAW - *iv_return = SOCK_RAW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_9 (const char *name, IV *iv_return) { - /* Names all of length 9. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_DECnet AF_HYLINK AF_OSINET AF_UNSPEC MSG_BCAST MSG_MCAST MSG_PROXY - MSG_TRUNC PF_DECnet PF_HYLINK PF_OSINET PF_UNSPEC SCM_CREDS SHUT_RDWR - SOMAXCONN SO_LINGER SO_RCVBUF SO_SNDBUF TCP_MAXRT */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'A': - if (memEQ(name, "MSG_BCAST", 9)) { - /* ^ */ -#ifdef MSG_BCAST - *iv_return = MSG_BCAST; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "MSG_MCAST", 9)) { - /* ^ */ -#ifdef MSG_MCAST - *iv_return = MSG_MCAST; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'B': - if (memEQ(name, "SO_RCVBUF", 9)) { - /* ^ */ -#ifdef SO_RCVBUF - *iv_return = SO_RCVBUF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SO_SNDBUF", 9)) { - /* ^ */ -#ifdef SO_SNDBUF - *iv_return = SO_SNDBUF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "SHUT_RDWR", 9)) { - /* ^ */ -#ifdef SHUT_RDWR - *iv_return = SHUT_RDWR; - return PERL_constant_ISIV; -#else - *iv_return = 2; - return PERL_constant_ISIV; -#endif - } - break; - case 'E': - if (memEQ(name, "SCM_CREDS", 9)) { - /* ^ */ -#ifdef SCM_CREDS - *iv_return = SCM_CREDS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "SO_LINGER", 9)) { - /* ^ */ -#ifdef SO_LINGER - *iv_return = SO_LINGER; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "AF_HYLINK", 9)) { - /* ^ */ -#ifdef AF_HYLINK - *iv_return = AF_HYLINK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_HYLINK", 9)) { - /* ^ */ -#ifdef PF_HYLINK - *iv_return = PF_HYLINK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "AF_OSINET", 9)) { - /* ^ */ -#ifdef AF_OSINET - *iv_return = AF_OSINET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_OSINET", 9)) { - /* ^ */ -#ifdef PF_OSINET - *iv_return = PF_OSINET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "MSG_PROXY", 9)) { - /* ^ */ -#if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /* might be an enum */ - *iv_return = MSG_PROXY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SOMAXCONN", 9)) { - /* ^ */ -#ifdef SOMAXCONN - *iv_return = SOMAXCONN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "AF_UNSPEC", 9)) { - /* ^ */ -#ifdef AF_UNSPEC - *iv_return = AF_UNSPEC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_UNSPEC", 9)) { - /* ^ */ -#ifdef PF_UNSPEC - *iv_return = PF_UNSPEC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "MSG_TRUNC", 9)) { - /* ^ */ -#ifdef MSG_TRUNC - *iv_return = MSG_TRUNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "TCP_MAXRT", 9)) { - /* ^ */ -#ifdef TCP_MAXRT - *iv_return = TCP_MAXRT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'n': - if (memEQ(name, "AF_DECnet", 9)) { - /* ^ */ -#ifdef AF_DECnet - *iv_return = AF_DECnet; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_DECnet", 9)) { - /* ^ */ -#ifdef PF_DECnet - *iv_return = PF_DECnet; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_10 (const char *name, IV *iv_return) { - /* Names all of length 10. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_DATAKIT AF_IMPLINK MSG_CTRUNC PF_DATAKIT PF_IMPLINK SCM_RIGHTS - SOCK_DGRAM SOL_SOCKET TCP_MAXSEG TCP_STDURG UIO_MAXIOV */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'A': - if (memEQ(name, "AF_DATAKIT", 10)) { - /* ^ */ -#ifdef AF_DATAKIT - *iv_return = AF_DATAKIT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_DATAKIT", 10)) { - /* ^ */ -#ifdef PF_DATAKIT - *iv_return = PF_DATAKIT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'C': - if (memEQ(name, "SOL_SOCKET", 10)) { - /* ^ */ -#ifdef SOL_SOCKET - *iv_return = SOL_SOCKET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "TCP_STDURG", 10)) { - /* ^ */ -#ifdef TCP_STDURG - *iv_return = TCP_STDURG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "SCM_RIGHTS", 10)) { - /* ^ */ -#if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /* might be an enum */ - *iv_return = SCM_RIGHTS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SOCK_DGRAM", 10)) { - /* ^ */ -#ifdef SOCK_DGRAM - *iv_return = SOCK_DGRAM; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "AF_IMPLINK", 10)) { - /* ^ */ -#ifdef AF_IMPLINK - *iv_return = AF_IMPLINK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_IMPLINK", 10)) { - /* ^ */ -#ifdef PF_IMPLINK - *iv_return = PF_IMPLINK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "MSG_CTRUNC", 10)) { - /* ^ */ -#if defined(MSG_CTRUNC) || defined(HAS_MSG_CTRUNC) /* might be an enum */ - *iv_return = MSG_CTRUNC; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "TCP_MAXSEG", 10)) { - /* ^ */ -#ifdef TCP_MAXSEG - *iv_return = TCP_MAXSEG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "UIO_MAXIOV", 10)) { - /* ^ */ -#ifdef UIO_MAXIOV - *iv_return = UIO_MAXIOV; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_11 (const char *name, IV *iv_return) { - /* Names all of length 11. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - IPPROTO_TCP MSG_WAITALL SCM_CONNECT SOCK_STREAM SO_RCVLOWAT SO_RCVTIMEO - SO_SNDLOWAT SO_SNDTIMEO TCP_NODELAY */ - /* Offset 7 gives the best switch position. */ - switch (name[7]) { - case 'E': - if (memEQ(name, "TCP_NODELAY", 11)) { - /* ^ */ -#ifdef TCP_NODELAY - *iv_return = TCP_NODELAY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "SO_RCVTIMEO", 11)) { - /* ^ */ -#ifdef SO_RCVTIMEO - *iv_return = SO_RCVTIMEO; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SO_SNDTIMEO", 11)) { - /* ^ */ -#ifdef SO_SNDTIMEO - *iv_return = SO_SNDTIMEO; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SCM_CONNECT", 11)) { - /* ^ */ -#ifdef SCM_CONNECT - *iv_return = SCM_CONNECT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "SO_RCVLOWAT", 11)) { - /* ^ */ -#ifdef SO_RCVLOWAT - *iv_return = SO_RCVLOWAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SO_SNDLOWAT", 11)) { - /* ^ */ -#ifdef SO_SNDLOWAT - *iv_return = SO_SNDLOWAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SOCK_STREAM", 11)) { - /* ^ */ -#ifdef SOCK_STREAM - *iv_return = SOCK_STREAM; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "MSG_WAITALL", 11)) { - /* ^ */ -#ifdef MSG_WAITALL - *iv_return = MSG_WAITALL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case '_': - if (memEQ(name, "IPPROTO_TCP", 11)) { - /* ^ */ -#ifdef IPPROTO_TCP - *iv_return = IPPROTO_TCP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_12 (const char *name, IV *iv_return) { - /* Names all of length 12. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_APPLETALK MSG_CTLFLAGS MSG_DONTWAIT MSG_ERRQUEUE MSG_NOSIGNAL - PF_APPLETALK SO_BROADCAST SO_DONTROUTE SO_KEEPALIVE SO_OOBINLINE - SO_REUSEADDR SO_REUSEPORT */ - /* Offset 10 gives the best switch position. */ - switch (name[10]) { - case 'A': - if (memEQ(name, "MSG_NOSIGNAL", 12)) { - /* ^ */ -#ifdef MSG_NOSIGNAL - *iv_return = MSG_NOSIGNAL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "SO_REUSEADDR", 12)) { - /* ^ */ -#ifdef SO_REUSEADDR - *iv_return = SO_REUSEADDR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'G': - if (memEQ(name, "MSG_CTLFLAGS", 12)) { - /* ^ */ -#ifdef MSG_CTLFLAGS - *iv_return = MSG_CTLFLAGS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "MSG_DONTWAIT", 12)) { - /* ^ */ -#ifdef MSG_DONTWAIT - *iv_return = MSG_DONTWAIT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "AF_APPLETALK", 12)) { - /* ^ */ -#ifdef AF_APPLETALK - *iv_return = AF_APPLETALK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "PF_APPLETALK", 12)) { - /* ^ */ -#ifdef PF_APPLETALK - *iv_return = PF_APPLETALK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SO_OOBINLINE", 12)) { - /* ^ */ -#ifdef SO_OOBINLINE - *iv_return = SO_OOBINLINE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SO_REUSEPORT", 12)) { - /* ^ */ -#ifdef SO_REUSEPORT - *iv_return = SO_REUSEPORT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "SO_BROADCAST", 12)) { - /* ^ */ -#ifdef SO_BROADCAST - *iv_return = SO_BROADCAST; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "SO_DONTROUTE", 12)) { - /* ^ */ -#ifdef SO_DONTROUTE - *iv_return = SO_DONTROUTE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "MSG_ERRQUEUE", 12)) { - /* ^ */ -#ifdef MSG_ERRQUEUE - *iv_return = MSG_ERRQUEUE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'V': - if (memEQ(name, "SO_KEEPALIVE", 12)) { - /* ^ */ -#ifdef SO_KEEPALIVE - *iv_return = SO_KEEPALIVE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_13 (const char *name, IV *iv_return) { - /* Names all of length 13. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - MSG_CTLIGNORE MSG_DONTROUTE MSG_MAXIOVLEN SCM_TIMESTAMP SO_ACCEPTCONN - SO_DONTLINGER TCP_KEEPALIVE */ - /* Offset 5 gives the best switch position. */ - switch (name[5]) { - case 'A': - if (memEQ(name, "MSG_MAXIOVLEN", 13)) { - /* ^ */ -#ifdef MSG_MAXIOVLEN - *iv_return = MSG_MAXIOVLEN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'C': - if (memEQ(name, "SO_ACCEPTCONN", 13)) { - /* ^ */ -#ifdef SO_ACCEPTCONN - *iv_return = SO_ACCEPTCONN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "TCP_KEEPALIVE", 13)) { - /* ^ */ -#ifdef TCP_KEEPALIVE - *iv_return = TCP_KEEPALIVE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "SCM_TIMESTAMP", 13)) { - /* ^ */ -#ifdef SCM_TIMESTAMP - *iv_return = SCM_TIMESTAMP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SO_DONTLINGER", 13)) { - /* ^ */ -#ifdef SO_DONTLINGER - *iv_return = SO_DONTLINGER; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "MSG_DONTROUTE", 13)) { - /* ^ */ -#if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /* might be an enum */ - *iv_return = MSG_DONTROUTE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "MSG_CTLIGNORE", 13)) { - /* ^ */ -#ifdef MSG_CTLIGNORE - *iv_return = MSG_CTLIGNORE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_14 (const char *name, IV *iv_return) { - /* Names all of length 14. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SOCK_SEQPACKET SO_USELOOPBACK */ - /* Offset 8 gives the best switch position. */ - switch (name[8]) { - case 'O': - if (memEQ(name, "SO_USELOOPBACK", 14)) { - /* ^ */ -#ifdef SO_USELOOPBACK - *iv_return = SO_USELOOPBACK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "SOCK_SEQPACKET", 14)) { - /* ^ */ -#ifdef SOCK_SEQPACKET - *iv_return = SOCK_SEQPACKET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant (const char *name, STRLEN len, IV *iv_return) { - /* Initially switch on the length of the name. */ - /* When generated this function returned values for the list of names given - in this section of perl code. Rather than manually editing these functions - to add or remove constants, which would result in this comment and section - of code becoming inaccurate, we recommend that you edit this section of - code, and use it to regenerate a new set of constant functions which you - then use to replace the originals. - - Regenerate these constant functions by feeding this entire source file to - perl -x - -#!perl -w -use ExtUtils::Constant qw (constant_types C_constant XS_constant); - -my $types = {IV => 1}; -my @names = (qw(AF_802 AF_APPLETALK AF_CCITT AF_CHAOS AF_DATAKIT AF_DECnet - AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_LAT - AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP AF_SNA - AF_UNIX AF_UNSPEC AF_X25 IOV_MAX IPPROTO_TCP MSG_BCAST - MSG_CTLFLAGS MSG_CTLIGNORE MSG_DONTWAIT MSG_EOF MSG_EOR - MSG_ERRQUEUE MSG_FIN MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL - MSG_RST MSG_SYN MSG_TRUNC MSG_WAITALL PF_802 PF_APPLETALK - PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP - PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT PF_NS - PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25 - SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP SOCK_DGRAM - SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET - SOMAXCONN SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER - SO_DONTROUTE SO_ERROR SO_KEEPALIVE SO_LINGER SO_OOBINLINE - SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT - SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK - TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG TCP_NODELAY TCP_STDURG - UIO_MAXIOV MSG_URG), - {name=>"MSG_CTRUNC", type=>"IV", macro=>["#if defined(MSG_CTRUNC) || defined(HAS_MSG_CTRUNC) /" . "* might be an enum *" . "/\n", "#endif\n"]}, - {name=>"MSG_DONTROUTE", type=>"IV", macro=>["#if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /" . "* might be an enum *" . "/\n", "#endif\n"]}, - {name=>"MSG_OOB", type=>"IV", macro=>["#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /" . "* might be an enum *" . "/\n", "#endif\n"]}, - {name=>"MSG_PEEK", type=>"IV", macro=>["#if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /" . "* might be an enum *" . "/\n", "#endif\n"]}, - {name=>"MSG_PROXY", type=>"IV", macro=>["#if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /" . "* might be an enum *" . "/\n", "#endif\n"]}, - {name=>"SCM_RIGHTS", type=>"IV", macro=>["#if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /" . "* might be an enum *" . "/\n", "#endif\n"]}, - {name=>"SHUT_RD", type=>"IV", default=>["IV", "0"]}, - {name=>"SHUT_RDWR", type=>"IV", default=>["IV", "2"]}, - {name=>"SHUT_WR", type=>"IV", default=>["IV", "1"]}); - -print constant_types(); # macro defs -foreach (C_constant ("Socket", 'constant', 'IV', $types, undef, undef, @names) ) { - print $_, "\n"; # C constant subs -} -print "#### XS Section:\n"; -print XS_constant ("Socket", $types); -__END__ - */ - - switch (len) { - case 5: - return constant_5 (name, iv_return); - break; - case 6: - return constant_6 (name, iv_return); - break; - case 7: - return constant_7 (name, iv_return); - break; - case 8: - return constant_8 (name, iv_return); - break; - case 9: - return constant_9 (name, iv_return); - break; - case 10: - return constant_10 (name, iv_return); - break; - case 11: - return constant_11 (name, iv_return); - break; - case 12: - return constant_12 (name, iv_return); - break; - case 13: - return constant_13 (name, iv_return); - break; - case 14: - return constant_14 (name, iv_return); - break; - case 15: - if (memEQ(name, "SCM_CREDENTIALS", 15)) { -#ifdef SCM_CREDENTIALS - *iv_return = SCM_CREDENTIALS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - +#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 "constants.c" MODULE = Socket PACKAGE = Socket -void -constant(sv) - PREINIT: -#ifdef dXSTARG - dXSTARG; /* Faster if we have it. */ -#else - dTARGET; -#endif - STRLEN len; - int type; - IV iv; - /* NV nv; Uncomment this if you need to return NVs */ - /* const char *pv; Uncomment this if you need to return PVs */ - INPUT: - SV * sv; - const char * s = SvPV(sv, len); - PPCODE: - /* Change this to constant(s, len, &iv, &nv); - if you need to return both NVs and IVs */ - type = constant(s, len, &iv); - /* Return 1 or 2 items. First is error message, or undef if no error. - Second, if present, is found value */ - switch (type) { - case PERL_constant_NOTFOUND: - sv = sv_2mortal(newSVpvf("%s is not a valid Socket macro", s)); - PUSHs(sv); - break; - case PERL_constant_NOTDEF: - sv = sv_2mortal(newSVpvf( - "Your vendor has not defined Socket macro %s, used", s)); - PUSHs(sv); - break; - case PERL_constant_ISIV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHi(iv); - break; - /* Uncomment this if you need to return UVs - case PERL_constant_ISUV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHu((UV)iv); - break; */ - default: - sv = sv_2mortal(newSVpvf( - "Unexpected return type %d while processing Socket macro %s used", - type, s)); - PUSHs(sv); - } +INCLUDE: constants.xs void inet_aton(host) @@ -1620,7 +224,10 @@ inet_aton(host) { struct in_addr ip_address; struct hostent * phe; - int ok = inet_aton(host, &ip_address); + 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 ); @@ -1628,10 +235,9 @@ inet_aton(host) } ST(0) = sv_newmortal(); - if (ok) { + if (ok) sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address ); } - } void inet_ntoa(ip_address_sv) @@ -1641,18 +247,46 @@ inet_ntoa(ip_address_sv) STRLEN addrlen; struct in_addr addr; char * addr_str; - char * ip_address = SvPV(ip_address_sv,addrlen); - if (addrlen != sizeof(addr)) { - croak("Bad arg length for %s, length is %d, should be %d", - "Socket::inet_ntoa", - addrlen, sizeof(addr)); + 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. */ + New(1138, addr_str, 4 * 3 + 3 + 1, char); + 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); } - Copy( ip_address, &addr, sizeof addr, char ); - addr_str = inet_ntoa(addr); - - ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(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) @@ -1675,7 +309,7 @@ pack_sockaddr_un(pathname) if (pathname[0] != '/' && pathname[0] != '\\') croak("Relative UNIX domain socket name '%s' unsupported", pathname); - else if (len < 8 + else if (len < 8 || pathname[7] != '/' && pathname[7] != '\\' || !strnicmp(pathname + 1, "socket", 6)) off = 7; @@ -1690,9 +324,10 @@ pack_sockaddr_un(pathname) if (*s = '/') *s = '\\'; } -# else /* !( defined OS2 ) */ +# else /* !( defined OS2 ) */ Copy( pathname, 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"); @@ -1708,7 +343,7 @@ unpack_sockaddr_un(sun_sv) #ifdef I_SYS_UN struct sockaddr_un addr; STRLEN sockaddrlen; - char * sun_ad = SvPV(sun_sv,sockaddrlen); + char * sun_ad = SvPVbyte(sun_sv,sockaddrlen); char * e; # ifndef __linux__ /* On Linux sockaddrlen on sockets returned by accept, recvfrom, @@ -1738,18 +373,32 @@ unpack_sockaddr_un(sun_sv) } void -pack_sockaddr_in(port,ip_address) +pack_sockaddr_in(port, ip_address_sv) unsigned short port - char * ip_address + 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); - Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char ); - + sin.sin_addr.s_addr = htonl(addr.s_addr); ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin)); } @@ -1761,8 +410,8 @@ unpack_sockaddr_in(sin_sv) STRLEN sockaddrlen; struct sockaddr_in addr; unsigned short port; - struct in_addr ip_address; - char * sin = SvPV(sin_sv,sockaddrlen); + 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", @@ -1774,47 +423,11 @@ unpack_sockaddr_in(sin_sv) "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))); - } - -void -INADDR_ANY() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_ANY); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); - } - -void -INADDR_LOOPBACK() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_LOOPBACK); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); - } - -void -INADDR_NONE() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_NONE); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); - } - -void -INADDR_BROADCAST() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_BROADCAST); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); + PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof ip_address))); }