POE-Component-Client-Ident-1.07/0040755000175000001440000000000010712134533015333 5ustar chrisusersPOE-Component-Client-Ident-1.07/inc/0040755000175000001440000000000010712134533016104 5ustar chrisusersPOE-Component-Client-Ident-1.07/inc/Module/0040755000175000001440000000000010712134533017331 5ustar chrisusersPOE-Component-Client-Ident-1.07/inc/Module/Install.pm0100644000175000001440000001761110712134513021276 0ustar chrisusers#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.68'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die << "END_DIE"; Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; POE-Component-Client-Ident-1.07/inc/Module/Install/0040755000175000001440000000000010712134533020737 5ustar chrisusersPOE-Component-Client-Ident-1.07/inc/Module/Install/Fetch.pm0100644000175000001440000000463010712134515022326 0ustar chrisusers#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; POE-Component-Client-Ident-1.07/inc/Module/Install/Makefile.pm0100644000175000001440000001351110712134515023010 0ustar chrisusers#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } require File::Find; %test_dir = (); File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->build_requires, $self->requires) ); # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 363 POE-Component-Client-Ident-1.07/inc/Module/Install/Base.pm0100644000175000001440000000203510712134514022143 0ustar chrisusers#line 1 package Module::Install::Base; $VERSION = '0.68'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 POE-Component-Client-Ident-1.07/inc/Module/Install/Metadata.pm0100644000175000001440000002152710712134514023020 0ustar chrisusers#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } # configure_requires is currently a null-op sub configure_requires { 1 } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'gpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; } $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; POE-Component-Client-Ident-1.07/inc/Module/Install/Can.pm0100644000175000001440000000337410712134515022002 0ustar chrisusers#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 POE-Component-Client-Ident-1.07/inc/Module/Install/WriteAll.pm0100644000175000001440000000162410712134514023017 0ustar chrisusers#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{'PL_FILES'} ) { $self->makemaker_args( PL_FILES => {} ); } if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; POE-Component-Client-Ident-1.07/inc/Module/Install/Win32.pm0100644000175000001440000000341610712134515022200 0ustar chrisusers#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } } 1; POE-Component-Client-Ident-1.07/Changes0100644000175000001440000000253510712134505016627 0ustar chrisusersChangelog for POE::Component::Client::Ident:- ============================================= 1.07 Wed Oct 31 17:19:56 GMT 2007 - Updated Module::Install to 0.68 1.06 Sun Aug 05 11:44:11 BST 2007 - Fixed abstract_from and build_requires in Makefile.PL 1.04 Thu Dec 7 17:27:17 GMT 2006 - Ident-Agent was hanging on to a reference to the spawning session. Changed to session->ID. 1.02 Fri Sep 1 10:27:59 BST 2006 - Rearranged distribution file structure. - Added test pod and pod coverage. - Fixed documentation coverage. 1.01 Fri May 19 16:41:56 BST 2006 - Minor bug in Agent.pm was causing two error events to be generated in the case of a socket error. 1.00 Wed Apr 26 13:48:34 BST 2006 - Minor code revisions - switched test script to Test::More 0.8 Thu Nov 3 12:55:56 GMT 2005 - Changed Ident-Agent API to be objectified. 0.7 Fri Apr 29 10:51:22 BST 2005 - Amended Ident.pm so that it only stashes child session IDs not the session objects themselves. - Doh, had forgotten to include 'use Socket' in Ident.pm. 0.6 Fri Apr 22 12:00:56 BST 2005 - Hopefully fixed the issues that _pRiVi was having. 0.5 Sat Apr 16 11:26:37 BST 2005 - _pRiVi @ MAGnet teased a bug in _time_out. 0.4 Tue Feb 8 12:55:40 GMT 2005 - Added an additional delay _time_out to Ident-Agent.pm, so that it'll properly timeout on firewalled hosts/ports. POE-Component-Client-Ident-1.07/lib/0040755000175000001440000000000010712134533016101 5ustar chrisusersPOE-Component-Client-Ident-1.07/lib/POE/0040755000175000001440000000000010712134533016524 5ustar chrisusersPOE-Component-Client-Ident-1.07/lib/POE/Filter/0040755000175000001440000000000010712134533017751 5ustar chrisusersPOE-Component-Client-Ident-1.07/lib/POE/Filter/Ident.pm0100755000175000001440000001053510566272413021365 0ustar chrisusers# Author Chris "BinGOs" Williams # Cribbed the regexps from Net::Ident by Jan-Pieter Cornet # # This module may be used, modified, and distributed under the same # terms as Perl itself. Please see the license that came with your Perl # distribution for details. # package POE::Filter::Ident; use strict; use Carp; use vars qw($VERSION); $VERSION = '1.10'; sub new { my $class = shift; my %args = @_; $args{lc $_} = delete $args{$_} for keys %args; bless \%args, $class; } # Set/clear the 'debug' flag. sub debug { my $self = shift; $self->{'debug'} = $_[0] if @_; return $self->{'debug'}; } sub get { my ($self, $raw) = @_; my $events = []; foreach my $line (@$raw) { warn "<<< $line\n" if $self->{'debug'}; next unless $line =~ /\S/; my ($port1, $port2, $replytype, $reply) = $line =~ /^\s*(\d+)\s*,\s*(\d+)\s*:\s*(ERROR|USERID)\s*:\s*(.*)$/; SWITCH: { unless ( defined $reply ) { push @$events, { name => 'barf', args => [ 'UKNOWN-ERROR' ] }; last SWITCH; } if ( $replytype eq 'ERROR' ) { my ($error); ( $error = $reply ) =~ s/\s+$//; push @$events, { name => 'error', args => [ $port1, $port2, $error ] }; last SWITCH; } if ( $replytype eq 'USERID' ) { my ($opsys, $userid); unless ( ($opsys, $userid) = ($reply =~ /\s*((?:[^\\:]+|\\.)*):(.*)$/) ) { # didn't parse properly, abort. push @$events, { name => 'barf', args => [ 'UKNOWN-ERROR' ] }; last SWITCH; } # remove trailing whitespace, except backwhacked whitespaces from opsys $opsys =~ s/([^\\])\s+$/$1/; # un-backwhack opsys. $opsys =~ s/\\(.)/$1/g; # in all cases is leading whitespace removed from the username, even # though rfc1413 mentions that it shouldn't be done, current # implementation practice dictates otherwise. What insane OS would # use leading whitespace in usernames anyway... $userid =~ s/^\s+//; # Test if opsys is "special": if it contains a charset definition, # or if it is "OTHER". This means that it is rfc1413-like, instead # of rfc931-like. (Why can't they make these RFCs non-conflicting??? ;) # Note that while rfc1413 (the one that superseded rfc931) indicates # that _any_ characters following the final colon are part of the # username, current implementation practice inserts a space there, # even "modern" identd daemons. # Also, rfc931 specifically mentions escaping characters, while # rfc1413 does not mention it (it isn't really necessary). Anyway, # I'm going to remove trailing whitespace from userids, and I'm # going to un-backwhack them, unless the opsys is "special". unless ( $opsys =~ /,/ || $opsys eq 'OTHER' ) { # remove trailing whitespace, except backwhacked whitespaces. $userid =~ s/([^\\])\s+$/$1/; # un-backwhack $userid =~ s/\\(.)/$1/g; } push @$events, { name => 'reply', args => [ $port1, $port2, $opsys, $userid ] }; last SWITCH; } # If we fell out here then it is probably an error push @$events, { name => 'barf', args => [ 'UKNOWN-ERROR' ] }; } } return $events; } # This sub is so useless to implement that I won't even bother. sub put { croak "Call to unimplemented subroutine POE::Filter::Ident->put()"; } 1; __END__ =head1 NAME POE::Filter::Ident -- A POE-based parser for the Ident protocol. =head1 SYNOPSIS my $filter = POE::Filter::Ident->new(); my @events = @{$filter->get( [ @lines ] )}; =head1 DESCRIPTION POE::Filter::Ident takes lines of raw Ident input and turns them into weird little data structures, suitable for feeding to POE::Component::Client::Ident::Agent. They look like this: { name => 'event name', args => [ some info about the event ] } =head1 CONSTRUCTOR =over =item new Creates a new POE::Filter::Ident object. Takes no arguments. =back =head1 METHODS =over =item get Takes an array reference full of lines of raw Ident text. Returns an array reference of processed, pasteurized events. =item put There is no "put" method. That would be kinda silly for this filter, don't you think? =item debug Pass true/false value to enable/disable debugging information. =back =head1 AUTHOR Dennis "fimmtiu" Taylor, Edennis@funkplanet.comE. Hacked for Ident by Chris "BinGOs" Williams Echris@Bingosnet.co.ukE Code for parsing the the Ident messages from Net::Ident by Jan-Pieter Cornet. =head1 SEE ALSO Net::Ident =cut POE-Component-Client-Ident-1.07/lib/POE/Component/0040755000175000001440000000000010712134533020466 5ustar chrisusersPOE-Component-Client-Ident-1.07/lib/POE/Component/Client/0040755000175000001440000000000010712134533021704 5ustar chrisusersPOE-Component-Client-Ident-1.07/lib/POE/Component/Client/Ident.pm0100644000175000001440000001607410712134424023311 0ustar chrisusers# Author: Chris "BinGOs" Williams # # This module may be used, modified, and distributed under the same # terms as Perl itself. Please see the license that came with your Perl # distribution for details. # package POE::Component::Client::Ident; use 5.006; use strict; use warnings; use Socket; use POE qw(Component::Client::Ident::Agent); use Carp; use vars qw($VERSION); $VERSION = '1.07'; sub spawn { my ( $package, $alias ) = splice @_, 0, 2; my $self = bless { alias => $alias }, $package; $self->{session_id} = POE::Session->create ( object_states => [ $self => [qw(_start _child query)], $self => { ident_agent_reply => '_ident_agent_reply', ident_agent_error => '_ident_agent_error', shutdown => '_shutdown', }, ], )->ID(); return $self; } sub session_id { $_[0]->{session_id}; } sub shutdown { my $self = shift; $poe_kernel->call( $self->{session_id}, @_ ); } sub _start { my ($kernel,$self,$session) = @_[KERNEL,OBJECT,SESSION]; $self->{session_id} = $session->ID(); $kernel->alias_set( $self->{alias} ) if $self->{alias}; $kernel->refcount_increment( $self->{session_id}, __PACKAGE__ ) unless $self->{alias}; undef; } sub _child { my ($kernel,$self,$what,$child) = @_[KERNEL,OBJECT,ARG0,ARG1]; if ( $what eq 'create' ) { # Stuff here to match up to our query $self->{children}->{ $child->ID() } = 1; } if ( $what eq 'lose' ) { delete $self->{children}->{ $child->ID() }; } undef; } sub _shutdown { my ($kernel,$self) = @_[KERNEL,OBJECT]; $kernel->call( $_ => 'shutdown' ) for keys %{ $self->{children} }; $kernel->alias_remove($_) for $kernel->alias_list(); $kernel->refcount_decrement( $self->{session_id}, __PACKAGE__ ) unless $self->{alias}; undef; } sub query { my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER]; my $package = ref $self; my ($peeraddr,$peerport,$sockaddr,$sockport,$socket) = _parse_arguments( @_[ARG0 .. $#_] ); unless ( $peeraddr and $peerport and $sockaddr and $sockport ) { croak "Not enough arguments/items for $package->query"; } $kernel->refcount_increment( $sender->ID() => __PACKAGE__ ); POE::Component::Client::Ident::Agent->spawn( @_[ARG0 .. $#_], Reference => $sender->ID() ); undef; } sub _ident_agent_reply { my ($kernel,$self,$ref) = @_[KERNEL,OBJECT,ARG0]; my $requester = delete $ref->{Reference}; $kernel->post( $requester, 'ident_client_reply' , $ref, @_[ARG1 .. $#_] ); $kernel->refcount_decrement( $requester => __PACKAGE__ ); undef; } sub _ident_agent_error { my ($kernel,$self,$ref) = @_[KERNEL,OBJECT,ARG0]; my $requester = delete $ref->{Reference}; $kernel->post( $requester, 'ident_client_error', $ref, @_[ARG1 .. $#_] ); $kernel->refcount_decrement( $requester => __PACKAGE__ ); undef; } sub _parse_arguments { my %hash = @_; my @returns; # If we get a socket it takes precedence over any other arguments SWITCH: { if ( defined $hash{'Socket'} ) { $returns[0] = inet_ntoa( (unpack_sockaddr_in( getpeername $hash{'Socket'} ))[1] ); $returns[1] = (unpack_sockaddr_in( getpeername $hash{'Socket'} ))[0]; $returns[2] = inet_ntoa( (unpack_sockaddr_in( getsockname $hash{'Socket'} ))[1] ); $returns[3] = (unpack_sockaddr_in( getsockname $hash{'Socket'} ))[0]; $returns[4] = $hash{'Socket'}; last SWITCH; } if ( defined $hash{'PeerAddr'} and defined $hash{'PeerPort'} and defined $hash{'SockAddr'} and defined $hash{'SockAddr'} ) { $returns[0] = $hash{'PeerAddr'}; $returns[1] = $hash{'PeerPort'}; $returns[2] = $hash{'SockAddr'}; $returns[3] = $hash{'SockPort'}; last SWITCH; } } return @returns; } =head1 NAME POE::Component::Client::Ident - A component that provides non-blocking ident lookups to your sessions. =head1 SYNOPSIS use POE::Component::Client::Ident; my $poco_obj = POE::Component::Client::Ident->spawn ( 'Ident-Client' ); $kernel->post ( 'Ident-Client' => query => Socket => $socket ); $kernel->post ( 'Ident-Client' => query => PeerAddr => '10.0.0.1', PeerPort => 2345, SockAddr => '192.168.1.254', SockPort => 6669, BuggyIdentd => 1, TimeOut => 30 ); =head1 DESCRIPTION POE::Component::Client::Ident is a POE component that provides non-blocking Ident lookup services to other components and sessions. The Ident protocol is described in RFC 1413 L. The component takes requests in the form of events, spawns L sessions to perform the Ident queries and returns the appropriate responses to the requesting session. =head1 CONSTRUCTOR =over =item spawn Takes one argument, a kernel alias to christen the new component with. Returns an object. =back =head1 METHODS These methods are available on the poco object returned by spawn(). =over =item session_id Returns the component's session ID. =item shutdown Takes no arguments. Causes the component to terminate gracefully. Any pending Ident::Agent components that are running will be closed without returning events. =back =head1 INPUT The component accepts the following events: =over =item query Takes either the arguments: "PeerAddr", the remote IP address where a TCP connection has originated; "PeerPort", the port where the TCP has originated from; "SockAddr", the address of our end of the connection; "SockPort", the port of our end of the connection; OR: "Socket", the socket handle of the connection, the component will work out all the details for you. If Socket is defined, it will override the settings of the other arguments. See the documentation for Ident-Agent for extra parameters you may pass. =item shutdown Takes no arguments. Causes the component to terminate gracefully. Any pending Ident::Agent components that are running will be closed without returning events. =back =head1 OUTPUT The events you can expect to receive having submitted a 'query'. All the events returned by the component have a hashref as ARG0. This hashref contains the arguments that were passed to the component. If a socket handle was passed, the hashref will contain the appropriate PeerAddr, PeerPort, SockAddr and Sock Port. =over =item ident_client_reply Returned when the component receives a USERID response from the identd. ARG0 is hashref, ARG1 is the opsys field and ARG2 is the userid or something else depending on whether the opsys field is set to 'OTHER' ( Don't blame me, read the RFC ). =item ident_client_error Returned when the component receives an ERROR response from the identd, there was some sort of communication error with the remote host ( ie. no identd running ) or it had some other problem with making the connection to the other host. No matter. ARG0 is hashref, ARG1 is the type of error. =back =head1 AUTHOR Chris Williams, Echris@bingosnet.co.uk =head1 SEE ALSO RFC 1413 L L POE-Component-Client-Ident-1.07/lib/POE/Component/Client/Ident/0040755000175000001440000000000010712134533022747 5ustar chrisusersPOE-Component-Client-Ident-1.07/lib/POE/Component/Client/Ident/Agent.pm0100644000175000001440000002615510712134436024353 0ustar chrisusers# Author: Chris "BinGOs" Williams # # This module may be used, modified, and distributed under the same # terms as Perl itself. Please see the license that came with your Perl # distribution for details. # package POE::Component::Client::Ident::Agent; use 5.006; use strict; use warnings; use POE qw( Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW Filter::Line Filter::Stream Filter::Ident); use Carp; use Socket; use vars qw($VERSION); $VERSION = '1.07'; sub spawn { my $package = shift; my ($peeraddr,$peerport,$sockaddr,$sockport,$identport,$buggyidentd,$timeout,$reference) = _parse_arguments(@_); unless ( $peeraddr and $peerport and $sockaddr and $sockport ) { croak "Not enough arguments supplied to $package->spawn"; } my $self = $package->_new($peeraddr,$peerport,$sockaddr,$sockport,$identport,$buggyidentd,$timeout,$reference); $self->{session_id} = POE::Session->create( object_states => [ $self => { shutdown => '_shutdown', }, $self => [qw(_start _sock_up _sock_down _sock_failed _parse_line _time_out)], ], )->ID(); return $self; } sub _new { my ( $package, $peeraddr, $peerport, $sockaddr, $sockport, $identport, $buggyidentd, $timeout, $reference) = @_; return bless { event_prefix => 'ident_agent_', peeraddr => $peeraddr, peerport => $peerport, sockaddr => $sockaddr, sockport => $sockport, identport => $identport, buggyidentd => $buggyidentd, timeout => $timeout, reference => $reference }, $package; } sub session_id { return $_[0]->{session_id}; } sub _start { my ( $kernel, $self, $session, $sender ) = @_[ KERNEL, OBJECT, SESSION, SENDER ]; $self->{sender} = $sender->ID(); $self->{session_id} = $session->ID(); $self->{ident_filter} = POE::Filter::Ident->new(); $kernel->delay( '_time_out' => $self->{timeout} ); $self->{socketfactory} = POE::Wheel::SocketFactory->new( SocketDomain => AF_INET, SocketType => SOCK_STREAM, SocketProtocol => 'tcp', RemoteAddress => $self->{'peeraddr'}, RemotePort => ( $self->{'identport'} ? ( $self->{'identport'} ) : ( 113 ) ), SuccessEvent => '_sock_up', FailureEvent => '_sock_failed', ( $self->{sockaddr} ? (BindAddress => $self->{sockaddr}) : () ), ); $self->{query_string} = $self->{peerport} . ", " . $self->{sockport}; $self->{query} = { PeerAddr => $self->{peeraddr}, PeerPort => $self->{peerport}, SockAddr => $self->{sockaddr}, SockPort => $self->{sockport}, Reference => $self->{reference} }; undef; } sub _sock_up { my ($kernel,$self,$socket) = @_[KERNEL,OBJECT,ARG0]; my $filter; delete $self->{socketfactory}; if ( $self->{buggyidentd} ) { $filter = POE::Filter::Line->new(); } else { $filter = POE::Filter::Line->new( Literal => "\x0D\x0A" ); } $self->{socket} = new POE::Wheel::ReadWrite ( Handle => $socket, Driver => POE::Driver::SysRW->new(), Filter => $filter, InputEvent => '_parse_line', ErrorEvent => '_sock_down', ); $kernel->post( $self->{sender}, $self->{event_prefix} . 'error', $self->{query}, "UKNOWN-ERROR" ) unless $self->{socket}; $self->{socket}->put($self->{query_string}) if $self->{socket}; $kernel->delay( '_time_out' => $self->{timeout} ); undef; } sub _sock_down { my ($kernel,$self) = @_[KERNEL,OBJECT]; $kernel->post( $self->{sender}, $self->{event_prefix} . 'error', $self->{query}, "UKNOWN-ERROR" ) unless $self->{had_a_response}; delete $self->{socket}; $kernel->delay( '_time_out' => undef ); undef; } sub _sock_failed { my ($kernel, $self) = @_[KERNEL,OBJECT]; $kernel->post( $self->{sender}, $self->{event_prefix} . 'error', $self->{query}, "UKNOWN-ERROR" ); $kernel->delay( '_time_out' => undef ); delete $self->{socketfactory}; undef; } sub _time_out { my ($kernel,$self) = @_[KERNEL,OBJECT]; $kernel->post( $self->{sender}, $self->{event_prefix} . 'error', $self->{query}, "UKNOWN-ERROR" ); delete $self->{socketfactory}; delete $self->{socket}; undef; } sub _parse_line { my ($kernel,$self,$line) = @_[KERNEL,OBJECT,ARG0]; my @cooked; @cooked = @{$self->{ident_filter}->get( [$line] )}; foreach my $ev (@cooked) { if ( $ev->{name} eq 'barf' ) { # Filter choaked for whatever reason $kernel->post( $self->{sender}, $self->{event_prefix} . 'error', $self->{query}, "UKNOWN-ERROR" ); } else { $ev->{name} = $self->{event_prefix} . $ev->{name}; my ($port1, $port2, @args) = @{$ev->{args}}; if ( $self->_port_pair_matches( $port1, $port2 ) ) { $kernel->post( $self->{sender}, $ev->{name}, $self->{query}, @args ); } else { $kernel->post( $self->{sender}, $self->{event_prefix} . 'error', $self->{query}, "UKNOWN-ERROR" ); } } } $kernel->delay( '_time_out' => undef ); $self->{had_a_response} = 1; delete $self->{socket}; undef; } sub shutdown { my $self = shift; $poe_kernel->call( $self->session_id() => 'shutdown' => @_ ); } sub _shutdown { my ($kernel,$self) = @_[KERNEL,OBJECT]; $self->{had_a_response} = 1; delete $self->{socket}; $kernel->delay( '_time_out' => undef ); undef; } sub _port_pair_matches { my ($self) = shift; my ($port1,$port2) = @_; return 1 if $port1 == $self->{peerport} and $port2 == $self->{sockport}; return 0; } sub _parse_arguments { my ( %hash ) = @_; my @returns; # If we get a socket it takes precedence over any other arguments SWITCH: { if ( defined ( $hash{'Reference'} ) ) { $returns[7] = $hash{'Reference'}; } if ( defined ( $hash{'IdentPort'} ) ) { $returns[4] = $hash{'IdentPort'}; } if ( defined ( $hash{'BuggyIdentd'} ) and $hash{'BuggyIdentd'} == 1 ) { $returns[5] = $hash{'BuggyIdentd'}; } if ( defined ( $hash{'TimeOut'} ) and ( $hash{'TimeOut'} > 5 or $hash{'TimeOut'} < 30 ) ) { $returns[6] = $hash{'TimeOut'}; } $returns[6] = 30 unless ( defined ( $returns[6] ) ); if ( defined ( $hash{'Socket'} ) ) { $returns[0] = inet_ntoa( (unpack_sockaddr_in( getpeername $hash{'Socket'} ))[1] ); $returns[1] = (unpack_sockaddr_in( getpeername $hash{'Socket'} ))[0]; $returns[2] = inet_ntoa( (unpack_sockaddr_in( getsockname $hash{'Socket'} ))[1] ); $returns[3] = (unpack_sockaddr_in( getsockname $hash{'Socket'} ))[0]; last SWITCH; } if ( defined ( $hash{'PeerAddr'} ) and defined ( $hash{'PeerPort'} ) and defined ( $hash{'SockAddr'} ) and defined ( $hash{'SockAddr'} ) ) { $returns[0] = $hash{'PeerAddr'}; $returns[1] = $hash{'PeerPort'}; $returns[2] = $hash{'SockAddr'}; $returns[3] = $hash{'SockPort'}; last SWITCH; } } return @returns; } =head1 NAME POE::Component::Client::Ident::Agent - A component to provide a one-shot non-blocking Ident query. =head1 SYNOPSIS use POE::Component::Client::Ident::Agent; my $poco = POE::Component::Client::Ident::Agent->spawn( PeerAddr => "192.168.1.12", # Originating IP Address PeerPort => 12345, # Originating port SockAddr => "192.168.2.24", # Local IP address SockPort => 69, # Local Port Socket => $socket_handle, # Or pass in a socket handle IdentPort => 113, # Port to send queries to on originator # Default shown BuggyIdentd => 0, # Dealing with an Identd that isn't # RFC compatable. Default is 0. TimeOut => 30, # Adjust the timeout period. Reference => $scalar # Give the component a reference ); sub _child { my ($action,$child,$reference) = @_[ARG0,ARG1,ARG2]; if ( $action eq 'create' ) { # Stuff } } sub ident_agent_reply { } sub ident_agent_error { } =head1 DESCRIPTION POE::Component::Client::Ident::Agent is a POE component that provides a single "one shot" look up of a username on the remote side of a TCP connection to other components and sessions, using the ident (auth/tap) protocol. The Ident protocol is described in RFC 1413 L. The component implements a single ident request. Your session spawns the component, passing the relevant arguments and at some future point will receive either a 'ident_agent_reply' or 'ident_agent_error', depending on the outcome of the query. If you are looking for a robust method of managing Ident::Agent sessions then please consult the documentation for L, which takes care of Agent management for you. =head1 CONSTRUCTOR =over =item spawn Takes either the arguments: "PeerAddr", the remote IP address where a TCP connection has originated; "PeerPort", the port where the TCP has originated from; "SockAddr", the address of our end of the connection; "SockPort", the port of our end of the connection; OR: "Socket", the socket handle of the connection, the component will work out all the details for you. If Socket is defined, it will override the settings of the other arguments, except for: "IdentPort", which is the port on the remote host where we send our ident queries. This is optional, defaults to 113. You may also specify BuggyIdentd to 1, to support Identd that doesn't terminate lines as per the RFC. You may also specify TimeOut between 5 and 30, to have a shorter timeout in seconds on waiting for a response from the Identd. Default is 30 seconds. Optionally, you can specify Reference, which is anything that'll fit in a scalar. This will get passed back as part of the response. See below. Returns an POE::Component::Client::Ident::Agent object, which has the following methods. =back =head1 METHODS =over =item session_id Returns the POE session ID of the component. =item shutdown Terminates the component. =back =head1 OUTPUT All the events returned by the component have a hashref as ARG0. This hashref contains the arguments that were passed to the component. If a socket handle was passed, the hashref will contain the appropriate PeerAddr, PeerPort, SockAddr and SockPort. If the component was spawned with a Reference parameter, this will be passed back as a key of the hashref. The following events are sent to the calling session by the component: =over =item ident_agent_reply Returned when the component receives a USERID response from the identd. ARG0 is hashref, ARG1 is the opsys field and ARG2 is the userid or something else depending on whether the opsys field is set to 'OTHER' ( Don't blame me, read the RFC ). =item ident_agent_error Returned when the component receives an ERROR response from the identd, there was some sort of communication error with the remote host ( ie. no identd running ) or it had some other problem with making the connection to the other host. No matter. ARG0 is hashref, ARG1 is the type of error. =back =head1 AUTHOR Chris Williams, Echris@bingosnet.co.uk =head1 SEE ALSO RFC 1413 L L L POE-Component-Client-Ident-1.07/MANIFEST0100644000175000001440000000063410566274073016477 0ustar chrisusersChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/POE/Component/Client/Ident.pm lib/POE/Component/Client/Ident/Agent.pm lib/POE/Filter/Ident.pm Makefile.PL MANIFEST This list of files META.yml README t/1.t t/2.t t/3.t t/4.t POE-Component-Client-Ident-1.07/t/0040755000175000001440000000000010712134533015576 5ustar chrisusersPOE-Component-Client-Ident-1.07/t/4.t0100644000175000001440000000021710566274053016134 0ustar chrisusersuse Test::More; eval { require Test::Kwalitee; Test::Kwalitee->import() }; plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; POE-Component-Client-Ident-1.07/t/2.t0100644000175000001440000000020110475774402016125 0ustar chrisusersuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); POE-Component-Client-Ident-1.07/t/3.t0100644000175000001440000000026110475774656016147 0ustar chrisusers use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); POE-Component-Client-Ident-1.07/t/1.t0100644000175000001440000000576610475776564016164 0ustar chrisusersuse Test::More tests => 5; BEGIN { use_ok('POE::Component::Client::Ident') }; diag( "Testing POE::Component::Client::Ident $POE::Component::Client::Ident::VERSION, POE $POE::VERSION, Perl $], $^X" ); use Socket; use POE qw(Wheel::SocketFactory Wheel::ReadWrite); my $self = POE::Component::Client::Ident->spawn ( 'Ident-Client' ); isa_ok( $self, 'POE::Component::Client::Ident' ); POE::Session->create ( inline_states => { _start => \&server_start, _stop => \&server_stop, server_accepted => \&server_accepted, server_error => \&server_error, client_input => \&client_input, client_error => \&client_error, close_all => \&close_down_server, ident_client_reply => \&ident_client_reply, ident_client_error => \&ident_client_error, }, heap => { Port1 => 12345, Port2 => 123, UserID => 'bingos' }, ); $poe_kernel->run(); exit 0; sub server_start { $_[HEAP]->{server} = POE::Wheel::SocketFactory->new ( BindAddress => '127.0.0.1', SuccessEvent => "server_accepted", FailureEvent => "server_error", ); ($our_port, undef) = unpack_sockaddr_in( $_[HEAP]->{server}->getsockname ); $_[KERNEL]->post ( 'Ident-Client' => query => IdentPort => $our_port, PeerAddr => '127.0.0.1', PeerPort => $_[HEAP]->{Port1}, SockAddr => '127.0.0.1', SockPort => $_[HEAP]->{Port2} ); $_[KERNEL]->delay ( 'close_all' => 60 ); undef; } sub server_stop { pass("Server stop"); undef; } sub close_down_server { $_[KERNEL]->call ( 'Ident-Client' => 'shutdown' ); delete $_[HEAP]->{server}; undef; } sub server_accepted { my $client_socket = $_[ARG0]; my $wheel = POE::Wheel::ReadWrite->new ( Handle => $client_socket, InputEvent => "client_input", ErrorEvent => "client_error", Filter => POE::Filter::Line->new( Literal => "\x0D\x0A" ), ); $_[HEAP]->{client}->{ $wheel->ID() } = $wheel; undef; } sub client_input { my ( $heap, $input, $wheel_id ) = @_[ HEAP, ARG0, ARG1 ]; # Quick and dirty parsing as we know it is our component connecting my ($port1,$port2) = split ( /\s*,\s*/, $input ); if ( $port1 == $heap->{Port1} and $port2 == $heap->{Port2} ) { $heap->{client}->{$wheel_id}->put( "$port1 , $port2 : USERID : UNIX : " . $heap->{UserID} ); pass("Correct response from client"); } else { $heap->{client}->{$wheel_id}->put( "$port1 , $port2 : ERROR : UNKNOWN-ERROR"); } undef; } sub client_error { my ( $heap, $wheel_id ) = @_[ HEAP, ARG3 ]; delete $heap->{client}->{$wheel_id}; undef; } sub server_error { delete $_[HEAP]->{server}; undef; } sub ident_client_reply { my ($kernel,$heap,$ref,$opsys,$userid) = @_[KERNEL,HEAP,ARG0,ARG1,ARG2]; ok( $userid eq $heap->{UserID}, "USERID Test" ); $kernel->delay( 'close_all' => undef ); $kernel->yield( 'close_all' ); undef; } sub ident_client_error { my ($kernel,$heap) = @_[KERNEL,HEAP]; $kernel->delay( 'close_all' => undef ); $kernel->yield( 'close_all' ); undef; } POE-Component-Client-Ident-1.07/META.yml0100644000175000001440000000076210712134515016606 0ustar chrisusers--- abstract: A component that provides non-blocking ident lookups to your sessions. author: - Chris Williams build_requires: Test::More: 0.47 distribution_type: module generated_by: Module::Install version 0.68 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: POE-Component-Client-Ident no_index: directory: - inc - t requires: Carp: 0 POE: 0.0607 Socket: 0 warnings: 0 version: 1.07 POE-Component-Client-Ident-1.07/Makefile.PL0100644000175000001440000000057410655325001017306 0ustar chrisusersuse inc::Module::Install; name 'POE-Component-Client-Ident'; author 'Chris Williams '; license 'perl'; version_from 'lib/POE/Component/Client/Ident.pm'; abstract_from 'lib/POE/Component/Client/Ident.pm'; build_requires 'Test::More' => 0.47; requires 'warnings' => 0; requires 'POE' => 0.06_07; requires 'Carp' => 0; requires 'Socket' => 0; WriteAll(); POE-Component-Client-Ident-1.07/README0100644000175000001440000000311010144076776016220 0ustar chrisusersPOE::Component::Client::Ident ============================ 1). Background: POE::Component::Client::Ident is a POE (Perl Object Environment) component which provides a convenient way for POE applications to perform non-blocking Ident (auth/tap) protocol remote username lookups. The component will mainly of use to the authors of server daemons and server components which sometimes have a requirement to confirm the username provided by the client and, therefore, use the Ident protocol to query the remote host. For example, the IRC protocol. 2). Implementation: The component implements a brokering service for other components and POE sessions. The component is spawned and given a kernel alias. Components and POE sessions post request events to the component, which in turn spawns helper agents ( implemented as a separate component, see below ) that undertake the messy business of connecting to the remote host and asking the right questions to obtain a valid username, a denial, some other information or a metaphorical shrug symbolised by an error. The helper agents are implemented as a sub component ( POE::Component::Client::Ident:: Agent ), which performs a one shot Ident query using the parameters that are passed to it at startup, and passes any response for good or evil back to the session that spawned it. This component is ideal if all you require are these kind of lookups, especially if you don't want the slightly additional overhead added by the broker component. 4). DISCLAIMER This module is provided "as is". No Income Tax. No V.A.T. No money back. No guarantee.