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
|
#!/usr/bin/perl
# ptkfinger v0.2
# A Finger Client (without using a special module) for Perl/Tk
# By Alan Ford <alan@whirlnet.co.uk> 07/04/99
#
# Changelog:
# 07/04/99 First Released Version (0.1)
# 06/06/99 Added support for giving finger address on command line (0.2)
#
# Distributed with no warranty under the GNU Public License
require 5.002;
use IO::Socket;
use Socket;
use English;
use Tk;
use Tk::DialogBox;
sub finger ;
sub help ;
my $version = "0.2";
my $MW = MainWindow->new;
$MW->title("Perl/Tk Finger");
$MW->Label(-text => "Version $version - Written by Alan Ford <alan\@whirlnet.co.uk>")->pack(-side => 'bottom');
my $lookup_frame = $MW->Frame()->pack(-expand => '1', -fill => 'both', -side => 'top');
$lookup_frame->Label(-text => "Address to Finger:")->pack(-side => 'left');
my $lookup_user = $lookup_frame->Entry(-width => '10', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');
$lookup_frame->Label(-text => "\@")->pack(-side => 'left');
my $lookup_host = $lookup_frame->Entry(-width => '25', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');
my $long_value = '0';
my $long_output = $lookup_frame->Checkbutton(-onvalue => '1', -offvalue => '0', -variable => \$long_value, -text => 'Long Output')->pack(-side => 'left');
my $finger = $lookup_frame->Button(-text => 'Finger',
-command => sub
{
finger;
});
$finger->pack(-side => 'left', -expand => '1', -fill => 'both');
my $exit = $lookup_frame->Button(-text => 'Exit',
-command => sub
{
exit;
});
$exit->pack(-side => 'left', -expand => '1', -fill => 'both');
my $scroll = $MW->Scrollbar();
$scroll->pack(-side => 'right', -fill => 'y');
my $display = $MW->Text(-height => '25', -width => '80', -yscrollcommand => ['set', $scroll])->pack(-side => 'bottom', -expand => '1', -fill => 'both');
$scroll->configure(-command => ['yview', $display]);
if ($ARGV[0]) {
# Are they asking for help?
if ($ARGV[0] =~ /help$/) {
help;
}
if ($ARGV[0] eq "-?") {
help;
}
if ($ARGV[0] eq "-h") {
help;
}
# Address (probably) specified as command-line option
my $cmduser = $ARGV[0];
my $cmdhost;
($cmduser, $cmdhost) = split /@/, $ARGV[0], 2;
$lookup_user->insert('0', $cmduser);
$lookup_host->insert('0', $cmdhost);
finger;
}
MainLoop;
sub finger {
$display->delete('1.0', 'end');
my $host = $lookup_host->get;
if ($host eq "") {
$host = "localhost";
$lookup_host->insert('0', "localhost");
}
my $user = $lookup_user->get;
my $msg;
my $remote = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => "finger(79)",
);
unless ($remote) {
$msg = "Cannot connect to $host\n";
$display->insert('end', $msg);
next;
}
$remote->autoflush(1);
# use CRLF network line terminators
if ($long_value == 1) {
print $remote "/W $user\015\012";
} else {
print $remote "$user\015\012";
}
while ($_ = <$remote>) {
#print;
$_ =~ s/\r$//; # trim annoying \r line-endings on some finger output
$display->insert('end', $_);
}
close($remote) or sub {
$msg = "Can't close socket: $!\n";
$display->insert('end', $msg);
};
}
sub help {
print <<EOF
ptkfinger - Perk/Tk Finger Client for X version $version (requires Perl/Tk)
Address to finger can (but is not required) be specified as a parameter.
Report bugs to the author, Alan Ford <alan\@whirlnet.co.uk>
For more information: `man ptkfinger'
EOF
;
exit;
}
|
