/*
# This file is excerpeted from perl-5.8.0/ext/Socket/Socket.xs
# and pruned for just what is needed for use in this module
#
# Copyright 2003, 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.
#
#########################################################################
# 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.
#
*/
#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 */