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