1#$Id: clihub.pm 998 2013-08-14 12:21:20Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/lib/Net/DirectConnect/clihub.pm $ 2package #hide from cpan 3 Net::DirectConnect::clihub; 4use strict; 5no strict qw(refs); 6use warnings "NONFATAL" => "all"; 7no warnings qw(uninitialized); 8no if $] >= 5.017011, warnings => 'experimental::smartmatch'; 9use utf8; 10use Time::HiRes qw(time sleep); 11use Data::Dumper; #dev only 12$Data::Dumper::Sortkeys = $Data::Dumper::Indent = 1; 13use Net::DirectConnect; 14use Net::DirectConnect::clicli; 15#use Net::DirectConnect::http; 16our $VERSION = ( split( ' ', '$Revision: 998 $' ) )[1]; 17use base 'Net::DirectConnect'; 18 19sub name_to_ip($) { 20 my ($name) = @_; 21 unless ( $name =~ /^\d+\.\d+\.\d+\.\d+$/ ) { 22 local $_ = ( gethostbyname($name) )[4]; 23 return ( $name, 1 ) unless length($_) == 4; 24 $name = inet_ntoa($_); 25 } 26 return $name; 27} 28 29sub init { 30 my $self = shift; 31 #%$self = ( 32 #%$self, 33 local %_ = ( 34 'Nick' => 'NetDCBot', 35 'port' => 411, 36 'host' => 'localhost', 37 'Pass' => '', 38 'key' => 'zzz', 39 #'auto_wait' => 1, 40 'supports_avail' => [ qw( 41 NoGetINFO 42 NoHello 43 UserIP2 44 UserCommand 45 TTHSearch 46 OpPlus 47 Feed 48 MCTo 49 HubTopic 50 ) 51 ], 52 'search_every' => 10, 53 'search_every_min' => 10, 54 'auto_connect' => 1, 55 'auto_bug' => 1, 56 'reconnects' => 99999, 57 'NoGetINFO' => 1, #test 58 'NoHello' => 1, 59 'UserIP2' => 1, 60 'TTHSearch' => 1, 61 'Version' => '1,0091', 62 'auto_GetNickList' => 1, 63 'follow_forcemove' => 1, 64 'incomingclass' => 'Net::DirectConnect::clicli', 65 'disconnect_recursive' => 1, 66 ); 67 $self->{$_} //= $_{$_} for keys %_; 68 $self->{'periodic'}{ __FILE__ . __LINE__ } = sub { 69 my $self = shift if ref $_[0]; 70 $self->search_buffer() if $self->{'socket'}; 71 }; 72 #$self->log($self, 'inited',"MT:$self->{'message_type'}", ' with', Dumper \@_); 73 #$self->baseinit(); 74 #share_full share_tth want 75 $self->{$_} ||= $self->{'parent'}{$_} ||= {} for qw( NickList IpList PortList PortList_udp); #handler 76 #$self->{'NickList'} ||= {}; 77 #$self->{'IpList'} ||= {}; 78 #$self->{'PortList'} ||= {}; 79 #$self->log( $self, 'inited3', "MT:$self->{'message_type'}", ' with' ); 80 #You are already in the hub. 81 # $self->{'parse'} ||= { 82 $self->module_load('filelist'); 83 local %_ = ( 84 'chatline' => sub { 85 my $self = shift if ref $_[0]; 86 #$self->log( 'dev', Dumper \@_); 87 my ( $nick, $text ) = $_[0] =~ /^(?:<|\* )(.+?)>? (.+)$/s; 88 #$self->log('dcdev', 'chatline parse', Dumper(\@_,$nick, $text)); 89 $self->log( 'warn', "[$nick] oper: already in the hub [$self->{'Nick'}]" ), $self->nick_generate(), $self->reconnect(), 90 if ( ( !keys %{ $self->{'NickList'} } or $self->{'NickList'}{$nick}{'oper'} ) 91 and $text eq 'You are already in the hub.' ); 92 if ( $self->{'NickList'}{$nick}{'oper'} or $self->{'NickList'}{$nick}{'hubbot'} or $nick eq 'Hub-Security' ) { 93 if ( 94 $text =~ 95/Минимальный интервал поиска составляет: \(Minimum search interval is:\) (\d+)секунд \(seconds\)/ 96 or $text =~ /^(?:Minimum search interval is|Минимальный интервал поиска):(\d+)s/ 97 or $text =~ /Search ignored\. Please leave at least (\d+) seconds between search attempts\./ #Hub-Security opendchub 98 or $text =~ 99/Минимальный интервал между поисковыми запросами:(\d+)сек., попробуйте чуть позже/ 100 or $text =~ /You can do 1 searches in (\d+) seconds/ 101 ) 102 { 103 $self->{'search_every'} = int( rand(5) + $1 || $self->{'search_every_min'} ); 104 $self->log( 'warn', "[$nick] oper: set min interval = $self->{'search_every'}" ); 105 $self->search_retry(); 106 } 107 if ( $text =~ 108 /(?:Пожалуйста )?подождите (\d+) секунд перед следующим поиском\./i 109 or $text =~ /(?:Please )?wait (\d+) seconds before next search\./i 110 or $text eq 'Пожалуйста не используйте поиск так часто!' 111 or $text eq "Please don't flood with searches!" 112 or $text eq 'Sorry Hub is busy now, no search, try later..' ) 113 { 114 $self->{'search_every'} += int( rand(5) + $1 || $self->{'search_every_min'} ); 115 $self->log( 'warn', "[$nick] oper: increase min interval => $self->{'search_every'}" ); 116 $self->search_retry(); 117 } 118 } 119 if ( !$self->{count_parse}{chatline} and $text =~ /PtokaX/i ) { 120 #$self->log( 'dev', "[$nick] - probably hub bot" ); 121 $self->{'NickList'}{$nick}{'hubbot'} = 1; 122 } 123 $self->search_retry(), 124 if $self->{'NickList'}->{$nick}{'oper'} and $text eq 'Sorry Hub is busy now, no search, try later..'; 125 }, 126 'welcome' => sub { 127 my $self = shift if ref $_[0]; 128 my ( $nick, $text ) = $_[0] =~ /^(?:<|\* )(.+?)>? (.+)$/s; 129 if ( !keys %{ $self->{'NickList'} } or !exists $self->{'NickList'}->{$nick} or $self->{'NickList'}->{$nick}{'oper'} ) { 130 if ( $text =~ /^Bad nickname: unallowed characters, use these (\S+)/ ) 131 # 132 { 133 my $try = $self->{'Nick'}; 134 $try =~ s/[^\Q$1\E]//g; 135 $self->log( 'warn', "CHNICK $self->{'Nick'} -> $try" ); 136 $self->{'Nick'} = $try if length $try; 137 } elsif ( $text =~ /Bad nickname: Wait (\d+)sec before reconnecting/i 138 or $text =~ 139 /Пожалуйста подождите (\d+) секунд до повторного подключения\./ 140 or $text =~ /Do not reconnect too fast. Wait (\d+) secs before reconnecting./ ) 141 { 142 #sleep $1 + 1; 143 $self->work( $1 + 10 ); 144 } elsif ( $self->{'auto_bug'} and $nick eq 'VerliHub' and $text =~ /^This Hub Is Running Version 0.9.8d/i ) { #_RC1 145 ++$self->{'bug_MyINFO_last'}; 146 $self->log( 'dev', "possible bug fixed [$self->{'bug_MyINFO_last'}]" ); 147 } 148 } 149 }, 150 'Lock' => sub { 151 my $self = shift if ref $_[0]; 152 #$self->log( "lockparse", @_ ); 153 $self->{'sendbuf'} = 1; 154 $self->cmd('Supports'); 155 my ($lock) = $_[0] =~ /^(.+?)(\s+Pk=.+)?\s*$/is; 156 #print "lock[$1]\n"; 157 #$self->log( 'dev', "lock from [$_[0]] = [$lock]"); 158 $self->cmd( 'Key', $self->lock2key($lock) ); 159 $self->{'sendbuf'} = 0; 160 $self->cmd('ValidateNick'); 161 }, 162 'Hello' => sub { 163 my $self = shift if ref $_[0]; 164 #$self->log('info', "HELLO recieved, connected. me=[$self->{'Nick'}]", @_); 165 return unless $_[0] eq $self->{'Nick'}; 166 $self->{'sendbuf'} = 1; 167 $self->cmd('Version'); 168 $self->{'sendbuf'} = 0 unless $self->{'auto_GetNickList'}; 169 $self->cmd('MyINFO') unless $self->{'bug_MyINFO_last'}; 170 $self->{'sendbuf'} = 0, $self->cmd('GetNickList') if $self->{'auto_GetNickList'}; 171 $self->{'sendbuf'} = 0, $self->cmd('MyINFO') if $self->{'bug_MyINFO_last'}; 172 $self->{'status'} = 'connected'; 173 $self->cmd('BotINFO') if $self->{botinfo}; 174 $self->cmd('make_hub'); 175 }, 176 'Supports' => sub { 177 my $self = shift if ref $_[0]; 178 $self->supports_parse( $_[0], $self ); 179 }, 180 'ValidateDenide' => sub { 181 my $self = shift if ref $_[0]; 182 $self->log( 'warn', "ValidateDenide", $self->{'Nick'}, @_ ); 183 $self->cmd('nick_generate'); 184 $self->cmd('ValidateNick'); 185 }, 186 'To' => sub { 187 my $self = shift if ref $_[0]; 188 #$self->log( 'msg', "Private message to", @_ ); 189 #@_; 190 undef; 191 }, 192 'MyINFO' => sub { 193 my $self = shift if ref $_[0]; 194 my ( $nick, $info ) = $_[0] =~ /\S+\s+(\S+)\s+(.*)/; 195 $self->{'NickList'}->{$nick}{'Nick'} = $nick; 196 $self->info_parse( $info, $self->{'NickList'}{$nick} ); 197 $self->{'NickList'}->{$nick}{'online'} = 1; 198 }, 199 'UserIP' => sub { 200 my $self = shift if ref $_[0]; 201 /(\S+)\s+(\S+)/, $self->{'NickList'}{$1}{'ip'} = $2, $self->{'IpList'}{$2} = $self->{'NickList'}{$1}, 202 $self->{'IpList'}{$2}{'port'} = $self->{'PortList'}{$2} 203 for grep $_, split /\$\$/, $_[0]; 204 }, 205 'HubName' => sub { 206 my $self = shift if ref $_[0]; 207 $self->{'HubName'} = $_[0]; 208 }, 209 'HubTopic' => sub { 210 my $self = shift if ref $_[0]; 211 $self->{'HubTopic'} = $_[0]; 212 }, 213 'NickList' => sub { 214 my $self = shift if ref $_[0]; 215 $self->{'NickList'}->{$_}{'online'} = 1 for grep $_, split /\$\$/, $_[0]; 216 $self->GetINFO() if $self->{auto_GetINFO}; 217 }, 218 'OpList' => sub { 219 my $self = shift if ref $_[0]; 220 $self->{'NickList'}->{$_}{'oper'} = 1 for grep $_, split /\$\$/, $_[0]; 221 }, 222 'ForceMove' => sub { 223 my $self = shift if ref $_[0]; 224 my ($to) = grep { length $_ } split /;/, $_[0]; 225 $self->log( 'warn', "ForceMove to $to :: ", @_ ); 226 $self->disconnect(); 227 sleep(1); 228 $self->connect($to) if $self->{'follow_forcemove'} and $to; 229 }, 230 'Quit' => sub { 231 my $self = shift if ref $_[0]; 232 $self->{'NickList'}->{ $_[0] }{'online'} = 0; 233 }, 234 'ConnectToMe' => sub { 235 my $self = shift if ref $_[0]; 236 my ( $nick, $host, $port ) = $_[0] =~ /\s*(\S+)\s+(\S+)\:(\S+)/; 237 $self->{'IpList'}{$host}{'port'} = $self->{'PortList'}->{$host} = $port; 238 #$self->log('dev', "portlist: $host = $self->{'PortList'}->{$host} :=$port"); 239 $self->log("ignore flooding attempt to [$host:$port ] ($self->{flood}{$host})"), $self->{flood}{$host} = time + 30, 240 return 241 if $self->{flood}{$host} > time; 242 $self->{flood}{$host} = time + 60; 243 return if $self->{'clients'}{ $host . ':' . $port }->{'socket'}; 244 $self->{'clients'}{ $host . ':' . $port } = Net::DirectConnect::clicli->new( 245 #! %$self, $self->clear(), 246 parent => $self, 'host' => $host, 'port' => $port, 247#'want' => \%{ $self->{'want'} }, 'NickList' => \%{ $self->{'NickList'} }, 'IpList' => \%{ $self->{'IpList'} }, 'PortList' => \%{ $self->{'PortList'} }, 'handler' => \%{ $self->{'handler'} }, 248#'want' => $self->{'want'}, 249#'NickList' => $self->{'NickList'}, 250#'IpList' => $self->{'IpList'}, 251#'PortList' => $self->{'PortList'}, 252#'handler' => $self->{'handler'}, 253#'share_tth' => $self->{'share_tth'}, 254#'reconnects' => 0, 255 'auto_connect' => 1, 256 ); 257 }, 258 'RevConnectToMe' => sub { 259 my $self = shift if ref $_[0]; 260 my ( $to, $from ) = split /\s+/, $_[0]; 261 #$self->log( 'dev', "[$from eq $self->{'Nick'}] ($_[0])" ); 262 #$self->log( 'dev', 'go ctm' ), 263 $self->cmd( 'ConnectToMe', $to ) if $from eq $self->{'Nick'}; 264 }, 265 'GetPass' => sub { 266 my $self = shift if ref $_[0]; 267 $self->cmd('MyPass'); 268 }, 269 'BadPass' => sub { 270 my $self = shift if ref $_[0]; 271 }, 272 'LogedIn' => sub { 273 my $self = shift if ref $_[0]; 274 }, 275 'Search' => sub { 276 my $self = shift if ref $_[0]; 277 my $search = $_[0]; 278 $self->make_hub(); 279 my $params = { 'time' => int( time() ), 'hub' => $self->{'hub_name'}, }; 280 ( $params->{'who'}, $params->{'cmds'} ) = split /\s+/, $search; 281 $params->{'cmd'} = [ split /\?/, $params->{'cmds'} ]; 282 if ( $params->{'who'} =~ /^Hub:(.+)$/ ) { $params->{'nick'} = $1; } 283 else { ( $params->{'ip'}, $params->{'udp'} ) = split /:/, $params->{'who'}; } 284 if ( $params->{'cmd'}[4] =~ /^TTH:([0-9A-Z]{39})$/ ) { $params->{'tth'} = $1; } 285 else { $params->{'string'} = $params->{'cmd'}[4]; } 286 $self->{'PortList_udp'}->{ $params->{'ip'} } = $params->{'udp'} if $params->{'udp'}; 287 $params->{'string'} =~ tr/$/ /; 288 #$self->cmd('make_hub'); 289 #r$self->{'share_tth'} 290 my $found = $self->{'share_full'}{ $params->{'tth'} } || $self->{'share_full'}{ $params->{'string'} }; 291 my $tth = $self->{'share_tth'}{$found}; 292 if ( 293 $found 294 and $tth 295 #$params->{'tth'} and $self->{'share_tth'}{ $params->{'tth'} } 296 ) 297 { 298 $self->log( 299 'adcdev', 'Search', $params->{'who'}, 300 #$self->{'share_tth'}{ $params->{'tth'} }, 301 $found, -s $found, -e $found, 302 ), 303 #$self->{'share_tth'}{ $params->{'tth'} } =~ tr{\\}{/}; 304 #$self->{'share_tth'}{ $params->{'tth'} } =~ s{^/+}{}; 305 my $path; 306 if ( $self->{'adc'} ) { 307 $path = $self->adc_path_encode( 308 $found 309 #$self->{'share_tth'}{ $params->{'tth'} } 310 ); 311 } else { 312 $path = $found; #$self->{'share_tth'}{ $params->{'tth'} }; 313 $path =~ s{^\w:}{}; 314 $path =~ s{^\W+}{}; 315 $path =~ tr{/}{\\}; 316 $path = Encode::encode $self->{charset_protocol}, Encode::decode( $self->{charset_fs}, $path, Encode::FB_WARN ), 317 Encode::FB_WARN 318 if $self->{charset_fs} ne $self->{charset_protocol}; 319 } 320 local @_ = ( 321 'SR', ( 322 #( $self->{'M'} eq 'P' or !$self->{'myport_tcp'} or !$self->{'myip'} ) ? 323 $self->{'Nick'} 324 #: $self->{'myip'} . ':' . $self->{'myport_tcp'} 325 ), 326 $path . "\x05" . ( -s $found or -1 ), 327 $self->{'S'} . '/' 328 . $self->{'S'} . "\x05" 329 . 330 #"TTH:" . $params->{'tth'} 331 ( $params->{'tth'} ? $params->{'cmd'}[4] : "TTH:" . $tth ) 332 #. ( $self->{'M'} eq 'P' ? " ($self->{'host'}:$self->{'port'})" : '' ), 333 #. ( " ($self->{'host'}:$self->{'port'})\x05$params->{'nick'}" ), 334 . ( 335 #" ($self->{'host'}:$self->{'port'})" 336 #" (".name_to_ip($self->{'host'}).":$self->{'port'})" 337 #" (".inet_ntoa(gethostbyname ($self->{'host'})).":$self->{'port'})" 338 " ($self->{'hostip'}:$self->{'port'})" . ( ( $params->{'ip'} and $params->{'udp'} ) ? '' : "\x05$params->{'nick'}" ) 339 ), 340#. ( $self->{'M'} eq 'P' ? " ($self->{'host'}:$self->{'port'})\x05$params->{'nick'}" : '' ), 341#{ SI => -s $self->{'share_tth'}{ $params->{TR} },SL => $self->{INF}{SL},FN => $self->adc_path_encode( $self->{'share_tth'}{ $params->{TR} } ),=> $params->{TO} || $self->make_token($peerid),TR => $params->{TR}} 342 ); 343 if ( $params->{'ip'} and $params->{'udp'} ) { 344 $self->send_udp( $params->{'ip'}, $params->{'udp'}, $self->{'cmd_bef'} . join ' ', @_ ); 345 } else { 346 $self->cmd(@_); 347 } 348 } 349#'SR', ( $self->{'M'} eq 'P' ? "Hub:$self->{'Nick'}" : "$self->{'myip'}:$self->{'myport_udp'}" ), join '?', 350#Hub: [Outgoing][80.240.208.42:4111] $SR prrrrroo0 distr\s60\games\10598_paintball2.zip621237 1/2TTH:3TFVOXE2DS6W62RWL2QBEKZBQLK3WRSLG556ZCA (80.240.208.42:4111)breathe| 351#$SR prrrrroo0 distr\moscow\mom\Mo\P\Paintball.htm1506 1/2TTH:NRRZNA5MYJSZGMPQ634CPGCPX3ZBRLKHAACPAFQ (80.240.208.42:4111)breathe| 352#$SR prrrrroo0 distr\moscow\mom\Map\P\Paintball.htm3966 1/2TTH:QLRRMET6MSNJTIRKBDLQYU6RMI5QVZDZOGAXEXA (80.240.208.42:4111)breathe| 353#$SR ILICH ЕГТС_07_2007\bases\sidhouse.DBF120923801 6/8TTH:4BAKR7LLXE65I6S4HASIXWIZONBEFS7VVZ7QQ2Y (80.240.211.183:411) 354#$SR gellarion7119 MuZonnO\Mark Knopfler - Get Lucky (2009)\mark_knopfler_-_you_cant_beat_the_house.mp36599140 7/7TTH:IDPHZ4AJIIWDYOFEKCCVJUNVIPGSGTYFW5CGEQQ (80.240.211.183:411) 355#$SR 13th_day Картинки\еще девки\sacrifice_penthouse02.jpg62412 0/20TTH:GHMWHVBKRLF52V26VFO4M4RUQ65NC3YKWIW7FPI (80.240.211.183:411) 356#DIRECT: 357#$SR server1 server\Unsorted\Desperate.Housewives.S04.720p.HDTV.x264\desperate.housewives.s04e03.720p.hdtv.x264.Rus.Eng.mkv1194423977 2/2TTH:6YWRGDXNQJEOGSB4Q7Y3Y7XRM7EXPLUK7GBRJ3A (80.240.211.183:411) 358#$SR MikMEBX Deep purple\1980-1988\08-The House Of Blue Light.1987 10/10[ f12p.ru ][ F12P-HUB ] - день единства... вспомните хорошее и улыбнитесь друг другу.. пусть это будет днем гармонии (80.240.211.183) 359#PASSIVE 360#$SR ILICH ЕГТС_07_2007\bases\sidhouse.DBF120923801 6/8TTH:4BAKR7LLXE65I6S4HASIXWIZONBEFS7VVZ7QQ2Y (80.240.211.183:411) 361#$SR gellarion7119 MuZonnO\Mark Knopfler - Get Lucky (2009)\mark_knopfler_-_you_cant_beat_the_house.mp36599140 7/7TTH:IDPHZ4AJIIWDYOFEKCCVJUNVIPGSGTYFW5CGEQQ (80.240.211.183:411) 362#$SR SALAGA Видео\Фильмы\XXX\xxx Penthouse.avi732665856 0/5TTH:3OFCM6GPQZNBNAMV6SRDFHFPK2X76EO6UCIO7ZQ (80.240.211.183:411) 363 return $params; 364 }, 365 'SR' => sub { 366 my $self = shift if ref $_[0]; 367#$self->log( 'dev', "SR", @_ , 'parent=>', $self->{parent}, 'h=', $self->{handler}, Dumper($self->{handler}), 'ph=', $self->{parent}{handler}, Dumper($self->{parent}{handler}), ) if $self; 368 $self->make_hub(); 369 my $params = { 'time' => int( time() ), 'hub' => $self->{'hub_name'}, }; 370 ( $params->{'nick'}, $params->{'str'} ) = split / /, $_[0], 2; 371 $params->{'str'} = [ split /\x05/, $params->{'str'} ]; 372 $params->{'file'} = shift @{ $params->{'str'} }; 373 ( $params->{'filename'} ) = $params->{'file'} =~ m{([^\\]+)$}; 374 ( $params->{'ext'} ) = $params->{'filename'} =~ m{[^.]+\.([^.]+)$}; 375 ( $params->{'size'}, $params->{'slots'} ) = split / /, shift @{ $params->{'str'} }; 376 ( $params->{'tth'}, $params->{'ipport'} ) = split / /, shift @{ $params->{'str'} }; 377 ( $params->{'tth'}, $params->{'ipport'} ) = ( $params->{'size'}, $params->{'slots'} ) unless $params->{'tth'}; 378 ( $params->{'target'} ) = shift @{ $params->{'str'} }; 379 $params->{'tth'} =~ s/^TTH://; 380 ( $params->{'ipport'}, $params->{'ip'}, $params->{'tcp'} ) = $params->{'ipport'} =~ /\(((\S+):(\d+))\)/; 381 delete $params->{'str'}; 382 #( $params->{'slotsopen'}, $params->{'S'} ) = split /\//, $params->{'slots'}; 383 #$params->{'slotsfree'} = $params->{'S'} - $params->{'slotsopen'}; 384 ( $params->{'slotsfree'}, $params->{'S'} ) = split /\//, $params->{'slots'}; 385 #$params->{'slotsfree'} = $params->{'S'} - $params->{'slotsopen'}; 386 $params->{'string'} = $self->{'search_last_string'}; 387 $self->{'NickList'}{ $params->{'nick'} }{$_} = $params->{$_} for qw(S ip tcp); 388 $self->{'PortList'}->{ $params->{'ip'} } = $params->{'tcp'}; 389 $self->{'IpList'}->{ $params->{'ip'} } = $self->{'NickList'}{ $params->{'nick'} }; 390 $params->{'TR'} = $params->{'tth'}; 391 $params->{FN} = $params->{'filename'}; 392 my $peerid = $params->{'nick'}; 393 $params->{CID} = $peerid; 394 #($params->{'file'}) = $params->{FN} =~ m{([^\\/]+)$}; 395 my $wdl = $self->{'want_download'}{ $params->{'TR'} } || $self->{'want_download'}{ $params->{'filename'} }; 396 if ($wdl) { #exists $self->{'want_download'}{ $params->{'TR'} } ) { 397 #$self->{'want_download'}{ $params->{'TR'} } 398 $wdl->{$peerid} = $params; #maybe not all 399 if ( $params->{'filename'} ) { ++$self->{'want_download_filename'}{ $params->{TR} }{ $params->{'filename'} }; } 400 $self->{'want_download'}{ $params->{TR} }{$peerid} = $params; # _tth_from 401 } 402 return $params; 403 }, 404 'UserCommand' => sub { 405 my $self = shift if ref $_[0]; 406 }, 407 #}; 408 ); 409 $self->{'parse'}{$_} ||= $_{$_} for keys %_; 410 411=COMMANDS 412 413 414 415 416 417 418 419 420=cut 421 422 #$self->{'cmd'} = { 423 local %_ = ( 424 'connect_aft' => sub { 425 my $self = shift if ref $_[0]; 426 #$self->log( 'dbg', "nothing to do after connect"); 427 }, 428 'chatline' => sub { 429 my $self = shift if ref $_[0]; 430 for (@_) { 431 if ( $self->{'min_chat_delay'} and ( time - $self->{'last_chat_time'} < $self->{'min_chat_delay'} ) ) { 432 $self->log( 'dbg', 'sleep', $self->{'min_chat_delay'} - time + $self->{'last_chat_time'} ); 433 $self->wait_sleep( $self->{'min_chat_delay'} - time + $self->{'last_chat_time'} ); 434 } 435 $self->{'last_chat_time'} = time; 436 $self->log( 437 'dcdmp', 438 "($self->{'number'}) we send [", 439 "<$self->{'Nick'}> $_|", 440 "]:", $self->send("<$self->{'Nick'}> $_|"), $! 441 ); 442 } 443 }, 444 'To' => sub { 445 my $self = shift if ref $_[0]; 446 my $to = shift; 447 $self->sendcmd( 'To:', $to, "From: $self->{'Nick'} \$<$self->{'Nick'}> $_" ) for (@_); 448 }, 449 'Key' => sub { 450 my $self = shift if ref $_[0]; 451 $self->sendcmd( 'Key', $_[0] ); 452 }, 453 'ValidateNick' => sub { 454 my $self = shift if ref $_[0]; 455 $self->sendcmd( 'ValidateNick', $self->{'Nick'} ); 456 }, 457 'Version' => sub { 458 my $self = shift if ref $_[0]; 459 $self->sendcmd( 'Version', $self->{'Version'} ); 460 }, 461 'MyINFO' => sub { 462 my $self = shift if ref $_[0]; 463 $self->sendcmd( 'MyINFO', '$ALL', $self->myinfo() ); 464 }, 465 'GetNickList' => sub { 466 $self->sendcmd('GetNickList'); 467 }, 468 'GetINFO' => sub { 469 my $self = shift if ref $_[0]; 470 @_ = grep { $self->{'NickList'}{$_}{'online'} and !$self->{'NickList'}{$_}{'info'} } keys %{ $self->{'NickList'} } 471 unless @_; 472 local $self->{'sendbuf'} = 1; 473 $self->sendcmd( 'GetINFO', $_, $self->{'Nick'} ) for @_; 474 $self->sendcmd(); 475 }, 476 'BotINFO' => sub { 477 my $self = shift if ref $_[0]; 478 $self->sendcmd( 'BotINFO', $self->{botinfo} ); 479 }, 480 'ConnectToMe' => sub { 481 my $self = shift if ref $_[0]; 482 $self->log( 'dcdbg', "cannot ConnectToMe from passive mode" ), return 483 if $self->{'M'} eq 'P' and !$self->{'allow_passive_ConnectToMe'}; 484 $self->log( 'err', "please define myip" ), return unless $self->{'myip'}; 485 $self->sendcmd( 'ConnectToMe', $_[0], "$self->{'myip'}:$self->{'myport'}" ); 486 }, 487 'RevConnectToMe' => sub { 488 my $self = shift if ref $_[0]; 489 $self->log( "send", ( 'RevConnectToMe', $self->{'Nick'}, $_[0] ), ref $_[0] ); 490 $self->sendcmd( 'RevConnectToMe', $self->{'Nick'}, $_[0] ); 491 }, 492 'MyPass' => sub { 493 my $self = shift if ref $_[0]; 494 my $pass = ( $_[0] or $self->{'Pass'} ); 495 $self->sendcmd( 'MyPass', $pass ) if $pass; 496 }, 497 'Supports' => sub { 498 my $self = shift if ref $_[0]; 499 $self->sendcmd( 'Supports', $self->supports() || return ); 500 }, 501 'Quit' => sub { 502 my $self = shift if ref $_[0]; 503 $self->sendcmd( 'Quit', $self->{'Nick'} ); 504 $self->disconnect(); 505 }, 506 'SR' => sub { 507 my $self = shift if ref $_[0]; 508 $self->sendcmd( 'SR', @_ ); 509 }, 510 'Search' => sub { 511 my $self = shift if ref $_[0]; 512 #$self->log('devsearch', "mode=[$self->{'M'}]"); 513 $self->sendcmd( 'Search', ( $self->{'M'} eq 'P' ? "Hub:$self->{'Nick'}" : "$self->{'myip'}:$self->{'myport_udp'}" ), 514 join '?', @_ ); 515 }, 516 'search_nmdc' => sub { 517 my $self = shift if ref $_[0]; 518 local @_ = @_; 519 $_[0] =~ tr/ /$/; 520 @_ = ( ( 'F', 'T', '0', undef )[ 0 .. 3 - $#_ ], reverse @_ ); 521 $_[3] ||= ( $_[4] =~ s/^(TTH:)?([A-Z0-9]{39})$/TTH:$2/ ? '9' : '1' ) unless defined $_[3]; 522 # 523 #$self->cmd( 'search_buffer', 'F', 'T', '0', '1', @_ ); 524 $self->search_buffer(@_); 525 }, 526 'search_tth' => sub { 527 my $self = shift if ref $_[0]; 528 $self->{'search_last_string'} = undef; 529 $self->search_nmdc(@_); 530 }, 531 'search_string' => sub { 532 my $self = shift if ref $_[0]; 533 #my $string = $_[0]; 534 $self->{'search_last_string'} = $_[0]; #$string; 535 #$string =~ tr/ /$/; 536 $self->search_nmdc(@_); 537 }, 538 'search_send' => sub { 539 my $self = shift if ref $_[0]; 540 #$self->log( 'devsearchsend', "$self->{'M'} ne 'P' and $self->{'myip'} and $self->{'myport_udp'}" ); 541 $self->sendcmd( 542 'Search', ( 543 ( $self->{'M'} ne 'P' and $self->{'myip'} and $self->{'myport_udp'} ) 544 ? "$self->{'myip'}:$self->{'myport_udp'}" 545 : 'Hub:' . $self->{'Nick'} 546 ), 547 join '?', 548 @{ $_[0] || $self->{'search_last'} } 549 ); 550 }, 551 # 552 'stat_hub' => sub { 553 my $self = shift if ref $_[0]; 554 local %_; 555 #for my $w qw(SS) { 556 #++$_{UC}, 557 local @_ = grep { length $_ and $_ ne $self->{'Nick'} } keys %{ $self->{'NickList'} }; 558 $_{SS} += $self->{'NickList'}{$_}{'sharesize'} for @_; 559 #} 560 $_{UC} = @_; 561 return \%_; 562 }, 563 #}; 564 ); 565 $self->{'cmd'}{$_} ||= $_{$_} for keys %_; 566 #$self->log( 'dev', "0making listeners [$self->{'M'}]" ); 567 if ( $self->{'M'} eq 'A' or !$self->{'M'} ) { 568 #$self->log( 'dev', "making listeners: tcp, class=", $self->{'incomingclass'} ); 569 $self->{'clients'}{'listener_tcp'} = $self->{'incomingclass'}->new( 570 #%$self, $self->clear(), 571 #'want' => \%{ $self->{'want'} }, 572 #'NickList' => \%{ $self->{'NickList'} }, 573 #'IpList' => \%{ $self->{'IpList'} }, 574 #'PortList' => \%{ $self->{'PortList'} }, 575 #'handler' => \%{ $self->{'handler'} }, 576 #'share_tth' => $self->{'share_tth'}, 577 'myport' => $self->{'myport'}, 578 'auto_listen' => 1, 579 'parent' => $self, 580 ); 581 $self->{'myport'} = $self->{'myport_tcp'} = $self->{'clients'}{'listener_tcp'}{'myport'}; 582 $self->log( 'err', "cant listen tcp (file transfers)" ) unless $self->{'myport_tcp'}; 583 #$self->log( 'dev', "making listeners: udp" ); 584 $self->{'clients'}{'listener_udp'} = $self->{'incomingclass'}->new( 585 #%$self, $self->clear(), 586 'parent' => $self, 'Proto' => 'udp', 'myport' => $self->{myport_udp}, 587 #? 'want' => \%{ $self->{'want'} }, 588 #? 'NickList' => \%{ $self->{'NickList'} }, 589 #? 'IpList' => \%{ $self->{'IpList'} }, 590 #? 'PortList' => \%{ $self->{'PortList'} }, 591 #'handler' => \%{ $self->{'handler'} }, 592 #'handler' => $self->{'handler'} , 593 #$self->{'clients'}{''} = $self->{'incomingclass'}->new( %$self, $self->clear(), 594 #'LocalPort'=>$self->{'myport'}, 595 #'debug'=>1, 596 #'nonblocking' => 0, 597 'parse' => { 598 'SR' => $self->{'parse'}{'SR'}, 599 'PSR' => sub { #U 600 my $self = shift if ref $_[0]; 601 #my $self = ref $_[0] ? shift() : $self; 602 $self->log( 'dev', "PSR", @_ ) if $self; 603 }, 604 'UPSR' => sub { # TODO 605 my $self = shift if ref $_[0]; 606 #my $self = ref $_[0] ? shift() : $self; 607 #!$self->log( 'dev', "UPSR", 'udp' ) if $self; 608 for ( split /\n+/, $_[0] ) { return $self->parser($_) if /^\$SR/; } 609 #$self->log( 'dev', "UPSR", @_ ) if $self; 610 }, 611#2008/12/14-13:30:50 [3] rcv: welcome UPSR FQ2DNFEXG72IK6IXALNSMBAGJ5JAYOQXJGCUZ4A NIsss2911 HI81.9.63.68:4111 U40 TRZ34KN23JX2BQC2USOTJLGZNEWGDFB327RRU3VUQ PC4 PI0,64,92,94,100,128,132,135 RI64,65,66,67,68,68,69,70,71,72 612#UPSR CDARCZ6URO4RAZKK6NDFTVYUQNLMFHS6YAR3RKQ NIAspid HI81.9.63.68:411 U40 TRQ6SHQECTUXWJG5ZHG3L322N5B2IV7YN2FG4YXFI PC2 PI15,17,20,128 RI128,129,130,131 613#$SR [Predator]Wolf DC++\Btyan Adams - Please Forgive Me.mp314217310 18/20TTH:G7DXSTGPHTXSD2ZZFQEUBWI7PORILSKD4EENOII (81.9.63.68:4111) 614#2008/12/14-13:30:50 welcome UPSR FQ2DNFEXG72IK6IXALNSMBAGJ5JAYOQXJGCUZ4A NIsss2911 HI81.9.63.68:4111 U40 TRZ34KN23JX2BQC2USOTJLGZNEWGDFB327RRU3VUQ PC4 PI0,64,92,94,100,128,132,135 RI64,65,66,67,68,68,69,70,71,72 615#UPSR CDARCZ6URO4RAZKK6NDFTVYUQNLMFHS6YAR3RKQ NIAspid HI81.9.63.68:411 U40 TRQ6SHQECTUXWJG5ZHG3L322N5B2IV7YN2FG4YXFI PC2 PI15,17,20,128 RI128,129,130,131 616#$SR [Predator]Wolf DC++\Btyan Adams - Please Forgive Me.mp314217310 18/20TTH:G7DXSTGPHTXSD2ZZFQEUBWI7PORILSKD4EENOII (81.9.63.68:4111) 617 }, 618 'auto_listen' => 1, 619 'parent' => $self, 620 ); 621 $self->{'myport_udp'} = $self->{'clients'}{'listener_udp'}{'myport'}; 622 $self->log( 'err', "cant listen udp (search repiles)" ) unless $self->{'myport_udp'}; 623 } 624 625=z 626 $self->log( 'dev', "making listeners: http" ); 627 $self->{'clients'}{'listener_http'} = Net::DirectConnect::http->new( 628 %$self, $self->clear(), 629#'want' => \%{ $self->{'want'} }, 630#'NickList' => \%{ $self->{'NickList'} }, 631#'IpList' => \%{ $self->{'IpList'} }, 632## 'PortList' => \%{ $self->{'PortList'} }, 633 'handler' => \%{ $self->{'handler'} }, 634#$self->{'clients'}{''} = $self->{'incomingclass'}->new( %$self, $self->clear(), 635 #'LocalPort'=>$self->{'myport'}, 636 #'debug'=>1, 637 'auto_listen' => 1, 638 ); 639 $self->{'myport_http'} = $self->{'clients'}{'listener_http'}{'myport'}; 640 $self->log( 'err', "cant listen http" ) 641 unless $self->{'myport_http'}; 642=cut 643 644 $self->{'handler_int'}{'disconnect_bef'} = sub { 645 #delete $self->{'sid'}; 646 #$self->log( 'dev', 'disconnect int' ) if $self and $self->{'log'}; 647 }; 648} 6491; 650