1*0Sstevel@tonic-gatepackage Net::netent; 2*0Sstevel@tonic-gateuse strict; 3*0Sstevel@tonic-gate 4*0Sstevel@tonic-gateuse 5.006_001; 5*0Sstevel@tonic-gateour $VERSION = '1.00'; 6*0Sstevel@tonic-gateour(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); 7*0Sstevel@tonic-gateBEGIN { 8*0Sstevel@tonic-gate use Exporter (); 9*0Sstevel@tonic-gate @EXPORT = qw(getnetbyname getnetbyaddr getnet); 10*0Sstevel@tonic-gate @EXPORT_OK = qw( 11*0Sstevel@tonic-gate $n_name @n_aliases 12*0Sstevel@tonic-gate $n_addrtype $n_net 13*0Sstevel@tonic-gate ); 14*0Sstevel@tonic-gate %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); 15*0Sstevel@tonic-gate} 16*0Sstevel@tonic-gateuse vars @EXPORT_OK; 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gate# Class::Struct forbids use of @ISA 19*0Sstevel@tonic-gatesub import { goto &Exporter::import } 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateuse Class::Struct qw(struct); 22*0Sstevel@tonic-gatestruct 'Net::netent' => [ 23*0Sstevel@tonic-gate name => '$', 24*0Sstevel@tonic-gate aliases => '@', 25*0Sstevel@tonic-gate addrtype => '$', 26*0Sstevel@tonic-gate net => '$', 27*0Sstevel@tonic-gate]; 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gatesub populate (@) { 30*0Sstevel@tonic-gate return unless @_; 31*0Sstevel@tonic-gate my $nob = new(); 32*0Sstevel@tonic-gate $n_name = $nob->[0] = $_[0]; 33*0Sstevel@tonic-gate @n_aliases = @{ $nob->[1] } = split ' ', $_[1]; 34*0Sstevel@tonic-gate $n_addrtype = $nob->[2] = $_[2]; 35*0Sstevel@tonic-gate $n_net = $nob->[3] = $_[3]; 36*0Sstevel@tonic-gate return $nob; 37*0Sstevel@tonic-gate} 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gatesub getnetbyname ($) { populate(CORE::getnetbyname(shift)) } 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gatesub getnetbyaddr ($;$) { 42*0Sstevel@tonic-gate my ($net, $addrtype); 43*0Sstevel@tonic-gate $net = shift; 44*0Sstevel@tonic-gate require Socket if @_; 45*0Sstevel@tonic-gate $addrtype = @_ ? shift : Socket::AF_INET(); 46*0Sstevel@tonic-gate populate(CORE::getnetbyaddr($net, $addrtype)) 47*0Sstevel@tonic-gate} 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gatesub getnet($) { 50*0Sstevel@tonic-gate if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { 51*0Sstevel@tonic-gate require Socket; 52*0Sstevel@tonic-gate &getnetbyaddr(Socket::inet_aton(shift)); 53*0Sstevel@tonic-gate } else { 54*0Sstevel@tonic-gate &getnetbyname; 55*0Sstevel@tonic-gate } 56*0Sstevel@tonic-gate} 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate1; 59*0Sstevel@tonic-gate__END__ 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gate=head1 NAME 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gateNet::netent - by-name interface to Perl's built-in getnet*() functions 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate=head1 SYNOPSIS 66*0Sstevel@tonic-gate 67*0Sstevel@tonic-gate use Net::netent qw(:FIELDS); 68*0Sstevel@tonic-gate getnetbyname("loopback") or die "bad net"; 69*0Sstevel@tonic-gate printf "%s is %08X\n", $n_name, $n_net; 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gate use Net::netent; 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate $n = getnetbyname("loopback") or die "bad net"; 74*0Sstevel@tonic-gate { # there's gotta be a better way, eh? 75*0Sstevel@tonic-gate @bytes = unpack("C4", pack("N", $n->net)); 76*0Sstevel@tonic-gate shift @bytes while @bytes && $bytes[0] == 0; 77*0Sstevel@tonic-gate } 78*0Sstevel@tonic-gate printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes; 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gate=head1 DESCRIPTION 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gateThis module's default exports override the core getnetbyname() and 83*0Sstevel@tonic-gategetnetbyaddr() functions, replacing them with versions that return 84*0Sstevel@tonic-gate"Net::netent" objects. This object has methods that return the similarly 85*0Sstevel@tonic-gatenamed structure field name from the C's netent structure from F<netdb.h>; 86*0Sstevel@tonic-gatenamely name, aliases, addrtype, and net. The aliases 87*0Sstevel@tonic-gatemethod returns an array reference, the rest scalars. 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gateYou may also import all the structure fields directly into your namespace 90*0Sstevel@tonic-gateas regular variables using the :FIELDS import tag. (Note that this still 91*0Sstevel@tonic-gateoverrides your core functions.) Access these fields as variables named 92*0Sstevel@tonic-gatewith a preceding C<n_>. Thus, C<$net_obj-E<gt>name()> corresponds to 93*0Sstevel@tonic-gate$n_name if you import the fields. Array references are available as 94*0Sstevel@tonic-gateregular array variables, so for example C<@{ $net_obj-E<gt>aliases() 95*0Sstevel@tonic-gate}> would be simply @n_aliases. 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gateThe getnet() function is a simple front-end that forwards a numeric 98*0Sstevel@tonic-gateargument to getnetbyaddr(), and the rest 99*0Sstevel@tonic-gateto getnetbyname(). 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gateTo access this functionality without the core overrides, 102*0Sstevel@tonic-gatepass the C<use> an empty import list, and then access 103*0Sstevel@tonic-gatefunction functions with their full qualified names. 104*0Sstevel@tonic-gateOn the other hand, the built-ins are still available 105*0Sstevel@tonic-gatevia the C<CORE::> pseudo-package. 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate=head1 EXAMPLES 108*0Sstevel@tonic-gate 109*0Sstevel@tonic-gateThe getnet() functions do this in the Perl core: 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gate sv_setiv(sv, (I32)nent->n_net); 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gateThe gethost() functions do this in the Perl core: 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate sv_setpvn(sv, hent->h_addr, len); 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gateThat means that the address comes back in binary for the 118*0Sstevel@tonic-gatehost functions, and as a regular perl integer for the net ones. 119*0Sstevel@tonic-gateThis seems a bug, but here's how to deal with it: 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gate use strict; 122*0Sstevel@tonic-gate use Socket; 123*0Sstevel@tonic-gate use Net::netent; 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate @ARGV = ('loopback') unless @ARGV; 126*0Sstevel@tonic-gate 127*0Sstevel@tonic-gate my($n, $net); 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate for $net ( @ARGV ) { 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gate unless ($n = getnetbyname($net)) { 132*0Sstevel@tonic-gate warn "$0: no such net: $net\n"; 133*0Sstevel@tonic-gate next; 134*0Sstevel@tonic-gate } 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gate printf "\n%s is %s%s\n", 137*0Sstevel@tonic-gate $net, 138*0Sstevel@tonic-gate lc($n->name) eq lc($net) ? "" : "*really* ", 139*0Sstevel@tonic-gate $n->name; 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gate print "\taliases are ", join(", ", @{$n->aliases}), "\n" 142*0Sstevel@tonic-gate if @{$n->aliases}; 143*0Sstevel@tonic-gate 144*0Sstevel@tonic-gate # this is stupid; first, why is this not in binary? 145*0Sstevel@tonic-gate # second, why am i going through these convolutions 146*0Sstevel@tonic-gate # to make it looks right 147*0Sstevel@tonic-gate { 148*0Sstevel@tonic-gate my @a = unpack("C4", pack("N", $n->net)); 149*0Sstevel@tonic-gate shift @a while @a && $a[0] == 0; 150*0Sstevel@tonic-gate printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a; 151*0Sstevel@tonic-gate } 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gate if ($n = getnetbyaddr($n->net)) { 154*0Sstevel@tonic-gate if (lc($n->name) ne lc($net)) { 155*0Sstevel@tonic-gate printf "\tThat addr reverses to net %s!\n", $n->name; 156*0Sstevel@tonic-gate $net = $n->name; 157*0Sstevel@tonic-gate redo; 158*0Sstevel@tonic-gate } 159*0Sstevel@tonic-gate } 160*0Sstevel@tonic-gate } 161*0Sstevel@tonic-gate 162*0Sstevel@tonic-gate=head1 NOTE 163*0Sstevel@tonic-gate 164*0Sstevel@tonic-gateWhile this class is currently implemented using the Class::Struct 165*0Sstevel@tonic-gatemodule to build a struct-like class, you shouldn't rely upon this. 166*0Sstevel@tonic-gate 167*0Sstevel@tonic-gate=head1 AUTHOR 168*0Sstevel@tonic-gate 169*0Sstevel@tonic-gateTom Christiansen 170