1# 2# $Id: fleech.pl,v 1.41 2003/01/11 23:07:48 piotr Exp $ 3# 4# This script works the best with sysreset file server. For other file 5# server types you probably need to add regexps. 6# 7# Commands: (for "/fleech add" uses current irc server - make sure nick is 8# on this server (e.g. execute "/fleech" commands in the window with 9# channel in which a nick is, or use C-x)) 10# 11# Setting trigger: (<trigger> is a command you'd use to connect to fserve 12# without "/ctcp nick" part. Currently only /ctcp triggers are supported) 13# /fleech add nick trigger <trigger> 14# 15# Adding file: (<file> is a file with full path, with "/" not "\" even if 16# fserve is run on windows) 17# /fleech add nick file <file> 18# 19# Adding multiple files with one command: (see also 'Multiple files' section 20# below for examples and better description) 21# /fleech add nick rfile xxx{01,5}yy\{\\{y 22# 23# Starting leeching: 24# /fleech go 25# 26# Listing status: 27# /fleech list 28# 29# Removing Completed file records: 30# /fleech clrc 31# 32# There is also /fleech set command which is currently not documented 33# (RTFS :P), and a couple of /set fleech_ settings 34# 35# Example usage: ('nick' is fserve's nick) 36# /fleech add nick trigger !get me 37# /fleech add nick file lonewolf/Lone Wolf vol15 Story74.rar 38# /fleech add nick file Lone Wolf15.jpg 39# /fleech list 40# /fleech go 41# 42# Multiple files: [patch by Stylianos Papadopoulos] 43# Suppose you want to get files abc.r00, abc.r01, ..., abc.r45. 44# You can add them all with one command: 45# /fleech add nick rfile path/to/file/abc.r{00,45} 46# The "{00,45}" will be replaced by 00, 01, ..., 45 and files will be 47# added for download. 48# If the file name have "{" or "\" in it you need to escape such characters 49# with a "\", so "{" -> "\{", "\" -> "\\" 50# For example: 51# /fleech add nick rfile xxx{01,5}yy\{\\{y 52# will add xxx01yy{\{y, xxx02yy{\{y, ... , xxx05yy{\{y for download. 53# 54# 55# TODO: 56# - when get is closed and we're checking if there are other the same gets, 57# check only for gets with bigger tranfd 58# - loading, saving leechs 59# - user should be able to specify his own regexps for checking if file was 60# queued etc, connect this with some name, and notify fleech.pl that 61# server-nick fserve is that type fserve 62# 63# Changes: 64# 0.0.2i (2005.03.06): 65# - Multiple files adding with "/fleech add nick rfile" command, patch 66# from Stylianos Papadopoulos [papasv69 //at// hotmail //dot// com] 67# (thanks!) 68# 0.0.2h (2003.04.13): 69# - /fleech set <oldnick> nick <newnick> 70# - some other small fixes/changes 71# 0.0.2g (2003.01.13): 72# - rechecking bugfix 73# 0.0.2f (2003.01.12): 74# - new command "/fleech clrc" to remove record of complete files 75# - some sanity checks in /fleech set 76# 0.0.2e (2003.01.10): 77# - should work when fserv changes nick. Because of this, use 78# "/fleech add nick trigger !trigger" and not, like previously, 79# "/fleech add nick trigger /ctcp nick !trigger". 80# 81 82 83use Irssi; 84use strict; 85use vars qw($VERSION %IRSSI); 86 87$VERSION = "0.0.2i"; 88%IRSSI = ( 89 authors => 'Piotr Krukowiecki', 90 name => 'fleech', 91 contact => 'piotr //at// krukowiecki //dot// net', 92 description => 'fserve leecher - helps you download files from file servers', 93 license => 'GNU GPL v2', 94 url => 'http://www.krukowiecki.net/code/irssi/' 95); 96 97 98### Data model: (i know this sucks :( ) 99# servertag->nick-> %hash: 100# trigger->$ 101# path->@ (where are we in file server?) 102# state->$ 103# type->$ (type of server, for example default, sysreset etc) 104# lastaction->$ (when was last action performed/received) 105# cfile->$ (number of file we're operating now, -1 if none (i.e. the send has come or fserver ACK'ed queueing/sending the file) 106# files->@ of %hash: 107# name (file name with full path) 108# state (complete, in transfer, not complete, etc.) 109# depth (how deep in dirs the file is. file in root dir == 0) 110# size (size of file, -1 means yet unknown) 111 112my %serv = (); 113my $dbglog = ""; 114#my $dbglog = Irssi::get_irssi_dir() . "/fleech.dbg"; 115 116my %states = ( 117 '0' => 'Nothing done', 118 '1' => 'Initiating connection', # sent e.g. "/ctcp nick trigger" 119 '2' => 'Connecting', # accepted chat by "/dcc chat nick" 120 '3' => 'Connected, waiting till end of welcome message', # dcc chat established, probably reading welcome message 121 '4' => 'Connected, changing dir', # sent "cd dir" 122 '5' => 'Connected, queueing files', # sent "get file" 123 '6' => 'Files queued', # we belive we have queued all files we could 124 '7' => 'All files complete', # we belive we have all files we wanted 125 '8' => 'Slots Full', # can't queue cause slots full 126 ); 127 128my %fstates = ( 129 '0' => 'File not complete', 130 '1' => 'Transfer in progress', # the files is currently being send to us 131 '2' => 'Completed', # we assume we have whole file on disk 132 '3' => 'File queued', # we assume it's in queue 133 ); 134 135my %servers = ( 136 'SysReset.*FileServer' => 'sysreset', 137 'I.*-.*n.*-.*v.*-.*i.*-.*s.*-.*i.*-.*o.*-.*n.*File Server with Advanced File Serving features' => 'invision', # stupid colors 138 'Edward_K Script' => 'edward_k', 139 ); 140 141# TODO : Check more servers for regexps 142my %patterns = ( 143 'default' => { 144 'EoWM' => '\[\\\]', # End of Welcome Message 145 'file queued' => 'queue(d|ing).*in.*slot|add.*file.*to.*slot', 146 'my slots full' => 'queue slot.*full|have filled.*queue slots|no.*sends.*avail', 147 'sending file' => 'sending', 148 'invalid file name' => 'invalid filename|not.*valid.*file', 149 'already queued' => 'already.*(queued|sending)', 150 'dir changed' => '\[\\\.*\]', 151 }, 152 'sysreset' => { 153 'EoWM' => '\[\\\]', # End of Welcome Message 154 'file queued' => 'Adding your file to queue slot.*The file will send when the next send slot is open', #ok 155 'my slots full' => 'Sorry, all of your queue slots are full', #ok 156 'all slots full' => 'Sorry, all send and queue slots are full', #ok 157 'sending file' => 'Sending File', #ok 158 'invalid file name' => 'Invalid file name, please use the form:', #OK 159 'already sending' => 'That file is already sending', # ok 160 'already queued' => 'That file has already been queued in slot', # ok 161 'dir changed' => '\[\\\.*\]', #ok 162 'press S' => "[[]'C' for more, 'S' to stop[]]", 163 }, 164 'edward_k' => { 165 'EoWM' => '\[\\\]', #ok 166 'file queued' => 'Queuing.*It has been placed in queue slot.*, it will send when sends are available', #ok 167 'my slots full' => 'Sorry, there are too many sends in progress right now and you have used all your queue slots\. If you still want to get a file please wait for one to finish and try again', #ok 168# 'all slots full' => 'Sorry, all send and queue slots are full', 169 'sending file' => 'Sending', #ok 170# 'already sending' => 'That file is already sending', # not have? 171 'already queued' => 'Sorry, that queue already exists in queue slot.*, you have already queued that file', #ok 172 'dir changed' => '\[\\\.*\]', # ok 173 }, 174 'invision' => { 175 'EndoWM' => '\[\\\]', # End of Welcome Message 176 'file queued' => 'The file has been queued in slot|Th�.*file.*has be�n.*qu�ued.*in.*sl�t', #ok 1,2 177 'my slots full' => 'Invision has determined you have used all your queue slots', #ok 2 178 'all slots full' => 'Sorry but the Maximum Allowed Queues of.*has been reached\. Please try again later', 179 'sending file' => 'InstaSending|Sending .*(MB)+.*\.', #ok1 180 'invalid file name' => 'File does not exists|ERROR:.*That is not a valid File', #ok1,2 181 'already queued' => 'h�t que��.*alread�.*e��sts in.*queu� slot.*, try �nother f�l�', # ok1 182 'dir changed' => '\[\\\.*\]', #ok 183 }, 184 'lamielle' => { # 185 'EoWM' => '\[\\\]', # OK 186 'my slots full' => 'You already have a send going, please do not try to get another file till it has stopped', 187 'invalid file name' => 'Invalid filename', #OK 188 'dir changed' => '\[\\\.*\]', #ok 189 }, 190 ); 191 192### 193# "DCC CHAT from nick" came (or dcc send from nick, but we don't care) 194sub sig_dcc_request { 195 my ($dcc, $sendaddr) = @_; 196 print_dbg("Signal 'dcc request': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}' sendaddr '$sendaddr'", 3); 197 my $nick = lc $dcc->{'nick'}; 198 my $tag = $dcc->{'servertag'}; 199 200 return if (($dcc->{type} ne 'CHAT') 201 or (not exists $serv{$tag}) 202 or (not exists $serv{$tag}{$nick}) 203 or ($serv{$tag}{$nick}{'state'} != 1)); 204 205 print_dbg("Accepting connection", 3); 206 $serv{$tag}{$nick}{'state'} = 2; 207 $serv{$tag}{$nick}{'lastaction'} = time(); 208 $dcc->{'server'}->command("DCC CHAT $dcc->{nick}"); 209} 210 211### 212# dcc chat established or dcc get established 213sub sig_dcc_connected { 214 my $dcc = @_[0]; 215 print_dbg("Signal 'dcc connected': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}'", 3); 216 my $nick = lc $dcc->{'nick'}; 217 my $tag = $dcc->{'servertag'}; 218 219 return if ((not exists $serv{$tag}) 220 or (not exists $serv{$tag}{$nick})); 221 my $fserv = get_fserv($tag, $nick); 222 if ($dcc->{'type'} eq 'CHAT') { 223 return if ($$fserv{'state'} != 2); 224 225 print_dbg("Connection established", 3); 226 $$fserv{'state'} = 3; 227 $$fserv{'lastaction'} = time(); 228 return; 229 } 230 if ($dcc->{'type'} eq 'GET') { 231 print_dbg("We have get!", 3); 232 233 my $fnumber = find_file($fserv, $dcc->{'arg'}); 234 if ($fnumber == -1) { 235 print_dbg("We have not queued this file", 3); 236 return; 237 } 238 239 my $file = $$fserv{'files'}[$fnumber]; 240 if ($$file{'state'} == 2) { 241 print_dbg("File completed, ignoring send", 3); 242 return; 243 } 244 245 $$file{'state'} = 1; 246 $$file{'size'} = $dcc->{'size'}; 247 $$fserv{'lastaction'} = time(); 248 $$fserv{'cfile'} = -1 if ($fnumber == $$fserv{'cfile'}); 249 250 if (($$fserv{'state'} == 0 or $$fserv{'state'} == 6 or 251 $$fserv{'state'} == 8) and 252 (find_file_to_queue($tag, $nick) != -1)) { 253 initiate_connection($tag, $nick); 254 return; 255 } 256 return; 257 } 258} 259 260 261### 262# Finds number of file with name filename. File name has spaces changed 263# to underscores and the search is case nonsensitive 264# Does not care about file state 265# nick record, filename 266sub find_file_modified ($$) { 267 my ($fserv, $file) = @_; 268 my $number = -1; 269 foreach (@{$$fserv{files}}) { 270 $number++; 271 my $name = $$_{'name'}; 272 $name =~ tr/A-Z /a-z_/; # FIXME : i hope locales won't be a problem... 273 return $number 274 if ($name =~ m/^\Q${file}\E$/i or $name =~ m/\/\Q${file}\E$/i); 275 } 276 return -1; 277} 278 279### 280# Finds number of file with name filename. Searches for exact match. 281# Does not care about file state 282# nick record, filename 283sub find_file_exact($$) { 284 my ($fserv, $file) = @_; 285 my $number = -1; 286 foreach (@{$$fserv{files}}) { 287 $number++; 288 return $number if ($$_{name} eq $file or $$_{name} =~ m|/\Q${file}\E$|); 289 } 290 return -1; 291} 292 293sub find_file($$) { 294 my ($fserv, $file) = @_; 295 my $num = find_file_exact($fserv, $file); 296 return $num if ($num >= 0); 297 return find_file_modified($fserv, $file); 298} 299 300### 301# End of dcc chat or end of dcc get 302sub sig_dcc_destroyed { 303 my $dcc = @_[0]; 304 print_dbg("Signal 'dcc destroyed': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}'", 3); 305 my $nick = lc $dcc->{'nick'}; 306 my $tag = $dcc->{'servertag'}; 307 308 return if ((not exists $serv{$tag}) 309 or (not exists $serv{$tag}{$nick})); 310 311 my $fserv = get_fserv($tag, $nick); 312 313 if ($dcc->{'type'} eq 'CHAT') { # TODO : sometimes we should reconnect at once (when?) 314 print_dbg("Chat connection closed", 3); 315 $$fserv{'state'} = 0 if ($$fserv{'state'} < 6); 316 $$fserv{'cfile'} = -1; 317 $$fserv{'lastaction'} = time(); 318 @{$$fserv{'path'}} = (); 319 320 return; 321 } 322 323 if ($dcc->{'type'} eq 'GET') { 324 my $fnumber = find_file($fserv, $dcc->{'arg'}); 325 if ($fnumber == -1) { 326 print_dbg("We have not queued this file", 3); 327 return; 328 } 329 330 my $file = $$fserv{'files'}[$fnumber]; 331 if ($$file{'state'} == 2) { 332 print_dbg("File completed, ignoring this event", 3); 333 return; 334 } 335 336 print_dbg("Dcc get connection closed", 3); 337 $$fserv{'lastaction'} = time(); 338 339 if ($dcc->{'size'} == $dcc->{'transfd'}) { 340 $$fserv{'files'}[$fnumber]{'state'} = 2; 341 $$fserv{'cfile'} = -1 if ($fnumber == $$fserv{'cfile'}); # possibile if we had send for the file from before script was loaded 342 } else { 343 if (!gets_exists($tag, $dcc->{'nick'}, $dcc->{'arg'})) { 344 $$fserv{'files'}[$fnumber]{'state'} = 0; 345 $$fserv{cfile} = -1 if ($fnumber == $$fserv{cfile}); # possibile if we had send for the file from before script was loaded 346 } 347 } 348 349 if (all_files_complete($tag, $nick)) { 350 $$fserv{'state'} = 7; 351 print_dbg("Leeching complete for nick $nick\@$tag", 2); 352 return; 353 } 354 355 if (($$fserv{'state'} == 0 or $$fserv{'state'} == 6 or 356 $$fserv{'state'} == 8) and 357 (find_file_to_queue($tag, $nick) != -1)) { 358 initiate_connection($tag, $nick); 359 return; 360 } 361 362 return; 363 } 364} 365 366### 367# Text was send thorough dcc chat 368# $dcc->{arg} is CHAT, what else can it be if type == CHAT? 369sub sig_dcc_chat_message { 370 my ($dcc, $message) = @_; 371 print_dbg("Signal 'dcc chat message': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}' message '$message'", 3); 372 my $nick = lc $dcc->{'nick'}; 373 my $tag = $dcc->{'servertag'}; 374 375 return if ((not exists $serv{$tag}) 376 or (not exists $serv{$tag}{$nick}) 377 or ($dcc->{'type'} ne 'CHAT')); 378 379 my $fserv = get_fserv($tag, $nick); 380 $$fserv{'lastaction'} = time(); 381 if ($$fserv{'state'} == 3) { # waiting till end of welcome message 382 if ($$fserv{'type'} eq 'default') { 383 foreach (keys %servers) { 384 if ($message =~ /$_/i) { 385 $$fserv{'type'} = $servers{$_}; 386 print_dbg("Recognized '$_' server", 2); 387 last; 388 } 389 } 390 } 391 if ($message =~ /$patterns{$$fserv{'type'}}{'EoWM'}/i) { 392 print_dbg("Got End of Welcome Message", 3); 393 get_next_file($dcc->{'server'}, $nick); 394 return; 395 } 396 if ((exists $patterns{$$fserv{'type'}}{'press S'} and 397 $message =~ /$patterns{$$fserv{'type'}}{'press S'}/i)) { 398 print_dbg("Pressing S", 3); 399 $dcc->{'server'}->command("MSG =$dcc->{nick} S"); 400 return; 401 } 402 return; 403 } 404 if ($$fserv{'state'} == 4) { # changing dir 405 # TODO : should check $message for 'directory not existing' etc 406 print_dbg("Current state 4", 3); 407 if ($message =~ /$patterns{$$fserv{'type'}}{'dir changed'}/i) { 408 print_dbg("Directory successfully changed", 3); 409 get_next_file($dcc->{'server'}, $nick); 410 } 411 return; 412 } 413 if ($$fserv{'state'} == 5) { # sent "get file" 414 print_dbg("Current state 5", 3); 415 if ((exists $patterns{$$fserv{'type'}}{'file queued'} and 416 $message =~ /$patterns{$$fserv{'type'}}{'file queued'}/i) or 417 (exists $patterns{$$fserv{'type'}}{'sending file'} and 418 $message =~ /$patterns{$$fserv{'type'}}{'sending file'}/i)) { 419 print_dbg("File successfully queued", 3); 420 if ($$fserv{'cfile'} != -1) { 421 $$fserv{'files'}[$$fserv{'cfile'}]{'state'} = 3; 422 $$fserv{'cfile'} = -1; 423 } 424 get_next_file($dcc->{'server'}, $nick); 425 return; 426 } 427 if ((exists $patterns{$$fserv{'type'}}{'my slots full'} and 428 $message =~ /$patterns{$$fserv{'type'}}{'my slots full'}/i)) { 429 print_dbg("Can't queue file, my slots full", 3); 430 $$fserv{'cfile'} = -1; 431 $$fserv{'state'} = 8; 432 $dcc->{'server'}->command("MSG =$dcc->{nick} quit"); 433 return; 434 } 435 if ((exists $patterns{$$fserv{'type'}}{'all slots full'} and 436 $message =~ /$patterns{$$fserv{'type'}}{'all slots full'}/i)) { 437 print_dbg("Can't queue file, all slots full", 3); 438 $$fserv{'cfile'} = -1; 439 $$fserv{'state'} = 0; 440 $dcc->{'server'}->command("MSG =$dcc->{nick} quit"); 441 return; 442 } 443 if ((exists $patterns{$$fserv{'type'}}{'already queued'} and 444 $message =~ /$patterns{$$fserv{'type'}}{'already queued'}/i) or 445 (exists $patterns{$$fserv{'type'}}{'already sending'} and 446 $message =~ /$patterns{$$fserv{'type'}}{'already sending'}/i)) { # the same as 'file queued' 447 print_dbg("File has been already queued/sending", 3); 448 if ($$fserv{'cfile'} != -1) { 449 $$fserv{'files'}[$$fserv{'cfile'}]{'state'} = 3; # TODO : can it be that the file is in transfer? 450 $$fserv{'cfile'} = -1; 451 } 452 get_next_file($dcc->{'server'}, $nick); 453 return; 454 } 455 if (exists $patterns{$$fserv{'type'}}{'sending file'} and 456 $message =~ /$patterns{$$fserv{'type'}}{'sending file'}/i) { # the same as 'file queued' 457 print_dbg("File is being send at once", 3); 458 if ($$fserv{'cfile'} != -1) { 459 $$fserv{'files'}[$$fserv{'cfile'}]{'state'} = 3; 460 $$fserv{'cfile'} = -1; 461 } 462 get_next_file($dcc->{'server'}, $nick); 463 return; 464 } 465 } 466} 467 468### 469sub sig_no_such_nick { 470 my ($server, $args, $sender_nick, $sender_address) = @_; 471 my ($myself, $nick) = split(/ /, $args, 3); 472 print_dbg("no such nick '$nick' on '$server->{tag}'", 3); 473 $nick = lc $nick; 474 my $tag = $server->{'tag'}; 475 return if ((not exists $serv{$tag}) or (not exists $serv{$tag}{$nick}) 476 or ($serv{$tag}{$nick}{'state'} != 1)); 477 478 $serv{$tag}{$nick}{'state'} = 0; 479 $serv{$tag}{$nick}{'lastaction'} = time(); 480 print_dbg("Changed state to 0", 3); 481} 482 483### 484# 485sub sig_nicklist_changed { 486 my ($chan, $nick, $oldnick) = @_; 487 print_dbg("Nick change on $chan->{server}{tag} from $oldnick to $nick->{nick}", 3); 488 $nick = lc($nick->{'nick'}); 489 my $tag = $chan->{'server'}{'tag'}; 490 if ((exists $serv{$tag}) and 491 (exists $serv{$tag}{$oldnick})) { 492 print_dbg("Changing record for this nick", 3); 493 my $record = delete $serv{$tag}{$oldnick}; 494 $serv{$tag}{$nick} = $record; 495 } 496} 497 498### 499# server tag, nick, filename 500sub gets_exists($$$) { 501 my ($tag, $nick, $file) = @_; 502 foreach (Irssi::Irc::dccs()) { 503 print_dbg("gets_exists: checking nick: '$_->{nick}', serv: '$_->{servertag}', type: '$_->{type}', arg: '$_->{arg}'", 4); 504 return 1 if ($_->{'type'} eq 'GET' and $tag eq $_->{servertag} 505 and $nick eq $_->{nick} and $file eq $_->{arg}); 506 } 507 print_dbg("gets_exists: FOUND NO GETS", 3); 508 return 0; 509} 510 511### 512# Tries to get next file, we must be connected to fserv 513# server, nick 514sub get_next_file($$) { 515 my ($server, $nick) = @_; 516 my $fserv = get_fserv($server->{tag}, $nick); 517 my $fnumber = find_file_to_queue($server->{tag}, $nick); 518 if ($fnumber == -1) { 519 if (all_files_complete($server->{tag}, $nick)) { 520 $$fserv{state} = 7; 521 print_dbg("Leeching complete for nick $nick\@$server->{tag}", 2); 522 $server->command("MSG =$nick quit"); 523 return; 524 } 525 # TODO : should wait a bit and see if the send comes 526 $$fserv{state} = 6; 527 print_dbg("Queued all files possibile", 3); 528 $server->command("MSG =$nick quit"); 529 return; 530 } 531 532 print_dbg("Will try to get file number $fnumber", 3) 533 if ($$fserv{state} != 4); 534 535 if (change_dir($server->{tag}, $nick, $fnumber)) { 536 print_dbg("We're in the dir where the file is", 4); 537 538 $$fserv{state} = 5; 539 my @arr = split ('/', $$fserv{files}[$fnumber]{name}); 540 $server->command("MSG =$nick get " 541 .(pop @arr) ); 542 543 return; 544 } 545 return; 546} 547 548### 549# server tag, nick, file number 550# Tries to change current directory on fserve to the one where the file is 551# If it's in the dir returns true, if not yet returs false 552sub change_dir($$$) { 553 my ($tag, $nick, $fileno) = @_; 554 my $fserv = get_fserv($tag, $nick); 555 my $file = $$fserv{files}[$fileno]; 556 557 my $server = Irssi::server_find_tag($tag); 558 if (!$server) { 559 # TODO : must do sth more in this case 560 print_dbg("Could not find server '$tag'", 3); 561 return; 562 } 563 564 $$fserv{state} = 4; 565 566 # simple case, file in root and we're in root 567 return 1 if (@{$$fserv{path}} == 0 and $$file{depth} == 0); 568 569 # we are deeper than the file, we must go up for sure. 570 if ($$file{depth} < @{$$fserv{path}}) { 571 print_dbg("change_dir: #5", 4); 572 pop @{$$fserv{path}}; 573 $$fserv{lastaction} = time(); 574 $server->command("MSG =$nick cd .."); 575 return 0; 576 } 577 578 my @fpath = split ('/', $$file{name}); pop @fpath; # has all dirs 579 print_dbg("File we want to traverse is '@fpath'", 4); 580 581 # we're in root dir, must cd to first dir for sure 582 if (@{$$fserv{path}} == 0) { 583 print_dbg("change_dir: #10", 4); 584 push (@{$$fserv{path}}, $fpath[0]); 585 $$fserv{lastaction} = time(); 586 $server->command("MSG =$nick cd $fpath[0]"); 587 return 0; 588 } 589 590 my @path = @{$$fserv{path}}; # just to have thing easier 591 while (@path) { 592 print_dbg("change_dir: comparing '$fpath[0]' and '$path[0]'", 4); 593 last if ($fpath[0] ne $path[0]); # go on as long as dirs are equal 594 shift @fpath; shift @path; 595 print_dbg("Current path='@path', fpath='@fpath'", 4); 596 } 597 if (@path == 0) { # so far we are on good path 598 print_dbg("change_dir: #15", 4); 599 return 1 if (@fpath == 0); # yup! no more dirs! 600 601 print_dbg("change_dir: #20", 4); 602 # must go deeper 603 push (@{$$fserv{path}}, $fpath[0]); 604 print_dbg("Going deeper, path='@path', fpath='@fpath'", 4); 605 $$fserv{lastaction} = time(); 606 $server->command("MSG =$nick cd $fpath[0]"); 607 return 0; 608 } 609 610 print_dbg("change_dir: #25", 4); 611 # dir is different - must go up 612 pop @{$$fserv{path}}; 613 $$fserv{lastaction} = time(); 614 $server->command("MSG =$nick cd .."); 615} 616 617### 618# Returns -1 if can't find it 619# server tag, nick 620sub find_file_to_queue($$) { 621 my ($tag, $nick) = @_; 622 my $fserv = get_fserv($tag, $nick); 623 624 return $$fserv{cfile} if ($$fserv{cfile} >= 0); 625 626 my $fnumber = -1; 627 foreach my $file (@{$$fserv{files}}) { 628 $fnumber++; 629 next unless ($$file{'state'} == 0); 630 $$fserv{cfile} = $fnumber; 631 return $fnumber; 632 } 633 return -1; 634} 635 636### 637# server tag, nick 638sub all_files_complete($$) { 639 my ($tag, $nick) = @_; 640 my $fserv = get_fserv($tag, $nick); 641 foreach (@{$$fserv{files}}) { 642 return 0 if ($$_{'state'} != 2); # FIXME : probably will have to be fixed when implemented missing files etc 643 } 644 return 1; 645} 646 647### 648# server tag, nick 649sub get_fserv($$) { 650 my ($tag, $nick) = @_; 651 return \%{$serv{$tag}{$nick}}; 652} 653 654### 655# server tag, nick, trigger 656sub add_trigger ($$$) { 657 my ($tag, $nick, $trigger) = @_; 658 $nick = lc $nick; 659 my $fserv = get_fserv($tag,$nick); 660 if (not exists $$fserv{trigger}) { 661 @{$$fserv{path}} = (); 662 $$fserv{state} = 0; 663 $$fserv{type} = 'default'; 664 $$fserv{cfile} = -1; 665 $$fserv{lastaction} = 0; # when was last action performed 666 @{$$fserv{files}} = (); 667 } 668 $$fserv{trigger} = $trigger; 669} 670 671### 672# server tag, nick, file 673sub add_file ($$$) { 674 my ($tag, $nick, $file) = @_; 675 $nick = lc $nick; 676 my $fserv = get_fserv($tag,$nick); 677 $file =~ s{^/}{}; 678 $file =~ s{/$}{}; 679 my $depth = ($file =~ tr|/||); # counting number of slashes ... 680 push (@{$$fserv{files}}, 681 { 'name' => $file, 'state' => 0, 'depth' => $depth, 682 'size' => -1}); 683} 684 685### 686# server tag, nick 687sub initiate_connection($$) { 688 my ($tag, $nick) = @_; 689 my $server = Irssi::server_find_tag($tag); 690 if (!$server) { 691 print_dbg("Could not find server '$tag'", 3); 692 return; 693 } 694 my $fserv = get_fserv($tag,$nick); 695 print_dbg("Initiating connection with $nick", 3); 696 $$fserv{state} = 1; 697 $$fserv{lastaction} = time(); 698 $server->command("CTCP $nick $$fserv{trigger}"); 699} 700 701### 702# server tag, nick 703sub execute_next_command ($$) { 704 my ($tag, $nick) = @_; 705 706 my $fserv = get_fserv($tag,$nick); 707 708 if ($$fserv{'state'} == 0 or $$fserv{'state'} == 6 or $$fserv{'state'} == 8) { 709 initiate_connection($tag, $nick); 710 } 711 712 # if it's for example 'changing dir' don't wait for response but 713 # execute next command (i.e. next cd or get) 714} 715 716### 717# 718sub time4check { 719 my ($tag, $nick, $fserv); 720 my $time = time(); 721 print_dbg("Time 4 check", 3); 722 my $recheck = Irssi::settings_get_int('fleech_recheck_interval'); 723 my $conn_timeout = Irssi::settings_get_int('fleech_max_connecting_time'); 724 foreach $tag (keys %serv) { 725 while (($nick, $fserv) = each %{$serv{$tag}}) { 726 next if ($$fserv{'lastaction'} == 0); 727 $$fserv{'state'} = 0 728 if (($$fserv{'state'} == 1 or $$fserv{'state'} == 2) 729 and ($time > $$fserv{'lastaction'} + $conn_timeout)); 730 next if (($$fserv{'state'} != 0 and $$fserv{'state'} != 6 731 and $$fserv{'state'} != 8) or 732 ($time < $$fserv{'lastaction'} + $recheck) or 733 (find_file_to_queue($tag, $nick) == -1)); 734 735 print_dbg ("Checking '$nick'\@'$tag'", 4); 736 execute_next_command($tag, $nick); 737 } 738 } 739} 740 741### 742# text[, level] 743sub print_dbg { 744 my ($txt, $mlvl) = @_; 745 my $lvl = Irssi::settings_get_int('fleech_verbose_level'); 746if ($dbglog) { 747 if (not open (DBGLOG, ">>", $dbglog)) { 748 $dbglog = ""; 749 } else { 750 # print_dbg("fleech.pl $VERSION loaded"); 751 print DBGLOG time() . " $txt\n" if ($dbglog); 752 } 753} 754 Irssi::print("$txt") if ($mlvl < $lvl); 755} 756 757### 758# server tag, nick 759sub list_nick ($$) { 760 my ($s, $nick) = @_; 761 my $fserv = get_fserv($s, $nick); 762 print_dbg("Nick: '$nick'"); 763 print_dbg(" type : '$$fserv{type}'"); 764 print_dbg(" trigger: '$$fserv{trigger}'"); 765 print_dbg(" state : '$$fserv{state}' " 766 ."($states{$$fserv{state}})"); 767 print_dbg(" cfile : '$$fserv{cfile}'", 2); 768 print_dbg(" path : '@{$$fserv{path}}'", 2); 769 print_dbg(" lastaction: '$$fserv{lastaction}'", 2); 770 print_dbg(" files :"); 771 my $fn = 0; 772 foreach my $file (@{$$fserv{files}}) { 773 print_dbg(" $fn)", 1); $fn++; 774 print_dbg(" name : '$$file{name}'"); 775 print_dbg(" depth: '$$file{depth}'", 2); 776 print_dbg(" size : '$$file{size}'", 1); 777 print_dbg(" state: '$$file{state}' ($fstates{$$file{state}})"); 778 } 779} 780############################# 781# take a string and expand it to an array of strings by substituting {00x,y} with 00x,00x+1,..,y 782# \{ is substituted with { and \\ with \ so \{->{ and \\{->\{ 783sub expand_str($){ 784 my ($str)=@_; 785 #print Dumper($str); 786 $str=~s/\%/\%\%/g; 787 my $from=0; 788 my $to=0; 789 my $zeros=''; 790 if($str=~s/(^|[^\\])((\\\\)*)(\{(\d+),(\d+)\})/$1$2\%s/){ 791 #print "matched\n"; 792 $from=$5; 793 $to=$6; 794 $zeros=$from; 795 if($from=~/^0/){ 796 $zeros='0'.length($from); 797 }else{ 798 $zeros=''; 799 } 800 } 801 $str=~s/\\\{/\{/g; 802 $str=~s/\\\\/\\/g; 803 #print Dumper($str);#" $str $from,$to\n"; 804 my $toret=[]; 805 for(my $i=$from;$i<=$to;$i++){ 806 push @$toret,sprintf($str,sprintf('%'.$zeros.'d',$i)); 807 } 808 return $toret; 809} 810 811### 812# /fleech add nick trigger /ctcp nick dupa 813# /fleech add nick file /dir/file 814sub cmd_fleech { 815 my ($data, $server, $channel) = @_; 816 817 my ($command, $nick, $rest) = split (" ", $data, 3); 818 $_ = $command; 819 if (/^list/) { 820 foreach my $s (keys %serv) { 821 print_dbg("Server '$s'"); 822 foreach my $nick (keys %{$serv{$s}}) { 823 list_nick($s, $nick); 824 } 825 } 826 return; 827 } 828 if (/^add/) { 829 my ($type, $command) = split (" ", $rest, 2); 830 print_dbg("Adding type '$type' for '$nick' on '$server->{tag}': '$command'", 4); 831 if ($type eq 'trigger') { 832 add_trigger($server->{tag}, $nick, $command); 833 return; 834 } 835 if ($type eq 'file') { 836 if (not exists $serv{$server->{'tag'}} or 837 not exists $serv{$server->{'tag'}}{lc($nick)}) { 838 print_dbg("No such server or nick record"); 839 return; 840 } 841 add_file($server->{tag}, $nick, $command); 842 return; 843 } 844 if ($type eq 'rfile') { 845 if (not exists $serv{$server->{'tag'}} or 846 not exists $serv{$server->{'tag'}}{lc($nick)}) { 847 print_dbg("No such server or nick record"); 848 return; 849 } 850 my $papasv_list=expand_str($command); 851 my $papasv_item; 852 foreach $papasv_item (@$papasv_list){ 853 #Irssi::print($papasv_item); 854 add_file($server->{tag}, $nick, $papasv_item); 855 } 856 return; 857 } 858 print_dbg("Unknown type '$type'"); 859 return; 860 } 861 if (/^del/) { 862 } 863 if (/^set/) { 864 # set nick field value 865 # or in case of field == file: 866 # set nick file number field value 867 # or in case of field == nick: 868 # set nick nick newnick 869 # For example: 870 # /fleech set somenick type sysreset 871 # /fleech set somenick file 2 state complete 872 # /fleech set somenick nick newnick 873 my ($field, $rest) = split (" ", $rest, 2); 874 if (not exists $serv{$server->{'tag'}} or 875 not exists $serv{$server->{'tag'}}{lc($nick)}) { 876 print_dbg("No such server or nick record"); 877 return; 878 } 879 if ($field eq 'files') { 880 my ($fn, $field, $rest) = split (" ", $rest, 3); 881 $serv{$server->{'tag'}}{lc($nick)}{'files'}[$fn]{$field} = $rest; 882 return; 883 } elsif ($field eq 'nick') { 884 if ((exists $serv{$server->{'tag'}}) and 885 (exists $serv{$server->{'tag'}}{lc($nick)})) { 886 my $record = delete $serv{$server->{'tag'}}{lc($nick)}; 887 $serv{$server->{'tag'}}{lc($rest)} = $record; 888 return; 889 } 890 Irssi::print("No such server or nick"); 891 return; 892 } 893 $serv{$server->{'tag'}}{lc($nick)}{$field} = $rest; 894 return; 895 } 896 if (/^go/) { 897 foreach my $s (keys %serv) { 898 foreach my $n (keys %{$serv{$s}}) { 899 if ($serv{$s}{$n}{state} == 0) { 900 execute_next_command($s, $n); 901 } 902 } 903 } 904 return; 905 } 906 if (/^clrc/) { 907 my $fc = 0; 908 foreach my $s (keys %serv) { 909 foreach my $n (keys %{$serv{$s}}) { 910 my $f = scalar @{$serv{$s}{$n}{'files'}}; 911 while (--$f >= 0) { 912 if ($serv{$s}{$n}{'files'}[$f]{'state'} == 2) { 913 print_dbg("Removing from $n '" 914 ."$serv{$s}{$n}{files}[$f]{name}'", 1); 915 splice @{$serv{$s}{$n}{'files'}}, $f, 1; 916 $fc++; 917 } 918 } 919 @{$serv{$s}{$n}{'files'}} = () if (not @{$serv{$s}{$n}{'files'}}); 920 } 921 } 922 print_dbg("Removed $fc file(s)") if ($fc); 923 return; 924 } 925 926} 927 928# FIXME: which one of signal_add{,_first,_last} use? 929Irssi::signal_add_last('nicklist changed', 'sig_nicklist_changed'); 930Irssi::signal_add_last('dcc request', 'sig_dcc_request'); 931Irssi::signal_add_last('dcc connected', 'sig_dcc_connected'); 932Irssi::signal_add_last('dcc destroyed', 'sig_dcc_destroyed'); 933Irssi::signal_add_last('dcc chat message', 'sig_dcc_chat_message'); 934Irssi::signal_add("event 401", "sig_no_such_nick"); 935 936 937Irssi::command_bind('fleech', 'cmd_fleech'); 938 939Irssi::settings_add_int($IRSSI{'name'}, 'fleech_verbose_level', 1); # 0 - no messages at all, 1 - std messages, 2 - more verbose, 3 - even more verbose, 4 - debug messages 940Irssi::settings_add_int($IRSSI{'name'}, 'fleech_recheck_interval', 60*30); # check if can queue more files every this seconds 941Irssi::settings_add_int($IRSSI{'name'}, 'fleech_max_connecting_time', 60*5); # if fserv in state 1 or 2 more than this seconds, reset it to state 0 942Irssi::settings_add_int($IRSSI{'name'}, 'fleech_timeout', 60); # functions that checks timeouts etc is called every this seconds 943 944my $ttag = Irssi::timeout_add(1000*Irssi::settings_get_int('fleech_timeout'), "time4check", undef); 945 946 947 948# vim:ts=4:noexpandtab 949