1##################################################################
2#                                                                #
3#  Net::Finger, a Perl implementation of a finger client.        #
4#                                                                #
5#  By Dennis "FIMM" Taylor, <corbeau@execpc.com>                 #
6#                                                                #
7#  This module may be used and distributed under the same terms  #
8#  as Perl itself. See your Perl distribution for details.       #
9#                                                                #
10##################################################################
11# $Id$
12
13package Net::Finger;
14
15use strict;
16use Socket;
17use Carp;
18use vars qw($VERSION @ISA @EXPORT $error $debug);
19
20require Exporter;
21@ISA = qw(Exporter);
22@EXPORT = qw( &finger );
23
24$VERSION = '1.06';
25$debug = 0;
26
27
28# I know the if ($debug) crap gets in the way of the code a bit, but
29# it's a worthy sacrifice as far as I'm concerned.
30
31sub finger {
32    my ($addr, $verbose) = @_;
33    my ($host, $port, $request, @lines, $line);
34
35    unless (@_) {
36        carp "Not enough arguments to Net::Finger::finger()";
37    }
38
39    # Set the error indicator to something innocuous.
40    $error = "";
41
42    $addr ||= '';
43    if (index( $addr, '@' ) >= 0) {
44        my @tokens = split /\@/, $addr;
45        $host = pop @tokens;
46        $request = join '@', @tokens;
47
48    } else {
49        $host = 'localhost';
50        $request = $addr;
51    }
52
53    if ($verbose) {
54        $request = "/W $request";
55    }
56
57    if ($debug) {
58        warn "Creating a new socket.\n";
59    }
60
61    unless (socket( SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'))) {
62        $error = "Can\'t create a new socket: $!";
63        return;
64    }
65    select SOCK;  $| = 1;  select STDOUT;
66
67    $port = ($host =~ s/:([0-9]*)$// && $1) ? $1 :
68	                (getservbyname('finger', 'tcp'))[2];
69
70    if ($debug) {
71        warn "Connecting to $host, port $port.\n";
72    }
73
74    unless (connect( SOCK, sockaddr_in($port, inet_aton($host)) ))
75    {
76        $error = "Can\'t connect to $host: $!";
77        return;
78    }
79
80    if ($debug) {
81        warn "Sending request: \"$request\"\n";
82    }
83
84    print SOCK "$request\015\012";
85
86    if ($debug) {
87        warn "Waiting for response.\n";
88    }
89
90    while (defined( $line = <SOCK> )) {
91	$line =~ s/\015?\012/\n/g;    # thanks (again), Pudge!
92	push @lines, $line;
93    }
94
95    if ($debug) {
96        warn "Response received. Closing connection.\n";
97    }
98
99    close SOCK;
100    return( wantarray ? @lines : join('', @lines) );
101}
102
103
104
1051;
106__END__
107
108=head1 NAME
109
110Net::Finger - a Perl implementation of a finger client.
111
112=head1 SYNOPSIS
113
114  use Net::Finger;
115
116  # You can put the response in a scalar...
117  $response = finger('corbeau@execpc.com');
118  unless ($response) {
119      warn "Finger problem: $Net::Finger::error";
120  }
121
122  # ...or an array.
123  @lines = finger('corbeau@execpc.com', 1);
124
125=head1 DESCRIPTION
126
127Net::Finger is a simple, straightforward implementation of a finger client
128in Perl -- so simple, in fact, that writing this documentation is almost
129unnecessary.
130
131This module has one automatically exported function, appropriately
132entitled C<finger()>. It takes two arguments:
133
134=over
135
136=item *
137
138A username or email address to finger. (Yes, it does support the
139vaguely deprecated "user@host@host" syntax.) If you need to use a port
140other than the default finger port (79), you can specify it like so:
141"username@hostname:port".
142
143=item *
144
145(Optional) A boolean value for verbosity. True == verbose output. If
146you don't give it a value, it defaults to false. Actually, whether
147this output will differ from the non-verbose version at all is up to
148the finger server.
149
150=back
151
152C<finger()> is context-sensitive. If it's used in a scalar context, it
153will return the server's response in one large string. If it's used in
154an array context, it will return the response as a list, line by
155line. If an error of some sort occurs, it returns undef and puts a
156string describing the error into the package global variable
157C<$Net::Finger::error>. If you'd like to see some excessively verbose
158output describing every step C<finger()> takes while talking to the
159other server, put a true value in the variable C<$Net::Finger::debug>.
160
161Here's a sample program that implements a very tiny, stripped-down
162finger(1):
163
164    #!/usr/bin/perl -w
165
166    use Net::Finger;
167    use Getopt::Std;
168    use vars qw($opt_l);
169
170    getopts('l');
171    $x = finger($ARGV[0], $opt_l);
172
173    if ($x) {
174        print $x;
175    } else {
176        warn "$0: error: $Net::Finger::error\n";
177    }
178
179=head1 BUGS
180
181=over
182
183=item *
184
185Doesn't yet do non-blocking requests. (FITNR. Really.)
186
187=item *
188
189Doesn't do local requests unless there's a finger server running on localhost.
190
191=item *
192
193Contrary to the name's implications, this module involves no teledildonics.
194
195=back
196
197=head1 AUTHOR
198
199Dennis Taylor, E<lt>corbeau@execpc.comE<gt>
200
201=head1 SEE ALSO
202
203perl(1), finger(1), RFC 1288.
204
205=cut
206