Authen-Libwrap-0.23000755000766000024 013012347323 13666 5ustar00dmueystaff000000000000Authen-Libwrap-0.23/Build.PL000444000766000024 460713012347323 15326 0ustar00dmueystaff000000000000# # $Id: Build.PL,v 1.3 2003/12/17 03:39:54 james Exp $ # use strict; use warnings; use Module::Build; use File::Spec; my $inc_dir; my $lib_dir; # possible prefixes where we might find libwrap.a # if you know of other common ones please let me know my @prefixes = ( File::Spec->catdir( File::Spec->rootdir, 'usr' ), File::Spec->catdir( File::Spec->rootdir, 'usr', 'local' ), File::Spec->catdir( File::Spec->rootdir, 'opt' ), File::Spec->catdir( File::Spec->rootdir, 'opt', 'local' ), File::Spec->catdir( File::Spec->rootdir, 'opt', 'libwrap' ), File::Spec->catdir( File::Spec->rootdir, 'opt', 'tcpwrappers' ), ); # try to figure out where libwrap.a is for my $prefix( @prefixes ) { for my $libname( qw|libwrap.so libwrap.a| ) { my $candidate = File::Spec->catfile( $prefix, 'lib', $libname ); if( -e $candidate && -f _ && -r _ ) { my $y_n = Module::Build->y_n( "do you want to link against $candidate?", "y" ); if( $y_n ) { $lib_dir = File::Spec->catdir( $prefix, 'lib' ); last; } } } } # try to figure out where tcpd.h is for my $prefix( @prefixes ) { my $candidate = File::Spec->catfile( $prefix, 'include', 'tcpd.h' ); if( -e $candidate && -f _ && -r _ ) { my $y_n = Module::Build->y_n( "do you want to use $candidate as your header?", "y" ); if( $y_n ) { $inc_dir = File::Spec->catdir( $prefix, 'include' ); last; } } } # if we can't find it, prompt unless( $inc_dir ) { $inc_dir = Module::Build->prompt( "enter include directory to use:", File::Spec->catdir($prefixes[0], 'include') ); } unless( $lib_dir ) { $lib_dir = Module::Build->prompt( "enter library directory to use:", File::Spec->catdir($prefixes[0], 'lib') ); } # create the Buildfile Module::Build->new( module_name => 'Authen::Libwrap', dist_version => '0.23', license => 'perl', requires => { 'Scalar::Util' => 0, }, build_requires => { 'Test::More' => 0, 'Test::Exception' => 0, }, create_makefile_pl => 'passthrough', extra_compiler_flags => "-I$inc_dir", extra_linker_flags => [ "-L$lib_dir", "-lwrap" ] )->create_build_script; # # EOF Authen-Libwrap-0.23/ChangeLog000444000766000024 335413012347323 15602 0ustar00dmueystaff000000000000Revision history for Perl extension Authen::Libwrap. 0.23 Mon Nov 14 08:37:06 2016 - Add github URL to bug POD. - thanks BDRACO: Avoid no warnings as it creates a cop_warnings for every cop in the scope - Add generated from POD README.md 0.22 Sun Jul 06 17:59:49 2010 - thanks BDRACO: needless importing is slow 0.21 Sun Jul 20 17:59:49 2008 - DMUEY fix rt 25239 0.20 Wed Dec 17 2003 - re-org directories to fit current CPAN standards - switch from ExtUtils::MakeMaker to Module::Build - first shot at figuring out where libwrap is automatically - minor pod fixup - move test suite inline and use Test::More functionality - removed AUTOLOAD constants and use plain Perl constants - switched from DynaLoader to XSLoader - moved hosts_ctl into the module and changed the XS function name to _hosts_ctl to provide alternate Perl function signatures - added the ability to get hostname and ip address information from an IO::Socket, a GLOB or GLOBREF 0.10 Tue Feb 13 2001 - Three years and *still* nobody wrote something like this ? - Cleaned up a bit, verified on FreeBSD 4. - renamed from TCP_Wrappers to Authen::Libwrap in prep for distribution on CPAN [...] History unknown. Module never received much fedback, so it wasn't uploaded to CPAN. 0.003 Fri Apr 3 1998 - Released to a few interested parties from comp.lang.perl.modules 0.002 Wed Apr 1 1998 - I couldn't quite bring myself to release this on April Fool's day (as appropriate as it may have been) 0.001 Mon Mar 27 1998 - Damn! It compiles (and seems to work to boot!) Authen-Libwrap-0.23/example.pl000444000766000024 72313012347323 15775 0ustar00dmueystaff000000000000use Authen::Libwrap qw( hosts_ctl STRING_UNKNOWN ); $rc = hosts_ctl( "james", "localhost", "127.0.0.1", STRING_UNKNOWN ); print "Access is ", $rc ? "granted" : "refused", "\n"; $rc = hosts_ctl( "james", "expn.ehlo.com", "10.1.1.2", STRING_UNKNOWN ); print "Access is ", $rc ? "granted" : "refused", "\n"; $Authen::Libwrap::DEBUG = 1; $rc = hosts_ctl( "james", "vrfy.ehlo.com", "10.1.1.1", "STRING_UNKNOWN" ); print "Access is ", $rc ? "granted" : "refused", "\n"; Authen-Libwrap-0.23/Makefile.PL000444000766000024 226313012347323 16000 0ustar00dmueystaff000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4206 unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); Authen-Libwrap-0.23/MANIFEST000444000766000024 40413012347323 15132 0ustar00dmueystaff000000000000Build.PL ChangeLog example.pl lib/Authen/Libwrap.pm lib/Authen/Libwrap.xs Makefile.PL MANIFEST README.md t/01_inline.t t/02_maintainer.t t/03_pod.t t/hosts.allow META.yml Module meta-data (added by MakeMaker) ppport.h META.json Authen-Libwrap-0.23/META.json000444000766000024 205713012347323 15450 0ustar00dmueystaff000000000000{ "abstract" : "access to Wietse Venema's TCP Wrappers library", "author" : [ "James FitzGibbon, Ejfitz@CPAN.orgE" ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4206", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Authen-Libwrap", "prereqs" : { "build" : { "requires" : { "ExtUtils::CBuilder" : "0", "Test::Exception" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } }, "runtime" : { "requires" : { "Scalar::Util" : "0" } } }, "provides" : { "Authen::Libwrap" : { "file" : "lib/Authen/Libwrap.pm", "version" : "0.23" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.23" } Authen-Libwrap-0.23/META.yml000444000766000024 121713012347323 15275 0ustar00dmueystaff000000000000--- abstract: "access to Wietse Venema's TCP Wrappers library" author: - 'James FitzGibbon, Ejfitz@CPAN.orgE' build_requires: ExtUtils::CBuilder: '0' Test::Exception: '0' Test::More: '0' configure_requires: Module::Build: '0.42' dynamic_config: 1 generated_by: 'Module::Build version 0.4206, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Authen-Libwrap provides: Authen::Libwrap: file: lib/Authen/Libwrap.pm version: '0.23' requires: Scalar::Util: '0' resources: license: http://dev.perl.org/licenses/ version: '0.23' Authen-Libwrap-0.23/ppport.h000444000766000024 7165713012347323 15560 0ustar00dmueystaff000000000000 /* ppport.h -- Perl/Pollution/Portability Version 2.009 * * Automatically Created by Devel::PPPort on Tue Dec 16 20:07:00 2003 * * Do NOT edit this file directly! -- Edit PPPort.pm instead. * * Version 2.x, Copyright (C) 2001, Paul Marquess. * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. * This code may be used and distributed under the same license as any * version of Perl. * * This version of ppport.h is designed to support operation with Perl * installations back to 5.004, and has been tested up to 5.8.1. * * If this version of ppport.h is failing during the compilation of this * module, please check if a newer version of Devel::PPPort is available * on CPAN before sending a bug report. * * If you are using the latest version of Devel::PPPort and it is failing * during compilation of this module, please send a report to perlbug@perl.com * * Include all following information: * * 1. The complete output from running "perl -V" * * 2. This file. * * 3. The name & version of the module you were trying to build. * * 4. A full log of the build that failed. * * 5. Any other information that you think could be relevant. * * * For the latest version of this code, please retreive the Devel::PPPort * module from CPAN. * */ /* * In order for a Perl extension module to be as portable as possible * across differing versions of Perl itself, certain steps need to be taken. * Including this header is the first major one, then using dTHR is all the * appropriate places and using a PL_ prefix to refer to global Perl * variables is the second. * */ /* If you use one of a few functions that were not present in earlier * versions of Perl, please add a define before the inclusion of ppport.h * for a static include, or use the GLOBAL request in a single module to * produce a global definition that can be referenced from the other * modules. * * Function: Static define: Extern define: * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL * */ /* To verify whether ppport.h is needed for your module, and whether any * special defines should be used, ppport.h can be run through Perl to check * your source code. Simply say: * * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] * * The result will be a list of patches suggesting changes that should at * least be acceptable, if not necessarily the most efficient solution, or a * fix for all possible problems. It won't catch where dTHR is needed, and * doesn't attempt to account for global macro or function definitions, * nested includes, typemaps, etc. * * In order to test for the need of dTHR, please try your module under a * recent version of Perl that has threading compiled-in. * */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # include # endif # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) # include # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) /* It is very unlikely that anyone will try to use this with Perl 6 (or greater), but who knows. */ #if PERL_REVISION != 5 # error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_Sv Sv # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_defgv defgv # define PL_dirty dirty # define PL_dowarn dowarn # define PL_hints hints # define PL_na na # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfpv rsfp # define PL_stdingv stdingv # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes /* Replace: 0 */ #endif #ifdef HASATTRIBUTE # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif #else # define PERL_UNUSED_DECL #endif #ifndef dNOOP # define NOOP (void)0 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP # define dTHXa(x) dNOOP # define dTHXoa(x) dNOOP #endif #ifndef pTHX # define pTHX void # define pTHX_ # define aTHX # define aTHX_ #endif /* IV could also be a quad (say, a long long), but Perls * capable of those should have IVSIZE already. */ #if !defined(IVSIZE) && defined(LONGSIZE) # define IVSIZE LONGSIZE #endif #ifndef IVSIZE # define IVSIZE 4 /* A bold guess, but the best we can make. */ #endif #ifndef UVSIZE # define UVSIZE IVSIZE #endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) # define NVTYPE long double # else # define NVTYPE double # endif typedef NVTYPE NV; #endif #ifndef INT2PTR #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) #endif #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) #if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) #else # define PTR2ul(p) INT2PTR(unsigned long,p) #endif #endif /* !INT2PTR */ #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif /* DEFSV appears first in 5.004_56 */ #ifndef DEFSV # define DEFSV GvSV(PL_defgv) #endif #ifndef SAVE_DEFSV # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB(HV * stash, char * name, SV *sv); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #ifndef START_MY_CXT /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use * this, if you want to make the extension thread-safe. See ext/re/re.xs * for an example of the use of these macros. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. * 4. Use the MY_CXT_INIT macro such that it is called exactly once * (typically put in the BOOT: section). * 5. Use the members of the my_cxt_t structure everywhere as * MY_CXT.member. * 6. Use the dMY_CXT macro (a declaration) in all the functions that * access MY_CXT. */ #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ #define START_MY_CXT #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ dMY_CXT_SV; \ /* newSV() allocates one more than needed */ \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ #define pMY_CXT my_cxt_t *my_cxtp #define pMY_CXT_ pMY_CXT, #define _pMY_CXT ,pMY_CXT #define aMY_CXT my_cxtp #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT #else /* single interpreter */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif #endif /* START_MY_CXT */ #ifndef IVdf # if IVSIZE == LONGSIZE # define IVdf "ld" # define UVuf "lu" # define UVof "lo" # define UVxf "lx" # define UVXf "lX" # else # if IVSIZE == INTSIZE # define IVdf "d" # define UVuf "u" # define UVof "o" # define UVxf "x" # define UVXf "X" # endif # endif #endif #ifndef NVef # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ # define NVef PERL_PRIeldbl # define NVff PERL_PRIfldbl # define NVgf PERL_PRIgldbl # else # define NVef "e" # define NVff "f" # define NVgf "g" # endif #endif #ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ # define AvFILLp AvFILL #endif #ifdef SvPVbyte # if PERL_REVISION == 5 && PERL_VERSION < 7 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ # undef SvPVbyte # define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) static char * my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } # endif #else # define SvPVbyte SvPV #endif #ifndef SvPV_nolen # define SvPV_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX(sv) : sv_2pv_nolen(sv)) static char * sv_2pv_nolen(pTHX_ register SV *sv) { STRLEN n_a; return sv_2pv(sv, &n_a); } #endif #ifndef get_cv # define get_cv(name,create) perl_get_cv(name,create) #endif #ifndef get_sv # define get_sv(name,create) perl_get_sv(name,create) #endif #ifndef get_av # define get_av(name,create) perl_get_av(name,create) #endif #ifndef get_hv # define get_hv(name,create) perl_get_hv(name,create) #endif #ifndef call_argv # define call_argv perl_call_argv #endif #ifndef call_method # define call_method perl_call_method #endif #ifndef call_pv # define call_pv perl_call_pv #endif #ifndef call_sv # define call_sv perl_call_sv #endif #ifndef eval_pv # define eval_pv perl_eval_pv #endif #ifndef eval_sv # define eval_sv perl_eval_sv #endif #ifndef PERL_SCAN_GREATER_THAN_UV_MAX # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 #endif #ifndef PERL_SCAN_SILENT_ILLDIGIT # define PERL_SCAN_SILENT_ILLDIGIT 0x04 #endif #ifndef PERL_SCAN_ALLOW_UNDERSCORES # define PERL_SCAN_ALLOW_UNDERSCORES 0x01 #endif #ifndef PERL_SCAN_DISALLOW_PREFIX # define PERL_SCAN_DISALLOW_PREFIX 0x02 #endif #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) #define I32_CAST #else #define I32_CAST (I32*) #endif #ifndef grok_hex static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_hex(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_hex(string, len, flags, result) \ _grok_hex((string), (len), (flags), (result)) #endif #ifndef grok_oct static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_oct(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_oct(string, len, flags, result) \ _grok_oct((string), (len), (flags), (result)) #endif #if !defined(grok_bin) && defined(scan_bin) static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_bin(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_bin(string, len, flags, result) \ _grok_bin((string), (len), (flags), (result)) #endif #ifndef IN_LOCALE # define IN_LOCALE \ (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) #endif #ifndef IN_LOCALE_RUNTIME # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) #endif #ifndef IN_LOCALE_COMPILETIME # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) #endif #ifndef IS_NUMBER_IN_UV # define IS_NUMBER_IN_UV 0x01 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 # define IS_NUMBER_NOT_INT 0x04 # define IS_NUMBER_NEG 0x08 # define IS_NUMBER_INFINITY 0x10 # define IS_NUMBER_NAN 0x20 #endif #ifndef grok_numeric_radix # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send) #define grok_numeric_radix Perl_grok_numeric_radix bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) { #ifdef USE_LOCALE_NUMERIC #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) if (PL_numeric_radix_sv && IN_LOCALE) { STRLEN len; char* radix = SvPV(PL_numeric_radix_sv, len); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #else /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix * must manually be requested from locale.h */ #include struct lconv *lc = localeconv(); char *radix = lc->decimal_point; if (radix && IN_LOCALE) { STRLEN len = strlen(radix); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #endif /* PERL_VERSION */ #endif /* USE_LOCALE_NUMERIC */ /* always try "." if numeric radix didn't match because * we may have data from different locales mixed */ if (*sp < send && **sp == '.') { ++*sp; return TRUE; } return FALSE; } #endif /* grok_numeric_radix */ #ifndef grok_number #define grok_number Perl_grok_number int Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) { const char *s = pv; const char *send = pv + len; const UV max_div_10 = UV_MAX / 10; const char max_mod_10 = UV_MAX % 10; int numtype = 0; int sawinf = 0; int sawnan = 0; while (s < send && isSPACE(*s)) s++; if (s == send) { return 0; } else if (*s == '-') { s++; numtype = IS_NUMBER_NEG; } else if (*s == '+') s++; if (s == send) return 0; /* next must be digit or the radix separator or beginning of infinity */ if (isDIGIT(*s)) { /* UVs are at least 32 bits, so the first 9 decimal digits cannot overflow. */ UV value = *s - '0'; /* This construction seems to be more optimiser friendly. (without it gcc does the isDIGIT test and the *s - '0' separately) With it gcc on arm is managing 6 instructions (6 cycles) per digit. In theory the optimiser could deduce how far to unroll the loop before checking for overflow. */ if (++s < send) { int digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { /* Now got 9 digits, so need to check each time for overflow. */ digit = *s - '0'; while (digit >= 0 && digit <= 9 && (value < max_div_10 || (value == max_div_10 && digit <= max_mod_10))) { value = value * 10 + digit; if (++s < send) digit = *s - '0'; else break; } if (digit >= 0 && digit <= 9 && (s < send)) { /* value overflowed. skip the remaining digits, don't worry about setting *valuep. */ do { s++; } while (s < send && isDIGIT(*s)); numtype |= IS_NUMBER_GREATER_THAN_UV_MAX; goto skip_value; } } } } } } } } } } } } } } } } } } numtype |= IS_NUMBER_IN_UV; if (valuep) *valuep = value; skip_value: if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT; while (s < send && isDIGIT(*s)) /* optional digits after the radix */ s++; } } else if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ /* no digits before the radix means we need digits after it */ if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); if (valuep) { /* integer approximation is valid - it's 0. */ *valuep = 0; } } else return 0; } else if (*s == 'I' || *s == 'i') { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; s++; if (s < send && (*s == 'I' || *s == 'i')) { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; s++; if (s == send || (*s != 'T' && *s != 't')) return 0; s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; s++; } sawinf = 1; } else if (*s == 'N' || *s == 'n') { /* XXX TODO: There are signaling NaNs and quiet NaNs. */ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; sawnan = 1; } else return 0; if (sawinf) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; } else if (sawnan) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; } else if (s < send) { /* we can have an optional exponent part */ if (*s == 'e' || *s == 'E') { /* The only flag we keep is sign. Blow away any "it's UV" */ numtype &= IS_NUMBER_NEG; numtype |= IS_NUMBER_NOT_INT; s++; if (s < send && (*s == '-' || *s == '+')) s++; if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); } else return 0; } } while (s < send && isSPACE(*s)) s++; if (s >= send) return numtype; if (len == 10 && memEQ(pv, "0 but true", 10)) { if (valuep) *valuep = 0; return IS_NUMBER_IN_UV; } return 0; } #endif /* grok_number */ #ifndef PERL_MAGIC_sv # define PERL_MAGIC_sv '\0' #endif #ifndef PERL_MAGIC_overload # define PERL_MAGIC_overload 'A' #endif #ifndef PERL_MAGIC_overload_elem # define PERL_MAGIC_overload_elem 'a' #endif #ifndef PERL_MAGIC_overload_table # define PERL_MAGIC_overload_table 'c' #endif #ifndef PERL_MAGIC_bm # define PERL_MAGIC_bm 'B' #endif #ifndef PERL_MAGIC_regdata # define PERL_MAGIC_regdata 'D' #endif #ifndef PERL_MAGIC_regdatum # define PERL_MAGIC_regdatum 'd' #endif #ifndef PERL_MAGIC_env # define PERL_MAGIC_env 'E' #endif #ifndef PERL_MAGIC_envelem # define PERL_MAGIC_envelem 'e' #endif #ifndef PERL_MAGIC_fm # define PERL_MAGIC_fm 'f' #endif #ifndef PERL_MAGIC_regex_global # define PERL_MAGIC_regex_global 'g' #endif #ifndef PERL_MAGIC_isa # define PERL_MAGIC_isa 'I' #endif #ifndef PERL_MAGIC_isaelem # define PERL_MAGIC_isaelem 'i' #endif #ifndef PERL_MAGIC_nkeys # define PERL_MAGIC_nkeys 'k' #endif #ifndef PERL_MAGIC_dbfile # define PERL_MAGIC_dbfile 'L' #endif #ifndef PERL_MAGIC_dbline # define PERL_MAGIC_dbline 'l' #endif #ifndef PERL_MAGIC_mutex # define PERL_MAGIC_mutex 'm' #endif #ifndef PERL_MAGIC_shared # define PERL_MAGIC_shared 'N' #endif #ifndef PERL_MAGIC_shared_scalar # define PERL_MAGIC_shared_scalar 'n' #endif #ifndef PERL_MAGIC_collxfrm # define PERL_MAGIC_collxfrm 'o' #endif #ifndef PERL_MAGIC_tied # define PERL_MAGIC_tied 'P' #endif #ifndef PERL_MAGIC_tiedelem # define PERL_MAGIC_tiedelem 'p' #endif #ifndef PERL_MAGIC_tiedscalar # define PERL_MAGIC_tiedscalar 'q' #endif #ifndef PERL_MAGIC_qr # define PERL_MAGIC_qr 'r' #endif #ifndef PERL_MAGIC_sig # define PERL_MAGIC_sig 'S' #endif #ifndef PERL_MAGIC_sigelem # define PERL_MAGIC_sigelem 's' #endif #ifndef PERL_MAGIC_taint # define PERL_MAGIC_taint 't' #endif #ifndef PERL_MAGIC_uvar # define PERL_MAGIC_uvar 'U' #endif #ifndef PERL_MAGIC_uvar_elem # define PERL_MAGIC_uvar_elem 'u' #endif #ifndef PERL_MAGIC_vstring # define PERL_MAGIC_vstring 'V' #endif #ifndef PERL_MAGIC_vec # define PERL_MAGIC_vec 'v' #endif #ifndef PERL_MAGIC_utf8 # define PERL_MAGIC_utf8 'w' #endif #ifndef PERL_MAGIC_substr # define PERL_MAGIC_substr 'x' #endif #ifndef PERL_MAGIC_defelem # define PERL_MAGIC_defelem 'y' #endif #ifndef PERL_MAGIC_glob # define PERL_MAGIC_glob '*' #endif #ifndef PERL_MAGIC_arylen # define PERL_MAGIC_arylen '#' #endif #ifndef PERL_MAGIC_pos # define PERL_MAGIC_pos '.' #endif #ifndef PERL_MAGIC_backref # define PERL_MAGIC_backref '<' #endif #ifndef PERL_MAGIC_ext # define PERL_MAGIC_ext '~' #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ Authen-Libwrap-0.23/README.md000444000766000024 1136513012347323 15330 0ustar00dmueystaff000000000000# NAME Authen::Libwrap - access to Wietse Venema's TCP Wrappers library # SYNOPSIS use Authen::Libwrap qw( hosts_ctl STRING_UNKNOWN ); # we know the remote username (using identd) $rc = hosts_ctl( "programname", "hostname.domain.com", "10.1.1.1", "username" ); print "Access is ", $rc ? "granted" : "refused", "\n"; # we don't know the remote username $rc = hosts_ctl( "programname", "hostname.domain.com", "10.1.1.1"), ); print "Access is ", $rc ? "granted" : "refused", "\n"; # use a socket instead my $client = $listener->accept(); $rc = hosts_ctl( "programname" $socket ); print "Access is ", $rc ? "granted" : "refused", "\n"; # DESCRIPTION The Authen::Libwrap module allows you to access the hosts\_ctl() function from the popular TCP Wrappers security package. This allows validation of network access from perl programs against the system-wide `hosts.allow` file. If any of the parameters to hosts\_ctl() are not known (i.e. username due to lack of an identd server), the constant STRING\_UNKNOWN may be passed to the function. # FUNCTIONS Authen::Libwrap has only one function, though it can be invoked in several ways. In each case, an true return code indicates that the connection is allowed per the rules in `hosts.allow` and an undef value indicates the opposite. ## hosts\_ctl($daemon, $hostname, $ip\_addr, \[ $user \] ) Takes three mandatory and one optional argument. `$daemon` is the service for which access is being requested (like 'ftpd' or 'sendmail'). `$hostname` is the name of the host requesting access. `$ip_addr` is the IP address of the host in dotted-quad notation. `$user` is the name of the user requesting access. If unknown, $user can be omitted; STRING\_UNKNOWN will be passed in it's place. ## hosts\_ctl($daemon, $socket, \[ $user \] ) If you have a socket (be it a glob, glob reference or an IO::Socket::INET, you can pass that as the second argument. The hostname and IP address will be determined using this socket. If the hostname or IP address cannot be determined from the socket, STRING\_UNKNOWN will be passed in their place. # DEBUGGING If you want to see the arguments that will be passed to the C function hosts\_ctl(), set $Authen::Libwrap::DEBUG to a true value. # EXPORTS Nothing unless you ask for it. hosts\_ctl optionally STRING\_UNKNOWN optionally # EXPORT\_TAGS - **functions** hosts_ctl - **constants** STRING_UNKNOWN - **all** everything the module has to offer. # CONSTANTS STRING_UNKNOWN # BUGS AND FEATURES Please report any bugs or feature requests (and a pull request for bonus points) through the issue tracker at [https://github.com/drmuey/p5-Authen-Libwrap/issues](https://github.com/drmuey/p5-Authen-Libwrap/issues). - **twist** in `hosts.allow` Calls to hosts\_ctl() which match a line in `hosts.allow` that uses the "twist" option will terminate the running perl program. This is not a bug in Authen::Libwrap per se -- libwrap uses exec(3) to replace the running process with the specified program, so there's nothing to return to. Some operating systems ship with a default catch-all rule in `hosts.allow` that uses the twist option. You may have to modify this configuration to use Authen::Libwrap effectively. - Test suite is not comprehensive The test suite isn't very comprehensive because the path to hosts.allow is set when libwrap is built and I can't tell what the user's rules are. I can make sure the function calls don't die, but I can't really tell if any call to hosts\_ctl should give back a true or false value. # TODO In early 2003 I was contacted by another Perl developer who had developed an XS interface to libwrap that covered more of the API than mine did. Originally he offered it as a patch to my module, but at the time I wasn't in a position to actively maintain anything on CPAN, so I suggested that he upload it himself. I unfortunately lost the email thread to a disk crash. As of December 2003 I don't see any other modules professing to support libwrap om CPAN. If that person is still out there, please get in contact with me, otherwise I'll plan on implementing some of these TODOs in the new year: - provide support for hosts\_access and request\_\* functions - develop an OO interface # SEE ALSO [Authen::Tcpdmatch](https://metacpan.org/pod/Authen::Tcpdmatch), a Pure Perl module that can parse hosts.allow and hosts.deny if you don't need all the underlying features of libwrap. hosts\_access(3), hosts\_access(5), hosts\_options(5) Wietse's tools and papers page: [ftp://ftp.porcupine.org/pub/security/index.html](ftp://ftp.porcupine.org/pub/security/index.html). # AUTHOR James FitzGibbon, <jfitz@CPAN.org> Authen-Libwrap-0.23/lib000755000766000024 013012347323 14434 5ustar00dmueystaff000000000000Authen-Libwrap-0.23/lib/Authen000755000766000024 013012347323 15660 5ustar00dmueystaff000000000000Authen-Libwrap-0.23/lib/Authen/Libwrap.pm000444000766000024 2536713012347323 20010 0ustar00dmueystaff000000000000=head1 NAME Authen::Libwrap - access to Wietse Venema's TCP Wrappers library =head1 SYNOPSIS use Authen::Libwrap qw( hosts_ctl STRING_UNKNOWN ); # we know the remote username (using identd) $rc = hosts_ctl( "programname", "hostname.domain.com", "10.1.1.1", "username" ); print "Access is ", $rc ? "granted" : "refused", "\n"; # we don't know the remote username $rc = hosts_ctl( "programname", "hostname.domain.com", "10.1.1.1"), ); print "Access is ", $rc ? "granted" : "refused", "\n"; # use a socket instead my $client = $listener->accept(); $rc = hosts_ctl( "programname" $socket ); print "Access is ", $rc ? "granted" : "refused", "\n"; =head1 DESCRIPTION The Authen::Libwrap module allows you to access the hosts_ctl() function from the popular TCP Wrappers security package. This allows validation of network access from perl programs against the system-wide F file. If any of the parameters to hosts_ctl() are not known (i.e. username due to lack of an identd server), the constant STRING_UNKNOWN may be passed to the function. =begin testing use Test::Exception; use_ok('Authen::Libwrap'); Authen::Libwrap->import( ':all' ); ok( defined(&hosts_ctl), "'hosts_ctl' function is exported"); ok( defined(&STRING_UNKNOWN), "'STRING_UNKNOWN' constant is exported"); my $daemon = "tcp_wrappers_test"; my $hostname = "localhost"; my $hostaddr = "127.0.0.1"; my $username = 'me'; # these tests aren't very comprehensive because the path to hosts.allow # is set when libwrap is built and I can't tell what the user's rules # are. I can make sure they don't croak, but I can't really tell # if any call to hosts_ctl should give back a true or false value # call with all four arguments explicitly lives_ok { hosts_ctl($daemon, $hostname, $hostaddr, $username) } 'call hosts_ctl with four explicit args'; # use a default user lives_ok { hosts_ctl($daemon, $hostname, $hostaddr) } 'call hosts_ctl without a username'; # give something that is blessed but not a IO::Socket my $thingy = bless {}, 'Foo'; throws_ok { hosts_ctl($daemon, $thingy) } qr/can't use/, 'cannot use a non-socket as a socket'; # pass an IO::Socket that is not initialized use IO::Socket::INET; my $sock = IO::Socket::INET->new; throws_ok { hosts_ctl($daemon, $sock) } qr/can't get peer/, 'call hosts_ctl an uninitialized IO::Socket'; # set up a listening socket and connect to it my $listener; lives_and { $listener = IO::Socket::INET->new( LocalAddr => '127.0.0.1', Proto => 'tcp', Listen => 10, ); isa_ok($listener, 'IO::Socket::INET'); } 'create listener socket'; lives_and { $sock = IO::Socket::INET->new( PeerAddr => '127.0.0.1', PeerPort => $listener->sockport, Proto => 'tcp' ); isa_ok($sock, 'IO::Socket::INET'); } 'connect to listener'; # use an IO::Socket with a username lives_ok { hosts_ctl($daemon, $sock, $username) } 'call hosts_ctl with a glob and username'; # use an IO::Socket without a username lives_ok { hosts_ctl($daemon, $sock) } 'call hosts_ctl with a glob and username'; # close the IO::Socket $sock->close; throws_ok { hosts_ctl($daemon, $sock) } qr/can't get peer/, 'call hosts_ctl an uninitialized IO::Socket'; # try with an uninitialized glob throws_ok { hosts_ctl($daemon, *SOCK) } qr/can't get peer/, 'call hosts_ctl an uninitialized GLOB'; # connect to the listening socket lives_and { my $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto); my $iaddr = inet_aton('127.0.0.1'); my $paddr = sockaddr_in($listener->sockport, $iaddr); connect(SOCK,$paddr); } 'connect to listener'; # use a glob with a username lives_ok { hosts_ctl($daemon, *SOCK, $username) } 'call hosts_ctl with a glob and username'; # use a glob without a username lives_ok { hosts_ctl($daemon, *SOCK) } 'call hosts_ctl with a glob and username'; # close the glob close SOCK; throws_ok { hosts_ctl($daemon, *SOCK) } qr/can't get peer/, 'call hosts_ctl an uninitialized GLOB'; # try with an uninitialized globref throws_ok { hosts_ctl($daemon, \*SOCK) } qr/can't get peer/, 'call hosts_ctl an uninitialized GLOBREF'; # connect to the listening socket lives_and { my $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto); my $iaddr = inet_aton('127.0.0.1'); my $paddr = sockaddr_in($listener->sockport, $iaddr); connect(SOCK,$paddr); } 'connect to listener'; # use a globref with a username lives_ok { hosts_ctl($daemon, \*SOCK, $username) } 'call hosts_ctl with a glob and username'; # use a globref without a username lives_ok { hosts_ctl($daemon, \*SOCK) } 'call hosts_ctl with a glob and username'; # close the glob close SOCK; =end testing =cut package Authen::Libwrap; use strict; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $DEBUG); use constant STRING_UNKNOWN => "unknown"; require Exporter; use XSLoader (); use Carp (); use Scalar::Util (); use Socket (); @ISA = 'Exporter'; # set up our exports @EXPORT_OK = qw( hosts_ctl STRING_UNKNOWN ); %EXPORT_TAGS = ( functions => [ qw|hosts_ctl| ], constants => [ qw|STRING_UNKNOWN| ], ); { my %seen; push @{$EXPORT_TAGS{all}}, grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS; } Exporter::export_ok_tags('all'); $VERSION = '0.23'; # pull in the XS parts XSLoader::load 'Authen::Libwrap', $VERSION; # set this to a true value to enable XS argument debug output $DEBUG = 0; =head1 FUNCTIONS Authen::Libwrap has only one function, though it can be invoked in several ways. In each case, an true return code indicates that the connection is allowed per the rules in F and an undef value indicates the opposite. =head2 hosts_ctl($daemon, $hostname, $ip_addr, [ $user ] ) Takes three mandatory and one optional argument. C<$daemon> is the service for which access is being requested (like 'ftpd' or 'sendmail'). C<$hostname> is the name of the host requesting access. C<$ip_addr> is the IP address of the host in dotted-quad notation. C<$user> is the name of the user requesting access. If unknown, $user can be omitted; STRING_UNKNOWN will be passed in it's place. =head2 hosts_ctl($daemon, $socket, [ $user ] ) If you have a socket (be it a glob, glob reference or an IO::Socket::INET, you can pass that as the second argument. The hostname and IP address will be determined using this socket. If the hostname or IP address cannot be determined from the socket, STRING_UNKNOWN will be passed in their place. =cut sub hosts_ctl { my $daemon = shift; my $hostname; my $ip_addr; my $user; # next arg could be a literal hostname or a socket or a glob if( Scalar::Util::reftype $_[0] eq 'IO' || Scalar::Util::reftype $_[0] eq 'GLOB' || Scalar::Util::reftype \$_[0] eq 'GLOB' ) { # get the peer address from the socket my $socket = shift; my(undef, $peer) = eval { Socket::sockaddr_in(getpeername($socket)) }; Carp::croak "can't get peer address from socket" if $@; # get the IP addr $ip_addr = Socket::inet_ntoa($peer) || STRING_UNKNOWN; if( $peer ) { # get IP address or set to unknown $ip_addr = Socket::inet_ntoa($peer) || STRING_UNKNOWN; # get hostname or set to unknown $hostname = gethostbyaddr($peer, &Socket::AF_INET) || STRING_UNKNOWN; } else { # set hostname and IP addr to unknown $hostname = STRING_UNKNOWN; $ip_addr = STRING_UNKNOWN; } } elsif( ref $_[0] ) { # ref but not one we can use Carp::croak("can't use a ", ref $_[0], " as a socket"); } else { # must be a hostname then ip addr $hostname = shift || STRING_UNKNOWN; $ip_addr = shift || STRING_UNKNOWN; } # if there isn't another argument then we sub one in $user = shift || STRING_UNKNOWN; # dispatch to the XS function if( $DEBUG ) { warn("hosts_ctl: $daemon, $hostname, $ip_addr, $user\n"); } return _hosts_ctl($daemon, $hostname, $ip_addr, $user); } # keep require happy 1; __END__ =head1 DEBUGGING If you want to see the arguments that will be passed to the C function hosts_ctl(), set $Authen::Libwrap::DEBUG to a true value. =head1 EXPORTS Nothing unless you ask for it. hosts_ctl optionally STRING_UNKNOWN optionally =head1 EXPORT_TAGS =over 4 =item * B hosts_ctl =item * B STRING_UNKNOWN =item * B everything the module has to offer. =back =head1 CONSTANTS STRING_UNKNOWN =head1 BUGS AND FEATURES Please report any bugs or feature requests (and a pull request for bonus points) through the issue tracker at L. =over 4 =item * B in F Calls to hosts_ctl() which match a line in F that uses the "twist" option will terminate the running perl program. This is not a bug in Authen::Libwrap per se -- libwrap uses exec(3) to replace the running process with the specified program, so there's nothing to return to. Some operating systems ship with a default catch-all rule in F that uses the twist option. You may have to modify this configuration to use Authen::Libwrap effectively. =item * Test suite is not comprehensive The test suite isn't very comprehensive because the path to hosts.allow is set when libwrap is built and I can't tell what the user's rules are. I can make sure the function calls don't die, but I can't really tell if any call to hosts_ctl should give back a true or false value. =back =head1 TODO In early 2003 I was contacted by another Perl developer who had developed an XS interface to libwrap that covered more of the API than mine did. Originally he offered it as a patch to my module, but at the time I wasn't in a position to actively maintain anything on CPAN, so I suggested that he upload it himself. I unfortunately lost the email thread to a disk crash. As of December 2003 I don't see any other modules professing to support libwrap om CPAN. If that person is still out there, please get in contact with me, otherwise I'll plan on implementing some of these TODOs in the new year: =over 4 =item * provide support for hosts_access and request_* functions =item * develop an OO interface =back =head1 SEE ALSO L, a Pure Perl module that can parse hosts.allow and hosts.deny if you don't need all the underlying features of libwrap. hosts_access(3), hosts_access(5), hosts_options(5) Wietse's tools and papers page: L. =head1 AUTHOR James FitzGibbon, Ejfitz@CPAN.orgE =cut # # EOF Authen-Libwrap-0.23/lib/Authen/Libwrap.xs000444000766000024 114713012347323 17774 0ustar00dmueystaff000000000000/* * $Id: Libwrap.xs,v 1.4 2003/12/18 02:53:34 james Exp $ */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include int allow_severity = LOG_INFO; int deny_severity = LOG_NOTICE; MODULE = Authen::Libwrap PACKAGE = Authen::Libwrap int _hosts_ctl(daemon, client_name, client_addr, client_user) char *daemon char *client_name char *client_addr char *client_user CODE: RETVAL = hosts_ctl(daemon, client_name, client_addr, client_user); OUTPUT: RETVAL POSTCALL: if( 0 == RETVAL ) { XSRETURN_UNDEF; } /* EOF */ Authen-Libwrap-0.23/t000755000766000024 013012347323 14131 5ustar00dmueystaff000000000000Authen-Libwrap-0.23/t/01_inline.t000444000766000024 1062413012347323 16254 0ustar00dmueystaff000000000000#!/usr/local/bin/perl -w use Test::More 'no_plan'; package Catch; sub TIEHANDLE { my($class, $var) = @_; return bless { var => $var }, $class; } sub PRINT { my($self) = shift; ${'main::'.$self->{var}} .= join '', @_; } sub OPEN {} # XXX Hackery in case the user redirects sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want. sub READ {} sub READLINE {} sub GETC {} my $Original_File = 'lib/Authen/Libwrap.pm'; package main; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'Catch', '_STDOUT_' or die $!; tie *STDERR, 'Catch', '_STDERR_' or die $!; { undef $main::_STDOUT_; undef $main::_STDERR_; #line 43 lib/Authen/Libwrap.pm use Test::Exception; use_ok('Authen::Libwrap'); Authen::Libwrap->import( ':all' ); ok( defined(&hosts_ctl), "'hosts_ctl' function is exported"); ok( defined(&STRING_UNKNOWN), "'STRING_UNKNOWN' constant is exported"); my $daemon = "tcp_wrappers_test"; my $hostname = "localhost"; my $hostaddr = "127.0.0.1"; my $username = 'me'; # these tests aren't very comprehensive because the path to hosts.allow # is set when libwrap is built and I can't tell what the user's rules # are. I can make sure they don't croak, but I can't really tell # if any call to hosts_ctl should give back a true or false value # call with all four arguments explicitly lives_ok { hosts_ctl($daemon, $hostname, $hostaddr, $username) } 'call hosts_ctl with four explicit args'; # use a default user lives_ok { hosts_ctl($daemon, $hostname, $hostaddr) } 'call hosts_ctl without a username'; # give something that is blessed but not a IO::Socket my $thingy = bless {}, 'Foo'; throws_ok { hosts_ctl($daemon, $thingy) } qr/can't use/, 'cannot use a non-socket as a socket'; # pass an IO::Socket that is not initialized use IO::Socket::INET; my $sock = IO::Socket::INET->new; throws_ok { hosts_ctl($daemon, $sock) } qr/can't get peer/, 'call hosts_ctl an uninitialized IO::Socket'; # set up a listening socket and connect to it my $listener; lives_and { $listener = IO::Socket::INET->new( LocalAddr => '127.0.0.1', Proto => 'tcp', Listen => 10, ); isa_ok($listener, 'IO::Socket::INET'); } 'create listener socket'; lives_and { $sock = IO::Socket::INET->new( PeerAddr => '127.0.0.1', PeerPort => $listener->sockport, Proto => 'tcp' ); isa_ok($sock, 'IO::Socket::INET'); } 'connect to listener'; # use an IO::Socket with a username lives_ok { hosts_ctl($daemon, $sock, $username) } 'call hosts_ctl with a glob and username'; # use an IO::Socket without a username lives_ok { hosts_ctl($daemon, $sock) } 'call hosts_ctl with a glob and username'; # close the IO::Socket $sock->close; throws_ok { hosts_ctl($daemon, $sock) } qr/can't get peer/, 'call hosts_ctl an uninitialized IO::Socket'; # try with an uninitialized glob throws_ok { hosts_ctl($daemon, *SOCK) } qr/can't get peer/, 'call hosts_ctl an uninitialized GLOB'; # connect to the listening socket lives_and { my $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto); my $iaddr = inet_aton('127.0.0.1'); my $paddr = sockaddr_in($listener->sockport, $iaddr); connect(SOCK,$paddr); } 'connect to listener'; # use a glob with a username lives_ok { hosts_ctl($daemon, *SOCK, $username) } 'call hosts_ctl with a glob and username'; # use a glob without a username lives_ok { hosts_ctl($daemon, *SOCK) } 'call hosts_ctl with a glob and username'; # close the glob close SOCK; throws_ok { hosts_ctl($daemon, *SOCK) } qr/can't get peer/, 'call hosts_ctl an uninitialized GLOB'; # try with an uninitialized globref throws_ok { hosts_ctl($daemon, \*SOCK) } qr/can't get peer/, 'call hosts_ctl an uninitialized GLOBREF'; # connect to the listening socket lives_and { my $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto); my $iaddr = inet_aton('127.0.0.1'); my $paddr = sockaddr_in($listener->sockport, $iaddr); connect(SOCK,$paddr); } 'connect to listener'; # use a globref with a username lives_ok { hosts_ctl($daemon, \*SOCK, $username) } 'call hosts_ctl with a glob and username'; # use a globref without a username lives_ok { hosts_ctl($daemon, \*SOCK) } 'call hosts_ctl with a glob and username'; # close the glob close SOCK; undef $main::_STDOUT_; undef $main::_STDERR_; } Authen-Libwrap-0.23/t/02_maintainer.t000444000766000024 466213012347323 17113 0ustar00dmueystaff000000000000# these tests require a specific /etc/hosts.allow file in order to work # unless by some miracle you configure your /etc/hosts.allow just like # mine, no tests will be executed by this script. # if you really want to use these tests, copy t/hosts.allow to # /etc/hosts.allow (or wherever your libwrap expects to find hosts.allow), # change $hosts_allow if necessary and re-run the test suite. BEGIN { my $hosts_allow = '/etc/hosts.allow'; my $expected_md5 = 'foo'; eval { eval "use Digest::MD5"; die if $@; die unless( -f $hosts_allow && -r _ ); open(HOSTSALLOW, $hosts_allow); my $digest = Digest::MD5->new->addfile(*HOSTSALLOW); close(HOSTSALLOW); die unless( $digest->hexdigest eq '8bc3fb6dcb07f81c85a213a475b2f3f5' ); }; if( $@ ) { use Test::More skip_all => 'maintainer tests'; } } use Test::More tests => 14; use Test::Exception; use_ok('Authen::Libwrap'); Authen::Libwrap->import(':all'); lives_and { is( hosts_ctl('foo', STRING_UNKNOWN(), '10.1.1.1'), 1); } '10.1.1.1 can access foo'; lives_and { is( hosts_ctl('foo', STRING_UNKNOWN(), '10.1.1.2'), undef); } '10.1.1.2 cannot access foo'; lives_and { is( hosts_ctl('foo', 'foo.com', STRING_UNKNOWN()), 1); } 'foo.com can access foo'; lives_and { is( hosts_ctl('foo', 'bar.com', STRING_UNKNOWN()), undef); } 'bar.com cannot access foo'; lives_and { is( hosts_ctl('bar', 'foo.com', STRING_UNKNOWN()), 1); } 'foo.com can access bar'; lives_and { is( hosts_ctl('bar', 'bar.com', STRING_UNKNOWN()), undef); } 'bar.com cannot access bar'; lives_and { is( hosts_ctl('baz', 'localhost', '127.0.0.1'), 1 ); } 'localhost can access baz'; lives_and { is( hosts_ctl('quux', STRING_UNKNOWN(), '10.1.1.1'), 1); } '10.1.1.1 can access quux'; lives_and { is( hosts_ctl('quux', STRING_UNKNOWN(), '10.2.1.1'), undef); } '10.2.1.1 cannot access quux'; lives_and { is( hosts_ctl('quux', STRING_UNKNOWN(), '10.3.1.1'), 1); } '10.3.1.1 can access quux'; lives_and { is( hosts_ctl('gzonk', 'me', '1.1.1.1'), 1); } 'known host can access gzonk'; SKIP: { skip "known/unknown doesn't seem be working", 2; lives_and { is( hosts_ctl('gzonk', STRING_UNKNOWN(), STRING_UNKNOWN(), 'me'), 1); } 'known user can access gzonk'; lives_and { is( hosts_ctl('wibble', 'me', '1.1.1.1', STRING_UNKNOWN()), undef); } 'unknown user cannot access wibble'; }; # # EOF Authen-Libwrap-0.23/t/03_pod.t000444000766000024 20113012347323 15510 0ustar00dmueystaff000000000000use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Authen-Libwrap-0.23/t/hosts.allow000444000766000024 61513012347323 16450 0ustar00dmueystaff000000000000# special hosts.allow for testing Authen::Libwrap tcp_wrappers_test : ALL : deny foo : 10.1.1.1 : allow foo : foo.com : allow foo : ALL : deny bar : bar.com : deny bar : ALL : allow baz : PARANOID : deny baz : ALL : allow quux : 10.1.1. : allow quux : 10.2.1. : deny quux : 10. : allow quux : ALL : deny gzonk : KNOWN : allow gzonk : ALL : deny wibble : UNKNOWN : deny wibble : ALL : allow