http://www.perlmonks.org?node_id=26337
Category: networking daemons
Author/Contact Info ident666@voltar.org
Description: I saw a nullident.c program at freashmeat. I thought, hmmm, this would be funnier if it was random, and more insulting. They don't need to know who you are anyway.
#!/usr/bin/perl
#
#  Do this in your inetd.conf
#   #auth   stream  tcp     nowait    nobody    /usr/sbin/in.identd in
+.identd -l -e -o
#   auth   stream  tcp     nowait    nobody    /usr/local/jbin/ident-6
+66 ident-666
#
######################################################################
+##

use strict;

my $dict = "/usr/dict/words";
my $request;

&read_request and &write_response;

sub read_request {
    while(<>) {
        if( /(\S+)/ ) {
            $request = $1;
            return 1;
        }
    }

    return 0;
}

sub write_response {
    my $userid = &pick_word(3+rand(15));
    printf "%.20s : USERID : YouAreAPeeBrain : %.20s\r\n", $request, $
+userid;
    return 1;
}

sub pick_word {
    my $reqsize = int(shift);

    my $ret  = "";
    my $die  =  0;

    my ($set, $cur, $end) = (0, 1, 2);

    open DICT, "$dict" or die "redmist code: $!";
    seek DICT, rand(-s $dict), $set;

    <DICT>; # this get's us to the start of the next line.

    TOP: while (<DICT>) {
        ($ret = $1 and last) if /^(\w{$reqsize})$/;
    }

    if(length($ret) != $reqsize) {
        # ok, go back around
        seek DICT, 0, $set;

        # but remember we were already here ...
        die "Word too big, aaaaaaaahhhhhh!" if $die;
        $die = 1;

        goto TOP;
    }
    close DICT;

    return $ret;
}