Net-Hesiod
view release on metacpan or search on metacpan
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION %EXPORT_TAGS);
@ISA = qw(Exporter DynaLoader);
#We don't pollute namespace by default
@EXPORT = qw( );
#Some convenient tags
%EXPORT_TAGS =
( 'resolve' => [qw( hesiod_init hesiod_end hesiod_resolve)],
'all' => [ qw( hesiod_init hesiod_end hesiod_resolve
hesiod_to_bind hesiod_getpwnam hesiod_getpwuid
hesiod_getservbyname hesiod_getmailhost) ]
);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT_OK = qw( hesiod_init hesiod_end hesiod_resolve
hesiod_to_bind hesiod_getpwnam hesiod_getpwuid
hesiod_getservbyname hesiod_getmailhost);
$VERSION = '1.11';
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;
sub getpwnam($$)
{ my $context = shift;
if ( ! ref($context) )
{ croak "Net::Hesiod::getpwnam called as class method.";
}
my $name=shift;
return hesiod_getpwnam($context,$name);
}
sub getpwuid($$)
{ my $context = shift;
if ( ! ref($context) )
{ croak "Net::Hesiod::getpwuid called as class method.";
}
my $uid=shift;
return hesiod_getpwuid($context,$uid);
}
sub getservbyname($$$)
{ my $context = shift;
if ( ! ref($context) )
{ croak "Net::Hesiod::getservbyname called as class method.";
}
my $serv=shift;
my $proto=shift;
=head1 NAME
Net::Hesiod - Perl interface to Hesiod Library API
=head1 SYNOPSIS
=head2 Non-OO interface
use Net::Hesiod qw(
hesiod_init hesiod_end hesiod_to_bind hesiod_resolve
hesiod_getpwnam hesiod_getpwuid
hesiod_getservbyname hesiod_getmailhost );
$res=hesiod_init($context);
$bindname = hesiod_to_bind($context,$name,$type);
@results = hesiod_resolve($context,$name,$type);
@pwent = hesiod_getpwnam($context,$username);
@pwent = hesiod_getpwuid($context,$uid);
@servent = hesiod_getservbyname($context,$servicename,$proto);
@mhent = hesiod_getmailhost($context,$username);
hesiod_end($context);
=head2 Object-orientated interface
use Net::Hesiod;
my $ctxt = new Net::Hesiod;
$bindname = $ctxt->to_bind($name,$type);
@results = $ctxt->resolve($name,$type);
@pwent = $ctxt->getpwnam($username);
@pwent = $ctxt->getpwuid($uid);
@servent = $ctxt->getservbyname($servicename,$proto);
@mhent = $ctxt->getmailhost($username);
$results = $ctxt->query($name,$type,$delim);
@results = $ctxt->query($name,$type,$delim);
=head1 DESCRIPTION
These routines interface to the Hesiod Library API. Hesiod is a distributed
otherwise.
The C<hesiod_to_bind> routine and the C<to_bind> method convert a hesiod
query on a name and type to a DNS type query. No actual lookup is done.
The C<hesiod_resolve> routine and the C<resolve> method perform an actual
query. As with all DNS queries, multiple records can be returned, each of
which is returned as separate items in returned list. Usually, only the
first item is relevant.
The routines C<hesiod_getpwnam>, C<hesiod_getpwuid>, C<hesiod_getservbyname>,
and the related methods (C<getpwnam>, C<getpwuid>, and C<getservbyname>), are
hesiod versions of the Core Perl routines C<getpwnam>, C<getpwuid>, and
C<getservbyname>. The arrays returned have the same structure as the Core
routines. B<NOTE>: The service entry returned by C<hesiod_getservbyname> and
the related method has the port number in host-byte order, not network-byte
order as the standard C servent structure does. This is consistent with the
CORE C<getservbyname> and related functions.
C<hesiod_getmailhost> and the related method C<getmailhost> return the Hesiod
postoffice structure for the named user. The returned I<post office> array
has three elements, corresponding to the type, host, and name of the mailbox.
=item hesiod_init
=item hesiod_end
=item hesiod_resolve
=item hesiod_to_bind
=item hesiod_getpwnam
=item hesiod_getpwuid
=item hesiod_getservbyname
=item hesiod_getmailhost
=back
The first three can alternatively be exported with the tag I<resolve>, and
the whole list with the tag I<all>.
This code is provided AS IS, without any express or implied warranties.
=head1 SEE ALSO
=over 4
L<hesiod>
L<hesiod_init>, L<hesiod_end>, L<hesiod_to_bind>, L<hesiod_resolve>
L<hesiod_getpwnam>, L<hesiod_getpwuid>, L<hesiod_getservbyname>, L<hesiod_getmailhost>
MIT's Athena Project
http://web.mit.edu/is/athena/
=back
=cut
tmp = sv_newmortal(); sv_setpv(tmp,pw->pw_gecos);
XPUSHs(tmp);
tmp = sv_newmortal(); sv_setpv(tmp,pw->pw_dir);
XPUSHs(tmp);
tmp = sv_newmortal(); sv_setpv(tmp,pw->pw_shell);
XPUSHs(tmp);
hesiod_free_passwd(context,pw);
XSRETURN(9);
void
hesiod_getpwuid(context,uid)
void * context;
uid_t uid;
PREINIT:
struct passwd *pw;
dTARGET;
SV *tmp;
PPCODE:
pw = hesiod_getpwuid(context,uid);
/* Handle errors by returning empty */
if ( ! pw ) { XSRETURN_EMPTY; }
/* Presumably, have a valid response */
tmp = sv_newmortal(); sv_setpv(tmp,pw->pw_name);
XPUSHs(tmp);
tmp = sv_newmortal(); sv_setpv(tmp,pw->pw_passwd);
XPUSHs(tmp);
tmp = sv_newmortal(); sv_setiv(tmp,pw->pw_uid);
XPUSHs(tmp);
tmp = sv_newmortal(); sv_setiv(tmp,pw->pw_gid);
README.INSTALL view on Meta::CPAN
the location of the libhesiod.a, etc. library and the hesiod.h include file
respectively. Since usually these are in lib and include subdirectories of
some common Hesiod root, you can usually just set $HESIOD_ROOTDIR appropriately
and the other two will be fine.
The other option you may need to adjust is the $HACKS variable.
There are 2 "HACKS" currently defined to deal with cases in which
systems lack some components of the passwd structure. The variables
$PW_QUOTA_HACK and $PW_COMMENT_HACK determine whether the defines
DONT_HAVE_PW_QUOTA and DONT_HAVE_PW_COMMENT are sent to the C-code. If set,
the quota and comment fields returned by the hesiod getpwnam and getpwuid
functions will be undef. The system tries to determine whether these hacks
are needed automatically when Makefile.PL is run, but if it errs you can
manually override them.
The system also tries to automatically determine whether it needs to link
again libresolv.a, etc. or not. (Actually, it just determines whether
libresolv exists, and if so links against it, whether needed or not).
Finally, the tests require a fair amount of site specific information to
t/30_getpwnam.t view on Meta::CPAN
BEGIN { $| = 1; print "1..7\n"; }
END {print "not ok (can't load)\n" unless $loaded;}
use Net::Hesiod qw( :all );
$loaded = 1;
######################### End of black magic.
# Tests getpwnam, getpwuid
require 't/helpers.pl';
#Some site specific data for the testing module
require "t/testdata.pl";
my @nullarry = ();
#Test the raw interface functions
my $context;
hesiod_init($context) && die "Unable to hesiod_init: $!\n";
#1 check hesiod_getpwnam/getpwuid
my @pw = hesiod_getpwnam($context,$username);
my $uid = $pw[2]; #Extract uid
my @pw2 = hesiod_getpwuid($context,$uid);
print &are_arrays_equal(\@pw,\@pw2)? "ok 1\n" : "not ok 1\n";
#2 try with bogus username
@pw = hesiod_getpwnam($context,$bogususer);
print &are_arrays_equal(\@pw,\@nullarry)? "ok 2\n" : "not ok 2\n";
#3 try with bogus uid
@pw = hesiod_getpwuid($context,$bogusuid);
print &are_arrays_equal(\@pw,\@nullarry)? "ok 3\n" : "not ok 3\n";
hesiod_end($context);
#Now the same with OO interface
my $hesobj = new Net::Hesiod;
if ( ! defined $hesobj ) { die "Unable to create Net::Hesiod object: $!\n"; }
#4 Make sure OO version matches non-OO version
#@pw2 still has results of valid hesiod_getpwuid
@pw = $hesobj->getpwnam($username);
print &are_arrays_equal(\@pw,\@pw2)? "ok 4\n" : "not ok 4\n";
#5 match reverse
$uid = $pw[2]; #Extract uid
@pw2 = $hesobj->getpwuid($uid);
print &are_arrays_equal(\@pw,\@pw2)? "ok 5\n" : "not ok 5\n";
#6 try bogus username
@pw = $hesobj->getpwnam($bogususer);
print &are_arrays_equal(\@pw,\@nullarry)? "ok 6\n" : "not ok 6\n";
#7 try bogus username
@pw = $hesobj->getpwuid($bogusuid);
print &are_arrays_equal(\@pw,\@nullarry)? "ok 7\n" : "not ok 7\n";
t/make_testdata.pl view on Meta::CPAN
print "\nFor testing, we also want an invalid username and uid.\n";
my $tmp2;
my $tmp3;
foreach $tmp3 ( "xxxxxx", "yyyyyy", "zzzzzz", "xxxyyy", "xxxzzz", "yyyzzz" )
{ if ( $tmp2 = getpwnam $tmp3 ) {next; }
$tmp=$tmp3;
last;
}
my $bogususer=get_answer_with_default("Enter a bogus username [$tmp]: ",$tmp);
foreach $tmp3 ( 64001, 65001, 63099, 59999, 58999, "" )
{ if ( $tmp2 = getpwuid $tmp3 ) {next; }
$tmp=$tmp3;
last;
}
my $bogusuid=get_answer_with_default("Enter a bogus uid [$tmp]: ",$tmp);
print "\nTo test getservbyname, we need a service and protocol.\n";
my $service=get_answer_with_default("Enter a service name [smtp]: ","smtp");
my $proto=get_answer_with_default("Enter a protocol name [tcp]: ","tcp");
print "We also need the result of looking it up\n";
my @servres = getservbyname($service,$proto);
( run in 0.265 second using v1.01-cache-2.11-cpan-8d75d55dd25 )