Net::IdentServer - An rfc 1413 Ident server using Net::Server::Fork.

SYNOPSIS

    use Net::IdentServer;

    my $nis = Net::IdentServer->new();

    run $nis;
    # This is a working identd …
    # though, you probably need to be root

DESCRIPTION

Although you can run this as you see in the SYNOPSIS, you'll probably want to rewrite a few things.

Net::IdentServer inherits Net::Server, so click through to that module for a description of the arguments to new() and for how it reads @ARGV.

An example random fifteen-letter-word ident server follows:

    package main;

    RandomIdentServer->new( user=>'nobody', group=>'nobody' )->run;

    package RandomIdentServer;

    use strict;
    use base qw(Net::IdentServer);

    1;

    sub new {
        my $class = shift;
        my $this = $class->SUPER::new( @_ );

        open IN, "/usr/share/dict/words" or die "couldn't open dictionary: $!";
        while(<IN>) {
            if( /^(\S{15})$/ ) {
                push @{ $this->{words} }, $1;
            }
        }
        close IN;

        return $this;
    }

    sub choice {
        my $this = shift;

        my $i = int rand @{ $this->{words} };

        return $this->{words}->[$i];
    }

    sub print_response {
        my $this = shift;
        my ($local, $remote, $type, $info) = @_;

        if( $type eq "UNIX" ) {
            # intercept these valid responses and randomize them

            $info = $this->choice;
        }

        # Do what we would have done
        $this->SUPER::print_response( $local, $remote, $type, $info );
    }

Overridable Functions

print_response

See the "DESCRIPTION" for an actual example. This is the function that prints the reponse to the client. As arguments, it receives $local port, $remote port, result $os_name (in caps) and the extended $info (usually a username or error).

alt_lookup

∃ a function that receives $local_addr, $local_port, $rem_addr, and $rem_port as arguments. Confusingly, the $local_addr and $rem_addr refer to the present socket connection, and the $local_port and $rem_port refer to the ports being queried.

You can do whatever lookups you like on this data and return a $uid. If you return a negative $uid, do_lookup will perform the standard lookup.

The default alt_lookup just returns a -1.

Lastly, if you return a string that matches m/^JP:(.+)/, then $1 will be printed as the username.

Example:

    sub alt_lookup() {
        my $this = shift;

        # You could use this _instead_ of the
        # print_response() in the DESCRIPTION section.  The
        # advantage of the print_response is that it only
        # returns a "username" when the queried connection
        # actually exists.

        return "JP: " . $this->choice;
    }

not_found

not_found receives as arguments [see alt_lookup for description]: $local_addr, $local_port, $rem_addr, $rem_port

by default it logs a level 2 not found message and then prints the NO-USER error message

[for more info on the log() see the Net::Server docs]

The idea here is that you can do an additional lookup of the standard TCP lookup fails. For instance, you could do a lookup on a NAT'd machine in the local net.

print_error

There are only a couple choices of error messages in rfc1413

    $this->print_error($local_port, $rem_port, 'u'); # UNKNOWN-ERROR
    $this->print_error($local_port, $rem_port, 'h'); # HIDDEN-USER
    $this->print_error($local_port, $rem_port, 'n'); # NO-USER
    $this->print_error($local_port, $rem_port, 'i'); # INVALID-PORT

You could, of course, write your own by overriding this function entirely. But otherwise picking something besides the four examples shown will earn you an error and an exit(1).

AUTHOR

Paul Miller <jettero@cpan.org>

I'm using this in my own projects. If you like it or hate me or something, drop me a line. I usually answer my email.

COPYRIGHT

© 2014 Paul Miller

BUGS

Of course. But lemme know what they are?

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net::IdentServer

(maybe the name is one? Net::Ident::Server maybe? meh…)

There's no way this old code works with IPv6 ... it reads several bytes from /proc/net/somewhere and probably the whole mess needs to be redone.

LICENSE

Perl Artisitic License — use this like any other Perl thing.

(This was previously licensed under GPL v2, assume that's still the case if you like.)

SEE ALSO

Consider using POE::Component::Server::Ident. I haven't personally checked it out, but BINGOS wrote it so it's probably a better choice than this.

perl(1), Net::Server, RFC 1413

cpanm Net::IdentServer

perl -MCPAN -e shell
install Net::IdentServer