# -*- perl -*-
#
# Net::NIS::Tied - interface to YP^H^HNIS
#
# $Id: 104 $
#
package Net::NIS;
use strict;
use 5.006;
use warnings; # Sigh, only available in 5.6 and above
use Carp;
###############################################################################
# BEGIN user-configurable section
# Linux and Solaris seem to have this file. It contains a number of
# lines, each with a key/value pair (separated by spaces).
my $Nicknames_File = '/var/yp/nicknames';
# For those systems who don't have a nicknames file, here are some
# reasonable defaults.
my %Nicknames_Default =
(
passwd => 'passwd.byname',
group => 'group.byname',
networks => 'networks.byaddr',
hosts => 'hosts.byname',
protocols => 'protocols.bynumber',
services => 'services.byname',
aliases => 'mail.aliases',
ethers => 'ethers.byname',
);
# Special case: this magic map acts as a front end to yp_master()
our $Magic_ypmaster_map = '__YPMASTER';
# Ouch. It really hurts to enumerate these here, manually, instead of
# somehow relying on the autogenerated list made by h2xs. But at least
# we have a test (t/15yperr_num.t) that should catch inconsistencies.
#
# Please be sure to keep these in numerical order, starting with 0. If
# There are ever gaps in the YPERR_xxx sequence, or duplicates, we will
# have to rethink this approach. But until then, let's not worry.
use vars qw(@YPERRS);
@YPERRS = map { "YPERR_$_" }
qw(
SUCCESS
BADARGS
RPC
DOMAIN
MAP
KEY
YPERR
RESRC
NOMORE
PMAP
YPBIND
YPSERV
NODOM
BADDB
VERS
ACCESS
BUSY
);
# Magic! This variable is magically tied to a global in our .xs which
# keeps track of the status returned from the last yp_xxx() function.
#
# This variable is exported by default. I'm not too happy with its
# name, but it seems like the best out of all the possibilities I
# considered. The primary benefit is that, given the fixed nature
# of the YPERR_xxx constant names, '$yperr' will be easier for someone
# to remember than $yp_status, $ypstatus, $yp_err, or anything like that.
#
# Any other suggestions, before it's too late to change it?
use vars qw($yperr);
# END user-configurable section
###############################################################################
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $PKG);
require Exporter;
require DynaLoader;
require AutoLoader;
@ISA = qw(Exporter DynaLoader);
%EXPORT_TAGS = ( all => [ '$yperr', @YPERRS ] );
@EXPORT_OK = ( '$yperr', @YPERRS );
@EXPORT = ( '$yperr' );
$VERSION = '0.44';
$PKG = __PACKAGE__; # For interpolating into error messages
#############
# DESTROY # Not really used, but needed so AUTOLOAD doesn't trap it
#############
sub DESTROY {}
##############
# AUTOLOAD # from h2xs
##############
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
my $constname;
use vars qw($AUTOLOAD);
($constname = $AUTOLOAD) =~ s/.*:://;
croak "& not defined" if $constname eq 'constant';
my $val = constant($constname, @_ ? $_[0] : 0);
if ($! != 0) {
if ($! =~ /Invalid/) {
if ($constname =~ /^YP/) {
croak "No such constant, ${PKG}::$constname";
} else {
croak "No such function, ${PKG}::$constname()";
}
}
else {
croak "Your vendor has not defined Net::NIS macro $constname";
}
}
{
no strict 'refs';
*$AUTOLOAD = sub { $val };
}
goto &$AUTOLOAD;
}
bootstrap Net::NIS $VERSION;
# Magic: The $yperr variable will now have the YP status, int & string form
_yp_tie_status ($yperr);
######################
# _expand_nickname # Look for a string in the /var/yp/nicknames file
######################
sub _expand_nickname($) {
my $map = shift;
use vars '%nickname';
# First time through? Read the nicknames file, or initialize to a
# reasonable default (hardcoded above).
if (keys %nickname == 0) {
if (open NICKNAMES, '<', $Nicknames_File) {
while (defined (my $line = <NICKNAMES>)) {
$line =~ /^\s*(\S+)\s+(\S+)$/
or next;
$nickname{$1} = $2;
}
close NICKNAMES;
} else {
# No nicknames file
%nickname = %Nicknames_Default;
}
}
# If there's a nickname defined for this map, return it... otherwise,
# the map name itself.
$nickname{$map} || $map;
}
#############
# TIEHASH # establish the relationship between a hash and a YP map.
#############
sub TIEHASH {
my $class = shift;
# Second argument must be a map name (passwd, mail.aliases, etc)
my $map = shift
or croak "Usage: tie \%hash, $PKG, 'MAP NAME' [, 'DOMAIN' ]\n";
# Third argument (optional) is the NIS domain. If unset, bail out
# now, setting error to NODOM ("Local domain name not set"). Otherwise,
# if we try the yp_match, it fails with the less-than-helpful BADARGS.
my $domain = shift || yp_get_default_domain()
or do {
$yperr = YPERR_NODOM();
return undef;
};
# Check validity of map name.
# As a special case, use '__YPMASTER' to act as a front end to yp_master()
$map = _expand_nickname($map);
unless ($map eq $Magic_ypmaster_map) {
if (! Net::NIS::yp_master( $domain, $map )) {
$yperr = YPERR_MAP();
return undef;
}
}
# All OK. Force $yperr to OK, and return a blessed object
$yperr = YPERR_SUCCESS();
bless { map => $map, domain => $domain }, $class;
}
###########
# FETCH # read-only access to a key.
###########
sub FETCH {
my $self = shift;
my $key = shift;
# Special case for magic yp_master map
if ($self->{map} eq $Magic_ypmaster_map) {
return Net::NIS::yp_master($self->{domain}, $key);
}
# Have we slurped in all keys using yp_all() ? Look up our key therein.
if (exists $self->{_alldata} && exists $self->{_alldata}->{$key}) {
return $self->{_alldata}->{$key};
}
# Haven't called yp_all(), or key not found there. Do a real YP lookup.
if (defined (my $val = yp_match($self->{domain}, $self->{map}, $key))) {
return $val;
}
# Error... is it 'no such key in map'? That's OK
if ($yperr == YPERR_KEY()) {
return undef;
}
# Any other error: fatal
croak sprintf("Unable to find '%s' in %s. Reason: %s",
$key, $self->{map}, $yperr);
}
############
# EXISTS # Does a key exist? This isn't cheap, it still incurs a yp_match
############
sub EXISTS {
my $self = shift;
defined $self->FETCH (@_);
}
##############
# FIRSTKEY # For iterating with each() or keys()
##############
#
# Important note: this uses the yp_all() mechanism to slurp in a complete
# hash containing all the key/value pairs. It is delayed until here,
# because our caller could simply want to perform lookups (via FETCH)
# without iterating over all keys.
#
sub FIRSTKEY {
my $self = shift;
# Special case when called with magic yp_master key
if ($self->{map} eq $Magic_ypmaster_map) {
my %master;
for my $map (Net::NIS::yp_maplist( $self->{domain} )) {
$master{$map} = Net::NIS::yp_master( $self->{domain},$map );
}
$self->{_alldata} = \%master;
}
else {
# Each time we get called, slurp across again... just in case any
# values have changed. This is suboptimal: in effect, we're keeping
# a cache around for who-knows-how-long. Suggestions welcome for
# improving it (perhaps keeping a {_last_updated} time??)
$self->{_alldata} = yp_all ($self->{domain}, $self->{map});
# Returned value must be a hash. If it isn't, something bad happened.
if (ref $self->{_alldata} ne 'HASH') {
croak sprintf("No such map '%s'. Reason: %s",
$self->{map}, $yperr);
}
}
# Reset the each() operator, and let it do the rest.
my $trashme = keys %{ $self->{_alldata} };
return scalar each %{ $self->{_alldata} };
}
#############
# NEXTKEY # no-brainer, just lets each() do the work on our internal hash
#############
sub NEXTKEY {
my $self = shift;
return each %{ $self->{_alldata} };
}
# ------NO WRITE ACCESS ALLOWED------
sub _read_only(@) {
croak "$PKG provides read-only access";
}
sub STORE { _read_only(@_); }
sub DELETE { _read_only(@_); }
###############################################################################
1;
__END__