File: miniSocketXS.c

package info (click to toggle)
libnet-interface-perl 1.016-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 1,252 kB
  • ctags: 478
  • sloc: ansic: 3,397; sh: 2,736; perl: 888; makefile: 3
file content (130 lines) | stat: -rw-r--r-- 5,114 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

 # 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);
	}