# This file is excerpted from perl-5.8.0/ext/Socket/Socket.xs and
# modified slightly so that it compiles on older versions of perl/gcc
#
# 3/28/06 version 1.78 of Socket.xs, included in perl 5.9.3
# is 100% compatible with this version
#
# Copyright 2003 - 2006, Michael Robinton <michael@bizsystems.com
#
# This program is free software; you can redistribute it and/or modify
# it under the same license and provisions as perl.
#
#ifndef Newx
#define Newx(v,n,t) New(1138,v,n,t)
#endif
#########################################################################
# Perl Kit, Version 5
#
# Copyright 1989-2002, Larry Wall
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
#
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
#
# b) the "Artistic License" which comes with this Kit.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
#
# You should have received a copy of the Artistic License with this
# Kit, in the file named "Artistic". If not, I'll be glad to provide one.
#
# You should also have received a copy of the GNU General Public License
# along with this program in the file named "Copying". If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307, USA or visit their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.
#
# For those of you that choose to use the GNU General Public License,
# my interpretation of the GNU General Public License is that no Perl
# script falls under the terms of the GPL unless you explicitly put
# said script under the terms of the GPL yourself. Furthermore, any
# object code linked with perl does not automatically fall under the
# terms of the GPL, provided such object code only adds definitions
# of subroutines and variables, and does not otherwise impair the
# resulting interpreter from executing any standard Perl script. I
# consider linking in C subroutines in this manner to be the moral
# equivalent of defining subroutines in the Perl language itself. You
# may sell such an object file as proprietary provided that you provide
# or offer to provide the Perl source, as specified by the GNU General
# Public License. (This is merely an alternate way of specifying input
# to the program.) You may also sell a binary produced by the dumping of
# a running Perl script that belongs to you, provided that you provide or
# offer to provide the Perl source as specified by the GPL. (The
# fact that a Perl interpreter and your code are in the same binary file
# is, in this case, a form of mere aggregation.) This is my interpretation
# of the GPL. If you still have concerns or difficulties understanding
# my intent, feel free to contact me. Of course, the Artistic License
# spells all this out for your protection, so you may prefer to use that.
#
#include <netdb.h>
void
yinet_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;
# sigh.... these lines fail on older perl/gcc combinations
# 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);
ip_address = SvPV(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",
"NetAddr::IP::Util::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(). */
Newx(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);
}