1
2 # This file is excerpted from perl-5.8.0/ext/Socket/Socket.xs and
3 # modified slightly so that it compiles on older versions of perl/gcc
4 #
5 # 3/28/06 version 1.78 of Socket.xs, included in perl 5.9.3
6 # is 100% compatible with this version
7 #
8 # Copyright 2003 - 2006, Michael Robinton <michael@bizsystems.com
9 #
10 # This program is free software; you can redistribute it and/or modify
11 # it under the same license and provisions as perl.
12 #
13
14 #ifndef Newx
15 #define Newx(v,n,t) New(1138,v,n,t)
16 #endif
17
18 #########################################################################
19 # Perl Kit, Version 5
20 #
21 # Copyright 1989-2002, Larry Wall
22 # All rights reserved.
23 #
24 # This program is free software; you can redistribute it and/or modify
25 # it under the terms of either:
26 #
27 # a) the GNU General Public License as published by the Free
28 # Software Foundation; either version 1, or (at your option) any
29 # later version, or
30 #
31 # b) the "Artistic License" which comes with this Kit.
32 #
33 # This program is distributed in the hope that it will be useful,
34 # but WITHOUT ANY WARRANTY; without even the implied warranty of
35 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
36 # the GNU General Public License or the Artistic License for more details.
37 #
38 # You should have received a copy of the Artistic License with this
39 # Kit, in the file named "Artistic". If not, I'll be glad to provide one.
40 #
41 # You should also have received a copy of the GNU General Public License
42 # along with this program in the file named "Copying". If not, write to the
43 # Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
44 # 02111-1307, USA or visit their web page on the internet at
45 # http://www.gnu.org/copyleft/gpl.html.
46 #
47 # For those of you that choose to use the GNU General Public License,
48 # my interpretation of the GNU General Public License is that no Perl
49 # script falls under the terms of the GPL unless you explicitly put
50 # said script under the terms of the GPL yourself. Furthermore, any
51 # object code linked with perl does not automatically fall under the
52 # terms of the GPL, provided such object code only adds definitions
53 # of subroutines and variables, and does not otherwise impair the
54 # resulting interpreter from executing any standard Perl script. I
55 # consider linking in C subroutines in this manner to be the moral
56 # equivalent of defining subroutines in the Perl language itself. You
57 # may sell such an object file as proprietary provided that you provide
58 # or offer to provide the Perl source, as specified by the GNU General
59 # Public License. (This is merely an alternate way of specifying input
60 # to the program.) You may also sell a binary produced by the dumping of
61 # a running Perl script that belongs to you, provided that you provide or
62 # offer to provide the Perl source as specified by the GPL. (The
63 # fact that a Perl interpreter and your code are in the same binary file
64 # is, in this case, a form of mere aggregation.) This is my interpretation
65 # of the GPL. If you still have concerns or difficulties understanding
66 # my intent, feel free to contact me. Of course, the Artistic License
67 # spells all this out for your protection, so you may prefer to use that.
68 #
69
70 #include <netdb.h>
71
72 void
yinet_aton(host)73 yinet_aton(host)
74 char * host
75 CODE:
76 {
77 struct in_addr ip_address;
78 struct hostent * phe;
79 int ok =
80 (host != NULL) &&
81 (*host != '\0') &&
82 inet_aton(host, &ip_address);
83
84 if (!ok && (phe = gethostbyname(host))) {
85 Copy( phe->h_addr, &ip_address, phe->h_length, char );
86 ok = 1;
87 }
88
89 ST(0) = sv_newmortal();
90 if (ok)
91 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
92 }
93
94 void
95 inet_ntoa(ip_address_sv)
96 SV * ip_address_sv
97 CODE:
98 {
99 STRLEN addrlen;
100 struct in_addr addr;
101 char * addr_str;
102 char * ip_address;
103 # sigh.... these lines fail on older perl/gcc combinations
104 # if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
105 # croak("Wide character in Socket::inet_ntoa");
106 # ip_address = SvPVbyte(ip_address_sv, addrlen);
107 ip_address = SvPV(ip_address_sv,addrlen);
108 if (addrlen == sizeof(addr) || addrlen == 4)
109 addr.s_addr =
110 (ip_address[0] & 0xFF) << 24 |
111 (ip_address[1] & 0xFF) << 16 |
112 (ip_address[2] & 0xFF) << 8 |
113 (ip_address[3] & 0xFF);
114 else
115 croak("Bad arg length for %s, length is %d, should be %d",
116 "NetAddr::IP::Util::inet_ntoa",
117 addrlen, sizeof(addr));
118 /* We could use inet_ntoa() but that is broken
119 * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
120 * so let's use this sprintf() workaround everywhere.
121 * This is also more threadsafe than using inet_ntoa(). */
122 Newx(addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */
123 sprintf(addr_str, "%d.%d.%d.%d",
124 ((addr.s_addr >> 24) & 0xFF),
125 ((addr.s_addr >> 16) & 0xFF),
126 ((addr.s_addr >> 8) & 0xFF),
127 ( addr.s_addr & 0xFF));
128 ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
129 Safefree(addr_str);
130 }
131