1
2#
3# Variables:
4# /set kill_fake_gets_timeout X - if there is no tranfer in X minutes the get
5#	is closed
6#
7# Changes:
8# 1.1 (2003.02.11)
9#	Hmm. The previous official version didn't worket at all (forgot to
10#	uncomment one line) and notbody told me that. Means nobody is using this
11#	script...
12#	Anyway, this should be fixed. And now it closes stalled gets as well.
13#
14
15use strict;
16use vars qw($VERSION %IRSSI);
17
18$VERSION = "1.1";
19%IRSSI = (
20	authors     => "Piotr 'Cvbge' Krukowiecki",
21	name        => 'kill_fake_gets',
22	description => 'When new send arrives checks if there are old identical '.
23		'sends (ie from the same nick on the same server and with the same '.
24		'filename) and closes them',
25	license     => 'Public Domain',
26	changed     => '2003.02.11',
27	url         => 'http://pingu.ii.uj.edu.pl/~piotr/irssi/'
28);
29
30my $debug = 0; # set this to 1 to enable A LOT OF debug messages
31
32sub pd {
33	return if (not $debug);
34	my $dcc = @_[0];
35	Irssi::print("SDC '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}'");
36	Irssi::print("SDC created '$dcc->{created}' addr '$dcc->{addr}' port '$dcc->{port}'");
37	Irssi::print("SDC starttime '$dcc->{starttime}' transfd '$dcc->{transfd}'");
38	Irssi::print("SDC size '$dcc->{size}' skipped '$dcc->{skipped}'");
39}
40
41sub sig_dcc_connected {
42    my $dcc = @_[0];
43	return if ($dcc->{'type'} ne 'GET');
44	Irssi::print("SDC: dcc get connected") if ($debug);
45	pd($dcc);
46	foreach (Irssi::Irc::dccs()) {
47		pd($_);
48		if ($_->{'type'} eq 'GET' and
49			$_->{'nick'} eq $dcc->{'nick'} and
50			$_->{'servertag'} eq $dcc->{'servertag'} and
51			$_->{'arg'} eq $dcc->{'arg'} and
52			$_->{'created'} ne $dcc->{'created'} and
53			$_->{'starttime'} ne $dcc->{'starttime'} and
54			$_->{'port'} ne $dcc->{'port'}) {
55			Irssi::print("SDC: Destroying") if ($debug);
56			$_->destroy();
57		}
58	}
59}
60
61my %gets;
62
63sub sig_dcc_destroyed {
64	my $dcc = @_[0];
65	return if ($dcc->{'type'} ne 'GET');
66
67	Irssi::print('SDC: the get was destroyed:') if ($debug); pd($dcc);
68
69	# no record - the script must have been loaded less than 1 minute ago
70	if (not exists $gets{$dcc->{'servertag'}} or
71		not exists $gets{$dcc->{'servertag'}}{$dcc->{'nick'}} or
72		not exists $gets{$dcc->{'servertag'}}{$dcc->{'nick'}}{$dcc->{'arg'}}) {
73		Irssi::print('SDC: The record for this get does not exists') if ($debug);
74		return;
75	}
76
77	delete $gets{$dcc->{'servertag'}}{$dcc->{'nick'}}{$dcc->{'arg'}};
78	Irssi::print('SDC: record destroyed') if ($debug);
79}
80
81
82
83sub check_speed {
84	my $time = time();
85	my $timeout = 60 * Irssi::settings_get_int('kill_fake_gets_timeout');
86	foreach (Irssi::Irc::dccs()) {
87		next if ($_->{'type'} ne 'GET');
88		next if (not $_->{'starttime'}); # transfer not yet started
89
90		Irssi::print('SDC: checking get:') if ($debug);	pd($_);
91		# no such record - just loaded the script
92		if (not exists $gets{$_->{'servertag'}} or
93			not exists $gets{$_->{'servertag'}}{$_->{'nick'}} or
94			not exists $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}) {
95			$gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'time'} = $time;
96			$gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'} = $_->{'transfd'};
97			Irssi::print("Adding as new get: '$time', '$_->{transfd}'") if ($debug);
98			next;
99		}
100
101		# the transfer is in progress
102		if ($_->{'transfd'} != $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'}) {
103			Irssi::print('SDC: the transfer is in progress (change '.
104			($_->{'transfd'} - $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'})
105				.' bytes)') if ($debug);
106			$gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'time'} = $time;
107			$gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'} = $_->{'transfd'};
108			next;
109		}
110
111		Irssi::print('SDC: transfer stalled') if ($debug);
112		# transfer stalled
113		if ($time - $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'time'}
114			> $timeout) {
115			Irssi::print('SDC: closing this GET') if ($debug);
116			my $server = Irssi::server_find_tag($_->{'servertag'});
117		    if (!$server) {
118				Irssi::print('SDC: error: could not find server $_->{servertag}') if ($debug);
119				next;
120			}
121			$server->command("DCC CLOSE GET $_->{nick} $_->{arg}");
122		}
123	}
124}
125
126# After this many minutes of no data the get is closed
127Irssi::settings_add_int('misc', 'kill_fake_gets_timeout', 2);
128
129Irssi::signal_add_first('dcc connected', 'sig_dcc_connected');
130Irssi::signal_add_last('dcc destroyed', 'sig_dcc_destroyed');
131my $timeout_tag = Irssi::timeout_add(60*1000, 'check_speed', undef);
132