Codebase list libio-interface-perl / upstream/latest
Imported Upstream version 1.09 Salvatore Bonaccorso 8 years ago
15 changed file(s) with 1778 addition(s) and 1493 deletion(s). Raw diff Collapse all Expand all
+26
-0
Build.PL less more
0 #!/usr/bin/perl
1
2 use strict;
3 use Module::Build;
4
5 my $build = Module::Build->new(
6 module_name => 'IO::Interface',
7 dist_version_from => 'lib/IO/Interface.pm',
8 dist_author => 'Lincoln Stein <lincoln.stein@gmail.com>',
9 dist_abstract => 'Access and modify network interface card configuration',
10 license => 'perl',
11 build_requires => {
12 'ExtUtils::CBuilder' => 0,
13 },
14 requires => {
15 'perl' => '5.005',
16 },
17 );
18
19 $build->create_build_script();
20
21 # get rid of annoying warning from ExtUtils::ParseXS
22 my $sub = 's/\$\^W\s*=\s*1/\$^W = 0/';
23 system "perl -pi -e '$sub' Build";
24
25 exit 0;
+21
-14
Changes less more
00 Revision history for Perl extension IO::Interface.
1 1.09 Tue Dec 9 11:22:56 EST 2014
2 -Converted to use Module::Build
3
4 1.08 Mon Dec 8 10:38:42 EST 2014
5 -First Git version
6 -Apply segfault patches for OpenBSD from Mikolaj Kucharski.
7
18 1.07 Sun Jun 8 21:29:58 EDT 2014
2 Apply patch from Miolaj Kucharski to fix segfault on OpenBSD.
9 -Apply patch from Miolaj Kucharski to fix segfault on OpenBSD.
310
411 1.06 Thu Jul 21 13:40:49 EDT 2011
5 Address test 5 failure on systems with aliases on loopback.
12 -Address test 5 failure on systems with aliases on loopback.
613
714 1.05 Fri Jun 6 11:53:21 EDT 2008
8 Fix from Mitsuru Yoshida to compile on FreeBSD.
15 -Fix from Mitsuru Yoshida to compile on FreeBSD.
916
1017 1.04 Wed Dec 26 13:38:53 EST 2007
11 Fix from John Lightsey to avoid dmesg warnings on BSD systems.
18 -Fix from John Lightsey to avoid dmesg warnings on BSD systems.
1219
1320 1.03 Mon Jan 22 16:38:24 EST 2007
14 Fix to compile cleanly on solaris systems.
21 -Fix to compile cleanly on solaris systems.
1522
1623 1.02 Thu Sep 14 08:54:04 EDT 2006
17 More documentation fixes.
24 -More documentation fixes.
1825
1926 1.01 Wed Sep 13 20:52:32 EDT 2006
20 Documentation fix.
27 -Documentation fix.
2128
2229 1.00 Wed Sep 13 17:01:46 EDT 2006
23 Introduced IO::Interface::Simple.
24 Added index methods.
25 Compiles on CygWin.
30 -Introduced IO::Interface::Simple.
31 -Added index methods.
32 -Compiles on CygWin.
2633
2734 0.98 Sep 03 18:20:20 EST 2003
28 Fixed minor documentation error.
35 -Fixed minor documentation error.
2936
3037 0.97 May 14 16:50:46 EDT 2001
31 BSD portability fixes from Anton Berezin <tobez@tobez.org> and Jan L. Peterson <jlp@flipdog.com>
38 -BSD portability fixes from Anton Berezin <tobez@tobez.org> and Jan L. Peterson <jlp@flipdog.com>
3239
3340 0.96 May 7 10:44:48 EDT 2001
34 Documentation fixes
41 -Documentation fixes
3542
3643 0.94 July 17, 2000
37 Added the addr_to_interface function, and the pseudo device "any"
44 -Added the addr_to_interface function, and the pseudo device "any"
3845 which corresponds to INADDR_ANY
3946
4047 0.90 First release
+0
-279
Interface/Simple.pm less more
0 package IO::Interface::Simple;
1 use strict;
2 use IO::Socket;
3 use IO::Interface;
4
5 use overload '""' => \&as_string,
6 eq => '_eq_',
7 fallback => 1;
8
9 # class variable
10 my $socket;
11
12 # class methods
13 sub interfaces {
14 my $class = shift;
15 my $s = $class->sock;
16 return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list;
17 }
18
19 sub new {
20 my $class = shift;
21 my $if_name = shift;
22 my $s = $class->sock;
23 return unless defined $s->if_mtu($if_name);
24 return bless {s => $s,
25 name => $if_name},ref $class || $class;
26 }
27
28 sub new_from_address {
29 my $class = shift;
30 my $addr = shift;
31 my $s = $class->sock;
32 my $name = $s->addr_to_interface($addr) or return;
33 return $class->new($name);
34 }
35
36 sub new_from_index {
37 my $class = shift;
38 my $index = shift;
39 my $s = $class->sock;
40 my $name = $s->if_indextoname($index) or return;
41 return $class->new($name);
42 }
43
44 sub sock {
45 my $self = shift;
46 if (ref $self) {
47 return $self->{s} ||= $socket;
48 } else {
49 return $socket ||= IO::Socket::INET->new(Proto=>'udp');
50 }
51 }
52
53 sub _eq_ {
54 return shift->name eq shift;
55 }
56
57 sub as_string {
58 shift->name;
59 }
60
61 sub name {
62 shift->{name};
63 }
64
65 sub address {
66 my $self = shift;
67 $self->sock->if_addr($self->name,@_);
68 }
69
70 sub broadcast {
71 my $self = shift;
72 $self->sock->if_broadcast($self->name,@_);
73 }
74
75 sub netmask {
76 my $self = shift;
77 $self->sock->if_netmask($self->name,@_);
78 }
79
80 sub dstaddr {
81 my $self = shift;
82 $self->sock->if_dstaddr($self->name,@_);
83 }
84
85 sub hwaddr {
86 my $self = shift;
87 $self->sock->if_hwaddr($self->name,@_);
88 }
89
90 sub flags {
91 my $self = shift;
92 $self->sock->if_flags($self->name,@_);
93 }
94
95 sub mtu {
96 my $self = shift;
97 $self->sock->if_mtu($self->name,@_);
98 }
99
100 sub metric {
101 my $self = shift;
102 $self->sock->if_metric($self->name,@_);
103 }
104
105 sub index {
106 my $self = shift;
107 return $self->sock->if_index($self->name);
108 }
109
110 sub is_running { shift->_gettestflag(IO::Interface::IFF_RUNNING(),@_) }
111 sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(),@_) }
112 sub is_pt2pt { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(),@_) }
113 sub is_loopback { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(),@_) }
114 sub is_promiscuous { shift->_gettestflag(IO::Interface::IFF_PROMISC(),@_) }
115 sub is_multicast { shift->_gettestflag(IO::Interface::IFF_MULTICAST(),@_) }
116 sub is_notrailers { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(),@_) }
117 sub is_noarp { shift->_gettestflag(IO::Interface::IFF_NOARP(),@_) }
118
119 sub _gettestflag {
120 my $self = shift;
121 my $bitmask = shift;
122 my $flags = $self->flags;
123 if (@_) {
124 $flags |= $bitmask;
125 $self->flags($flags);
126 } else {
127 return ($flags & $bitmask) != 0;
128 }
129 }
130
131 1;
132
133 =head1 NAME
134
135 IO::Interface::Simple - Perl extension for access to network card configuration information
136
137 =head1 SYNOPSIS
138
139 use IO::Interface::Simple;
140
141 my $if1 = IO::Interface::Simple->new('eth0');
142 my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1');
143 my $if3 = IO::Interface::Simple->new_from_index(1);
144
145 my @interfaces = IO::Interface::Simple->interfaces;
146
147 for my $if (@interfaces) {
148 print "interface = $if\n";
149 print "addr = ",$if->address,"\n",
150 "broadcast = ",$if->broadcast,"\n",
151 "netmask = ",$if->netmask,"\n",
152 "dstaddr = ",$if->dstaddr,"\n",
153 "hwaddr = ",$if->hwaddr,"\n",
154 "mtu = ",$if->mtu,"\n",
155 "metric = ",$if->metric,"\n",
156 "index = ",$if->index,"\n";
157
158 print "is running\n" if $if->is_running;
159 print "is broadcast\n" if $if->is_broadcast;
160 print "is p-to-p\n" if $if->is_pt2pt;
161 print "is loopback\n" if $if->is_loopback;
162 print "is promiscuous\n" if $if->is_promiscuous;
163 print "is multicast\n" if $if->is_multicast;
164 print "is notrailers\n" if $if->is_notrailers;
165 print "is noarp\n" if $if->is_noarp;
166 }
167
168
169 =head1 DESCRIPTION
170
171 IO::Interface::Simple allows you to interrogate and change network
172 interfaces. It has overlapping functionality with Net::Interface, but
173 might compile and run on more platforms.
174
175 =head2 Class Methods
176
177 =over 4
178
179 =item $interface = IO::Interface::Simple->new('eth0')
180
181 Given an interface name, new() creates an interface object.
182
183 =item @iflist = IO::Interface::Simple->interfaces;
184
185 Returns a list of active interface objects.
186
187 =item $interface = IO::Interface::Simple->new_from_address('192.168.0.1')
188
189 Returns the interface object corresponding to the given address.
190
191 =item $interface = IO::Interface::Simple->new_from_index(2)
192
193 Returns the interface object corresponding to the given numeric
194 index. This is only supported on BSD-ish platforms.
195
196 =back
197
198 =head2 Object Methods
199
200 =over 4
201
202 =item $name = $interface->name
203
204 Get the name of the interface. The interface object is also overloaded
205 so that if you use it in a string context it is the same as calling
206 name().
207
208 =item $index = $interface->index
209
210 Get the index of the interface. This is only supported on BSD-like
211 platforms.
212
213 =item $addr = $interface->address([$newaddr])
214
215 Get or set the interface's address.
216
217
218 =item $addr = $interface->broadcast([$newaddr])
219
220 Get or set the interface's broadcast address.
221
222 =item $addr = $interface->netmask([$newmask])
223
224 Get or set the interface's netmask.
225
226 =item $addr = $interface->hwaddr([$newaddr])
227
228 Get or set the interface's hardware address.
229
230 =item $addr = $interface->mtu([$newmtu])
231
232 Get or set the interface's MTU.
233
234 =item $addr = $interface->metric([$newmetric])
235
236 Get or set the interface's metric.
237
238 =item $flags = $interface->flags([$newflags])
239
240 Get or set the interface's flags. These can be ANDed with the IFF
241 constants exported by IO::Interface or Net::Interface in order to
242 interrogate the state and capabilities of the interface. However, it
243 is probably more convenient to use the broken-out methods listed
244 below.
245
246 =item $flag = $interface->is_running([$newflag])
247
248 =item $flag = $interface->is_broadcast([$newflag])
249
250 =item $flag = $interface->is_pt2pt([$newflag])
251
252 =item $flag = $interface->is_loopback([$newflag])
253
254 =item $flag = $interface->is_promiscuous([$newflag])
255
256 =item $flag = $interface->is_multicast([$newflag])
257
258 =item $flag = $interface->is_notrailers([$newflag])
259
260 =item $flag = $interface->is_noarp([$newflag])
261
262 Get or set the corresponding configuration parameters. Note that the
263 operating system may not let you set some of these.
264
265 =back
266
267 =head1 AUTHOR
268
269 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
270
271 This module is distributed under the same license as Perl itself.
272
273 =head1 SEE ALSO
274
275 L<perl>, L<IO::Socket>, L<IO::Multicast>), L<IO::Interface>, L<Net::Interface>
276
277 =cut
278
+0
-296
Interface.pm less more
0 package IO::Interface;
1
2 require 5.005;
3 use strict;
4 use Carp;
5 use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD);
6
7 use IO::Socket;
8
9 require Exporter;
10 require DynaLoader;
11 use AutoLoader;
12
13 my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric
14 addr_to_interface if_index if_indextoname );
15 my @flags = qw(IFF_ALLMULTI IFF_AUTOMEDIA IFF_BROADCAST
16 IFF_DEBUG IFF_LOOPBACK IFF_MASTER
17 IFF_MULTICAST IFF_NOARP IFF_NOTRAILERS
18 IFF_POINTOPOINT IFF_PORTSEL IFF_PROMISC
19 IFF_RUNNING IFF_SLAVE IFF_UP);
20 %EXPORT_TAGS = ( 'all' => [@functions,@flags],
21 'functions' => \@functions,
22 'flags' => \@flags,
23 );
24
25 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
26
27 @EXPORT = qw( );
28
29 @ISA = qw(Exporter DynaLoader);
30 $VERSION = '1.07';
31
32 sub AUTOLOAD {
33 # This AUTOLOAD is used to 'autoload' constants from the constant()
34 # XS function. If a constant is not found then control is passed
35 # to the AUTOLOAD in AutoLoader.
36
37 my $constname;
38 ($constname = $AUTOLOAD) =~ s/.*:://;
39 croak "&constant not defined" if $constname eq 'constant';
40 my $val = constant($constname, @_ ? $_[0] : 0);
41 if ($! != 0) {
42 if ($! =~ /Invalid/ || $!{EINVAL}) {
43 $AutoLoader::AUTOLOAD = $AUTOLOAD;
44 goto &AutoLoader::AUTOLOAD;
45 }
46 else {
47 croak "Your vendor has not defined IO::Interface macro $constname";
48 }
49 }
50 {
51 no strict 'refs';
52 *$AUTOLOAD = sub { $val }; # *$AUTOLOAD = sub() { $val };
53 }
54 goto &$AUTOLOAD;
55 }
56
57 bootstrap IO::Interface $VERSION;
58
59 # copy routines into IO::Socket
60 {
61 no strict 'refs';
62 *{"IO\:\:Socket\:\:$_"} = \&$_ foreach @functions;
63 }
64
65 # Preloaded methods go here.
66
67 sub if_list {
68 my %hash = map {$_=>undef} &_if_list;
69 sort keys %hash;
70 }
71
72 sub addr_to_interface {
73 my ($sock,$addr) = @_;
74 return "any" if $addr eq '0.0.0.0';
75 my @interfaces = $sock->if_list;
76 foreach (@interfaces) {
77 my $if_addr = $sock->if_addr($_) or next;
78 return $_ if $if_addr eq $addr;
79 }
80 return; # couldn't find it
81 }
82
83 # Autoload methods go after =cut, and are processed by the autosplit program.
84 1;
85 __END__
86
87 =head1 NAME
88
89 IO::Interface - Perl extension for access to network card configuration information
90
91 =head1 SYNOPSIS
92
93 # ======================
94 # the new, preferred API
95 # ======================
96
97 use IO::Interface::Simple;
98
99 my $if1 = IO::Interface::Simple->new('eth0');
100 my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1');
101 my $if3 = IO::Interface::Simple->new_from_index(1);
102
103 my @interfaces = IO::Interface::Simple->interfaces;
104
105 for my $if (@interfaces) {
106 print "interface = $if\n";
107 print "addr = ",$if->address,"\n",
108 "broadcast = ",$if->broadcast,"\n",
109 "netmask = ",$if->netmask,"\n",
110 "dstaddr = ",$if->dstaddr,"\n",
111 "hwaddr = ",$if->hwaddr,"\n",
112 "mtu = ",$if->mtu,"\n",
113 "metric = ",$if->metric,"\n",
114 "index = ",$if->index,"\n";
115
116 print "is running\n" if $if->is_running;
117 print "is broadcast\n" if $if->is_broadcast;
118 print "is p-to-p\n" if $if->is_pt2pt;
119 print "is loopback\n" if $if->is_loopback;
120 print "is promiscuous\n" if $if->is_promiscuous;
121 print "is multicast\n" if $if->is_multicast;
122 print "is notrailers\n" if $if->is_notrailers;
123 print "is noarp\n" if $if->is_noarp;
124 }
125
126
127 # ===========
128 # the old API
129 # ===========
130
131 use IO::Socket;
132 use IO::Interface qw(:flags);
133
134 my $s = IO::Socket::INET->new(Proto => 'udp');
135 my @interfaces = $s->if_list;
136
137 for my $if (@interfaces) {
138 print "interface = $if\n";
139 my $flags = $s->if_flags($if);
140 print "addr = ",$s->if_addr($if),"\n",
141 "broadcast = ",$s->if_broadcast($if),"\n",
142 "netmask = ",$s->if_netmask($if),"\n",
143 "dstaddr = ",$s->if_dstaddr($if),"\n",
144 "hwaddr = ",$s->if_hwaddr($if),"\n";
145
146 print "is running\n" if $flags & IFF_RUNNING;
147 print "is broadcast\n" if $flags & IFF_BROADCAST;
148 print "is p-to-p\n" if $flags & IFF_POINTOPOINT;
149 print "is loopback\n" if $flags & IFF_LOOPBACK;
150 print "is promiscuous\n" if $flags & IFF_PROMISC;
151 print "is multicast\n" if $flags & IFF_MULTICAST;
152 print "is notrailers\n" if $flags & IFF_NOTRAILERS;
153 print "is noarp\n" if $flags & IFF_NOARP;
154 }
155
156 my $interface = $s->addr_to_interface('127.0.0.1');
157
158
159 =head1 DESCRIPTION
160
161 IO::Interface adds methods to IO::Socket objects that allows them to
162 be used to retrieve and change information about the network
163 interfaces on your system. In addition to the object-oriented access
164 methods, you can use a function-oriented style.
165
166 THIS API IS DEPRECATED. Please see L<IO::Interface::Simple> for the
167 preferred way to get and set interface configuration information.
168
169 =head2 Creating a Socket to Access Interface Information
170
171 You must create a socket before you can access interface
172 information. The socket does not have to be connected to a remote
173 site, or even used for communication. The simplest procedure is to
174 create a UDP protocol socket:
175
176 my $s = IO::Socket::INET->new(Proto => 'udp');
177
178 The various IO::Interface functions will now be available as methods
179 on this socket.
180
181 =head2 Methods
182
183 =over 4
184
185 =item @iflist = $s->if_list
186
187 The if_list() method will return a list of active interface names, for
188 example "eth0" or "tu0". If no interfaces are configured and running,
189 returns an empty list.
190
191 =item $addr = $s->if_addr($ifname [,$newaddr])
192
193 if_addr() gets or sets the interface address. Call with the interface
194 name to retrieve the address (in dotted decimal format). Call with a
195 new address to set the interface. In the latter case, the routine
196 will return a true value if the operation was successful.
197
198 my $oldaddr = $s->if_addr('eth0');
199 $s->if_addr('eth0','192.168.8.10') || die "couldn't set address: $!";
200
201 Special case: the address of the pseudo-device "any" will return the
202 IP address "0.0.0.0", which corresponds to the INADDR_ANY constant.
203
204 =item $broadcast = $s->if_broadcast($ifname [,$newbroadcast]
205
206 Get or set the interface broadcast address. If the interface does not
207 have a broadcast address, returns undef.
208
209 =item $mask = $s->if_netmask($ifname [,$newmask])
210
211 Get or set the interface netmask.
212
213 =item $dstaddr = $s->if_dstaddr($ifname [,$newdest])
214
215 Get or set the destination address for point-to-point interfaces.
216
217 =item $hwaddr = $s->if_hwaddr($ifname [,$newhwaddr])
218
219 Get or set the hardware address for the interface. Currently only
220 ethernet addresses in the form "00:60:2D:2D:51:70" are accepted.
221
222 =item $flags = $s->if_flags($ifname [,$newflags])
223
224 Get or set the flags for the interface. The flags are a bitmask
225 formed from a series of constants. See L<Exportable constants> below.
226
227 =item $ifname = $s->addr_to_interface($ifaddr)
228
229 Given an interface address in dotted form, returns the name of the
230 interface associated with it. Special case: the INADDR_ANY address,
231 0.0.0.0 will return a pseudo-interface name of "any".
232
233 =back
234
235 =head2 EXPORT
236
237 IO::Interface exports nothing by default. However, you can import the
238 following symbol groups into your namespace:
239
240 :functions Function-oriented interface (see below)
241 :flags Flag constants (see below)
242 :all All of the above
243
244 =head2 Function-Oriented Interface
245
246 By importing the ":functions" set, you can access IO::Interface in a
247 function-oriented manner. This imports all the methods described
248 above into your namespace. Example:
249
250 use IO::Socket;
251 use IO::Interface ':functions';
252
253 my $sock = IO::Socket::INET->new(Proto=>'udp');
254 my @interfaces = if_list($sock);
255 print "address = ",if_addr($sock,$interfaces[0]);
256
257 =head2 Exportable constants
258
259 The ":flags" constant imports the following constants for use with the
260 flags returned by if_flags():
261
262 IFF_ALLMULTI
263 IFF_AUTOMEDIA
264 IFF_BROADCAST
265 IFF_DEBUG
266 IFF_LOOPBACK
267 IFF_MASTER
268 IFF_MULTICAST
269 IFF_NOARP
270 IFF_NOTRAILERS
271 IFF_POINTOPOINT
272 IFF_PORTSEL
273 IFF_PROMISC
274 IFF_RUNNING
275 IFF_SLAVE
276 IFF_UP
277
278 This example determines whether interface 'tu0' supports multicasting:
279
280 use IO::Socket;
281 use IO::Interface ':flags';
282 my $sock = IO::Socket::INET->new(Proto=>'udp');
283 print "can multicast!\n" if $sock->if_flags & IFF_MULTICAST.
284
285 =head1 AUTHOR
286
287 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
288
289 This module is distributed under the same license as Perl itself.
290
291 =head1 SEE ALSO
292
293 perl(1), IO::Socket(3), IO::Multicast(3), L<IO::Interface::Simple>
294
295 =cut
+0
-817
Interface.xs less more
0 #include "EXTERN.h"
1 #include "perl.h"
2 #include "XSUB.h"
3
4 /* socket definitions */
5 #include <sys/types.h>
6 #include <sys/socket.h>
7 #include <sys/ioctl.h>
8
9 /* location of IFF_* constants */
10 #include <net/if.h>
11
12 /* location of getifaddrs() definition */
13 #ifdef USE_GETIFADDRS
14 #include <ifaddrs.h>
15
16 #ifdef HAVE_SOCKADDR_DL_STRUCT
17 #include <net/if_dl.h>
18 #endif
19
20 #endif
21
22 #ifndef SIOCGIFCONF
23 #include <sys/sockio.h>
24 #endif
25
26 #ifdef OSIOCGIFCONF
27 #define MY_SIOCGIFCONF OSIOCGIFCONF
28 #else
29 #define MY_SIOCGIFCONF SIOCGIFCONF
30 #endif
31
32 #ifdef PerlIO
33 typedef PerlIO * InputStream;
34 #else
35 #define PERLIO_IS_STDIO 1
36 typedef FILE * InputStream;
37 #define PerlIO_fileno(f) fileno(f)
38 #endif
39
40 #if !defined(__USE_BSD)
41 #if defined(__linux__)
42 typedef int IOCTL_CMD_T;
43 #define __USE_BSD
44 #elif defined(__APPLE__)
45 typedef unsigned long IOCTL_CMD_T;
46 #define __USE_BSD
47 #else
48 typedef int IOCTL_CMD_T;
49 #endif
50 #else
51 typedef unsigned long IOCTL_CMD_T;
52 #endif
53
54 /* HP-UX, Solaris */
55 #if !defined(ifr_mtu) && defined(ifr_metric)
56 #define ifr_mtu ifr_metric
57 #endif
58
59 static double
60 constant_IFF_N(char *name, int len, int arg)
61 {
62 errno = 0;
63 if (5 + 1 >= len ) {
64 errno = EINVAL;
65 return 0;
66 }
67 switch (name[5 + 1]) {
68 case 'A':
69 if (strEQ(name + 5, "OARP")) { /* IFF_N removed */
70 #ifdef IFF_NOARP
71 return IFF_NOARP;
72 #else
73 goto not_there;
74 #endif
75 }
76 case 'T':
77 if (strEQ(name + 5, "OTRAILERS")) { /* IFF_N removed */
78 #ifdef IFF_NOTRAILERS
79 return IFF_NOTRAILERS;
80 #else
81 goto not_there;
82 #endif
83 }
84 }
85 errno = EINVAL;
86 return 0;
87
88 not_there:
89 errno = ENOENT;
90 return 0;
91 }
92
93 static double
94 constant_IFF_PO(char *name, int len, int arg)
95 {
96 errno = 0;
97 switch (name[6 + 0]) {
98 case 'I':
99 if (strEQ(name + 6, "INTOPOINT")) { /* IFF_PO removed */
100 #ifdef IFF_POINTOPOINT
101 return IFF_POINTOPOINT;
102 #else
103 goto not_there;
104 #endif
105 }
106 case 'R':
107 if (strEQ(name + 6, "RTSEL")) { /* IFF_PO removed */
108 #ifdef IFF_PORTSEL
109 return IFF_PORTSEL;
110 #else
111 goto not_there;
112 #endif
113 }
114 }
115 errno = EINVAL;
116 return 0;
117
118 not_there:
119 errno = ENOENT;
120 return 0;
121 }
122
123 static double
124 constant_IFF_P(char *name, int len, int arg)
125 {
126 errno = 0;
127 switch (name[5 + 0]) {
128 case 'O':
129 return constant_IFF_PO(name, len, arg);
130 case 'R':
131 if (strEQ(name + 5, "ROMISC")) { /* IFF_P removed */
132 #ifdef IFF_PROMISC
133 return IFF_PROMISC;
134 #else
135 goto not_there;
136 #endif
137 }
138 }
139 errno = EINVAL;
140 return 0;
141
142 not_there:
143 errno = ENOENT;
144 return 0;
145 }
146
147 static double
148 constant_IFF_A(char *name, int len, int arg)
149 {
150 errno = 0;
151 switch (name[5 + 0]) {
152 case 'L':
153 if (strEQ(name + 5, "LLMULTI")) { /* IFF_A removed */
154 #ifdef IFF_ALLMULTI
155 return IFF_ALLMULTI;
156 #else
157 goto not_there;
158 #endif
159 }
160 case 'U':
161 if (strEQ(name + 5, "UTOMEDIA")) { /* IFF_A removed */
162 #ifdef IFF_AUTOMEDIA
163 return IFF_AUTOMEDIA;
164 #else
165 goto not_there;
166 #endif
167 }
168 }
169 errno = EINVAL;
170 return 0;
171
172 not_there:
173 errno = ENOENT;
174 return 0;
175 }
176
177 static double
178 constant_IFF_M(char *name, int len, int arg)
179 {
180 errno = 0;
181 switch (name[5 + 0]) {
182 case 'A':
183 if (strEQ(name + 5, "ASTER")) { /* IFF_M removed */
184 #ifdef IFF_MASTER
185 return IFF_MASTER;
186 #else
187 goto not_there;
188 #endif
189 }
190 case 'U':
191 if (strEQ(name + 5, "ULTICAST")) { /* IFF_M removed */
192 #ifdef IFF_MULTICAST
193 return IFF_MULTICAST;
194 #else
195 goto not_there;
196 #endif
197 }
198 }
199 errno = EINVAL;
200 return 0;
201
202 not_there:
203 errno = ENOENT;
204 return 0;
205 }
206
207 static double
208 constant_IFF(char *name, int len, int arg)
209 {
210 errno = 0;
211 if (3 + 1 >= len ) {
212 errno = EINVAL;
213 return 0;
214 }
215 switch (name[3 + 1]) {
216 case 'A':
217 if (!strnEQ(name + 3,"_", 1))
218 break;
219 return constant_IFF_A(name, len, arg);
220 case 'B':
221 if (strEQ(name + 3, "_BROADCAST")) { /* IFF removed */
222 #ifdef IFF_BROADCAST
223 return IFF_BROADCAST;
224 #else
225 goto not_there;
226 #endif
227 }
228 case 'D':
229 if (strEQ(name + 3, "_DEBUG")) { /* IFF removed */
230 #ifdef IFF_DEBUG
231 return IFF_DEBUG;
232 #else
233 goto not_there;
234 #endif
235 }
236 case 'L':
237 if (strEQ(name + 3, "_LOOPBACK")) { /* IFF removed */
238 #ifdef IFF_LOOPBACK
239 return IFF_LOOPBACK;
240 #else
241 goto not_there;
242 #endif
243 }
244 case 'M':
245 if (!strnEQ(name + 3,"_", 1))
246 break;
247 return constant_IFF_M(name, len, arg);
248 case 'N':
249 if (!strnEQ(name + 3,"_", 1))
250 break;
251 return constant_IFF_N(name, len, arg);
252 case 'P':
253 if (!strnEQ(name + 3,"_", 1))
254 break;
255 return constant_IFF_P(name, len, arg);
256 case 'R':
257 if (strEQ(name + 3, "_RUNNING")) { /* IFF removed */
258 #ifdef IFF_RUNNING
259 return IFF_RUNNING;
260 #else
261 goto not_there;
262 #endif
263 }
264 case 'S':
265 if (strEQ(name + 3, "_SLAVE")) { /* IFF removed */
266 #ifdef IFF_SLAVE
267 return IFF_SLAVE;
268 #else
269 goto not_there;
270 #endif
271 }
272 case 'U':
273 if (strEQ(name + 3, "_UP")) { /* IFF removed */
274 #ifdef IFF_UP
275 return IFF_UP;
276 #else
277 goto not_there;
278 #endif
279 }
280 }
281 errno = EINVAL;
282 return 0;
283
284 not_there:
285 errno = ENOENT;
286 return 0;
287 }
288
289 static double
290 constant_I(char *name, int len, int arg)
291 {
292 errno = 0;
293 if (1 + 1 >= len ) {
294 errno = EINVAL;
295 return 0;
296 }
297 switch (name[1 + 1]) {
298 case 'F':
299 if (!strnEQ(name + 1,"F", 1))
300 break;
301 return constant_IFF(name, len, arg);
302 case 'H':
303 if (strEQ(name + 1, "FHWADDRLEN")) { /* I removed */
304 #ifdef IFHWADDRLEN
305 return IFHWADDRLEN;
306 #else
307 goto not_there;
308 #endif
309 }
310 case 'N':
311 if (strEQ(name + 1, "FNAMSIZ")) { /* I removed */
312 #ifdef IFNAMSIZ
313 return IFNAMSIZ;
314 #else
315 goto not_there;
316 #endif
317 }
318 }
319 errno = EINVAL;
320 return 0;
321
322 not_there:
323 errno = ENOENT;
324 return 0;
325 }
326
327 static double
328 constant(char *name, int len, int arg)
329 {
330 errno = 0;
331 switch (name[0 + 0]) {
332 case 'I':
333 return constant_I(name, len, arg);
334 }
335 errno = EINVAL;
336 return 0;
337
338 not_there:
339 errno = ENOENT;
340 return 0;
341 }
342
343 int Ioctl (InputStream sock, IOCTL_CMD_T operation,void* result) {
344 int fd = PerlIO_fileno(sock);
345 return ioctl(fd,operation,result) == 0;
346 }
347
348 #ifdef IFHWADDRLEN
349 char* parse_hwaddr (char *string, struct sockaddr* hwaddr) {
350 int len,i,consumed;
351 unsigned int converted;
352 char* s;
353 s = string;
354 len = strlen(s);
355 for (i = 0; i < IFHWADDRLEN && len > 0; i++) {
356 if (sscanf(s,"%x%n",&converted,&consumed) <= 0)
357 break;
358 hwaddr->sa_data[i] = converted;
359 s += consumed + 1;
360 len -= consumed + 1;
361 }
362 if (i != IFHWADDRLEN)
363 return NULL;
364 else
365 return string;
366 }
367
368 /* No checking for string buffer length. Caller must ensure at least
369 3*4 + 3 + 1 = 16 bytes long */
370 char* format_hwaddr (char *string, struct sockaddr* hwaddr) {
371 int i,len;
372 char *s;
373 s = string;
374 s[0] = '\0';
375 for (i = 0; i < IFHWADDRLEN; i++) {
376 if (i < IFHWADDRLEN-1)
377 len = sprintf(s,"%02x:",(unsigned char)hwaddr->sa_data[i]);
378 else
379 len = sprintf(s,"%02x",(unsigned char)hwaddr->sa_data[i]);
380 s += len;
381 }
382 return string;
383 }
384 #endif
385
386 MODULE = IO::Interface PACKAGE = IO::Interface
387
388 double
389 constant(sv,arg)
390 PREINIT:
391 STRLEN len;
392 PROTOTYPE: $;$
393 INPUT:
394 SV * sv
395 char * s = SvPV(sv, len);
396 int arg
397 CODE:
398 RETVAL = constant(s,len,arg);
399 OUTPUT:
400 RETVAL
401
402 char*
403 if_addr(sock, name, ...)
404 InputStream sock
405 char* name
406 PROTOTYPE: $$;$
407 PREINIT:
408 STRLEN len;
409 IOCTL_CMD_T operation;
410 struct ifreq ifr;
411 char* newaddr;
412 CODE:
413 {
414 #if !(defined(HAS_IOCTL) && defined(SIOCGIFADDR))
415 XSRETURN_UNDEF;
416 #else
417 if (strncmp(name,"any",3) == 0) {
418 RETVAL = "0.0.0.0";
419 } else {
420 bzero((void*)&ifr,sizeof(struct ifreq));
421 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
422 ifr.ifr_addr.sa_family = AF_INET;
423 if (items > 2) {
424 newaddr = SvPV(ST(2),len);
425 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
426 croak("Invalid inet address");
427 #if defined(SIOCSIFADDR)
428 operation = SIOCSIFADDR;
429 #else
430 croak("Cannot set interface address on this platform");
431 #endif
432 } else {
433 operation = SIOCGIFADDR;
434 }
435 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
436 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
437 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
438 }
439 #endif
440 }
441 OUTPUT:
442 RETVAL
443
444 char*
445 if_broadcast(sock, name, ...)
446 InputStream sock
447 char* name
448 PROTOTYPE: $$;$
449 PREINIT:
450 STRLEN len;
451 IOCTL_CMD_T operation;
452 struct ifreq ifr;
453 char* newaddr;
454 CODE:
455 {
456 #if !(defined(HAS_IOCTL) && defined(SIOCGIFBRDADDR))
457 XSRETURN_UNDEF;
458 #else
459 bzero((void*)&ifr,sizeof(struct ifreq));
460 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
461 ifr.ifr_addr.sa_family = AF_INET;
462 if (items > 2) {
463 newaddr = SvPV(ST(2),len);
464 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
465 croak("Invalid inet address");
466 #if defined(SIOCSIFBRDADDR)
467 operation = SIOCSIFBRDADDR;
468 #else
469 croak("Cannot set broadcast address on this platform");
470 #endif
471 } else {
472 operation = SIOCGIFBRDADDR;
473 }
474 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
475 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
476 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
477 #endif
478 }
479 OUTPUT:
480 RETVAL
481
482 char*
483 if_netmask(sock, name, ...)
484 InputStream sock
485 char* name
486 PROTOTYPE: $$;$
487 PREINIT:
488 STRLEN len;
489 IOCTL_CMD_T operation;
490 struct ifreq ifr;
491 char* newaddr;
492 CODE:
493 {
494 #if !(defined(HAS_IOCTL) && defined(SIOCGIFNETMASK))
495 XSRETURN_UNDEF;
496 #else
497 bzero((void*)&ifr,sizeof(struct ifreq));
498 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
499 ifr.ifr_addr.sa_family = AF_INET;
500 if (items > 2) {
501 newaddr = SvPV(ST(2),len);
502 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
503 croak("Invalid inet address");
504 #if defined(SIOCSIFNETMASK)
505 operation = SIOCSIFNETMASK;
506 #else
507 croak("Cannot set netmask on this platform");
508 #endif
509 } else {
510 operation = SIOCGIFNETMASK;
511 }
512 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
513 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
514 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
515 #endif
516 }
517 OUTPUT:
518 RETVAL
519
520 char*
521 if_dstaddr(sock, name, ...)
522 InputStream sock
523 char* name
524 PROTOTYPE: $$;$
525 PREINIT:
526 STRLEN len;
527 IOCTL_CMD_T operation;
528 struct ifreq ifr;
529 char* newaddr;
530 CODE:
531 {
532 #if !(defined(HAS_IOCTL) && defined(SIOCGIFDSTADDR))
533 XSRETURN_UNDEF;
534 #else
535 bzero((void*)&ifr,sizeof(struct ifreq));
536 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
537 ifr.ifr_addr.sa_family = AF_INET;
538 if (items > 2) {
539 newaddr = SvPV(ST(2),len);
540 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
541 croak("Invalid inet address");
542 #if defined(SIOCSIFDSTADDR)
543 operation = SIOCSIFDSTADDR;
544 #else
545 croak("Cannot set destination address on this platform");
546 #endif
547 } else {
548 operation = SIOCGIFDSTADDR;
549 }
550 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
551 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
552 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
553 #endif
554 }
555 OUTPUT:
556 RETVAL
557
558 char*
559 if_hwaddr(sock, name, ...)
560 InputStream sock
561 char* name
562 PROTOTYPE: $$;$
563 PREINIT:
564 STRLEN len;
565 IOCTL_CMD_T operation;
566 struct ifreq ifr;
567 #if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT))
568 struct ifaddrs *ifap, *ifa;
569 struct sockaddr_dl* sdl;
570 sa_family_t family;
571 char *sdlname, *haddr, *s;
572 int hlen = 0;
573 int i;
574 #endif
575 char *newaddr,hwaddr[128];
576 CODE:
577 {
578 #if !((defined(HAS_IOCTL) && defined(SIOCGIFHWADDR)) || defined(USE_GETIFADDRS))
579 XSRETURN_UNDEF;
580 #endif
581 #if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT))
582 getifaddrs(&ifap);
583
584 while(1) {
585 for (ifa = ifap; ifa; ifa = ifa->ifa_next) {
586 if (strncmp(name, ifa->ifa_name, IFNAMSIZ) == 0) {
587 family = ifa->ifa_addr->sa_family;
588 if (family == AF_LINK) {
589 sdl = (struct sockaddr_dl *) ifa->ifa_addr;
590 haddr = sdl->sdl_data + sdl->sdl_nlen;
591 hlen = sdl->sdl_alen;
592 break;
593 }
594 }
595 ifap = ifap -> ifa_next;
596 }
597 freeifaddrs(ifap);
598
599 s = hwaddr;
600 s[0] = '\0';
601 if (ifap != NULL) {
602 for (i = 0; i < hlen; i++) {
603 if (i < hlen - 1)
604 len = sprintf(s,"%02x:",(unsigned char)haddr[i]);
605 else
606 len = sprintf(s,"%02x",(unsigned char)haddr[i]);
607 s += len;
608 }
609 }
610
611 freeifaddrs(ifap);
612
613 RETVAL = hwaddr;
614 #elif (defined(HAS_IOCTL) && defined(SIOCGIFHWADDR))
615 bzero((void*)&ifr,sizeof(struct ifreq));
616 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
617 ifr.ifr_hwaddr.sa_family = AF_UNSPEC;
618 if (items > 2) {
619 newaddr = SvPV(ST(2),len);
620 if (parse_hwaddr(newaddr,&ifr.ifr_hwaddr) == NULL)
621 croak("Invalid hardware address");
622 #if defined(SIOCSIFHWADDR)
623 operation = SIOCSIFHWADDR;
624 #else
625 croak("Cannot set hw address on this platform");
626 #endif
627 } else {
628 operation = SIOCGIFHWADDR;
629 }
630 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
631 RETVAL = format_hwaddr(hwaddr,&ifr.ifr_hwaddr);
632 #endif
633 }
634 OUTPUT:
635 RETVAL
636
637
638 int
639 if_flags(sock, name, ...)
640 InputStream sock
641 char* name
642 PROTOTYPE: $$;$
643 PREINIT:
644 IOCTL_CMD_T operation;
645 int flags;
646 struct ifreq ifr;
647 CODE:
648 {
649 #if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
650 XSRETURN_UNDEF;
651 #endif
652 bzero((void*)&ifr,sizeof(struct ifreq));
653 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
654 if (items > 2) {
655 ifr.ifr_flags = SvIV(ST(2));
656 #if defined(SIOCSIFFLAGS)
657 operation = SIOCSIFFLAGS;
658 #else
659 croak("Cannot set flags on this platform.");
660 #endif
661 } else {
662 operation = SIOCGIFFLAGS;
663 }
664 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
665 RETVAL = ifr.ifr_flags;
666 }
667 OUTPUT:
668 RETVAL
669
670 int
671 if_mtu(sock, name, ...)
672 InputStream sock
673 char* name
674 PROTOTYPE: $$;$
675 PREINIT:
676 IOCTL_CMD_T operation;
677 int flags;
678 struct ifreq ifr;
679 CODE:
680 {
681 #if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
682 XSRETURN_UNDEF;
683 #endif
684 bzero((void*)&ifr,sizeof(struct ifreq));
685 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
686 if (items > 2) {
687 ifr.ifr_flags = SvIV(ST(2));
688 #if defined(SIOCSIFMTU)
689 operation = SIOCSIFMTU;
690 #else
691 croak("Cannot set MTU on this platform.");
692 #endif
693 } else {
694 operation = SIOCGIFMTU;
695 }
696 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
697 RETVAL = ifr.ifr_mtu;
698 }
699 OUTPUT:
700 RETVAL
701
702 int
703 if_metric(sock, name, ...)
704 InputStream sock
705 char* name
706 PROTOTYPE: $$;$
707 PREINIT:
708 IOCTL_CMD_T operation;
709 int flags;
710 struct ifreq ifr;
711 CODE:
712 {
713 #if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
714 XSRETURN_UNDEF;
715 #endif
716 bzero((void*)&ifr,sizeof(struct ifreq));
717 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
718 if (items > 2) {
719 ifr.ifr_flags = SvIV(ST(2));
720 #if defined(SIOCSIFMETRIC)
721 operation = SIOCSIFMETRIC;
722 #else
723 croak("Cannot set metric on this platform.");
724 #endif
725 } else {
726 operation = SIOCGIFMETRIC;
727 }
728 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
729 RETVAL = ifr.ifr_metric;
730 }
731 OUTPUT:
732 RETVAL
733
734 int
735 if_index(sock, name, ...)
736 InputStream sock
737 char* name
738 PROTOTYPE: $$;$
739 CODE:
740 {
741 #ifdef __USE_BSD
742 RETVAL = if_nametoindex(name);
743 #else
744 XSRETURN_UNDEF;
745 #endif
746 }
747 OUTPUT:
748 RETVAL
749
750 char*
751 if_indextoname(sock, index, ...)
752 InputStream sock
753 int index
754 PROTOTYPE: $$;$
755 PREINIT:
756 char name[IFNAMSIZ];
757 CODE:
758 {
759 #ifdef __USE_BSD
760 RETVAL = if_indextoname(index,name);
761 #else
762 XSRETURN_UNDEF;
763 #endif
764 }
765 OUTPUT:
766 RETVAL
767
768 void
769 _if_list(sock)
770 InputStream sock
771 PROTOTYPE: $
772 PREINIT:
773 #ifdef USE_GETIFADDRS
774 struct ifaddrs *ifa_start;
775 struct ifaddrs *ifa;
776 #else
777 struct ifconf ifc;
778 struct ifreq *ifr;
779 int lastlen,len;
780 char *buf,*ptr;
781 #endif
782 PPCODE:
783 #ifdef USE_GETIFADDRS
784 if (getifaddrs(&ifa_start) < 0)
785 XSRETURN_EMPTY;
786
787 for (ifa = ifa_start ; ifa ; ifa = ifa->ifa_next)
788 XPUSHs(sv_2mortal(newSVpv(ifa->ifa_name,0)));
789
790 freeifaddrs(ifa_start);
791 #else
792 lastlen = 0;
793 len = 10 * sizeof(struct ifreq); /* initial buffer size guess */
794 for ( ; ; ) {
795 if ( (buf = safemalloc(len)) == NULL)
796 croak("Couldn't malloc buffer for ioctl: %s",strerror(errno));
797 ifc.ifc_len = len;
798 ifc.ifc_buf = buf;
799 if (ioctl(PerlIO_fileno(sock),MY_SIOCGIFCONF,&ifc) < 0) {
800 if (errno != EINVAL || lastlen != 0)
801 XSRETURN_EMPTY;
802 } else {
803 if (ifc.ifc_len == lastlen) break; /* success, len has not changed */
804 lastlen = ifc.ifc_len;
805 }
806 len += 10 * sizeof(struct ifreq); /* increment */
807 safefree(buf);
808 }
809
810 for (ptr = buf ; ptr < buf + ifc.ifc_len ; ptr += sizeof(struct ifreq)) {
811 ifr = (struct ifreq*) ptr;
812 XPUSHs(sv_2mortal(newSVpv(ifr->ifr_name,0)));
813 }
814 safefree(buf);
815 #endif
816
+202
-0
LICENSE less more
0 The Artistic License 2.0
1
2 Copyright (c) 2014 Lincoln Stein
3
4 Everyone is permitted to copy and distribute verbatim copies
5 of this license document, but changing it is not allowed.
6
7 Preamble
8
9 This license establishes the terms under which a given free software
10 Package may be copied, modified, distributed, and/or redistributed.
11 The intent is that the Copyright Holder maintains some artistic
12 control over the development of that Package while still keeping the
13 Package available as open source and free software.
14
15 You are always permitted to make arrangements wholly outside of this
16 license directly with the Copyright Holder of a given Package. If the
17 terms of this license do not permit the full use that you propose to
18 make of the Package, you should contact the Copyright Holder and seek
19 a different licensing arrangement.
20
21 Definitions
22
23 "Copyright Holder" means the individual(s) or organization(s)
24 named in the copyright notice for the entire Package.
25
26 "Contributor" means any party that has contributed code or other
27 material to the Package, in accordance with the Copyright Holder's
28 procedures.
29
30 "You" and "your" means any person who would like to copy,
31 distribute, or modify the Package.
32
33 "Package" means the collection of files distributed by the
34 Copyright Holder, and derivatives of that collection and/or of
35 those files. A given Package may consist of either the Standard
36 Version, or a Modified Version.
37
38 "Distribute" means providing a copy of the Package or making it
39 accessible to anyone else, or in the case of a company or
40 organization, to others outside of your company or organization.
41
42 "Distributor Fee" means any fee that you charge for Distributing
43 this Package or providing support for this Package to another
44 party. It does not mean licensing fees.
45
46 "Standard Version" refers to the Package if it has not been
47 modified, or has been modified only in ways explicitly requested
48 by the Copyright Holder.
49
50 "Modified Version" means the Package, if it has been changed, and
51 such changes were not explicitly requested by the Copyright
52 Holder.
53
54 "Original License" means this Artistic License as Distributed with
55 the Standard Version of the Package, in its current version or as
56 it may be modified by The Perl Foundation in the future.
57
58 "Source" form means the source code, documentation source, and
59 configuration files for the Package.
60
61 "Compiled" form means the compiled bytecode, object code, binary,
62 or any other form resulting from mechanical transformation or
63 translation of the Source form.
64
65
66 Permission for Use and Modification Without Distribution
67
68 (1) You are permitted to use the Standard Version and create and use
69 Modified Versions for any purpose without restriction, provided that
70 you do not Distribute the Modified Version.
71
72
73 Permissions for Redistribution of the Standard Version
74
75 (2) You may Distribute verbatim copies of the Source form of the
76 Standard Version of this Package in any medium without restriction,
77 either gratis or for a Distributor Fee, provided that you duplicate
78 all of the original copyright notices and associated disclaimers. At
79 your discretion, such verbatim copies may or may not include a
80 Compiled form of the Package.
81
82 (3) You may apply any bug fixes, portability changes, and other
83 modifications made available from the Copyright Holder. The resulting
84 Package will still be considered the Standard Version, and as such
85 will be subject to the Original License.
86
87
88 Distribution of Modified Versions of the Package as Source
89
90 (4) You may Distribute your Modified Version as Source (either gratis
91 or for a Distributor Fee, and with or without a Compiled form of the
92 Modified Version) provided that you clearly document how it differs
93 from the Standard Version, including, but not limited to, documenting
94 any non-standard features, executables, or modules, and provided that
95 you do at least ONE of the following:
96
97 (a) make the Modified Version available to the Copyright Holder
98 of the Standard Version, under the Original License, so that the
99 Copyright Holder may include your modifications in the Standard
100 Version.
101
102 (b) ensure that installation of your Modified Version does not
103 prevent the user installing or running the Standard Version. In
104 addition, the Modified Version must bear a name that is different
105 from the name of the Standard Version.
106
107 (c) allow anyone who receives a copy of the Modified Version to
108 make the Source form of the Modified Version available to others
109 under
110
111 (i) the Original License or
112
113 (ii) a license that permits the licensee to freely copy,
114 modify and redistribute the Modified Version using the same
115 licensing terms that apply to the copy that the licensee
116 received, and requires that the Source form of the Modified
117 Version, and of any works derived from it, be made freely
118 available in that license fees are prohibited but Distributor
119 Fees are allowed.
120
121
122 Distribution of Compiled Forms of the Standard Version
123 or Modified Versions without the Source
124
125 (5) You may Distribute Compiled forms of the Standard Version without
126 the Source, provided that you include complete instructions on how to
127 get the Source of the Standard Version. Such instructions must be
128 valid at the time of your distribution. If these instructions, at any
129 time while you are carrying out such distribution, become invalid, you
130 must provide new instructions on demand or cease further distribution.
131 If you provide valid instructions or cease distribution within thirty
132 days after you become aware that the instructions are invalid, then
133 you do not forfeit any of your rights under this license.
134
135 (6) You may Distribute a Modified Version in Compiled form without
136 the Source, provided that you comply with Section 4 with respect to
137 the Source of the Modified Version.
138
139
140 Aggregating or Linking the Package
141
142 (7) You may aggregate the Package (either the Standard Version or
143 Modified Version) with other packages and Distribute the resulting
144 aggregation provided that you do not charge a licensing fee for the
145 Package. Distributor Fees are permitted, and licensing fees for other
146 components in the aggregation are permitted. The terms of this license
147 apply to the use and Distribution of the Standard or Modified Versions
148 as included in the aggregation.
149
150 (8) You are permitted to link Modified and Standard Versions with
151 other works, to embed the Package in a larger work of your own, or to
152 build stand-alone binary or bytecode versions of applications that
153 include the Package, and Distribute the result without restriction,
154 provided the result does not expose a direct interface to the Package.
155
156
157 Items That are Not Considered Part of a Modified Version
158
159 (9) Works (including, but not limited to, modules and scripts) that
160 merely extend or make use of the Package, do not, by themselves, cause
161 the Package to be a Modified Version. In addition, such works are not
162 considered parts of the Package itself, and are not subject to the
163 terms of this license.
164
165
166 General Provisions
167
168 (10) Any use, modification, and distribution of the Standard or
169 Modified Versions is governed by this Artistic License. By using,
170 modifying or distributing the Package, you accept this license. Do not
171 use, modify, or distribute the Package, if you do not accept this
172 license.
173
174 (11) If your Modified Version has been derived from a Modified
175 Version made by someone other than you, you are nevertheless required
176 to ensure that your Modified Version complies with the requirements of
177 this license.
178
179 (12) This license does not grant you the right to use any trademark,
180 service mark, tradename, or logo of the Copyright Holder.
181
182 (13) This license includes the non-exclusive, worldwide,
183 free-of-charge patent license to make, have made, use, offer to sell,
184 sell, import and otherwise transfer the Package with respect to any
185 patent claims licensable by the Copyright Holder that are necessarily
186 infringed by the Package. If you institute patent litigation
187 (including a cross-claim or counterclaim) against any party alleging
188 that the Package constitutes direct or contributory patent
189 infringement, then this Artistic License to you shall terminate on the
190 date that such litigation is filed.
191
192 (14) Disclaimer of Warranty:
193 THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
194 IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
195 WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
196 NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL
197 LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL
198 BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
199 DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF
200 ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
201
+8
-6
MANIFEST less more
0 Build.PL
01 Changes
1 README
2 Interface.pm
3 Interface.xs
4 Interface/Simple.pm
2 lib/IO/Interface.pm
3 lib/IO/Interface.xs
4 lib/IO/Interface/Simple.pm
5 LICENSE
56 MANIFEST
6 Makefile.PL
7 META.json
8 META.yml Module meta-data (added by MakeMaker)
9 README.md
710 t/basic.t
811 t/simple.t
9 META.yml Module meta-data (added by MakeMaker)
+49
-0
META.json less more
0 {
1 "abstract" : "Access and modify network interface card configuration",
2 "author" : [
3 "Lincoln Stein <lincoln.stein@gmail.com>"
4 ],
5 "dynamic_config" : 1,
6 "generated_by" : "Module::Build version 0.4205",
7 "license" : [
8 "perl_5"
9 ],
10 "meta-spec" : {
11 "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
12 "version" : "2"
13 },
14 "name" : "IO-Interface",
15 "prereqs" : {
16 "build" : {
17 "requires" : {
18 "ExtUtils::CBuilder" : "0"
19 }
20 },
21 "configure" : {
22 "requires" : {
23 "Module::Build" : "0.42"
24 }
25 },
26 "runtime" : {
27 "requires" : {
28 "perl" : "5.005"
29 }
30 }
31 },
32 "provides" : {
33 "IO::Interface" : {
34 "file" : "lib/IO/Interface.pm",
35 "version" : "1.09"
36 },
37 "IO::Interface::Simple" : {
38 "file" : "lib/IO/Interface/Simple.pm"
39 }
40 },
41 "release_status" : "stable",
42 "resources" : {
43 "license" : [
44 "http://dev.perl.org/licenses/"
45 ]
46 },
47 "version" : "1.09"
48 }
+25
-18
META.yml less more
0 --- #YAML:1.0
1 name: IO-Interface
2 version: 1.07
3 abstract: ~
4 author: []
5 license: unknown
6 distribution_type: module
0 ---
1 abstract: 'Access and modify network interface card configuration'
2 author:
3 - 'Lincoln Stein <lincoln.stein@gmail.com>'
4 build_requires:
5 ExtUtils::CBuilder: '0'
76 configure_requires:
8 ExtUtils::MakeMaker: 0
9 build_requires:
10 ExtUtils::MakeMaker: 0
11 requires: {}
12 no_index:
13 directory:
14 - t
15 - inc
16 generated_by: ExtUtils::MakeMaker version 6.57_05
7 Module::Build: '0.42'
8 dynamic_config: 1
9 generated_by: 'Module::Build version 0.4205, CPAN::Meta::Converter version 2.120351'
10 license: perl
1711 meta-spec:
18 url: http://module-build.sourceforge.net/META-spec-v1.4.html
19 version: 1.4
12 url: http://module-build.sourceforge.net/META-spec-v1.4.html
13 version: '1.4'
14 name: IO-Interface
15 provides:
16 IO::Interface:
17 file: lib/IO/Interface.pm
18 version: '1.09'
19 IO::Interface::Simple:
20 file: lib/IO/Interface/Simple.pm
21 version: 0
22 requires:
23 perl: '5.005'
24 resources:
25 license: http://dev.perl.org/licenses/
26 version: '1.09'
+0
-52
Makefile.PL less more
0 use ExtUtils::MakeMaker;
1 use Config;
2
3 my @libs = ();
4 push @libs,'-lresolv' unless $Config{d_inetaton};
5
6 my $guess_cfg = {
7 'freebsd' => {
8 'defs' => '-D__USE_BSD',
9 },
10 'netbsd' => {
11 'defs' => '-D__USE_BSD',
12 },
13 'openbsd' => {
14 'defs' => '-D__USE_BSD',
15 }
16 };
17
18 my $guess = $guess_cfg->{$^O};
19 unless (ref $guess eq 'HASH') {
20 $guess = {'defs' => ''};
21 }
22
23 WriteMakefile(
24 'NAME' => 'IO::Interface',
25 'VERSION_FROM' => 'Interface.pm', # finds $VERSION
26 'LIBS' => ["@libs"], # e.g., '-lm'
27 'INC' => '', # e.g., '-I/usr/include/other'
28 PMLIBDIRS => ['Interface'],
29 CONFIGURE => sub {
30 my %attrs;
31 $attrs{DEFINE} = $guess->{'defs'};
32
33 print "Checking for getifaddrs()...";
34 eval { require 'ifaddrs.ph' };
35 if ($@ && !-r "/usr/include/ifaddrs.h") {
36 print " Nope, will not use it.\n";
37 } else {
38 $attrs{DEFINE} .= ' -DUSE_GETIFADDRS';
39 print " Okay, I will use it.\n";
40 }
41 print "Checking for sockaddr_dl...";
42 if (!-r "/usr/include/net/if_dl.h") {
43 print " Nope, will not use it.\n";
44 } else {
45 $attrs{DEFINE} .= ' -DHAVE_SOCKADDR_DL_STRUCT';
46 print " Okay, I will use it.\n";
47 }
48
49 \%attrs;
50 },
51 );
+0
-11
README less more
0 IO::Interface adds object-methods to IO::Socket objects to allow them
1 to get and set operational characteristics of network interface cards,
2 such as IP addresses, net masks, and so forth. It is useful for
3 identifying runtime characteristics of cards, such as broadcast
4 addresses, and finding interfaces that satisfy certain criteria, such
5 as the ability to multicast.
6
7 See the POD for more information.
8
9 Lincoln Stein <lstein@cshl.org>
10
+32
-0
README.md less more
0 LibIO-Interface-Perl
1 ====================
2
3 Perl interface to Unix network interface API
4
5 IO::Interface adds object methods to IO::Socket objects to allow them
6 to get and set operational characteristics of network interface
7 cards, such as IP addresses, net masks, and so forth. It is useful
8 for identifying runtime characteristics of cards, such as broadcast
9 addresses, and finding interfaces that satisfy certain criteria,
10 such Perl interface to Unix network interface API as the ability to
11 multicast.
12
13 For support, please use the GitHub repository at
14 https://github.com/lstein/LibIO-Interface-Perl
15
16 Author
17 ======
18
19 Lincoln D. Stein <lincoln.stein@gmail.com>
20
21 License
22 =======
23
24 Copyright 2001-2014, Lincoln D. Stein.
25
26 This library is distributed under the Perl Artistic License
27 2.0. Please see LICENSE for more information.
28
29
30
31
+287
-0
lib/IO/Interface/Simple.pm less more
0 package IO::Interface::Simple;
1 use strict;
2 use IO::Socket;
3 use IO::Interface;
4
5 use overload '""' => \&as_string,
6 eq => '_eq_',
7 fallback => 1;
8
9 # class variable
10 my $socket;
11
12 # class methods
13 sub interfaces {
14 my $class = shift;
15 my $s = $class->sock;
16 return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list;
17 }
18
19 sub new {
20 my $class = shift;
21 my $if_name = shift;
22 my $s = $class->sock;
23 return unless defined $s->if_mtu($if_name);
24 return bless {s => $s,
25 name => $if_name},ref $class || $class;
26 }
27
28 sub new_from_address {
29 my $class = shift;
30 my $addr = shift;
31 my $s = $class->sock;
32 my $name = $s->addr_to_interface($addr) or return;
33 return $class->new($name);
34 }
35
36 sub new_from_index {
37 my $class = shift;
38 my $index = shift;
39 my $s = $class->sock;
40 my $name = $s->if_indextoname($index) or return;
41 return $class->new($name);
42 }
43
44 sub sock {
45 my $self = shift;
46 if (ref $self) {
47 return $self->{s} ||= $socket;
48 } else {
49 return $socket ||= IO::Socket::INET->new(Proto=>'udp');
50 }
51 }
52
53 sub _eq_ {
54 return shift->name eq shift;
55 }
56
57 sub as_string {
58 shift->name;
59 }
60
61 sub name {
62 shift->{name};
63 }
64
65 sub address {
66 my $self = shift;
67 $self->sock->if_addr($self->name,@_);
68 }
69
70 sub broadcast {
71 my $self = shift;
72 $self->sock->if_broadcast($self->name,@_);
73 }
74
75 sub netmask {
76 my $self = shift;
77 $self->sock->if_netmask($self->name,@_);
78 }
79
80 sub dstaddr {
81 my $self = shift;
82 $self->sock->if_dstaddr($self->name,@_);
83 }
84
85 sub hwaddr {
86 my $self = shift;
87 $self->sock->if_hwaddr($self->name,@_);
88 }
89
90 sub flags {
91 my $self = shift;
92 $self->sock->if_flags($self->name,@_);
93 }
94
95 sub mtu {
96 my $self = shift;
97 $self->sock->if_mtu($self->name,@_);
98 }
99
100 sub metric {
101 my $self = shift;
102 $self->sock->if_metric($self->name,@_);
103 }
104
105 sub index {
106 my $self = shift;
107 return $self->sock->if_index($self->name);
108 }
109
110 sub is_running { shift->_gettestflag(IO::Interface::IFF_RUNNING(),@_) }
111 sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(),@_) }
112 sub is_pt2pt { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(),@_) }
113 sub is_loopback { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(),@_) }
114 sub is_promiscuous { shift->_gettestflag(IO::Interface::IFF_PROMISC(),@_) }
115 sub is_multicast { shift->_gettestflag(IO::Interface::IFF_MULTICAST(),@_) }
116 sub is_notrailers { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(),@_) }
117 sub is_noarp { shift->_gettestflag(IO::Interface::IFF_NOARP(),@_) }
118
119 sub _gettestflag {
120 my $self = shift;
121 my $bitmask = shift;
122 my $flags = $self->flags;
123 if (@_) {
124 $flags |= $bitmask;
125 $self->flags($flags);
126 } else {
127 return ($flags & $bitmask) != 0;
128 }
129 }
130
131 1;
132
133 =head1 NAME
134
135 IO::Interface::Simple - Perl extension for access to network card configuration information
136
137 =head1 SYNOPSIS
138
139 use IO::Interface::Simple;
140
141 my $if1 = IO::Interface::Simple->new('eth0');
142 my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1');
143 my $if3 = IO::Interface::Simple->new_from_index(1);
144
145 my @interfaces = IO::Interface::Simple->interfaces;
146
147 for my $if (@interfaces) {
148 print "interface = $if\n";
149 print "addr = ",$if->address,"\n",
150 "broadcast = ",$if->broadcast,"\n",
151 "netmask = ",$if->netmask,"\n",
152 "dstaddr = ",$if->dstaddr,"\n",
153 "hwaddr = ",$if->hwaddr,"\n",
154 "mtu = ",$if->mtu,"\n",
155 "metric = ",$if->metric,"\n",
156 "index = ",$if->index,"\n";
157
158 print "is running\n" if $if->is_running;
159 print "is broadcast\n" if $if->is_broadcast;
160 print "is p-to-p\n" if $if->is_pt2pt;
161 print "is loopback\n" if $if->is_loopback;
162 print "is promiscuous\n" if $if->is_promiscuous;
163 print "is multicast\n" if $if->is_multicast;
164 print "is notrailers\n" if $if->is_notrailers;
165 print "is noarp\n" if $if->is_noarp;
166 }
167
168
169 =head1 DESCRIPTION
170
171 IO::Interface::Simple allows you to interrogate and change network
172 interfaces. It has overlapping functionality with Net::Interface, but
173 might compile and run on more platforms.
174
175 =head2 Class Methods
176
177 =over 4
178
179 =item $interface = IO::Interface::Simple->new('eth0')
180
181 Given an interface name, new() creates an interface object.
182
183 =item @iflist = IO::Interface::Simple->interfaces;
184
185 Returns a list of active interface objects.
186
187 =item $interface = IO::Interface::Simple->new_from_address('192.168.0.1')
188
189 Returns the interface object corresponding to the given address.
190
191 =item $interface = IO::Interface::Simple->new_from_index(2)
192
193 Returns the interface object corresponding to the given numeric
194 index. This is only supported on BSD-ish platforms.
195
196 =back
197
198 =head2 Object Methods
199
200 =over 4
201
202 =item $name = $interface->name
203
204 Get the name of the interface. The interface object is also overloaded
205 so that if you use it in a string context it is the same as calling
206 name().
207
208 =item $index = $interface->index
209
210 Get the index of the interface. This is only supported on BSD-like
211 platforms.
212
213 =item $addr = $interface->address([$newaddr])
214
215 Get or set the interface's address.
216
217
218 =item $addr = $interface->broadcast([$newaddr])
219
220 Get or set the interface's broadcast address.
221
222 =item $addr = $interface->netmask([$newmask])
223
224 Get or set the interface's netmask.
225
226 =item $addr = $interface->hwaddr([$newaddr])
227
228 Get or set the interface's hardware address.
229
230 =item $addr = $interface->mtu([$newmtu])
231
232 Get or set the interface's MTU.
233
234 =item $addr = $interface->metric([$newmetric])
235
236 Get or set the interface's metric.
237
238 =item $flags = $interface->flags([$newflags])
239
240 Get or set the interface's flags. These can be ANDed with the IFF
241 constants exported by IO::Interface or Net::Interface in order to
242 interrogate the state and capabilities of the interface. However, it
243 is probably more convenient to use the broken-out methods listed
244 below.
245
246 =item $flag = $interface->is_running([$newflag])
247
248 =item $flag = $interface->is_broadcast([$newflag])
249
250 =item $flag = $interface->is_pt2pt([$newflag])
251
252 =item $flag = $interface->is_loopback([$newflag])
253
254 =item $flag = $interface->is_promiscuous([$newflag])
255
256 =item $flag = $interface->is_multicast([$newflag])
257
258 =item $flag = $interface->is_notrailers([$newflag])
259
260 =item $flag = $interface->is_noarp([$newflag])
261
262 Get or set the corresponding configuration parameters. Note that the
263 operating system may not let you set some of these.
264
265 =back
266
267 =head1 AUTHOR
268
269 Lincoln D. Stein <lincoln.stein@gmail.com>
270 Copyright 2001-2014, Lincoln D. Stein.
271
272 This library is distributed under the Perl Artistic License
273 2.0. Please see LICENSE for more information.
274
275 =head1 SUPPORT
276
277 For feature requests, bug reports and code contributions, please use
278 the GitHub repository at
279 https://github.com/lstein/LibIO-Interface-Perl
280
281 =head1 SEE ALSO
282
283 L<perl>, L<IO::Socket>, L<IO::Multicast>), L<IO::Interface>, L<Net::Interface>
284
285 =cut
286
+303
-0
lib/IO/Interface.pm less more
0 package IO::Interface;
1
2 require 5.005;
3 use strict;
4 use Carp;
5 use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD);
6
7 use IO::Socket;
8
9 require Exporter;
10 require DynaLoader;
11
12 my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric
13 addr_to_interface if_index if_indextoname );
14 my @flags = qw(IFF_ALLMULTI IFF_AUTOMEDIA IFF_BROADCAST
15 IFF_DEBUG IFF_LOOPBACK IFF_MASTER
16 IFF_MULTICAST IFF_NOARP IFF_NOTRAILERS
17 IFF_POINTOPOINT IFF_PORTSEL IFF_PROMISC
18 IFF_RUNNING IFF_SLAVE IFF_UP);
19 %EXPORT_TAGS = ( 'all' => [@functions,@flags],
20 'functions' => \@functions,
21 'flags' => \@flags,
22 );
23
24 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25
26 @EXPORT = qw( );
27
28 @ISA = qw(Exporter DynaLoader);
29 $VERSION = '1.09';
30
31 sub AUTOLOAD {
32 # This AUTOLOAD is used to 'autoload' constants from the constant()
33 # XS function. If a constant is not found then control is passed
34 # to the AUTOLOAD in AutoLoader.
35
36 my $constname;
37 ($constname = $AUTOLOAD) =~ s/.*:://;
38 croak "&constant not defined" if $constname eq 'constant';
39 my $val = constant($constname, @_ ? $_[0] : 0);
40 if ($! != 0) {
41 if ($! =~ /Invalid/ || $!{EINVAL}) {
42 $AutoLoader::AUTOLOAD = $AUTOLOAD;
43 goto &AutoLoader::AUTOLOAD;
44 }
45 else {
46 croak "Your vendor has not defined IO::Interface macro $constname";
47 }
48 }
49 {
50 no strict 'refs';
51 *$AUTOLOAD = sub { $val }; # *$AUTOLOAD = sub() { $val };
52 }
53 goto &$AUTOLOAD;
54 }
55
56 bootstrap IO::Interface $VERSION;
57
58 # copy routines into IO::Socket
59 {
60 no strict 'refs';
61 *{"IO\:\:Socket\:\:$_"} = \&$_ foreach @functions;
62 }
63
64 # Preloaded methods go here.
65
66 sub if_list {
67 my %hash = map {$_=>undef} &_if_list;
68 sort keys %hash;
69 }
70
71 sub addr_to_interface {
72 my ($sock,$addr) = @_;
73 return "any" if $addr eq '0.0.0.0';
74 my @interfaces = $sock->if_list;
75 foreach (@interfaces) {
76 my $if_addr = $sock->if_addr($_) or next;
77 return $_ if $if_addr eq $addr;
78 }
79 return; # couldn't find it
80 }
81
82 # Autoload methods go after =cut, and are processed by the autosplit program.
83 1;
84 __END__
85
86 =head1 NAME
87
88 IO::Interface - Perl extension for access to network card configuration information
89
90 =head1 SYNOPSIS
91
92 # ======================
93 # the new, preferred API
94 # ======================
95
96 use IO::Interface::Simple;
97
98 my $if1 = IO::Interface::Simple->new('eth0');
99 my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1');
100 my $if3 = IO::Interface::Simple->new_from_index(1);
101
102 my @interfaces = IO::Interface::Simple->interfaces;
103
104 for my $if (@interfaces) {
105 print "interface = $if\n";
106 print "addr = ",$if->address,"\n",
107 "broadcast = ",$if->broadcast,"\n",
108 "netmask = ",$if->netmask,"\n",
109 "dstaddr = ",$if->dstaddr,"\n",
110 "hwaddr = ",$if->hwaddr,"\n",
111 "mtu = ",$if->mtu,"\n",
112 "metric = ",$if->metric,"\n",
113 "index = ",$if->index,"\n";
114
115 print "is running\n" if $if->is_running;
116 print "is broadcast\n" if $if->is_broadcast;
117 print "is p-to-p\n" if $if->is_pt2pt;
118 print "is loopback\n" if $if->is_loopback;
119 print "is promiscuous\n" if $if->is_promiscuous;
120 print "is multicast\n" if $if->is_multicast;
121 print "is notrailers\n" if $if->is_notrailers;
122 print "is noarp\n" if $if->is_noarp;
123 }
124
125
126 # ===========
127 # the old API
128 # ===========
129
130 use IO::Socket;
131 use IO::Interface qw(:flags);
132
133 my $s = IO::Socket::INET->new(Proto => 'udp');
134 my @interfaces = $s->if_list;
135
136 for my $if (@interfaces) {
137 print "interface = $if\n";
138 my $flags = $s->if_flags($if);
139 print "addr = ",$s->if_addr($if),"\n",
140 "broadcast = ",$s->if_broadcast($if),"\n",
141 "netmask = ",$s->if_netmask($if),"\n",
142 "dstaddr = ",$s->if_dstaddr($if),"\n",
143 "hwaddr = ",$s->if_hwaddr($if),"\n";
144
145 print "is running\n" if $flags & IFF_RUNNING;
146 print "is broadcast\n" if $flags & IFF_BROADCAST;
147 print "is p-to-p\n" if $flags & IFF_POINTOPOINT;
148 print "is loopback\n" if $flags & IFF_LOOPBACK;
149 print "is promiscuous\n" if $flags & IFF_PROMISC;
150 print "is multicast\n" if $flags & IFF_MULTICAST;
151 print "is notrailers\n" if $flags & IFF_NOTRAILERS;
152 print "is noarp\n" if $flags & IFF_NOARP;
153 }
154
155 my $interface = $s->addr_to_interface('127.0.0.1');
156
157
158 =head1 DESCRIPTION
159
160 IO::Interface adds methods to IO::Socket objects that allows them to
161 be used to retrieve and change information about the network
162 interfaces on your system. In addition to the object-oriented access
163 methods, you can use a function-oriented style.
164
165 THIS API IS DEPRECATED. Please see L<IO::Interface::Simple> for the
166 preferred way to get and set interface configuration information.
167
168 =head2 Creating a Socket to Access Interface Information
169
170 You must create a socket before you can access interface
171 information. The socket does not have to be connected to a remote
172 site, or even used for communication. The simplest procedure is to
173 create a UDP protocol socket:
174
175 my $s = IO::Socket::INET->new(Proto => 'udp');
176
177 The various IO::Interface functions will now be available as methods
178 on this socket.
179
180 =head2 Methods
181
182 =over 4
183
184 =item @iflist = $s->if_list
185
186 The if_list() method will return a list of active interface names, for
187 example "eth0" or "tu0". If no interfaces are configured and running,
188 returns an empty list.
189
190 =item $addr = $s->if_addr($ifname [,$newaddr])
191
192 if_addr() gets or sets the interface address. Call with the interface
193 name to retrieve the address (in dotted decimal format). Call with a
194 new address to set the interface. In the latter case, the routine
195 will return a true value if the operation was successful.
196
197 my $oldaddr = $s->if_addr('eth0');
198 $s->if_addr('eth0','192.168.8.10') || die "couldn't set address: $!";
199
200 Special case: the address of the pseudo-device "any" will return the
201 IP address "0.0.0.0", which corresponds to the INADDR_ANY constant.
202
203 =item $broadcast = $s->if_broadcast($ifname [,$newbroadcast]
204
205 Get or set the interface broadcast address. If the interface does not
206 have a broadcast address, returns undef.
207
208 =item $mask = $s->if_netmask($ifname [,$newmask])
209
210 Get or set the interface netmask.
211
212 =item $dstaddr = $s->if_dstaddr($ifname [,$newdest])
213
214 Get or set the destination address for point-to-point interfaces.
215
216 =item $hwaddr = $s->if_hwaddr($ifname [,$newhwaddr])
217
218 Get or set the hardware address for the interface. Currently only
219 ethernet addresses in the form "00:60:2D:2D:51:70" are accepted.
220
221 =item $flags = $s->if_flags($ifname [,$newflags])
222
223 Get or set the flags for the interface. The flags are a bitmask
224 formed from a series of constants. See L<Exportable constants> below.
225
226 =item $ifname = $s->addr_to_interface($ifaddr)
227
228 Given an interface address in dotted form, returns the name of the
229 interface associated with it. Special case: the INADDR_ANY address,
230 0.0.0.0 will return a pseudo-interface name of "any".
231
232 =back
233
234 =head2 EXPORT
235
236 IO::Interface exports nothing by default. However, you can import the
237 following symbol groups into your namespace:
238
239 :functions Function-oriented interface (see below)
240 :flags Flag constants (see below)
241 :all All of the above
242
243 =head2 Function-Oriented Interface
244
245 By importing the ":functions" set, you can access IO::Interface in a
246 function-oriented manner. This imports all the methods described
247 above into your namespace. Example:
248
249 use IO::Socket;
250 use IO::Interface ':functions';
251
252 my $sock = IO::Socket::INET->new(Proto=>'udp');
253 my @interfaces = if_list($sock);
254 print "address = ",if_addr($sock,$interfaces[0]);
255
256 =head2 Exportable constants
257
258 The ":flags" constant imports the following constants for use with the
259 flags returned by if_flags():
260
261 IFF_ALLMULTI
262 IFF_AUTOMEDIA
263 IFF_BROADCAST
264 IFF_DEBUG
265 IFF_LOOPBACK
266 IFF_MASTER
267 IFF_MULTICAST
268 IFF_NOARP
269 IFF_NOTRAILERS
270 IFF_POINTOPOINT
271 IFF_PORTSEL
272 IFF_PROMISC
273 IFF_RUNNING
274 IFF_SLAVE
275 IFF_UP
276
277 This example determines whether interface 'tu0' supports multicasting:
278
279 use IO::Socket;
280 use IO::Interface ':flags';
281 my $sock = IO::Socket::INET->new(Proto=>'udp');
282 print "can multicast!\n" if $sock->if_flags & IFF_MULTICAST.
283
284 =head1 AUTHOR
285
286 Lincoln D. Stein <lincoln.stein@gmail.com>
287 Copyright 2001-2014, Lincoln D. Stein.
288
289 This library is distributed under the Perl Artistic License
290 2.0. Please see LICENSE for more information.
291
292 =head1 SUPPORT
293
294 For feature requests, bug reports and code contributions, please use
295 the GitHub repository at
296 https://github.com/lstein/LibIO-Interface-Perl
297
298 =head1 SEE ALSO
299
300 perl(1), IO::Socket(3), IO::Multicast(3), L<IO::Interface::Simple>
301
302 =cut
+825
-0
lib/IO/Interface.xs less more
0 /* Interface.xs: part of LibIO-Interface-Perl */
1 /* Copyright 2014 Lincoln D. Stein */
2 /* Licensed under Perl Artistic License 2.0 */
3 /* Please see LICENSE and README.md for more information. */
4
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
8
9 #include <stdio.h>
10 #include <string.h>
11
12 /* socket definitions */
13 #include <sys/types.h>
14 #include <sys/socket.h>
15 #include <sys/ioctl.h>
16
17 /* location of IFF_* constants */
18 #include <net/if.h>
19
20 /* location of getifaddrs() definition */
21 #ifdef USE_GETIFADDRS
22 #include <ifaddrs.h>
23
24 #ifdef HAVE_SOCKADDR_DL_STRUCT
25 #include <net/if_dl.h>
26 #endif
27
28 #endif
29
30 #ifndef SIOCGIFCONF
31 #include <sys/sockio.h>
32 #endif
33
34 #ifdef OSIOCGIFCONF
35 #define MY_SIOCGIFCONF OSIOCGIFCONF
36 #else
37 #define MY_SIOCGIFCONF SIOCGIFCONF
38 #endif
39
40 #ifdef PerlIO
41 typedef PerlIO * InputStream;
42 #else
43 #define PERLIO_IS_STDIO 1
44 typedef FILE * InputStream;
45 #define PerlIO_fileno(f) fileno(f)
46 #endif
47
48 #if !defined(__USE_BSD)
49 #if defined(__linux__)
50 typedef int IOCTL_CMD_T;
51 #define __USE_BSD
52 #elif defined(__APPLE__)
53 typedef unsigned long IOCTL_CMD_T;
54 #define __USE_BSD
55 #else
56 typedef int IOCTL_CMD_T;
57 #endif
58 #else
59 typedef unsigned long IOCTL_CMD_T;
60 #endif
61
62 /* HP-UX, Solaris */
63 #if !defined(ifr_mtu) && defined(ifr_metric)
64 #define ifr_mtu ifr_metric
65 #endif
66
67 static double
68 constant_IFF_N(char *name, int len, int arg)
69 {
70 errno = 0;
71 if (5 + 1 >= len ) {
72 errno = EINVAL;
73 return 0;
74 }
75 switch (name[5 + 1]) {
76 case 'A':
77 if (strEQ(name + 5, "OARP")) { /* IFF_N removed */
78 #ifdef IFF_NOARP
79 return IFF_NOARP;
80 #else
81 goto not_there;
82 #endif
83 }
84 case 'T':
85 if (strEQ(name + 5, "OTRAILERS")) { /* IFF_N removed */
86 #ifdef IFF_NOTRAILERS
87 return IFF_NOTRAILERS;
88 #else
89 goto not_there;
90 #endif
91 }
92 }
93 errno = EINVAL;
94 return 0;
95
96 not_there:
97 errno = ENOENT;
98 return 0;
99 }
100
101 static double
102 constant_IFF_PO(char *name, int len, int arg)
103 {
104 errno = 0;
105 switch (name[6 + 0]) {
106 case 'I':
107 if (strEQ(name + 6, "INTOPOINT")) { /* IFF_PO removed */
108 #ifdef IFF_POINTOPOINT
109 return IFF_POINTOPOINT;
110 #else
111 goto not_there;
112 #endif
113 }
114 case 'R':
115 if (strEQ(name + 6, "RTSEL")) { /* IFF_PO removed */
116 #ifdef IFF_PORTSEL
117 return IFF_PORTSEL;
118 #else
119 goto not_there;
120 #endif
121 }
122 }
123 errno = EINVAL;
124 return 0;
125
126 not_there:
127 errno = ENOENT;
128 return 0;
129 }
130
131 static double
132 constant_IFF_P(char *name, int len, int arg)
133 {
134 errno = 0;
135 switch (name[5 + 0]) {
136 case 'O':
137 return constant_IFF_PO(name, len, arg);
138 case 'R':
139 if (strEQ(name + 5, "ROMISC")) { /* IFF_P removed */
140 #ifdef IFF_PROMISC
141 return IFF_PROMISC;
142 #else
143 goto not_there;
144 #endif
145 }
146 }
147 errno = EINVAL;
148 return 0;
149
150 not_there:
151 errno = ENOENT;
152 return 0;
153 }
154
155 static double
156 constant_IFF_A(char *name, int len, int arg)
157 {
158 errno = 0;
159 switch (name[5 + 0]) {
160 case 'L':
161 if (strEQ(name + 5, "LLMULTI")) { /* IFF_A removed */
162 #ifdef IFF_ALLMULTI
163 return IFF_ALLMULTI;
164 #else
165 goto not_there;
166 #endif
167 }
168 case 'U':
169 if (strEQ(name + 5, "UTOMEDIA")) { /* IFF_A removed */
170 #ifdef IFF_AUTOMEDIA
171 return IFF_AUTOMEDIA;
172 #else
173 goto not_there;
174 #endif
175 }
176 }
177 errno = EINVAL;
178 return 0;
179
180 not_there:
181 errno = ENOENT;
182 return 0;
183 }
184
185 static double
186 constant_IFF_M(char *name, int len, int arg)
187 {
188 errno = 0;
189 switch (name[5 + 0]) {
190 case 'A':
191 if (strEQ(name + 5, "ASTER")) { /* IFF_M removed */
192 #ifdef IFF_MASTER
193 return IFF_MASTER;
194 #else
195 goto not_there;
196 #endif
197 }
198 case 'U':
199 if (strEQ(name + 5, "ULTICAST")) { /* IFF_M removed */
200 #ifdef IFF_MULTICAST
201 return IFF_MULTICAST;
202 #else
203 goto not_there;
204 #endif
205 }
206 }
207 errno = EINVAL;
208 return 0;
209
210 not_there:
211 errno = ENOENT;
212 return 0;
213 }
214
215 static double
216 constant_IFF(char *name, int len, int arg)
217 {
218 errno = 0;
219 if (3 + 1 >= len ) {
220 errno = EINVAL;
221 return 0;
222 }
223 switch (name[3 + 1]) {
224 case 'A':
225 if (!strnEQ(name + 3,"_", 1))
226 break;
227 return constant_IFF_A(name, len, arg);
228 case 'B':
229 if (strEQ(name + 3, "_BROADCAST")) { /* IFF removed */
230 #ifdef IFF_BROADCAST
231 return IFF_BROADCAST;
232 #else
233 goto not_there;
234 #endif
235 }
236 case 'D':
237 if (strEQ(name + 3, "_DEBUG")) { /* IFF removed */
238 #ifdef IFF_DEBUG
239 return IFF_DEBUG;
240 #else
241 goto not_there;
242 #endif
243 }
244 case 'L':
245 if (strEQ(name + 3, "_LOOPBACK")) { /* IFF removed */
246 #ifdef IFF_LOOPBACK
247 return IFF_LOOPBACK;
248 #else
249 goto not_there;
250 #endif
251 }
252 case 'M':
253 if (!strnEQ(name + 3,"_", 1))
254 break;
255 return constant_IFF_M(name, len, arg);
256 case 'N':
257 if (!strnEQ(name + 3,"_", 1))
258 break;
259 return constant_IFF_N(name, len, arg);
260 case 'P':
261 if (!strnEQ(name + 3,"_", 1))
262 break;
263 return constant_IFF_P(name, len, arg);
264 case 'R':
265 if (strEQ(name + 3, "_RUNNING")) { /* IFF removed */
266 #ifdef IFF_RUNNING
267 return IFF_RUNNING;
268 #else
269 goto not_there;
270 #endif
271 }
272 case 'S':
273 if (strEQ(name + 3, "_SLAVE")) { /* IFF removed */
274 #ifdef IFF_SLAVE
275 return IFF_SLAVE;
276 #else
277 goto not_there;
278 #endif
279 }
280 case 'U':
281 if (strEQ(name + 3, "_UP")) { /* IFF removed */
282 #ifdef IFF_UP
283 return IFF_UP;
284 #else
285 goto not_there;
286 #endif
287 }
288 }
289 errno = EINVAL;
290 return 0;
291
292 not_there:
293 errno = ENOENT;
294 return 0;
295 }
296
297 static double
298 constant_I(char *name, int len, int arg)
299 {
300 errno = 0;
301 if (1 + 1 >= len ) {
302 errno = EINVAL;
303 return 0;
304 }
305 switch (name[1 + 1]) {
306 case 'F':
307 if (!strnEQ(name + 1,"F", 1))
308 break;
309 return constant_IFF(name, len, arg);
310 case 'H':
311 if (strEQ(name + 1, "FHWADDRLEN")) { /* I removed */
312 #ifdef IFHWADDRLEN
313 return IFHWADDRLEN;
314 #else
315 goto not_there;
316 #endif
317 }
318 case 'N':
319 if (strEQ(name + 1, "FNAMSIZ")) { /* I removed */
320 #ifdef IFNAMSIZ
321 return IFNAMSIZ;
322 #else
323 goto not_there;
324 #endif
325 }
326 }
327 errno = EINVAL;
328 return 0;
329
330 not_there:
331 errno = ENOENT;
332 return 0;
333 }
334
335 static double
336 constant(char *name, int len, int arg)
337 {
338 errno = 0;
339 switch (name[0 + 0]) {
340 case 'I':
341 return constant_I(name, len, arg);
342 }
343 errno = EINVAL;
344 return 0;
345
346 not_there:
347 errno = ENOENT;
348 return 0;
349 }
350
351 int Ioctl (InputStream sock, IOCTL_CMD_T operation,void* result) {
352 int fd = PerlIO_fileno(sock);
353 return ioctl(fd,operation,result) == 0;
354 }
355
356 #ifdef IFHWADDRLEN
357 char* parse_hwaddr (char *string, struct sockaddr* hwaddr) {
358 int len,i,consumed;
359 unsigned int converted;
360 char* s;
361 s = string;
362 len = strlen(s);
363 for (i = 0; i < IFHWADDRLEN && len > 0; i++) {
364 if (sscanf(s,"%x%n",&converted,&consumed) <= 0)
365 break;
366 hwaddr->sa_data[i] = converted;
367 s += consumed + 1;
368 len -= consumed + 1;
369 }
370 if (i != IFHWADDRLEN)
371 return NULL;
372 else
373 return string;
374 }
375
376 /* No checking for string buffer length. Caller must ensure at least
377 3*4 + 3 + 1 = 16 bytes long */
378 char* format_hwaddr (char *string, struct sockaddr* hwaddr) {
379 int i,len;
380 char *s;
381 s = string;
382 s[0] = '\0';
383 for (i = 0; i < IFHWADDRLEN; i++) {
384 if (i < IFHWADDRLEN-1)
385 len = sprintf(s,"%02x:",(unsigned char)hwaddr->sa_data[i]);
386 else
387 len = sprintf(s,"%02x",(unsigned char)hwaddr->sa_data[i]);
388 s += len;
389 }
390 return string;
391 }
392 #endif
393
394 MODULE = IO::Interface PACKAGE = IO::Interface
395
396 double
397 constant(sv,arg)
398 PREINIT:
399 STRLEN len;
400 PROTOTYPE: $;$
401 INPUT:
402 SV * sv
403 char * s = SvPV(sv, len);
404 int arg
405 CODE:
406 RETVAL = constant(s,len,arg);
407 OUTPUT:
408 RETVAL
409
410 char*
411 if_addr(sock, name, ...)
412 InputStream sock
413 char* name
414 PROTOTYPE: $$;$
415 PREINIT:
416 STRLEN len;
417 IOCTL_CMD_T operation;
418 struct ifreq ifr;
419 char* newaddr;
420 CODE:
421 {
422 #if !(defined(HAS_IOCTL) && defined(SIOCGIFADDR))
423 XSRETURN_UNDEF;
424 #else
425 if (strncmp(name,"any",3) == 0) {
426 RETVAL = "0.0.0.0";
427 } else {
428 bzero((void*)&ifr,sizeof(struct ifreq));
429 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
430 ifr.ifr_addr.sa_family = AF_INET;
431 if (items > 2) {
432 newaddr = SvPV(ST(2),len);
433 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
434 croak("Invalid inet address");
435 #if defined(SIOCSIFADDR)
436 operation = SIOCSIFADDR;
437 #else
438 croak("Cannot set interface address on this platform");
439 #endif
440 } else {
441 operation = SIOCGIFADDR;
442 }
443 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
444 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
445 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
446 }
447 #endif
448 }
449 OUTPUT:
450 RETVAL
451
452 char*
453 if_broadcast(sock, name, ...)
454 InputStream sock
455 char* name
456 PROTOTYPE: $$;$
457 PREINIT:
458 STRLEN len;
459 IOCTL_CMD_T operation;
460 struct ifreq ifr;
461 char* newaddr;
462 CODE:
463 {
464 #if !(defined(HAS_IOCTL) && defined(SIOCGIFBRDADDR))
465 XSRETURN_UNDEF;
466 #else
467 bzero((void*)&ifr,sizeof(struct ifreq));
468 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
469 ifr.ifr_addr.sa_family = AF_INET;
470 if (items > 2) {
471 newaddr = SvPV(ST(2),len);
472 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
473 croak("Invalid inet address");
474 #if defined(SIOCSIFBRDADDR)
475 operation = SIOCSIFBRDADDR;
476 #else
477 croak("Cannot set broadcast address on this platform");
478 #endif
479 } else {
480 operation = SIOCGIFBRDADDR;
481 }
482 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
483 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
484 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
485 #endif
486 }
487 OUTPUT:
488 RETVAL
489
490 char*
491 if_netmask(sock, name, ...)
492 InputStream sock
493 char* name
494 PROTOTYPE: $$;$
495 PREINIT:
496 STRLEN len;
497 IOCTL_CMD_T operation;
498 struct ifreq ifr;
499 char* newaddr;
500 CODE:
501 {
502 #if !(defined(HAS_IOCTL) && defined(SIOCGIFNETMASK))
503 XSRETURN_UNDEF;
504 #else
505 bzero((void*)&ifr,sizeof(struct ifreq));
506 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
507 ifr.ifr_addr.sa_family = AF_INET;
508 if (items > 2) {
509 newaddr = SvPV(ST(2),len);
510 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
511 croak("Invalid inet address");
512 #if defined(SIOCSIFNETMASK)
513 operation = SIOCSIFNETMASK;
514 #else
515 croak("Cannot set netmask on this platform");
516 #endif
517 } else {
518 operation = SIOCGIFNETMASK;
519 }
520 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
521 #if defined(__NetBSD__) || defined(__OpenBSD__)
522 ifr.ifr_addr.sa_family = AF_INET;
523 #endif
524 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
525 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
526 #endif
527 }
528 OUTPUT:
529 RETVAL
530
531 char*
532 if_dstaddr(sock, name, ...)
533 InputStream sock
534 char* name
535 PROTOTYPE: $$;$
536 PREINIT:
537 STRLEN len;
538 IOCTL_CMD_T operation;
539 struct ifreq ifr;
540 char* newaddr;
541 CODE:
542 {
543 #if !(defined(HAS_IOCTL) && defined(SIOCGIFDSTADDR))
544 XSRETURN_UNDEF;
545 #else
546 bzero((void*)&ifr,sizeof(struct ifreq));
547 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
548 ifr.ifr_addr.sa_family = AF_INET;
549 if (items > 2) {
550 newaddr = SvPV(ST(2),len);
551 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 )
552 croak("Invalid inet address");
553 #if defined(SIOCSIFDSTADDR)
554 operation = SIOCSIFDSTADDR;
555 #else
556 croak("Cannot set destination address on this platform");
557 #endif
558 } else {
559 operation = SIOCGIFDSTADDR;
560 }
561 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
562 if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n");
563 RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr);
564 #endif
565 }
566 OUTPUT:
567 RETVAL
568
569 char*
570 if_hwaddr(sock, name, ...)
571 InputStream sock
572 char* name
573 PROTOTYPE: $$;$
574 PREINIT:
575 STRLEN len;
576 IOCTL_CMD_T operation;
577 struct ifreq ifr;
578 #if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT))
579 struct ifaddrs *ifap, *ifa;
580 struct sockaddr_dl* sdl;
581 sa_family_t family;
582 char *sdlname, *haddr, *s;
583 int hlen = 0;
584 int i;
585 #endif
586 char *newaddr,hwaddr[128];
587 CODE:
588 {
589 #if !((defined(HAS_IOCTL) && defined(SIOCGIFHWADDR)) || defined(USE_GETIFADDRS))
590 XSRETURN_UNDEF;
591 #endif
592 #if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT))
593 getifaddrs(&ifap);
594
595 for (ifa = ifap; ifa; ifa = ifa->ifa_next) {
596 if (strncmp(name, ifa->ifa_name, IFNAMSIZ) == 0) {
597 family = ifa->ifa_addr->sa_family;
598 if (family == AF_LINK) {
599 sdl = (struct sockaddr_dl *) ifa->ifa_addr;
600 haddr = sdl->sdl_data + sdl->sdl_nlen;
601 hlen = sdl->sdl_alen;
602 break;
603 }
604 }
605 }
606
607 s = hwaddr;
608 s[0] = '\0';
609 if (ifap != NULL) {
610 for (i = 0; i < hlen; i++) {
611 if (i < hlen - 1)
612 len = sprintf(s,"%02x:",(unsigned char)haddr[i]);
613 else
614 len = sprintf(s,"%02x",(unsigned char)haddr[i]);
615 s += len;
616 }
617 }
618
619 freeifaddrs(ifap);
620
621 RETVAL = hwaddr;
622 #elif (defined(HAS_IOCTL) && defined(SIOCGIFHWADDR))
623 bzero((void*)&ifr,sizeof(struct ifreq));
624 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
625 ifr.ifr_hwaddr.sa_family = AF_UNSPEC;
626 if (items > 2) {
627 newaddr = SvPV(ST(2),len);
628 if (parse_hwaddr(newaddr,&ifr.ifr_hwaddr) == NULL)
629 croak("Invalid hardware address");
630 #if defined(SIOCSIFHWADDR)
631 operation = SIOCSIFHWADDR;
632 #else
633 croak("Cannot set hw address on this platform");
634 #endif
635 } else {
636 operation = SIOCGIFHWADDR;
637 }
638 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
639 RETVAL = format_hwaddr(hwaddr,&ifr.ifr_hwaddr);
640 #endif
641 }
642 OUTPUT:
643 RETVAL
644
645
646 int
647 if_flags(sock, name, ...)
648 InputStream sock
649 char* name
650 PROTOTYPE: $$;$
651 PREINIT:
652 IOCTL_CMD_T operation;
653 int flags;
654 struct ifreq ifr;
655 CODE:
656 {
657 #if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
658 XSRETURN_UNDEF;
659 #endif
660 bzero((void*)&ifr,sizeof(struct ifreq));
661 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
662 if (items > 2) {
663 ifr.ifr_flags = SvIV(ST(2));
664 #if defined(SIOCSIFFLAGS)
665 operation = SIOCSIFFLAGS;
666 #else
667 croak("Cannot set flags on this platform.");
668 #endif
669 } else {
670 operation = SIOCGIFFLAGS;
671 }
672 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
673 RETVAL = ifr.ifr_flags;
674 }
675 OUTPUT:
676 RETVAL
677
678 int
679 if_mtu(sock, name, ...)
680 InputStream sock
681 char* name
682 PROTOTYPE: $$;$
683 PREINIT:
684 IOCTL_CMD_T operation;
685 int flags;
686 struct ifreq ifr;
687 CODE:
688 {
689 #if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
690 XSRETURN_UNDEF;
691 #endif
692 bzero((void*)&ifr,sizeof(struct ifreq));
693 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
694 if (items > 2) {
695 ifr.ifr_flags = SvIV(ST(2));
696 #if defined(SIOCSIFMTU)
697 operation = SIOCSIFMTU;
698 #else
699 croak("Cannot set MTU on this platform.");
700 #endif
701 } else {
702 operation = SIOCGIFMTU;
703 }
704 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
705 RETVAL = ifr.ifr_mtu;
706 }
707 OUTPUT:
708 RETVAL
709
710 int
711 if_metric(sock, name, ...)
712 InputStream sock
713 char* name
714 PROTOTYPE: $$;$
715 PREINIT:
716 IOCTL_CMD_T operation;
717 int flags;
718 struct ifreq ifr;
719 CODE:
720 {
721 #if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
722 XSRETURN_UNDEF;
723 #endif
724 bzero((void*)&ifr,sizeof(struct ifreq));
725 strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
726 if (items > 2) {
727 ifr.ifr_flags = SvIV(ST(2));
728 #if defined(SIOCSIFMETRIC)
729 operation = SIOCSIFMETRIC;
730 #else
731 croak("Cannot set metric on this platform.");
732 #endif
733 } else {
734 operation = SIOCGIFMETRIC;
735 }
736 if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
737 RETVAL = ifr.ifr_metric;
738 }
739 OUTPUT:
740 RETVAL
741
742 int
743 if_index(sock, name, ...)
744 InputStream sock
745 char* name
746 PROTOTYPE: $$;$
747 CODE:
748 {
749 #ifdef __USE_BSD
750 RETVAL = if_nametoindex(name);
751 #else
752 XSRETURN_UNDEF;
753 #endif
754 }
755 OUTPUT:
756 RETVAL
757
758 char*
759 if_indextoname(sock, index, ...)
760 InputStream sock
761 int index
762 PROTOTYPE: $$;$
763 PREINIT:
764 char name[IFNAMSIZ];
765 CODE:
766 {
767 #ifdef __USE_BSD
768 RETVAL = if_indextoname(index,name);
769 #else
770 XSRETURN_UNDEF;
771 #endif
772 }
773 OUTPUT:
774 RETVAL
775
776 void
777 _if_list(sock)
778 InputStream sock
779 PROTOTYPE: $
780 PREINIT:
781 #ifdef USE_GETIFADDRS
782 struct ifaddrs *ifa_start;
783 struct ifaddrs *ifa;
784 #else
785 struct ifconf ifc;
786 struct ifreq *ifr;
787 int lastlen,len;
788 char *buf,*ptr;
789 #endif
790 PPCODE:
791 #ifdef USE_GETIFADDRS
792 if (getifaddrs(&ifa_start) < 0)
793 XSRETURN_EMPTY;
794
795 for (ifa = ifa_start ; ifa ; ifa = ifa->ifa_next)
796 XPUSHs(sv_2mortal(newSVpv(ifa->ifa_name,0)));
797
798 freeifaddrs(ifa_start);
799 #else
800 lastlen = 0;
801 len = 10 * sizeof(struct ifreq); /* initial buffer size guess */
802 for ( ; ; ) {
803 if ( (buf = safemalloc(len)) == NULL)
804 croak("Couldn't malloc buffer for ioctl: %s",strerror(errno));
805 ifc.ifc_len = len;
806 ifc.ifc_buf = buf;
807 if (ioctl(PerlIO_fileno(sock),MY_SIOCGIFCONF,&ifc) < 0) {
808 if (errno != EINVAL || lastlen != 0)
809 XSRETURN_EMPTY;
810 } else {
811 if (ifc.ifc_len == lastlen) break; /* success, len has not changed */
812 lastlen = ifc.ifc_len;
813 }
814 len += 10 * sizeof(struct ifreq); /* increment */
815 safefree(buf);
816 }
817
818 for (ptr = buf ; ptr < buf + ifc.ifc_len ; ptr += sizeof(struct ifreq)) {
819 ifr = (struct ifreq*) ptr;
820 XPUSHs(sv_2mortal(newSVpv(ifr->ifr_name,0)));
821 }
822 safefree(buf);
823 #endif
824