/usr/share/perl5/POE/Filter/Ident.pm is in libpoe-component-client-ident-perl 1.07-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | # 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, E<lt>dennis@funkplanet.comE<gt>.
Hacked for Ident by Chris "BinGOs" Williams E<lt>chris@Bingosnet.co.ukE<gt>
Code for parsing the the Ident messages from Net::Ident by Jan-Pieter Cornet.
=head1 SEE ALSO
Net::Ident
=cut
|