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