Socket

 view release on metacpan or  search on metacpan

Socket.xs  view on Meta::CPAN

            const int maxlen = (int)sizeof(addr.sun_path);
#   endif
            while (addr_len < maxlen && addr.sun_path[addr_len])
                addr_len++;
        }

        ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
#else
        ST(0) = not_here("unpack_sockaddr_un");
#endif
    }

void
pack_sockaddr_in(port_sv, ip_address_sv)
        SV *    port_sv
        SV *    ip_address_sv
    CODE:
    {
        struct sockaddr_in sin;
        struct in_addr addr;
        STRLEN addrlen;
        unsigned short port = 0;
        char * ip_address;

        SvGETMAGIC(port_sv);
        if (SvOK(port_sv)) {
            port = SvUV_nomg(port_sv);
            if (SvUV_nomg(port_sv) > 0xFFFF)
                warn("Port number above 0xFFFF, will be truncated to %d for %s",
                        port, "Socket::pack_sockaddr_in");
        }

        SvGETMAGIC(ip_address_sv);
        if (!SvOK(ip_address_sv))
            croak("Undefined address for %s", "Socket::pack_sockaddr_in");
        ip_address = SvPVbyte_nomg(ip_address_sv, addrlen);
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
            croak("Wide character in %s", "Socket::pack_sockaddr_in");
        if (addrlen == sizeof(addr) || addrlen == 4)
            addr.s_addr =
                (unsigned int)(ip_address[0] & 0xFF) << 24 |
                (unsigned int)(ip_address[1] & 0xFF) << 16 |
                (unsigned int)(ip_address[2] & 0xFF) <<  8 |
                (unsigned int)(ip_address[3] & 0xFF);
        else
            croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf,
                    "Socket::pack_sockaddr_in", (UV)addrlen, (UV)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);
#  ifdef HAS_SOCKADDR_SA_LEN
        sin.sin_len = sizeof(sin);
#  endif
        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;
        SV *ip_address_sv;
        char * sin;
        if (!SvOK(sin_sv))
            croak("Undefined address for %s", "Socket::unpack_sockaddr_in");
        sin = SvPVbyte(sin_sv,sockaddrlen);
        if (sockaddrlen != sizeof(addr)) {
            croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf,
                  "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)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);
        }
        ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr));

        if(GIMME_V == G_LIST) {
            EXTEND(SP, 2);
            mPUSHi(ntohs(addr.sin_port));
            mPUSHs(ip_address_sv);
        }
        else {
            mPUSHs(ip_address_sv);
        }
    }

void
pack_sockaddr_in6(port_sv, sin6_addr, scope_id=0, flowinfo=0)
        SV *    port_sv
        SV *    sin6_addr
        unsigned long   scope_id
        unsigned long   flowinfo
    CODE:
    {
#ifdef HAS_SOCKADDR_IN6
        unsigned short port = 0;
        struct sockaddr_in6 sin6;
        char * addrbytes;
        STRLEN addrlen;

        SvGETMAGIC(port_sv);
        if (SvOK(port_sv)) {
            port = SvUV_nomg(port_sv);
            if (SvUV_nomg(port_sv) > 0xFFFF)
                warn("Port number above 0xFFFF, will be truncated to %d for %s",
                        port, "Socket::pack_sockaddr_in6");
        }

        SvGETMAGIC(sin6_addr);
        if (!SvOK(sin6_addr))
            croak("Undefined address for %s", "Socket::pack_sockaddr_in6");
        addrbytes = SvPVbyte_nomg(sin6_addr, addrlen);
        if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
            croak("Wide character in %s", "Socket::pack_sockaddr_in6");
        if (addrlen != sizeof(sin6.sin6_addr))
            croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                    "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
        Zero(&sin6, sizeof(sin6), char);
        sin6.sin6_family = AF_INET6;
        sin6.sin6_port = htons(port);
        sin6.sin6_flowinfo = htonl(flowinfo);
        Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
#  ifdef HAS_SIN6_SCOPE_ID
        sin6.sin6_scope_id = scope_id;
#  else
        if (scope_id != 0)
            warn("%s cannot represent non-zero scope_id %d",
                 "Socket::pack_sockaddr_in6", scope_id);
#  endif
#  ifdef HAS_SOCKADDR_SA_LEN
        sin6.sin6_len = sizeof(sin6);
#  endif
        ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
#else
        PERL_UNUSED_VAR(port_sv);
        PERL_UNUSED_VAR(sin6_addr);
        ST(0) = not_here("pack_sockaddr_in6");
#endif
    }

void
unpack_sockaddr_in6(sin6_sv)
        SV *    sin6_sv
        PPCODE:
        {
#ifdef HAS_SOCKADDR_IN6
        STRLEN addrlen;
        struct sockaddr_in6 sin6;
        char * addrbytes;
        SV *ip_address_sv;
        if (!SvOK(sin6_sv))
                croak("Undefined address for %s", "Socket::unpack_sockaddr_in6");
        addrbytes = SvPVbyte(sin6_sv, addrlen);
        if (addrlen != sizeof(sin6))
                croak("Bad arg length for %s, length is %" UVuf
                      ", should be %" UVuf,
                      "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6));
        Copy(addrbytes, &sin6, sizeof(sin6), char);
        if (sin6.sin6_family != AF_INET6)
                croak("Bad address family for %s, got %d, should be %d",
                      "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6);
        ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));

        if(GIMME_V == G_LIST) {
            EXTEND(SP, 4);
            mPUSHi(ntohs(sin6.sin6_port));
            mPUSHs(ip_address_sv);
#  ifdef HAS_SIN6_SCOPE_ID
            mPUSHi(sin6.sin6_scope_id);
#  else
            mPUSHi(0);
#  endif
            mPUSHi(ntohl(sin6.sin6_flowinfo));
        }
        else {
            mPUSHs(ip_address_sv);
        }
#else
        PERL_UNUSED_VAR(sin6_sv);
        ST(0) = not_here("pack_sockaddr_in6");
#endif
        }

void
inet_ntop(af, ip_address_sv)
        int     af
        SV *    ip_address_sv
    CODE:
    {
#ifdef HAS_INETNTOP
        STRLEN addrlen;
#ifdef AF_INET6
        struct in6_addr addr;
        char str[INET6_ADDRSTRLEN];
#else
        struct in_addr addr;
        char str[INET_ADDRSTRLEN];
#endif
        char *ip_address;

        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
            croak("Wide character in %s", "Socket::inet_ntop");

        ip_address = SvPVbyte(ip_address_sv, addrlen);

Socket.xs  view on Meta::CPAN


        ST(0) = sv_newmortal();
        if (ok) {
                sv_setpvn( ST(0), (char *)&ip_address, addrlen);
        }
#else
        PERL_UNUSED_VAR(af);
        PERL_UNUSED_VAR(host);
        ST(0) = not_here("inet_pton");
#endif
    }

void
pack_ip_mreq(multiaddr, interface=&PL_sv_undef)
        SV *    multiaddr
        SV *    interface
    CODE:
    {
#ifdef HAS_IP_MREQ
        struct ip_mreq mreq;
        char * multiaddrbytes;
        char * interfacebytes;

        {
            if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
                croak("Wide character in %s", "Socket::pack_ip_mreq");

            STRLEN len;
            multiaddrbytes = SvPVbyte(multiaddr, len);
            if (len != sizeof(mreq.imr_multiaddr))
                croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                        "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
        }

        Zero(&mreq, sizeof(mreq), char);
        Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
        if(SvOK(interface)) {
            if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
                croak("Wide character in %s", "Socket::pack_ip_mreq");

            STRLEN len;
            interfacebytes = SvPVbyte(interface, len);
            if (len != sizeof(mreq.imr_interface))
                croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                        "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));

            Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
        }
        else
            mreq.imr_interface.s_addr = INADDR_ANY;

        ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
#else
        not_here("pack_ip_mreq");
#endif
    }

void
unpack_ip_mreq(mreq_sv)
        SV * mreq_sv
    PPCODE:
    {
#ifdef HAS_IP_MREQ
        struct ip_mreq mreq;
        STRLEN mreqlen;
        char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
        if (mreqlen != sizeof(mreq))
            croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf,
                    "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq));
        Copy(mreqbytes, &mreq, sizeof(mreq), char);
        EXTEND(SP, 2);
        mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
        mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
#else
        not_here("unpack_ip_mreq");
#endif
    }

void
pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef)
        SV *    multiaddr
        SV *    source
        SV *    interface
    CODE:
    {
#if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
        struct ip_mreq_source mreq;
        char * multiaddrbytes;
        char * sourcebytes;
        char * interfacebytes;

        {
            if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
                croak("Wide character in %s", "Socket::pack_ip_mreq_source");

            STRLEN len;
            multiaddrbytes = SvPVbyte(multiaddr, len);
            if (len != sizeof(mreq.imr_multiaddr))
                croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                        "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
        }

        {
            if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1))
                croak("Wide character in %s", "Socket::pack_ip_mreq_source");

            STRLEN len;
            sourcebytes = SvPVbyte(source, len);
            if (len != sizeof(mreq.imr_sourceaddr))
                croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                        "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr));
        }

        Zero(&mreq, sizeof(mreq), char);
        Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
        Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char);

        if(SvOK(interface)) {
            if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
                croak("Wide character in %s", "Socket::pack_ip_mreq");

            STRLEN len;
            interfacebytes = SvPVbyte(interface, len);
            if (len != sizeof(mreq.imr_interface))
                croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                        "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
            Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
        }
        else
            mreq.imr_interface.s_addr = INADDR_ANY;

        ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
#else
        PERL_UNUSED_VAR(multiaddr);
        PERL_UNUSED_VAR(source);
        not_here("pack_ip_mreq_source");
#endif
    }

void
unpack_ip_mreq_source(mreq_sv)
        SV * mreq_sv
    PPCODE:
    {
#if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
        struct ip_mreq_source mreq;
        STRLEN mreqlen;
        char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
        if (mreqlen != sizeof(mreq))
            croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf,
                    "Socket::unpack_ip_mreq_source", (UV)mreqlen, (UV)sizeof(mreq));
        Copy(mreqbytes, &mreq, sizeof(mreq), char);
        EXTEND(SP, 3);
        mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
        mPUSHp((char *)&mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr));
        mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
#else
        PERL_UNUSED_VAR(mreq_sv);
        not_here("unpack_ip_mreq_source");
#endif
    }

void
pack_ipv6_mreq(multiaddr, ifindex)
        SV *    multiaddr
        unsigned int    ifindex
    CODE:
    {
#ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
        char * multiaddrbytes;

        {
            if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
                croak("Wide character in %s", "Socket::pack_ipv6_mreq");

            STRLEN len;
            multiaddrbytes = SvPVbyte(multiaddr, len);
            if (len != sizeof(mreq.ipv6mr_multiaddr))
                croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf,
                        "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr));
        }

        Zero(&mreq, sizeof(mreq), char);
        Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
        mreq.ipv6mr_interface = ifindex;

        ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
#else
        PERL_UNUSED_VAR(multiaddr);
        PERL_UNUSED_VAR(ifindex);
        not_here("pack_ipv6_mreq");
#endif
    }

void
unpack_ipv6_mreq(mreq_sv)
        SV * mreq_sv
    PPCODE:
    {
#ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
        STRLEN mreqlen;
        char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
        if (mreqlen != sizeof(mreq))
            croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf,
                    "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
        Copy(mreqbytes, &mreq, sizeof(mreq), char);
        EXTEND(SP, 2);
        mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
        mPUSHi(mreq.ipv6mr_interface);
#else
        PERL_UNUSED_VAR(mreq_sv);
        not_here("unpack_ipv6_mreq");
#endif
    }



( run in 1.663 second using v1.01-cache-2.11-cpan-5511b514fd6 )