html/kill_fake_gets.pl

• package main
  • pd
  • sig_dcc_connected
  • sig_dcc_destroyed
  • check_speed
• EOF

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