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
|
#!/usr/bin/perl
# CGI:IRC - http://cgiirc.sourceforge.net/
# Copyright (C) 2000-2002 David Leadbeater <http://contact.dgl.cx/>
# vim:set ts=3 expandtab shiftwidth=3 cindent:
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use strict;
use vars qw($VERSION);
use Socket;
($VERSION =
'$Name: rel_0_5_9 $ 0_5_CVS $Id: viewconnects.pl,v 1.4 2005/01/06 00:44:18 dgl Exp $'
) =~ s/^.*?(\d\S+) .*$/$1/;
$VERSION =~ s/_/./g;
# Change these if needed.
my $cgiircprefix="/tmp/cgiirc-";
my $resolve = 1;
if($ENV{GATEWAY_INTERFACE} =~ /CGI/) { # We aren't really a CGI script..
print "Content-type: text/plain\n\n";
}
my @connects = list_connects();
if(!@connects) {
print "No connections found.\n";
exit;
}
my $format = "%-9.9s %-15.15s " .
($resolve ? "%-38.38s" : "%-15.15s") .
" %-9.9s %-5.5s\n";
printf($format, "1st Nick", "Server", "Client", "Login", "Idle");
for my $u(@connects) {
my %user;
@user{qw/remoteip localip server nick clientip forwardedip ltime idle/} = @$u;
if($resolve) {
$user{clientip} = gethostbyaddr(inet_aton($user{clientip}), AF_INET) . " ($user{clientip})";
}
printf($format, @user{qw/nick server clientip ltime idle/});
}
sub list_connects {
my @connects;
(my $dir, my $prefix) = $cgiircprefix =~ /^(.*\/)([^\/]+)$/;
opendir(TMPDIR, $dir) or return undef;
for my $path(readdir TMPDIR) {
my @u;
next unless $path =~ /^\Q$prefix\E/;
$path = $dir . $path;
next unless -d $path;
local *TMP;
open(TMP, "<$path/server") or next;
@u = <TMP>;
chomp(@u);
close(TMP);
open(TMP, "<$path/ip") or next;
for my $n(0..1) {
chomp($_ = <TMP>);
$u[$n + 4] = $_;
}
close(TMP);
# login time
# ctime of the directory has highest chance to be the right one here
my @t = localtime((stat("$path"))[10]);
my @today = localtime();
my @days = qw/Sun Mon Tue Wed Thu Fri Sat/;
# anyone logged on for longer than a week/(since sun) will be wrong
# too bad eh?
if($t[6] == $today[6]) {
$u[6] = sprintf '%02d:%02d', $t[2], $t[1];
}else{
$u[6] = "$days[$t[6]] " . ($t[2] > 11 ? $t[2] - 12 . 'pm' : "$t[2]am");
}
# idle time
# mtime of the socket is the right one here
@t = gmtime(time - (stat("$path/sock"))[9]);
$u[7] = sprintf '%02d:%02d', $t[2] + $t[7] * 24, $t[1];
push(@connects, \@u);
}
return @connects;
}
|
