1#!/usr/local/bin/perl -w 2############################################################################# 3# 4# FServe - file server for Irssi using DCC 5# 6# Copyright (C) 2001 Martin Persson 7# Copyright (C) 2003 Andriy Gritsenko 8# Copyright (C) 2002-2004 Piotr Krukowiecki 9# 10# 11# If you have any comments, bug reports or anything else 12# please contact me at piotr at pingu.ii.uj.edu.pl 13# 14# "Official" home page is at http://pingu.ii.uj.edu.pl/~piotr/irssi 15# 16# 17# This program is free software; you can redistribute it and/or modify 18# it under the terms of the GNU General Public License as published by 19# the Free Software Foundation; either version 2 of the License, or 20# (at your option) any later version. 21# 22# This program is distributed in the hope that it will be useful, 23# but WITHOUT ANY WARRANTY; without even the implied warranty of 24# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25# GNU General Public License for more details. 26# 27# 28# Changelog 29# ==================================================================== 30# 31# TODO: 32# - when sending e.g. 3/2 files (e.g. because of min_upload), fserve 33# ad should say it's 3/2 sends, not 2/2 as it is now 34# - BUG: doesn't work if root_dir contains '+' ? 35# - Improve distro: /fs distro clear, etc 36# - possibility to, in case of failed send, not to resend file at once 37# but to requeue it in slot X 38# - More control in sends/queues (e.g. changing resends left, etc) 39# - /fs show_current_sends_to_channel 40# - restricted @find 41# - user priorities: new priority_user option in queue_priority + 42# /fs priouser nick 43# - @find should search thorough dirs as well. 44# - incorporate flood protection 45# ? make sure all server tags and user nicks are first lc()'ed 46# ? don't use send_user_msg, it's redundant 47# ? don't use message levels, but set window number 48# instead (might be better) 49# - Add '/fs queue all' or '/fs queue *' etc. 50# 51# 2.0.0 (2004.05.09) 52# * released rc4 without changes. Still a lot to do, but it's quite stable. 53# 54# 2.0.0rc4 (2004.01.27) 55# * fixed "() queued (0 B)" queued files 56# 57# 2.0.0rc3 (2003.06.19) 58# * fserve.pl works with old (before 0.8.6) irssi 59# * bugfix: min_upload was not working 60# * more documentation 61# 62# 2.0.0rc2 (2003.06.09) 63# * fixed 'send speed < 0' bug 64# * some queue-oriented fixes 65# * fixed '/fs delt' to update remaining sends and queues 66# * added '/fs queue *' to display all queues. 67# 68# 2.0.0rc1 (2003.06.01) Happy Child's Day :) 69# * Changed format of config file, it won't work with old (1.2.4 and 70# older file). If you're upgrading from 1.3.x and newer, just add 71# "[ConfigFileVersion 1.0]" (without '"') at the beginning of the 72# file. 73# This should be the last user-visible change of config/queue files. 74# * More documentation in /fs help 75# * Reseting upload_counter after having sent file 76# * renamed ignore_chat to ctcp_only 77# * renamed short_notice to custom_notice, added custom_notice_fields 78# * @find responses more Sysreset-like 79# 80# Important changes between 1.2.4 and 2.0.0rc1 81# (for detailed version look at fserve-1.4.0pre6) 82# Many thanks to Andriy Gritsenko for his work on the fserve. 83# * multiple server support 84# * multiple queue support (patch from A.G) 85# * good documentation: '/fs help' (although it's still not complete) 86# * changed format of queue file, saved sends and queues won't be back. 87# * many bugfixes, small fixes, changes in server logic etc. 88# * big patch from A.G, too much changes to list here. 89# 90# 91# 1.2.4 92# * bug workaround: removing ghost users (not tested... i don't have 93# such problems...) 94# * Removed window_close_on_quit - it was causing irssi to crash 95# * Patch from Daniel Seifert (dseifert at gmx dot de): 96# - added dont_notify option (to define channels where no notifies 97# should be sent to) 98# - english corrections 99# 100# 1.2.3 101# * Added: 102# - offline_message which is displayed when someone wants to access 103# disabled fserve 104# - fserve responds to !olist if (restricted_level > 0) and to 105# !vlist if (restricted_level == 1) 106# - fserve responds to "!list <my irc nick>" 107# * bug (?) workaround: sometimes fserve thinks it's still sending 108# the file when it's not. Now it's checking for such ghost sends 109# and removes them from sends list 110# * bugfix: can send files containing "'" now 111# 112# 1.2.2 113# * works with irssi 0.8.6 now, but doesn't work with irssi 0.8.5 and 114# former (incompatybile change in irssi 0.8.6 :( ) 115# 116# 1.2.1 117# * bugfix: @find didn't reported any files if there was only one match 118# 119# 1.2.0 120# * IMPORTANT CHANGE: there is no longer 'ops_priority' setting. You must 121# use 'queue_priority' instead (irssi will switch to it automatically 122# when loading old config). queue_priority is a list of space separated 123# priorities: "normal", "voice", "halfop", "op" and "others". Queue 124# is sorted according to the order in which they appear in queue_priority. 125# For example, if you set it to 'voice others normal' then first in queue 126# will be voiced people, then people with priority not mentioned in 127# queue_priority (in this case halfops and ops), then normal people. 128# If 'others' doesn't exists in queue_priority it's assumed to be at 129# the end 130# * Added: 131# - '/fs sortqueue' to sort queue according to queue_prority 132# - count_send_as_queue setting. If set to 1 user sends take 133# place in queue. For example, if it's set and user_slots == 1, 134# user can have only one send, or only one queued file. 135# - distro mode (/fs set distro, distro_file). When distro = 1 136# fileserver counts how many times each file was sent, and first 137# sends files with lowest send count. 138# In fact, distro setting isn't simply 0/1. It's a PROBABILITY of 139# using distro mode for the send. The values should be from range 140# [0,1], where 0 means don't use distro mode at all, and 1 means 141# allways use distro mode. For example when it's set to 0.7 it'll 142# use distro mode in 7 cases of 10 (more or less). 143# - '/fs distro stats' displays send count for files 144# * bugfix: 145# - send speed was wrongly calculated. 146# - fserve could sometimes use wrong network 147# - exit, bye shoult works now. Patch from Jan Rekorajski 148# (baggins at sith.mimuw.edu.pl). Chat windows are closed unless 149# close_window_on_quit is set to 0 150# * in conffile, queuefile and log_name you can use $IRSSI as part of the 151# path. It will be changed to Irssis home directory. 152# * hopefully better support for fserve explorers etc (changed 'dir' output) 153# * people who use different command char then '/' in /command shouldn't 154# have problems now 155# * some other fixes/changes 156# 157# 1.1.3 158# * added: 159# - +v/+%/+o only fserve. setting restricted_level to 3 means only ops 160# can access, to 2 only ops and halfops, to 1 only ops, halfops and 161# voiced users can access. if it's 0 everybody can access. 162# 163# 1.1.2 164# * added: 165# - !request support (/fs set request) 166# 167# 1.1.1 168# * bugfix: 169# - works with files containing more than one space in row 170# (e.g. 'blah blah') 171# * added: 172# - /fs set autosave_on_close - when set to 1 sends and queues 173# will be saved on /fs off 174# 175# 1.1.0 176# * bugfix: 177# - Enabling debug (/fs set debug 1) works now 178# * New: 179# - /fs set content - adds "On Fserve:(content)" to notice. 180# - /fs set motdfile - gets MOTD from file 181# - /fs set recache_interval - does /fs recache every recache_interval 182# seconds 183# - /ctcp ... NoResend 184# 185# 1.0.0 186# ----- 187# * added: 188# - sending small files without waiting in queues 189# (/fs set instant_send). Patch from Jan Rekorajski 190# (baggins at sith.mimuw.edu.pl) 191# - @find support (/fs set find, /fs set find_results). Patch from 192# Jan Rekorajski (baggins at sith.mimuw.edu.pl 193# - queuefile and $conffile in $fs_prefs{} 194# - /fs notify #channel1 #channel2 #etc 195# - current upstream is displayed in server notice 196# - resends ($max_resends) and better min_cps handling ($speedp). New 197# log position (dcc_soft_fail) if resend is possibile 198# - MOTD - '/fs set motd blah blah' 199# * bugfixes 200# - fserver should respond to all !list's (comparing # names not cases s.) 201# - fixed '/fs insert file' 202# - displays notice with correct colors even if Note: contains braces 203# - queued position reported after queueing file by +o/+v with 204# ops_priority on 205# * moved most usefull variables to %fs_prefs (/fs set ...) 206# * priority users are moved to the beginnign of the queue 207# * 'Autosaving...' is not printed anymore unless in debug mode 208# * Previously if ops_priority was on and nick was +o/+v the file was added 209# even if there was no free queue slot. Now it's not added, unless 210# ops_priority > 2. 211# * if irc server disconnects, fserve will change to 'frozen' state and will 212# wait for reconnection, then will wait next 150s to join channels etc. 213# If send will fail in that time then it will be moved to queue. 214# If you want to manually connect to new irc server, do /fs off, /fs on 215# 216# -- 217# Changes above by Cvbge (piotr at pingu.ii.uj.edu.pl) 218# -- 219# 220# 0.6.0 221# ----- 222# 223# * Merged patch from Ethan Fischer (allanon@crystaltokyo.com) 224# - added ignore_chat option that, when turned on, ignores the 225# trigger if said in the channel; it also changes the trigger 226# advertisement to "/ctcp nick !trigger" 227# - added ops_priority option that, when set to 1, force-adds 228# requests from to the top of the download queue regardless of 229# queue size; when set to 2, it does the same thing for voices 230# - added log_name option to specify the name of a logfile which 231# will be used to store transfer logs; the log contains the time 232# a dcc transfer finishes, whether it finished or failed, filename, 233# nick, bytes sent, start time, and end time 234# - added a kludge to kill dcc chats after an "exit" in sig_timeout() 235# - added a -clear option to the set command (eg, /fs set -clear 236# log_name) which sets the variable to an empty string 237# 238# * Merged patch from Brian (btherl@optushome.com.au) 239# - Avoid division by zero when dcc send takes 0 time to complete 240# - new user command "read" - allows reading of small (<30k) files, 241# such as checksum files 242# - set line delimeter before load_config() 243# - formatting of function headers 244# 245# thanks for the patches guys :) 246# 247# * the bytecounter now also counts the number of bytes sent 248# for failed transfers as well as successful transfers 249# (with respects to resumed files) 250# * some bugfixes I don't remember ;) 251# 252############################################################################# 253 254# Best viewed with TAB size = 4 ! 255 256use strict; 257no strict 'refs'; 258 259use Irssi; 260use Irssi::Irc; 261 262use vars qw($VERSION %IRSSI); 263 264$VERSION = "2.0.0"; 265my $conffile = '$IRSSI/fserve.conf'; 266 267%IRSSI = ( 268 authors => 'Piotr Krukowiecki & others', 269 contact => 'piotr at pingu.ii.uj.edu.pl', 270 name => 'FServe', 271 description => 'File server for irssi', 272 license => 'GPL v2', 273 url => 'http://pingu.ii.uj.edu.pl/~piotr/irssi' 274); 275 276 277my @welcome_msg = ( 278 "FServe $VERSION for Irssi", 279 "-", 280 "Commands: ls dir cd get read dequeue clr_queue queue sends", 281 " help who stats quit", 282); 283 284my @help_msg = ( 285 "-=[ Available commands ]=-", 286 " ls / dir - list files in current directory", 287 " cd <dir> - changes current directory to <dir>", 288 " (note: <dir> is case sensitive!)", 289 " get <file> - inserts <file> into the queue", 290 " read <file> - displays contents of <file>", 291 " dequeue <nr> - removes file in slot <nr>", 292 " clr_queue[s] - removes your queued files", 293 " queue[s] - lists the queue", 294 " sends - lists active sends", 295 " who - lists users online", 296 " stats - shows some statistice", 297 " quit - closes the connection", 298); 299 300my @srv_help_msg = ( 301 "command - [params] description\003\n", 302 "on - [0] enables fileserver", 303 "off - [0] disables fileserver", 304 "save - [0] save config file", 305 "load - [0] load config file", 306 "saveq - [0] saves sends/queues", 307 "loadq - [0] loads the queues", 308 "set - [0/2] sets variables", 309 "addq - [0] adds new queue", 310 "delq - [1] deletes queue", 311 "selq - [1] sets default queue for next 4 commands", 312 "setq - [0/2] sets queue variables", 313 "queue - [0-1] lists file queue", 314 "sortq - [0-1] sorts queue", 315 "move - [2-3] moves queue slots around", 316 "insert - [3] inserts a file in queue", 317 "clear - [1] removes queued files", 318 "sends - [0] lists active sends", 319 "who - [0] lists users online", 320 "stats - [0] shows server statistics", 321 "recache - [0] updates filecache\003\n", 322 "Usage: /fs <command> [<arguments>]", 323 "For parameter info type /fs <cmd>", 324 "Please read beginning of the fserve.pl (the changelog)", 325 "for more information", 326); 327 328############################################################################### 329# fileserver preferences (/fs set <var> <data>) 330# default values, feel free to change them 331############################################################################### 332my %fs_prefs = ( 333 auto_save => 599, 334 autosave_on_close => 1, 335 clr_dir => "\00312", 336 clr_file => "\00315", 337 clr_hi => "\00312", 338 clr_txt => "\00315", 339 count_send_as_queue => 0, 340 debug => 0, 341 distro => 0, 342 distro_file => '$IRSSI/fserve.distro', 343 idle_time => 120, 344 ignores => "", 345 log_name => '$IRSSI/fserve.log', # FIXME should be renamed to logfile or similar 346 max_queues => 10, 347 max_sends => 2, 348 max_time => 600, 349 max_users => 5, 350 min_upload => 0, 351 motd => '', 352 motdfile => '', 353 offline_message => '', # is displayed when someone wants to enter disabled fserve 354 queuefile => '$IRSSI/fserve.queue', 355 recache_interval => 3607, 356); 357 358my %fs_queue_defaults = ( 359 channels => '#CHANGE_ME', 360 content => '', 361 ctcp_only => 1, 362 custom_notice => 1, 363 custom_notice_fields=> "trigger sends queues min_cps note content", 364 dont_notify => "", 365 find => 3, 366 guaranted_queues => 0, 367 guaranted_sends => 0, 368 ignore_msg => 1, 369 ignores => "", 370 instant_send => 10240, 371 max_queues => 10, 372 max_resends => 3, 373 max_sends => 2, 374 min_cps => 9728, 375 motd => '', 376 nice => 0, 377 note => '', 378 notify_interval => 0, 379 notify_on_join => 0, 380 queue_priority => "", 381 request => "", 382 restricted_level => 0, 383 root_dir => '/path/to/files/CHANGE_ME', 384 servers => 'CHANGE_ME', 385 speed_warnings => 1, 386 trigger => '!trigger', 387 user_slots => 3, 388); 389 390############################################################################### 391# fileserver statistics 392############################################################################### 393my %fs_stats = ( 394 record_cps => 0, 395 rcps_nick => "", 396 sends_ok => 0, # sends succeeded 397 sends_fail => 0, # sends failed 398 transfd => 0, # total bytes transferred 399 login_count => 0, # total number of logins 400); 401 402my @fs_queues = (); 403my @fs_sends = (); 404my %fs_users = (); 405my %fs_distro = (); 406 407############################################################################### 408# private variables 409############################################################################### 410my $fs_enabled = 0; # always start disabled 411my $online_time = 0; # time since last script restart 412my $timer_tag; 413my $logfp; 414my @kill_dcc; 415my $upload_counter = 0; 416my $last_upload = 0; 417my $last_upload_check = 0; 418my $motdfile_modified = 0; #when was motd file last modified 419my @motd = (); 420my $default_queue = 0; 421my $next_queue = 0; 422my $FD = "'"; # old irssi (<0.8.6) doesn't use "'" in /dcc send 'file' 423 424############################################################################### 425# setup signal handlers 426############################################################################### 427Irssi::signal_add_first('event privmsg', 'sig_event_privmsg'); 428Irssi::signal_add_first('event join', 'sig_event_join'); 429Irssi::signal_add_first('default ctcp msg', 'sig_ctcp_msg'); 430Irssi::signal_add_last('dcc chat message', 'sig_dcc_msg'); 431 432Irssi::signal_add_last('dcc connected', 'sig_dcc_connected'); 433Irssi::signal_add('dcc destroyed', 'sig_dcc_destroyed'); 434 435Irssi::signal_add('nicklist changed', 'sig_nicklist_changed'); 436 437Irssi::command_bind('fs', 'sig_fs_command'); 438print_msg("FServe version $VERSION"); 439print_log("FServe starting up"); 440 441$_ = $conffile; 442s/\$IRSSI/Irssi::get_irssi_dir()/e or s/~/$ENV{"HOME"}/; 443if (-e) { 444 load_config(); 445} else { 446 print_msg("If this is your first time using this fserve"); 447 print_msg("I advise you to read help (/fs help)"); 448} 449if (!@fs_queues) { 450 print_debug("Added inital trigger"); 451 push (@fs_queues, { %fs_queue_defaults }); 452 @{$fs_queues[$#fs_queues]->{queue}} = (); 453} 454 455{ 456 my $ver = 'Very Old'; 457 eval { $ver = Irssi::version(); }; 458 if ($ver - 20021117 < 0) { 459 print_debug("Detected old irssi version: $ver") ; 460 $FD = ""; 461 } 462} 463 464if ($fs_prefs{distro} and $fs_prefs{distro_file}) { 465 $_ = $fs_prefs{distro_file}; 466 s/\$IRSSI/Irssi::get_irssi_dir()/e or s/~/$ENV{"HOME"}/; 467 if (-e) { 468 load_distro($_) and print_msg("Distro file loaded"); 469 } 470} 471 472############################################################################### 473# prints debug messages in the (fserve_dbg) window 474############################################################################### 475sub print_debug 476{ 477 if ($fs_prefs{debug}) { 478 Irssi::print("<DBG> @_", MSGLEVEL_CLIENTERROR); 479 } 480} 481 482############################################################################### 483# prints server message in current window 484############################################################################### 485sub print_msg 486{ 487 Irssi::active_win()->print("$fs_prefs{clr_txt} @_"); 488} 489 490sub print_what_we_did { 491 Irssi::print("@_", MSGLEVEL_CLIENTCRAP); 492} 493 494sub max($$) { return @_[0]>@_[1]?@_[0]:@_[1]; } 495sub min($$) { return @_[0]<@_[1]?@_[0]:@_[1]; } 496 497############################################################################### 498############################################################################### 499## 500## Signal handler routines 501## 502############################################################################### 503############################################################################### 504 505sub get_max_sends($) { 506 my $qn = @_[0]; 507 508 my $qu_msends = $fs_queues[$qn]->{max_sends}; 509 my $gl_msends = $fs_prefs{max_sends}; 510 my $guaranted_sends = $fs_queues[$qn]->{guaranted_sends}; 511 512 my $current_sends = $fs_queues[$qn]->{sends}; 513 my $free_sends = 514 max( $guaranted_sends - $current_sends, 515 min($gl_msends - @fs_sends, $qu_msends - $current_sends) ); 516 $free_sends = 0 if ($free_sends < 0); 517 my $max_sends = max( $guaranted_sends, min($qu_msends,$gl_msends) ); 518 519 return ($current_sends, $free_sends, $max_sends); 520} 521 522sub get_max_queues($) { 523 my $qn = @_[0]; 524 525 my $qu_mqueues = $fs_queues[$qn]->{max_queues}; 526 my $gl_mqueues = $fs_prefs{max_queues}; 527 my $guaranted_queues = $fs_queues[$qn]->{guaranted_queues}; 528 # TODO: keep this somewhere? 529 my $gl_current_queues = 0; 530 foreach (0 .. $#fs_queues) { 531 $gl_current_queues += @{$fs_queues[$_]->{queue}}; 532 } 533 534 my $current_queues = @{$fs_queues[$qn]->{queue}}; 535 my $free_queues = 536 max( $guaranted_queues - $current_queues, 537 min($gl_mqueues - $gl_current_queues, 538 $qu_mqueues - $current_queues) ); 539 $free_queues = 0 if ($free_queues < 0); 540 my $max_queues = max( $guaranted_queues, min($qu_mqueues, $gl_mqueues) ); 541 542 return ($current_queues, $free_queues, $max_queues); 543} 544 545############################################################################### 546# updates some variables when DCC CHAT is established 547############################################################################### 548sub sig_dcc_connected 549{ 550 my ($dcc) = @_; 551 my $tag = $dcc->{servertag}; 552 my $user_id = $dcc->{nick}."@".$tag; 553 print_debug("DCC connected: $dcc->{type} $user_id"); 554 555 return if ($dcc->{type} ne "CHAT" || !defined $fs_users{$user_id}); 556 557 print_debug("User $user_id connected!"); 558 $fs_users{$user_id}{status} = 0; 559 $fs_users{$user_id}{time} = 0; 560 $fs_stats{login_count}++; 561 562 foreach (@welcome_msg) { 563 send_user_msg($tag, $dcc->{nick}, $_); 564 } 565 send_user_msg($tag, $dcc->{nick}, "-"); 566 567 my $qn = $fs_users{$user_id}{queue}; 568 my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn); 569 my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn); 570 571 send_user_msg($tag, $dcc->{nick}, "Current/Free/Max Sends: ". 572 "$curr_sends/$free_sends/$max_sends"); 573 send_user_msg($tag, $dcc->{nick}, "Current/Free/Max Queues: ". 574 "$curr_queues/$free_queues/$max_queues"); 575 send_user_msg($tag, $dcc->{nick}, "Your queue: ". 576 count_user_files($tag, $dcc->{nick}, $qn). 577 "/$fs_queues[$qn]->{user_slots}"); 578 579 send_user_msg($tag, $dcc->{nick}, "Instant send: ". 580 size_to_str($fs_queues[$qn]{instant_send})) 581 if ($fs_queues[$qn]{instant_send} > 0); 582 583 if ($fs_prefs{motdfile}) { 584 send_user_msg($tag, $dcc->{nick}, "-"); 585 my $f = $fs_prefs{motdfile}; 586 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 587 if (! ((-f $f) and (-r $f))) { 588 print_msg("FServe: '$f' doesn't exists, isn't plain file or is not readable"); 589 } else { 590 my $lm = (stat($f))[9]; 591 if ($motdfile_modified < $lm) { 592 $motdfile_modified = $lm; 593 @motd = (); 594 open(FILE, "<", $f); 595 while(<FILE>) { 596 chomp; 597 s/\t/ /g; 598 push @motd, $_; 599 } 600 close(FILE, $f); 601 } 602 foreach (@motd) { 603 send_user_msg($tag, $dcc->{nick}, $_); 604 } 605 } 606 } 607 608 if (length($fs_prefs{motd})) { 609 send_user_msg($tag, $dcc->{nick}, "-"); 610 send_user_msg($tag, $dcc->{nick}, "$fs_prefs{motd}"); 611 } 612 if (length($fs_queues[$qn]{motd})) { 613 send_user_msg($tag, $dcc->{nick}, "-"); 614 send_user_msg($tag, $dcc->{nick}, "$fs_queues[$qn]{motd}"); 615 } 616 send_user_msg($tag, $dcc->{nick}, "-"); 617 send_user_msg($tag, $dcc->{nick}, '[\]'); 618} 619 620############################################################################### 621# cleanups after DCC CHAT/SEND disconnects 622############################################################################### 623sub sig_dcc_destroyed 624{ 625 my ($dcc) = @_; 626 my $nick = $dcc->{nick}; 627 my $server = $dcc->{server}; 628 my $server_tag = $dcc->{servertag}; 629 my $user_id = $nick.'@'.$server_tag; 630 631 print_debug("DCC destroyed: $dcc->{type} $user_id '$dcc->{arg}'"); 632 633 if ($dcc->{type} eq "CHAT" && defined $fs_users{$user_id}) { 634 delete $fs_users{$user_id}; 635 print_debug("Users left: ".keys %fs_users); 636 } elsif ($dcc->{type} eq "SEND") { 637 foreach my $sn (0 .. $#fs_sends) { 638 print_debug("check slot $sn: ". 639 "user=$fs_sends[$sn]->{nick}\@$fs_sends[$sn]->{server_tag}, ". 640 "file=$fs_sends[$sn]->{file}."); 641 if ($fs_sends[$sn]->{nick} eq $nick && 642 $fs_sends[$sn]->{server_tag} eq $server_tag && 643 $fs_sends[$sn]->{file} eq $dcc->{arg}) { 644 print_debug("found send in slot $sn"); 645 if ($dcc->{transfd} == $fs_sends[$sn]->{size}) { 646 print_log("dcc_finish $dcc->{arg} $user_id ". 647 "$dcc->{skipped} $dcc->{transfd} ". 648 "$dcc->{starttime} ".time()); 649 print_debug("file was finished"); 650 $fs_stats{sends_ok}++; 651 if ($fs_prefs{distro}) { 652 $fs_distro{$dcc->{arg}}{$dcc->{transfd}}++; 653 save_distro(); 654 } 655 656 ## Update speed record (if new) 657 if (time() > $dcc->{starttime}) { 658 my $speed = ($dcc->{transfd}-$dcc->{skipped})/ 659 (time() - $dcc->{starttime}); 660 661 if ($speed > $fs_stats{record_cps}) { 662 $fs_stats{record_cps} = $speed; 663 $fs_stats{rcps_nick} = $nick; 664 } 665 } 666 } else { 667 if ($fs_sends[$sn]->{transfd} == -1) { 668 # send was too slow 669 print_log("dcc_abort $dcc->{arg} $user_id ". 670 "$dcc->{skipped} $dcc->{transfd} ". 671 "$dcc->{starttime} ".time()); 672 } else { 673 $fs_sends[$sn]->{resends} += 1; 674 $fs_sends[$sn]->{warns} = 0; 675 $fs_sends[$sn]->{dontwarn} = 0; 676 delete $fs_sends[$sn]->{transfd}; 677 678 if ($fs_sends[$sn]->{resends} <= 679 $fs_queues[$fs_sends[$sn]{queue}]{max_resends}) { 680 681 # queue it for resending 682 # don't resend right now, you may be treated as flood 683 my $fsq = $fs_queues[$fs_sends[$sn]->{queue}]->{queue}; 684 # TODO should be parametrized (in which slot requeue) 685 my $resended_queue = 0; 686 foreach (0 .. $#{$fsq}) { 687 last if (!${$fsq}[$_]->{resends}); 688 $resended_queue++; 689 } 690 $resended_queue = 1 691 if (!$resended_queue && @{$fsq}>0); 692 print_debug("requeued $dcc->{arg} for ". 693 "$user_id in slot $resended_queue, ". 694 "resend $fs_sends[$sn]->{resends}"); 695 splice(@{$fsq}, $resended_queue, 0, { %{$fs_sends[$sn]} }); 696 $server->command("^NOTICE ". 697 "$fs_sends[$sn]->{nick} ". 698 "$fs_prefs{clr_txt} Send failed on try ". 699 $fs_sends[$sn]->{resends}." of ". 700 ($fs_queues[$fs_sends[$sn]{queue}]{max_resends}+1). 701 ". Type /ctcp ". 702 "$$server{nick} NoReSend to cancel " 703 ."any further resends.") 704 if ($server && $server->{connected}); 705 print_what_we_did("NOTICE ". 706 "$fs_sends[$sn]->{nick} ". 707 "$fs_prefs{clr_txt} Send failed on try ". 708 $fs_sends[$sn]->{resends}." of ". 709 ($fs_queues[$fs_sends[$sn]{queue}]{max_resends}+1). 710 ". Type /ctcp ". 711 "$$server{nick} NoReSend to cancel " 712 ."any further resends.") 713 if ($server && $server->{connected}); 714 print_log("dcc_soft_fail $dcc->{arg} $user_id ". 715 "$dcc->{skipped} $dcc->{transfd} ". 716 "$dcc->{starttime} ".time()); 717 } else { 718 print_log("dcc_fail $dcc->{arg} $user_id ". 719 "$dcc->{skipped} $dcc->{transfd} ". 720 "$dcc->{starttime} ".time()); 721 } 722 } 723 $fs_stats{sends_fail}++; 724 } 725 726 ## Update bytes transferred 727 $fs_stats{transfd} += ($dcc->{transfd} - $dcc->{skipped}); 728 splice(@fs_sends, $sn, 1); # FIXME : decrease number of sends? 729 print_debug("SEND closed to $user_id, file: ". 730 "$dcc->{arg}, bytes sent: ". 731 ($dcc->{transfd}-$dcc->{skipped}). 732 " (sent from slot $sn, ".@fs_sends." slots now)"); 733 return; 734 } 735 } 736 } 737} 738 739############################################################################### 740# handles dcc chat messages 741############################################################################### 742sub sig_dcc_msg 743{ 744 my $dcc = shift (@_); 745 my $msg = @_[0]; 746 my $user_id = $dcc->{nick}.'@'.$dcc->{servertag}; 747 748 # ignore messages from unconnected dcc chats 749 return unless ($fs_enabled && defined $fs_users{$user_id}); 750 751 # reset idle time for user 752 $fs_users{$user_id}{status} = 0; 753 754 my ($cmd, $args) = split(' ', $msg, 2); 755 $cmd = lc($cmd); 756 757 if ($cmd eq "dir" || $cmd eq "ls") { 758 list_dir($user_id, "$args"); 759 } elsif ($cmd eq "cd") { 760 change_dir($user_id, "$args"); 761 } elsif ($cmd eq "cd..") { # darn windows users ;) 762 change_dir($user_id, '..'); 763 } elsif ($cmd eq "get") { 764 queue_file($user_id, "$args"); 765 } elsif ($cmd eq "dequeue") { 766 $args =~ s/^\D*(\d+)\D*$/$1/; # stupid leechers, we have to remove garbage 767 dequeue_file($user_id, $args); 768 } elsif ($cmd eq "clr_queue" || $cmd eq "clr_queues") { 769 clear_queue($user_id, 0, $fs_users{$user_id}{queue}); 770 } elsif ($cmd eq "queue" || $cmd eq "queues") { 771 display_queue($user_id, $fs_users{$user_id}{queue}); 772 } elsif ($cmd eq "sends") { 773 display_sends($user_id); 774 } elsif ($cmd eq "who") { 775 display_who($user_id); 776 } elsif ($cmd eq "stats") { 777 display_stats($user_id); 778 } elsif ($cmd eq "read") { 779 display_file($user_id, "$args"); 780 } elsif ($cmd eq "help") { 781 foreach (@help_msg) { 782 send_user_msg($dcc->{servertag}, $dcc->{nick}, $_); 783 } 784 } elsif ($cmd eq "exit" || $cmd eq "quit" || $cmd eq "bye") { 785 push(@kill_dcc, $user_id); 786 } 787} 788 789############################################################################### 790# server, nick, queue_number 791############################################################################### 792sub try_connecting_user ($$$) 793{ 794 my ($server, $sender, $qn) = @_; 795 my $tag = $server->{tag}; 796 797 if (defined($fs_users{$sender."@".$tag})) { 798 if (!$fs_users{$sender."@".$tag}{ignore} && 799 $fs_queues[$qn]->{ignore_msg}) { 800 $server->command("^NOTICE $sender $fs_prefs{clr_txt}". 801 "A DCC chat offer has already been sent to you!"); 802 print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}". 803 "A DCC chat offer has already been sent to you!"); 804 } 805 806 $fs_users{$sender."@".$tag}{ignore} = 1; 807 return 1; 808 } 809 810 if (keys(%fs_users) < $fs_prefs{max_users}) { 811 if (!$fs_queues[$qn]->{restricted_level}) { 812 initiate_dcc_chat($server, $sender, $qn); 813 return 1; 814 } else { 815 foreach (split (' ', $fs_queues[$qn]->{channels})) { 816 my $ch = $server->channel_find($_); 817 next if !$ch; 818 my $n = $ch->nick_find($sender); 819 next if !$n; 820 if (($n->{op}) or 821 (($fs_queues[$qn]->{restricted_level} < 3) && $n->{halfop}) or 822 (($fs_queues[$qn]->{restricted_level} < 2) && $n->{voice})) { 823 initiate_dcc_chat($server, $sender, $qn); 824 return 1; 825 } 826 } 827 $server->command("^NOTICE $sender $fs_prefs{clr_txt}I'm sorry," 828 ." but this trigger is restricted. You need to be an". 829 (($fs_queues[$qn]->{restricted_level} == 3) ? " op" : 830 (($fs_queues[$qn]->{restricted_level} == 2) ? " op or halfop" : 831 " op, halfop or voiced")) . " to access this trigger"); 832 print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}I'm sorry," 833 ." but this trigger is restricted. You need to be an". 834 (($fs_queues[$qn]->{restricted_level} == 3) ? " op" : 835 (($fs_queues[$qn]->{restricted_level} == 2) ? " op or halfop" : 836 " op, halfop or voiced")) . " to access this trigger"); 837 } 838 } else { 839 $server->command("^NOTICE $sender $fs_prefs{clr_txt}". 840 "Sorry, server is full (". 841 $fs_prefs{clr_hi}.$fs_prefs{max_users}. 842 $fs_prefs{clr_txt}.")!"); 843 print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}". 844 "Sorry, server is full (". 845 $fs_prefs{clr_hi}.$fs_prefs{max_users}. 846 $fs_prefs{clr_txt}.")!"); 847 } 848 return 0; 849} 850 851 852############################################################################### 853# handles ctcp messages 854############################################################################### 855sub sig_ctcp_msg 856{ 857 my ($server, $args, $sender, $addr, $target) = @_; 858 $args = uc($args); 859 $args =~ s/\s*$//; # strip ending spaces 860 my $tag = $server->{tag}; 861 862 return if ($fs_prefs{ignores} && 863 $server->masks_match($fs_prefs{ignores}, $sender, $addr)); 864 865 if (!$fs_enabled) { 866 # find queue where the trigger is 867 foreach (0 .. $#fs_queues) { 868 next if ($args ne uc($fs_queues[$_]->{trigger})); 869 next if ($fs_queues[$_]{ignores} && 870 $server->masks_match($fs_queues[$_]{ignores}, $sender, $addr)); 871 872 foreach my $s (split(' ', $fs_queues[$_]->{servers})) { 873 if (uc($s) eq uc($tag) && 874 user_in_channel($server, $sender, $fs_queues[$_])) { 875 876 $server->command("^NOTICE $sender $fs_prefs{clr_txt}". 877 "Sorry, fserve is currently offline. $fs_prefs{offline_message}"); 878 print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}". 879 "Sorry, fserve is currently offline. $fs_prefs{offline_message}"); 880 Irssi::signal_stop(); 881 return; 882 } 883 } # loop over servers 884 } # loop over queues 885 Irssi::signal_stop(); 886 return; 887 } 888 889 print_debug("CTCP from $sender: '$args'"); 890 891 if ($args eq "NORESEND") { 892 my $found = 0; 893 foreach (0 .. $#fs_sends) { 894 if ($fs_sends[$_]{nick} eq $sender && 895 $fs_sends[$_]{server} eq $tag) { 896 print_debug("$sender: Canceling resends of $fs_sends[$_]->{file}"); 897 $fs_sends[$_]->{resends} = $fs_queues[$fs_sends[$_]{queue}]{max_resends}; 898 $found++; 899 } 900 } 901 my $message = ($found? 902 "Resend: All resends ($found) for currently sending ". 903 "files have been canceled." : 904 "Resend: You currently have no sending files set ". 905 "to resend."); 906 $server->command("^MSG $sender $message"); 907 print_what_we_did("MSG $sender $message"); 908 Irssi::signal_stop(); 909 return; 910 } # end NORESEND 911 912 913 foreach my $qn (0 .. $#fs_queues) { 914 next if ($args ne uc($fs_queues[$qn]->{trigger})); 915 print_debug("Got trigger in queue $qn"); 916 next if ($fs_queues[$qn]{ignores} && 917 $server->masks_match($fs_queues[$qn]{ignores}, $sender, $addr)); 918 print_debug("Not ignoring user"); 919 920 print_debug("Servers are $fs_queues[$qn]->{servers}"); 921 foreach my $s (split(' ', $fs_queues[$qn]->{servers})) { 922 print_debug("Checking server $s against $tag"); 923 next if (uc($tag) ne uc($s) || 924 !user_in_channel($server, $sender, $fs_queues[$qn])); 925 print_debug("Good tag and user in chan"); 926 927 if (try_connecting_user($server, $sender, $qn)) { 928 Irssi::signal_stop(); 929 return; 930 } 931 } 932 } 933 Irssi::signal_stop(); 934 return; 935} 936 937############################################################################### 938# notifies joining users 939############################################################################### 940sub sig_event_join 941{ 942 my ($server, $data, $sender, $addr) = @_; 943 my ($target) = ($data =~ /:(.*)/); 944 945 return if (!$fs_enabled); 946 947 foreach my $qn (0 .. $#fs_queues) { 948 next if (!$fs_queues[$qn]->{notify_on_join}); 949 next if ($fs_queues[$qn]{ignores} && 950 $server->masks_match($fs_queues[$qn]{ignores}, $sender, $addr)); 951 952 foreach my $s (split(' ', $fs_queues[$qn]->{servers})) { 953 next if (uc($s) ne uc($server->{tag})); 954 foreach my $channel (split(' ', $fs_queues[$qn]->{channels})) { 955 next if (uc($channel) ne uc($target)); 956 show_notice($server, $sender, $qn); 957 } # loop over channels 958 } # loop over servers 959 960 } # loop over queues 961 962} 963 964############################################################################### 965# handles channel and private messages 966############################################################################### 967sub sig_event_privmsg 968{ 969 my ($server, $data, $sender, $addr) = @_; 970 my ($target, $text) = split(/ :/, $data, 2); 971 972 return if (!$fs_enabled); 973 return if ($fs_prefs{ignores} && 974 $server->masks_match($fs_prefs{ignores}, $sender, $addr)); 975 976 foreach my $qn (0 .. $#fs_queues) { 977 next if ($fs_queues[$qn]{ignores} && 978 $server->masks_match($fs_queues[$qn]{ignores}, $sender, $addr)); 979 foreach my $s (split(' ', $fs_queues[$qn]->{servers})) { 980 next if (uc($s) ne uc($server->{tag})); 981 foreach my $channel (split(' ', $fs_queues[$qn]->{channels})) { 982 next if (uc($channel) ne uc($target)); 983 984 985 # trigger typed 986 if (!$fs_queues[$qn]->{ctcp_only} && 987 uc($text) eq uc($fs_queues[$qn]->{trigger})) { 988 try_connecting_user($server, $sender, $qn); 989 return; 990 } 991 992 # strip extra spaces 993 $_ = uc($text); 994 s/\s+$//; s/^\s+$//; s/\s+/ /g; 995 if (($_ eq '!LIST') || ($_ eq ('!LIST '.uc($$server{nick}))) || 996 ($_ eq '!OLIST' and $fs_queues[$qn]->{restricted_level}) || 997 ($_ eq '!VLIST' and $fs_queues[$qn]->{restricted_level} == 1) 998 ) { 999 show_notice($server, $sender, $qn); 1000 } 1001 if (length($fs_queues[$qn]->{request}) && ($_ eq '!REQUEST')) 1002 { 1003 my $msg = "[$fs_prefs{clr_hi}Request$fs_prefs{clr_txt}] ". 1004 "Message:[$fs_prefs{clr_hi}$fs_queues[$qn]->{request}". 1005 "$fs_prefs{clr_txt}] - FServe $VERSION"; 1006 $server->command("^NOTICE $sender $fs_prefs{clr_txt}$msg"); 1007 print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}$msg"); 1008 } 1009 1010 if ($fs_queues[$qn]->{find}) { 1011 if (/^\@FIND /) { 1012 if ($sender !~ /^#/) { 1013 show_find($server, $sender, $text, $qn); 1014 } 1015 } 1016 } 1017 1018 } # loop over channels 1019 } # loop over servers 1020 } # loop over queues 1021} 1022 1023 1024############################################################################### 1025# updates userinfo on nick changes 1026############################################################################### 1027sub sig_nicklist_changed 1028{ 1029 my ($chan, $nick, $oldnick) = @_; 1030 my $server_tag = $chan->{server}{tag}; 1031 1032 print_debug("NICK CHANGE: $oldnick -> $nick->{nick}\@$server_tag on $chan->{name}"); 1033 1034 foreach my $qn (0 .. $#fs_queues) { 1035 1036 my $ch_ok = 0; 1037 my $srv_ok = 0; 1038 foreach (split(' ', $fs_queues[$qn]->{channels})) { 1039 if (uc($_) eq uc($chan->{name})) { 1040 $ch_ok = 1; 1041 last; 1042 } 1043 } 1044 foreach (split(' ', $fs_queues[$qn]->{servers})) { 1045 if (uc($_) eq uc($server_tag)) { 1046 $srv_ok = 1; 1047 last; 1048 } 1049 } 1050 1051 next unless ($ch_ok && $srv_ok); 1052 1053 1054 my $old_user_id = $oldnick.'@'.$server_tag; 1055 my $user_id = $nick->{nick}.'@'.$server_tag; 1056 1057 if (defined $fs_users{$old_user_id}) { 1058 print_debug("Changing connected user data"); 1059 # update user data 1060 my $rec = $fs_users{$old_user_id}; 1061 delete $fs_users{$old_user_id}; 1062 $fs_users{$user_id} = { %{$rec} }; 1063 } 1064 1065 # update queue 1066 my $fsq = $fs_queues[$qn]->{queue}; 1067 foreach (0 .. $#{$fsq}) { 1068 if (${$fsq}[$_]->{nick} eq $oldnick && 1069 ${$fsq}[$_]->{server_tag} eq $server_tag) { 1070 print_debug("Changing queued file data"); 1071 ${$fsq}[$_]->{nick} = $nick->{nick}; 1072 } 1073 } 1074 1075 # DONT update sends - irssi bug? 1076 # irssi doesn't change nick in dcc sends 1077# foreach (0 .. $#fs_sends) { 1078# if ($fs_sends[$_]->{nick} eq $oldnick && 1079# $fs_sends[$_]->{server_tag} eq $server_tag) { 1080# $fs_sends[$_]->{nick} = $nick->{nick}; 1081# } 1082# } 1083 1084 } 1085} 1086 1087############################################################################### 1088# sig_timeout(): called once every second 1089############################################################################### 1090sub sig_timeout 1091{ 1092 # kill connections that said "bye", campers, ghost users etc. 1093 foreach (@kill_dcc) { 1094 my ($nick, $servertag) = split('@', $_); 1095 my $server = Irssi::server_find_tag($servertag); 1096 next if (!$server || !$server->{connected}); 1097 print_debug("Closing dcc chat to $nick on $servertag"); 1098 $server->command("DCC CLOSE CHAT $nick"); 1099 } 1100 @kill_dcc = (); 1101 1102 my $time = time(); 1103 1104 # check for campers... 1105 foreach (keys %fs_users) { 1106 $fs_users{$_}{time}++; 1107 if ($fs_users{$_}{status} >= 0) { 1108 $fs_users{$_}{status}++; 1109 my ($nick, $server_tag) = split('@', $_); 1110 1111 if ($fs_users{$_}{status} > $fs_prefs{idle_time}) { 1112 send_user_msg($server_tag, $nick, 1113 "Idletime ($fs_prefs{clr_hi}". 1114 "$fs_prefs{idle_time}$fs_prefs{clr_txt} sec) ". 1115 "reached, disconnecting!"); 1116 push(@kill_dcc, $_); 1117 } elsif ($fs_users{$_}{time} > $fs_prefs{max_time}) { 1118 send_user_msg($server_tag, $nick, 1119 "Does this look like a campsite? (". 1120 "$fs_prefs{clr_hi}$fs_prefs{max_time} ". 1121 "sec$fs_prefs{clr_txt})"); 1122 push(@kill_dcc, $_); 1123 } 1124 # 7 minutes for user to connect 1125 } elsif ($fs_users{$_}{status} == -1 and $fs_users{$_}{time} > 420) { 1126 print_msg("BUG workaround: probably ghost user '$_'. Removing from user list ."); 1127 delete $fs_users{$_}; 1128 } 1129 } 1130 1131 return if (! $fs_enabled); 1132 1133 $online_time++; 1134 1135 # auto save config file 1136 if ($fs_prefs{auto_save} && $time % $fs_prefs{auto_save} == 0) { 1137 print_debug("Autosaving..."); 1138 save_config(); 1139 save_queue(); 1140 } 1141 1142 # update all $queue->{sends} 1143 # FIXME: Do this 'the old way' 1144 # FIXME: BUG: since number of sends is computed only every second 1145 # users could exploit this and gain more sends/queues then allowed 1146 foreach (0 .. $#fs_queues) { $fs_queues[$_]->{sends} = 0; } 1147 foreach (0 .. $#fs_sends) { $fs_queues[$fs_sends[$_]->{queue}]->{sends}++; } 1148# foreach (0 .. $#fs_queues) { 1149# print_debug("Trigger #" . $_ . " have " . $fs_queues[$_]->{sends} . 1150# " sends.") ; 1151# } 1152 1153 # First send forced sends 1154 my $file_sent = 0; 1155 foreach (0 .. $#fs_queues) { 1156 if ($fs_queues[$_]->{sends} < $fs_queues[$_]->{guaranted_sends}) { 1157 if (run_queue($fs_queues[$_]) == 0) { 1158 $file_sent = 1; 1159 $upload_counter = 0; 1160 print_debug("Sent forced queue"); 1161 last; 1162 } 1163 } 1164 } 1165 1166 # send only one file per second. 1167 if (!$file_sent) { 1168 if (send_next_file() == 0) { 1169 $file_sent = 1; 1170 $upload_counter = 0; 1171 print_debug("Sent normal queue"); 1172 } 1173 } 1174 1175 # check for min upload (up to 2*max_sends+1) 1176 # FIXME don't use 2*m_s+1 but parametrize 1177 if (!$file_sent && @fs_sends >= $fs_prefs{max_sends} && 1178 $time > $last_upload_check && 1179 @fs_sends <= 2*$fs_prefs{max_sends} && ($time % 60) == 0) { 1180 my $curr_ups = 0; 1181 foreach my $dcc (Irssi::Irc::dccs()) { 1182 if ($dcc->{type} eq 'SEND') { 1183 $curr_ups += ($dcc->{transfd}-$dcc->{skipped})/($time - $last_upload_check); 1184 } 1185 } 1186 $curr_ups -= $last_upload; 1187 $last_upload += $curr_ups; 1188 $last_upload_check = $time; 1189 if ($curr_ups > 0 && $curr_ups < $fs_prefs{min_upload}) { 1190 $upload_counter++; 1191 print_debug("Upload $curr_ups is below minimal, counter is $upload_counter"); 1192 if ($upload_counter > 4) { 1193 send_next_file(1); 1194 $upload_counter = 0; 1195 } 1196 } else { 1197 $upload_counter = 0; 1198 } 1199 } 1200 1201 # recache files 1202 if ($fs_prefs{recache_interval} && 1203 $time % $fs_prefs{recache_interval} == 0) { 1204 update_files(); 1205 } 1206 1207 # notify channels 1208 foreach my $qn (0 .. $#fs_queues) { 1209 if ($fs_queues[$qn]->{notify_interval} && 1210 $time % $fs_queues[$qn]->{notify_interval} == 0) { 1211 foreach (split(' ', $fs_queues[$qn]->{channels})) { 1212 foreach my $s (split(' ', $fs_queues[$qn]->{servers})) { 1213 my $server = Irssi::server_find_tag($s); 1214 next if (!$server || !$server->{connected}); 1215 show_notice($server, $_, $qn); 1216 } 1217 } 1218 } 1219 } 1220 1221 # check speed of sends 1222 if (($time % 60) == 0) { 1223 for (my $s = $#fs_sends; $s >= 0; $s--) { 1224 if ($fs_queues[$fs_sends[$s]{queue}]{min_cps}) { 1225 check_send_speed($s); 1226 } 1227 } 1228 } 1229} 1230 1231############################################################################### 1232# check_send_speed(): aborts send in $slot if speed < $fs_prefs{min_cps} 1233############################################################################### 1234sub check_send_speed 1235{ 1236 my ($s) = @_; 1237 print_debug("check_sends_speed: checking speed of ". 1238 "$fs_sends[$s]->{nick}\@$fs_sends[$s]->{server_tag}". 1239 " $fs_sends[$s]->{file}"); 1240 1241 foreach my $dcc (Irssi::Irc::dccs()) { 1242 print_debug("check_sends_speed: checking DCC ". 1243 "$dcc->{nick}\@$dcc->{servertag} $dcc->{arg}"); 1244 1245 next if ($dcc->{type} ne 'SEND' || 1246 $dcc->{nick} ne $fs_sends[$s]->{nick} || 1247 $dcc->{servertag} ne $fs_sends[$s]->{server_tag} || 1248 $dcc->{arg} ne $fs_sends[$s]->{file}); 1249 1250 print_debug ("Found send"); 1251 return unless ($dcc->{starttime}); 1252 1253 if (defined $fs_sends[$s]->{transfd}) { 1254 my $speed = ($dcc->{transfd}-$fs_sends[$s]->{transfd})/60; 1255 my $min_cps = $fs_queues[$fs_sends[$s]{queue}]{min_cps}; 1256 if ($speed < 0) { 1257 print_msg("BUG: send speed < 0 ($speed). Send number $s, ". 1258 "dcc->transfd='$dcc->{transfd}', fs_sends->transfd='". 1259 $fs_sends[$s]->{transfd} . "', skipped='". 1260 $dcc->{skipped}. "', starttime='$dcc->{starttime}'. ". 1261 "Please report this to maintainer (the best is to attach ". 1262 "log output of last couple of minutes). Listing sends:"); 1263 display_sends('!fserve!'); 1264 } 1265 if ($speed < $min_cps) { 1266 # too slow... 1267 1268 if ($fs_sends[$s]->{warns} < 1269 $fs_queues[$fs_sends[$s]{queue}]->{speed_warnings}) { 1270 1271 # but he/she still has a chanse... 1272 my $warn_msg; 1273 my $last_warn_msg; 1274 1275 print_debug("$dcc->{nick}: send is too slow ($speed),". 1276 " but warns=".$fs_sends[$s]->{warns}); 1277 1278 if (!$fs_sends[$s]->{dontwarn}) { 1279 1280 if ($fs_sends[$s]->{warns} == 0) { 1281 $warn_msg = "First warning"; 1282 } elsif ($fs_sends[$s]->{warns} == 1) { 1283 $warn_msg = "Second warning"; 1284 } else { 1285 $warn_msg = "Warning"; 1286 $fs_sends[$s]->{dontwarn} = 1; 1287 $last_warn_msg = ' Next warnings will be suppressed.'; 1288 } 1289 my $server = $dcc->{server}; 1290 if ($server && $server->{connected}) { 1291 $server->command("^NOTICE $fs_sends[$s]->{nick} ". 1292 $fs_prefs{clr_txt}.$warn_msg. 1293 ": the speed of your send (". 1294 $fs_prefs{clr_hi}.size_to_str($speed)."/s". 1295 $fs_prefs{clr_txt}.") is less than min CPS ". 1296 "requirement (".$fs_prefs{clr_hi}. 1297 size_to_str($min_cps)."/s". 1298 $fs_prefs{clr_txt}.").".$last_warn_msg); 1299 print_what_we_did("NOTICE $fs_sends[$s]->{nick} ". 1300 $fs_prefs{clr_txt}.$warn_msg. 1301 ": the speed of your send (". 1302 $fs_prefs{clr_hi}.size_to_str($speed)."/s". 1303 $fs_prefs{clr_txt}.") is less than min CPS ". 1304 "requirement (".$fs_prefs{clr_hi}. 1305 size_to_str($min_cps)."/s". 1306 $fs_prefs{clr_txt}.").".$last_warn_msg); 1307 } 1308 } 1309 1310 $fs_sends[$s]->{warns} += 1; 1311 } else { 1312 # we must finish him :( 1313 my $server = $dcc->{server}; 1314 print_debug("$dcc->{nick}: warns=". 1315 $fs_sends[$s]->{warns}. 1316 " and speed is too slow ($speed)"); 1317 if ($server && $server->{connected}) { 1318 $server->command("^NOTICE $fs_sends[$s]->{nick} ". 1319 $fs_prefs{clr_txt}."The speed of your send (". 1320 $fs_prefs{clr_hi}.size_to_str($speed)."/s". 1321 $fs_prefs{clr_txt}.") is less than min CPS ". 1322 "requirement (".$fs_prefs{clr_hi}. 1323 size_to_str($min_cps)."/s". 1324 $fs_prefs{clr_txt}."), aborting..."); 1325 print_what_we_did("NOTICE $fs_sends[$s]->{nick} ". 1326 $fs_prefs{clr_txt}."The speed of your send (". 1327 $fs_prefs{clr_hi}.size_to_str($speed)."/s". 1328 $fs_prefs{clr_txt}.") is less than min CPS ". 1329 "requirement (".$fs_prefs{clr_hi}. 1330 size_to_str($min_cps)."/s". 1331 $fs_prefs{clr_txt}."), aborting..."); 1332 1333 $fs_sends[$s]{transfd} = -1; 1334 $server->command("DCC CLOSE SEND $dcc->{nick}"); 1335 } 1336 # FIXME: don't return here? 1337 return; # don't touch $fs_sends[$s] anymore! 1338 } 1339 } else { 1340 if ($fs_sends[$s]->{warns}) { 1341 print_debug("$dcc->{nick}: speed is ok ($speed), reset speed warnings"); 1342 $fs_sends[$s]->{warns} = 0; 1343 } 1344 } 1345 } 1346 $fs_sends[$s]->{transfd} = $dcc->{transfd}; 1347 return; 1348 } 1349 # Could not find active send matching out record - delete it 1350 # Don't know why it happens, one possibility is the file name in 1351 # dcc_destroyed do not match the one recoreded in fs_sends, but don't 1352 # know how it's possibile 1353 print_debug("BUG?: cannot find file $fs_sends[$s]->{file} sending to ". 1354 "$fs_sends[$s]->{nick}\@$fs_sends[$s]->{server_tag}"); 1355 print_debug("Active sends:"); 1356 foreach (Irssi::Irc::dccs()) { 1357 print_debug("$_->{nick}\@$_->{servertag} -> $_->{arg}") 1358 if ($_->{type} eq 'SEND'); 1359 } 1360 print_debug("Removing lost send"); 1361 splice(@fs_sends, $s, 1); 1362} 1363 1364 1365sub do_help 1366{ 1367 my $arg = lc(join(" ", @_)); 1368 print_msg ("Arg is '$arg'"); 1369 1370 if (! $arg) { print_msg(" 1371Help for FServe 1372 1373All FServe commands are executed using '/fs <command>' 1374syntax. 1375To get more help about specific topic type 1376'/fs help <topic>'. 1377 1378List of available help topics: 1379* commands - available commands 1380* tutorial - how to set up simple file server 1381* bugs - known bugs/limitations (TODO) 1382"); return; } 1383 1384 if ($arg eq "commands") { print_msg(" 1385List of FServe commands. 1386 1387To get more help about specific command type 1388'/fs help <command>'. 1389 1390v* on - enable fileserver 1391v* off - disable fileserver 1392v* save - save config file 1393v* load - load config file 1394v* saveq - save sends and queues 1395v* loadq - load queues 1396v* set - list/set global settings 1397v* sett - list/set trigger variables 1398v* addt - add new trigger 1399v* delt - delete trigger 1400v* selt - set default trigger 1401v* queue - list file queue 1402v* sortt - sort trigger 1403v* move - move queue slots around 1404* insert - insert a file into queue 1405* clear - remove queued files 1406* sends - list active sends 1407* who - list online online 1408* stats - show server statistics 1409* distro - show distro statistics 1410* recache - update filecache 1411* notify - show fserve ad to user/channel 1412* help - show help 1413"); return; } 1414 1415 if ($arg eq "on") { print_msg(" 1416ON 1417 1418Enables FServe, updates filecache. 1419Doesn't load saved queues. 1420 1421See also: LOADQ 1422"); return; } 1423 1424 if ($arg eq "off") { print_msg(" 1425OFF 1426 1427Disables FServe. 1428If 'autosave_on_close' is 1 saves sends and queues. 1429 1430See also: SAVEQ 1431"); return; } 1432 1433 if ($arg eq "save") { print_msg(" 1434SAVE 1435 1436Saves config file. 1437"); return; } 1438 1439 if ($arg eq "load") { print_msg(" 1440LOAD 1441 1442Loads config file. 1443"); return; } 1444 1445 if ($arg eq "saveq") { print_msg(" 1446SAVEQ 1447 1448Saves sends and queues. 1449 1450See also: LOADQ 1451"); return; } 1452 1453 if ($arg eq "loadq") { print_msg(" 1454LOADQ 1455 1456Loads sends and queues (sends are put 1457in the queues as first) 1458 1459See also: SAVEQ 1460"); return; } 1461 1462 if ($arg eq "set") { print_msg(" 1463SET [-clear] [variable value] 1464 1465If used without arguments lists global settings. 1466 1467You can unset variable with -clear switch, 1468for example: /fs set -clear offline_message 1469 1470To get help for specific variable use 1471/fs help set <variable_name> 1472 1473See also: SETT 1474"); return; } 1475 1476 if ($arg eq "sett") { print_msg(" 1477SETT [-clear] [variable value] 1478 1479If used without arguments lists current trigger 1480settings. 1481You can select current trigger with '/fs selt <number>' 1482 1483You can unset variable with -clear switch, 1484for example: /fs sett -clear offline_message 1485 1486To get help for specific variable use 1487/fs help sett <variable_name> 1488 1489See also: SET, SELT 1490"); return; } 1491 1492 if ($arg eq "addt") { print_msg(" 1493ADDT 1494 1495Adds new trigger. 1496 1497See also: SELT 1498"); return; } 1499 1500 if ($arg eq "delt") { print_msg(" 1501DELT <trigger number> 1502 1503Removes trigger. 1504It does not remove files from queues. 1505 1506See also: SELT 1507"); return; } 1508 1509 if ($arg eq "selt") { print_msg(" 1510SELT <trigger number> 1511 1512Selects default trigger. 1513 1514The default trigger is used as default for 1515MOVE, QUEUE, SETT, SORTT commands. 1516"); return; } 1517 1518 if ($arg eq "queue") { print_msg(" 1519QUEUE [<trigger number>] 1520 1521Displays queued files. 1522If used without argument uses default trigger. 1523You can use '*' as an argument to display all 1524queued files. 1525 1526See also: SELT 1527"); return; } 1528 1529 if ($arg eq "sortt") { print_msg(" 1530SORTT [<trigger number>] 1531 1532Sorts queued files according to queue_priority. 1533If used without argument uses default trigger. 1534 1535See also: SELT 1536"); return; } 1537 1538 if ($arg eq "move") { print_msg(" 1539MOVE [<trigger number>] <from> <to> 1540 1541Moves files queued in trigger <trigger number> (or default 1542trigger) from position <from> to position <to>. 1543 1544See also: SELT 1545"); return; } 1546 1547 if ($arg eq "distro") { print_msg(" 1548DISTRO stats 1549 1550Displays send count for files 1551 1552See also: SET distro 1553"); return; } 1554 1555 if ($arg eq "set auto_save") { print_msg(" 1556SET auto_save <seconds> 1557 1558Every <seconds> seconds saves config, sends and 1559queues 1560 1561See also: SET autosave_on_close 1562"); return; } 1563 1564 if ($arg eq "set autosave_on_close") { print_msg(" 1565SET autosave_on_close 0|1 1566 1567When set to 1 sends and queues will be saved in /fs off 1568 1569See also: SET auto_save 1570"); return; } 1571 1572 if ($arg =~ /^set clr_(dir|file|hi|txt)$/) { print_msg(" 1573SET clr_dir <color> 1574SET clr_file <color> 1575SET clr_hi <color> 1576SET clr_txt <color> 1577 1578This settings controll colors in fserve. 1579Currently it's a little bit inconsistent. 1580You can set <color> using ^C<txt_color>,<bg_color> 1581(standart irssi/bitchx colors), for example 1582/SET clr_txt ^C12 1583to set text color to blue. 1584 1585Remember to use xy color codes, i.e. don't use 1586^C9 but use ^C09. If not displaying files that start 1587with a number will be fscked ;) 1588"); return; } 1589 1590 if ($arg eq "set count_send_as_queue") { print_msg(" 1591SET count_send_as_queue 0|1 1592 1593If set to 1 sends user have are counted as queues. 1594So if user have 1 send and 2 file queued, and 1595user_slots is set to 3 the user won't be able 1596to queue any more files (because has 2 queues and 15971 send = 3 files). If count_send_as_queue was 0 1598the user would be able to queue one more file. 1599 1600See also: SETT user_slots 1601"); return; } 1602 1603 if ($arg eq "set debug") { print_msg(" 1604SET debug 0|1 1605 1606When set to 1 enables diagnostic messages 1607"); return; } 1608 1609 if ($arg eq "set distro" || $arg eq "set distro_file" ) { print_msg(" 1610SET distro <probability> 1611SET distro_file <file_name> 1612 1613When <probability> is 1 fileserver counts how many times 1614each file was sent, and first sends files with lowest send 1615count. 1616 1617In fact, distro setting isn't simply 0/1. It's a PROBABILITY of 1618using distro mode for the send. The values should be from range 1619[0,1], where 0 means don't use distro mode at all, and 1 means 1620allways use distro mode. 1621 1622For example when it's set to 0.7 it'll use distro mode in 7 1623cases of 10 (more or less). 1624 1625See also: DISTRO 1626"); return; } 1627 1628 if ($arg eq "set idle_time" || $arg eq "set max_time") { print_msg(" 1629SET idle_time <s1> 1630SET max_time <s2> 1631 1632Controls how much time the user can be connected with 1633fserve on dcc chat. 1634 1635User will be disconnected after either: 1636<s1> seconds of inactivity 1637<s2> seconds since connecting 1638"); return; } 1639 1640 if ($arg eq "set ignores" || $arg eq "sett ignores") { print_msg(" 1641SET ignores <mask> <mask2> ... 1642SETT ignores <mask> <mask2> ... 1643 1644Using this settings you can 'ban' users from the fserve. 1645Fserve won't respond to !list nor trigger. 1646 1647The <mask> is in normal nick!ident\@host format, 1648you can use '*' and '?'. 1649"); return; } 1650 1651 if ($arg eq "set log_name") { print_msg(" 1652SET log_name <file> 1653 1654Logs file transfers to <file> 1655 1656You can use \$IRSSI and ~ that specify irssi's home 1657and your home directory. 1658"); return; } 1659 1660 if ($arg eq "set max_queues" || 1661 $arg =~ /^sett (max_queues|guaranted_queues)$/){ print_msg(" 1662SET max_queues <val> 1663SETT max_queues <val> 1664SETT guaranted_queues <val> 1665 1666Those setting are responsibile for number of queues for 1667the trigger and for whole fserve. 1668 1669Algorithm used to compute number of free/max queues: 1670 1671Maximum queues := 1672 max( guaranted_queues, 1673 min(global max_queues, trigger max_queues) ) 1674 1675Free queues := 1676 max( guaranted_queues - number of trigger queues, 1677 min( global max_queues - number of all queues, 1678 trigger max_queues - number of queue queues ) ) 1679 1680In short: 1681a) the trigger has at least guaranted_queues queues 1682b) maximum number of queues is the smallest value of 1683 global and trigger max_queues, except for (a) 1684 1685See also: SET max_sends 1686 1687TODO: examples of usage 1688"); return; } 1689 1690 if ($arg eq "set max_sends" || 1691 $arg =~ /^sett (max_sends|guaranted_sends)$/){ print_msg(" 1692SET max_sends <val> 1693SETT max_sends <val> 1694SETT guaranted_sends <val> 1695 1696Those setting are responsibile for number of sends for 1697the trigger and for the whole fserve. 1698 1699Algorithm used to compute number of free/max sends: 1700 1701Maximum sends := 1702 max( guaranted_sends, 1703 min(global max_sends, trigger max_sends) ) 1704 1705Free sends := 1706 max( guaranted_sends - number of trigger sends, 1707 min( global max_sends - number of all sends, 1708 trigger max_sends - number of trigger sends ) ) 1709 1710In short: 1711a) the trigger has at least guaranted_sends sends 1712b) maximum number of sends is the smallest value of 1713 global and trigger max_sends, except for (a) 1714 1715See also: SET max_queues, SET min_upload 1716"); return; } 1717 1718 if ($arg eq "set max_users") { print_msg(" 1719SET max_users <number> 1720 1721Sets how many users can connect to the fserve. 1722"); return; } 1723 1724 if ($arg eq "set min_upload") { print_msg(" 1725SET min_upload <bps> 1726 1727Tries to make sure that sum of upload speeds 1728of all dcc sends is >= <bps>. If for 4 minutes 1729it's no it tries to send next file, even if 1730there is already max_sends sends. 1731"); return; } 1732 1733 if ($arg eq "set motd" or $arg eq "set motdfile" or 1734 $arg eq "sett motd") { print_msg(" 1735SET <motd> 1736SET <motd_file> 1737SETT <motd> 1738 1739Specifies messages that will be displayed in welcome message 1740after user connects to fserve. 1741The message can be read from file <motd_file>. 1742In <motd_file> you can use \$IRSSI and ~ that specify irssi's 1743home and your home directory. 1744"); return; } 1745 1746 if ($arg eq "set offline_message") { print_msg(" 1747SET offline_message <message> 1748 1749When fserve is offline and user tries to connect 1750to it using ctcp trigger fserve sends notice: 1751'Sorry, fserve is currently offline. <message>' 1752"); return; } 1753 1754 if ($arg eq "set queuefile") { print_msg(" 1755SET queuefile <file> 1756 1757Saves sends and queues to <file> 1758 1759You can use \$IRSSI and ~ that specify irssi's 1760home and your home directory. 1761"); return; } 1762 1763 if ($arg eq "set recache_interval") { print_msg(" 1764SET recache_interval <seconds> 1765 1766Every <seconds> does /fs recache. 1767"); return; } 1768 1769 if ($arg eq "sett channels") { print_msg(" 1770SETT channels <#channel1> [#channel2 ...] 1771 1772Space separated list of channels on which this 1773trigger will work. 1774 1775See also: SETT servers 1776"); return; } 1777 1778 if ($arg eq "sett content" or $arg eq "sett note") { print_msg(" 1779SETT content <content> 1780SETT note <note> 1781 1782Text that can be displayed in fserve ad. 1783 1784See also: SETT custom_notice 1785"); return; } 1786 1787 if ($arg eq "sett ctcp_only") { print_msg(" 1788SETT ctcp_only 0|1 1789 1790If set to 1 fserve will ignore triggers typed 1791on channels. It'll only respond to /ctcp. 1792 1793If set to 0 it will respond to both triggers typed 1794on channels and used in /ctcp. 1795"); return; } 1796 1797 if ($arg eq "sett custom_notice" || $arg eq "sett custom_notice_fields") { print_msg(" 1798SETT custom_notice 0|1 1799SETT custom_notice_fields <list of fields> 1800 1801Controls what will be included in fserver ad. 1802If custom_notice is 0 then everything is included. 1803If it's 1 then only fields specified in <list of fields> 1804will be included. 1805If it's 1 and custom_notice_fields is empty then fserve 1806doesn't show ad at all (but it still respond to trigger 1807etc.) 1808 1809Possibile fields: trigger, sends, queues, min_cps, online, 1810accessed, snagged, record, current_upstream, serving, 1811note, content 1812 1813Example: 1814/fs sett custom_notice_fields trigger note content 1815"); return; } 1816 1817 if ($arg eq "sett dont_notify") { print_msg(" 1818"); return; } 1819 if ($arg eq "sett find") { print_msg(" 1820"); return; } 1821 if ($arg eq "sett ignore_msg") { print_msg(" 1822"); return; } 1823 if ($arg eq "sett instant_send") { print_msg(" 1824"); return; } 1825 if ($arg eq "sett max_resends") { print_msg(" 1826"); return; } 1827 if ($arg eq "sett min_cps") { print_msg(" 1828"); return; } 1829 if ($arg eq "sett nice") { print_msg(" 1830"); return; } 1831 if ($arg eq "sett notify_interval") { print_msg(" 1832"); return; } 1833 1834 if ($arg eq "sett notify_on_join") { print_msg(" 1835SETT notify_on_join 0|1 1836 1837When on, users joining a served channel will 1838be sent an fserve notice. 1839"); return; } 1840 1841 if ($arg eq "sett queue_priority") { print_msg(" 1842"); return; } 1843 if ($arg eq "sett request") { print_msg(" 1844"); return; } 1845 if ($arg eq "sett restricted_level") { print_msg(" 1846"); return; } 1847 if ($arg eq "sett root_dir") { print_msg(" 1848"); return; } 1849 1850 if ($arg eq "sett servers") { print_msg(" 1851SETT servers <server_tag> [server_tag_2 ...] 1852 1853Space separated list of server tags on which this 1854trigger will work. 1855Please read tutorial on how to add server tags. 1856 1857See also SETT channels, tutorial 1858"); return; } 1859 1860 if ($arg eq "sett speed_warnings") { print_msg(" 1861"); return; } 1862 if ($arg eq "sett trigger") { print_msg(" 1863"); return; } 1864 1865 if ($arg eq "sett user_slots") { print_msg(" 1866SETT user_slots <number> 1867 1868Number of file user can queue (sometimes 1869files being sent counts as well - see 1870SET count_send_as_queue). 1871 1872See also: SET count_send_as_queue 1873"); return; } 1874 1875 if ($arg eq "tutorial") { 1876 print_msg(" 1877Setting up simple file server. 1878 1879After loading fserve you need to at least 1880- add first trigger with '/fs addt' 1881- set up 'root_dir', 'servers' and 'channels' 1882 For example: 1883 /fs sett root_dir /home/me/fs_root 1884 /fs sett servers aniv 1885 /fs sett channels #smurfs 1886 1887The 'aniv' is the name if irc network you'll be using. 1888You can add irc networks with '/ircnet add', for example: 1889/ircnet add aniv 1890and then 1891/server add -ircnet aniv irc.aniverse.com 1892 1893You can now enable the FServe with '/fs on'! 1894 1895Some other things you should know: 1896- you can list global and trigger-specific settings with 1897 '/fs set' and '/fs sett' 1898- you can add more triggers with '/fs addt' and choose default 1899 trigger with '/fs selt <number>' 1900- 'servers' and 'channels' can be a list of space separated 1901 values, for example '#smurfs #gumibears #wuzzles' 1902- '/fs help' has help for all FServe commands and settings 1903"); 1904 return; 1905 } 1906 1907 if ($arg eq "bugs") { print_msg(" 1908Limitations: 1909 1910There can be only one send per user on irc server, no matter 1911how many trigger there are. Maybe this should be changed to 19121 send/trigger or even be parametrized. Comments welcomme. 1913"); return; } 1914 1915 print_msg("No such help topic: $arg"); 1916} 1917 1918############################################################################## 1919# Handle an "/fs *" type command 1920############################################################################### 1921sub sig_fs_command 1922{ 1923 my ($cmd_line, $server, $win_item) = @_; 1924 my @args = split(' ', $cmd_line); 1925 1926 if (@args <= 0 || lc($args[0]) eq 'help') { 1927 shift @args; 1928 do_help(@args); 1929 return; 1930 } 1931 1932 # convert command to lowercase 1933 my $cmd = lc(shift(@args)); 1934 1935 if ($cmd eq 'on') { 1936 unless ($fs_enabled) { 1937 update_files(); 1938 $timer_tag = Irssi::timeout_add(1000, 'sig_timeout', 0); 1939 $fs_enabled = 1; 1940 } 1941 print_msg("Fileserver online!"); 1942 } elsif ($cmd eq 'off') { 1943 if ($fs_enabled) { 1944 $fs_enabled = 0; 1945 Irssi::timeout_remove($timer_tag); 1946 print_msg("Sends & Queue saved") 1947 if ($fs_prefs{autosave_on_close} && (!save_queue())); 1948 print_msg("Distro file saved") if ($fs_prefs{distro} and !save_distro()); 1949 } 1950 print_msg("Fileserver offline!"); 1951 } elsif ($cmd eq 'set' || $cmd eq 'sett') { 1952 my $hash; 1953 if ($cmd eq 'set') { 1954 $hash = \%fs_prefs; 1955 } else { 1956 $hash = $fs_queues[$default_queue]; 1957 } 1958 if (@args == 0) { 1959 my $msg = "[$fs_prefs{clr_hi}FServe Variables$fs_prefs{clr_txt}]"; 1960 if ($cmd eq 'sett') { 1961 $msg .= " for queue $default_queue"; 1962 } 1963 print_msg($msg); 1964 foreach (sort(keys %{$hash})) { 1965 if (/clr/) { 1966 print_msg("$_ $fs_prefs{clr_hi}=$fs_prefs{clr_txt} ". 1967 "$hash->{$_}COLOR"); 1968 } elsif ($cmd eq 'sett' && ($_ eq 'queue' || $_ eq 'cache' || 1969 $_ eq 'sends' || $_ eq 'filecount' || $_ eq 'bytecount')) { 1970 next; 1971 } else { 1972 print_msg("$_ $fs_prefs{clr_hi}=$fs_prefs{clr_txt} ". 1973 $hash->{$_}); 1974 } 1975 } 1976 print_msg("\003\n$fs_prefs{clr_txt}Ex: /fs set max_users 4"); 1977 } elsif (@args < 2) { 1978 print_msg("Error: usage /fs $cmd <var> <value>"); 1979 } elsif ($args[0] eq '-clear' && defined $hash->{$args[1]}) { 1980 print_msg("Clearing $args[1]"); 1981 $hash->{$args[1]} = ""; 1982 if ($args[1] eq 'log_name' && $logfp) { 1983 print_log("Closing log."); 1984 close($logfp); 1985 undef $logfp; 1986 } 1987 } elsif (defined $hash->{$args[0]}) { 1988 my $var = shift(@args); 1989 return if ($cmd eq 'sett' && ($var eq 'queue' || $var eq 'cache' || 1990 $var eq 'sends' || $var eq 'filecount' || $var eq 'bytecount')); 1991 $hash->{$var} = "@args"; 1992 if ($var =~ /^clr/) { 1993 print_msg("Setting: $var $fs_prefs{clr_hi}=$hash->{$var}COLOR"); 1994 } else { 1995 print_msg("Setting: $var $fs_prefs{clr_hi}=$fs_prefs{clr_txt} ". 1996 $hash->{$var}); 1997 } 1998 if ($var eq 'log_name') { 1999 if ($logfp) { 2000 print_log("Closing log."); 2001 close($logfp); 2002 undef $logfp; 2003 } 2004 print_log("Opening log."); 2005 } elsif ($var eq 'motdfile') { 2006 $motdfile_modified = 0; 2007 } 2008 } else { 2009 print_msg("Error: unknown variable ($args[0])"); 2010 } 2011 } elsif ($cmd eq 'save') { 2012 print_msg("Config file saved!") if (!save_config()); 2013 } elsif ($cmd eq 'load') { 2014 print_msg("Config file loaded!") if (!load_config()); 2015 } elsif ($cmd eq 'saveq') { 2016 print_msg("Sends & Queue saved!") if (!save_queue()); 2017 } elsif ($cmd eq 'loadq') { 2018 print_msg("Queue loaded!") if (!load_queue()); 2019 } elsif ($cmd eq 'who') { 2020 display_who('!fserve!'); 2021 } elsif ($cmd eq 'recache') { 2022 update_files(); 2023 } elsif ($cmd eq 'queue') { 2024 if (@args < 1) { 2025 display_queue('!fserve!', $default_queue); 2026 } elsif ($args[0] eq '*') { 2027 foreach (0 .. $#fs_queues) { 2028 display_queue('!fserve!', $_); 2029 } 2030 } elsif ($args[0] > $#fs_queues) { 2031 print_msg("Usage /fs queue [<queue>]"); 2032 } else { 2033 display_queue('!fserve!', $args[0]); 2034 } 2035 } elsif ($cmd eq 'sends') { 2036 display_sends('!fserve!'); 2037 } elsif ($cmd eq 'sortt') { 2038 if (@args < 1) { 2039 sort_queue($default_queue); 2040 } elsif ($args[0] > $#fs_queues) { 2041 print_msg("Usage /fs sortt [<queue>]"); 2042 } else { 2043 sort_queue($args[0]); 2044 } 2045 } elsif ($cmd eq 'stats') { 2046 display_stats('!fserve!'); 2047 foreach (0 .. $#fs_queues) { 2048 print_msg("Queue $_: ".scalar(@{$fs_queues[$_]->{queue}}).'/'. 2049 $fs_queues[$_]->{max_queues}." files"); 2050 } 2051 } elsif ($cmd eq 'insert') { 2052 if (@args < 3 || $args[0] > $#fs_queues) { 2053 print_msg("Usage /fs insert <queue> <nick> <file>"); 2054 return; 2055 } 2056 my $qn = shift(@args); 2057 my $nick_id = shift(@args); 2058 srv_queue_file($nick_id, "@args", $qn); 2059 } elsif ($cmd eq 'move') { 2060 if (@args < 2 || (@args > 2 && $args[0] > $#fs_queues)) { 2061 print_msg("Usage /fs move [<queue>] <from> <to>"); 2062 } elsif (@args == 2) { 2063 srv_move_slot($args[0], $args[1], $fs_queues[$default_queue]->{queue}); 2064 } else { 2065 srv_move_slot($args[1], $args[2], $fs_queues[$args[0]]->{queue}); 2066 } 2067 } elsif ($cmd eq 'clear') { 2068 if (@args < 1) { 2069 print_msg("Usage /fs clear <nick> | /fs clear -all"); 2070 return; 2071 } 2072 foreach (0 .. $#fs_queues) { 2073 if ($args[0] eq '-all') { 2074 my @nullqueue = (); 2075 $fs_queues[$_]->{queue} = [ @nullqueue ]; 2076 } else { 2077 clear_queue($args[0], 1, $_); 2078 } 2079 } 2080 } elsif ($cmd eq 'notify') { 2081 return unless ($fs_enabled); 2082 # TODO /fs notify #channel server 2083 # FIXME not working? 2084 foreach my $qn (0 .. $#fs_queues) { 2085 if (@args == 0) { 2086 foreach my $s (split(' ', $fs_queues[$qn]->{servers})) { 2087 my $server = Irssi::server_find_tag($s); 2088 next if (!$server || !$server->{connected}); 2089 foreach (split(' ', $fs_queues[$qn]->{channels})) { 2090 show_notice($server, $_, $qn); 2091 } 2092 } 2093 } else { 2094 foreach my $s (split(' ', $fs_queues[$qn]->{servers})) { 2095 my $server = Irssi::server_find_tag($s); 2096 next if (!$server || !$server->{connected}); 2097 foreach (@args) { 2098 show_notice($server, $_, $qn) 2099 if ($fs_queues[$qn]->{channels} =~ /.*$_.*/i); 2100 } 2101 } 2102 } 2103 } 2104 } elsif ($cmd eq 'distro') { 2105 if ($args[0] eq 'stats') { 2106 foreach (sort keys %fs_distro) { 2107 foreach my $size (sort keys %{$fs_distro{$_}}) { 2108 print_msg("$_ (".$size." B) $fs_distro{$_}{$size}"); 2109 } 2110 } 2111 } else { 2112 print_msg("Usage: /fs distro stats"); 2113 } 2114 } elsif ($cmd eq 'selt') { 2115 if (@args < 1 || $args[0] > $#fs_queues) { 2116 print_msg("Usage: /fs selt <queue>"); 2117 return; 2118 } 2119 $default_queue = $args[0]; 2120 print_msg("Selecting trigger: $default_queue"); 2121 } elsif ($cmd eq 'addt') { 2122 print_msg("Adding trigger: ".scalar(@fs_queues)); 2123 push (@fs_queues, { %fs_queue_defaults }); 2124 @{$fs_queues[$#fs_queues]->{queue}} = (); 2125 } elsif ($cmd eq 'delt') { 2126 if (@args < 1 || $args[0] > $#fs_queues) { 2127 print_msg("Usage: /fs delt <trigger_no>"); 2128 return; 2129 } elsif (@fs_queues < 2) { 2130 print_msg("You cannot remove last trigger!"); 2131 return; 2132 } 2133 my $qn = $args[0]; 2134 if ($fs_queues[$qn]->{sends}) { 2135 print_msg('There are on-going sends for this trigger,'); 2136 print_msg('please stop them first before removing the trigger.'); 2137 print_msg('(If you think fserve.pl should act differently'); 2138 print_msg('in this case please drop me a mail. Thanks)'); 2139 return; 2140 } 2141 splice (@fs_queues, $qn, 1); 2142 foreach (@fs_sends) { 2143 if ($_->{queue} > $qn) { 2144 $_->{queue}--; 2145 } 2146 } 2147 foreach ($qn .. $#fs_queues) { 2148 foreach my $q (@{$fs_queues[$_]->{queue}}) { 2149 $q->{queue}--; 2150 } 2151 } 2152 if ($default_queue >= $qn) { 2153 $default_queue--; 2154 } 2155 print_msg("Trigger $qn deleted"); 2156 } else { 2157 print_msg("Unrecognized command /fs $cmd"); 2158 } 2159} 2160 2161############################################################################### 2162############################################################################### 2163## 2164## Script subroutines 2165## 2166############################################################################### 2167############################################################################### 2168 2169############################################################################### 2170# initiate_dcc_chat($server, $nick, $qn): inits a dcc chat & sets some 2171# variables for $nick 2172############################################################################### 2173sub initiate_dcc_chat 2174{ 2175 my ($server, $nick, $qn) = @_; 2176 2177 print_debug("Initiating DCC CHAT to $nick for queue $qn"); 2178 2179 my %nickinfo = (); 2180 $nickinfo{status} = -1; 2181 $nickinfo{time} = 0; 2182 $nickinfo{ignore} = 0; 2183 $nickinfo{dir} = '/'; 2184 $nickinfo{queue} = $qn; 2185 $nickinfo{server} = $server->{tag}; 2186 2187 $fs_users{$nick."@".$server->{tag}} = { %nickinfo }; 2188 $server->command("DCC CHAT $nick"); 2189} 2190 2191############################################################################### 2192# show_notice($server, $dest, $qn): displays server notice to $dest 2193# ($dest = #channel or nick) 2194############################################################################### 2195sub show_notice 2196{ 2197 my ($server, $dest, $qn) = @_; 2198 my $queue = $fs_queues[$qn]; 2199 2200 foreach ($fs_queues[$qn]{dont_notify}) { 2201 return if ($_ eq $dest); 2202 } 2203 2204 my $msg = "\002(\002FServe Online\002)\002"; 2205 2206 my @fields_list = ("trigger", "sends", "queues", "min_cps", "online", 2207 "accessed", "snagged", "record", "current_upstream", "serving", 2208 "note", "content"); 2209 2210 if ($queue->{custom_notice}) { 2211 return if (!$queue->{custom_notice_fields}); # Don't send the ad 2212 @fields_list = split(' ', $queue->{custom_notice_fields}); 2213 } 2214 2215 foreach (@fields_list) { 2216 /trigger/ && do { 2217 $msg .= " Trigger:(/ctcp $$server{nick} $queue->{trigger})"; 2218 next; 2219 }; 2220 /sends/ && do { 2221 my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn); 2222 $msg .= " Sends:(".($max_sends-$free_sends)."/$max_sends)"; 2223 next; 2224 }; 2225 /queues/ && do { 2226 my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn); 2227 $msg .= " Queues:(".($max_queues-$free_queues)."/$max_queues)"; 2228 next; 2229 }; 2230 /min_cps/ && do { 2231 if ($queue->{min_cps}) { 2232 $msg .= ' Min CPS:('.size_to_str($queue->{min_cps}).'/s)'; 2233 } 2234 next; 2235 }; 2236 /online/ && do { 2237 $msg .= ' Online:('.(keys %fs_users)."/$fs_prefs{max_users})"; 2238 next; 2239 }; 2240 /accessed/ && do { 2241 $msg .= " Accessed:($fs_stats{login_count} times)"; 2242 next; 2243 }; 2244 /snagged/ && do { 2245 $msg .= ' Snagged:('.size_to_str($fs_stats{transfd}).' in '. 2246 ($fs_stats{sends_ok}+$fs_stats{sends_fail}).' files)'; 2247 next; 2248 }; 2249 /record/ && do { 2250 if ($fs_stats{record_cps}) { 2251 $msg .= ' Record CPS:('.size_to_str($fs_stats{record_cps}). 2252 '/s by '.$fs_stats{rcps_nick}.')'; 2253 } 2254 next; 2255 }; 2256 /current_upstream/ && do { 2257 my $curr_ups = 0; 2258 foreach my $dcc (Irssi::Irc::dccs()) { 2259 if ($dcc->{type} eq 'SEND') { 2260 $curr_ups += ($dcc->{transfd}-$dcc->{skipped})/ 2261 (time() - $dcc->{starttime} + 1); 2262 } 2263 } 2264 $msg .= ' Current Upstream:('.size_to_str($curr_ups).'/s)'; 2265 next; 2266 }; 2267 /serving/ && do { 2268 $msg .= ' Serving:('.size_to_str($queue->{bytecount}).' in '. 2269 "$queue->{filecount} files)"; 2270 next; 2271 }; 2272 /note/ && do { 2273 if (length($queue->{note})) { 2274 $msg .= " Note:($fs_prefs{clr_hi}$queue->{note}$fs_prefs{clr_txt})"; 2275 } 2276 next; 2277 }; 2278 /content/ && do { 2279 if (length($queue->{content})) { 2280 $msg .= " On FServe:($fs_prefs{clr_hi}$queue->{content}$fs_prefs{clr_txt})"; 2281 } 2282 next; 2283 }; 2284 print_debug("Unknown notice field: $_"); 2285 } 2286 2287 $msg =~ s/\(/\($fs_prefs{clr_hi}/g; 2288 $msg =~ s/\)/$fs_prefs{clr_txt}\)/g; 2289 2290 $msg .= " [FServe.pl $VERSION]"; 2291 2292 if ($dest =~ /^#/) { 2293 $server->command("MSG $dest $fs_prefs{clr_txt}$msg"); 2294 } else { 2295 $server->command("^NOTICE $dest $fs_prefs{clr_txt}$msg"); 2296 print_what_we_did("NOTICE $dest $fs_prefs{clr_txt}$msg"); 2297 } 2298} 2299 2300############################################################################### 2301# show_find($server, $who, $file, $qn): displays @find notice to $who 2302############################################################################### 2303sub show_find 2304{ 2305 my ($server, $who, $file, $qn) = @_; 2306 2307 $file =~ s/^\@find //i; 2308 $file = "\Q$file\E"; 2309 $file =~ s/([\\]?[* ])+/.*/g; 2310 2311 print_debug("requested find patter '$file' in queue $qn"); 2312 # prepare list 2313 my @founds = (); 2314 foreach my $dir (keys %{$fs_queues[$qn]->{cache}}) { 2315 my $files = $fs_queues[$qn]->{cache}{$dir}{files}; 2316 my $sizes = $fs_queues[$qn]->{cache}{$dir}{sizes}; 2317 2318 $dir =~ s/$/\//; 2319 $dir =~ s/^\/+//; 2320 foreach my $i (0 .. $#{$files}) { 2321 $_ = ${$files}[$i]; 2322# print_debug("Checking against '$_'"); 2323 if (/$file/i) { # hmm.. check Sysreset response... 2324# print_debug("This file matches!"); 2325 push (@founds, (scalar(@founds)+1).". File: (". 2326 $fs_prefs{clr_dir}.$dir.$_.$fs_prefs{clr_txt}.") Size:(". 2327 size_to_str(${$sizes}[$i]).")"); 2328 } 2329 } 2330 } 2331 2332 if (!@founds) { 2333 return; 2334 } 2335 2336 my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn); 2337 my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn); 2338 2339 my $message = "(\@Find Results) - [FServe.pl $VERSION]"; 2340 $server->command("^MSG $who $message"); 2341 print_what_we_did("MSG $who $message"); 2342 $message = "Found ".@founds." file(s) on trigger:(".$fs_prefs{clr_hi}. 2343 "/ctcp $server->{nick} $fs_queues[$qn]->{trigger}".$fs_prefs{clr_txt}. 2344 ") Sends:(".($max_sends-$free_sends)."/$max_sends)". 2345 " Queues:(".($max_queues-$free_queues)."/$max_queues)"; 2346 $server->command("^MSG $who $message"); 2347 print_what_we_did("MSG $who $message"); 2348 2349 foreach (0 .. $#founds) { 2350 last if ($_ >= $fs_queues[$qn]->{find}); 2351 $server->command("^MSG $who $founds[$_]"); 2352 print_what_we_did("MSG $who $founds[$_]"); 2353 } 2354 if (@founds > $fs_queues[$qn]->{find}) { 2355 $server->command("^MSG $who Too many results to display!"); 2356 print_what_we_did("MSG $who Too many results to display!"); 2357 } else { 2358 $server->command("^MSG $who End of \@Find."); 2359 print_what_we_did("MSG $who End of \@Find."); 2360 } 2361} 2362 2363############################################################################### 2364# change_dir($nick, $dir): changes directory for $nick 2365############################################################################### 2366sub change_dir 2367{ 2368 my ($nick, $dir) = @_; 2369 my ($irc_nick, $server_tag) = split('@', $nick); 2370 my $qn = $fs_users{$nick}{queue}; 2371 2372 $dir =~ s/\x03//g; # remove colors if any 2373 my @dir_fields = (); 2374 unless (substr($dir, 0, 1) eq '/') { 2375 @dir_fields = split('/', $fs_users{$nick}{dir}); 2376 } 2377 2378 foreach (split('/', $dir)) { 2379 next if ($_ eq '.'); 2380 if ($_ eq '..') { 2381 pop(@dir_fields); 2382 } else { 2383 push(@dir_fields, $_); 2384 } 2385 } 2386 2387 my $new_dir = '/'.join('/', @dir_fields); 2388 $new_dir =~ s/\/+/\//g; # remove excessive '/' 2389 2390 if (defined $fs_queues[$qn]->{cache}{$new_dir}) { 2391 $fs_users{$nick}{dir} = $new_dir; 2392 send_user_msg($server_tag, $irc_nick, 2393 "[$fs_prefs{clr_hi}$new_dir$fs_prefs{clr_txt}]"); 2394 } else { 2395 send_user_msg($server_tag, $irc_nick, 2396 "[$fs_prefs{clr_hi}$new_dir$fs_prefs{clr_txt}] doesn't exist!"); 2397 } 2398} 2399 2400############################################################################### 2401# list_dir($nick): list contents of current directory for $nick 2402############################################################################### 2403sub list_dir 2404{ 2405 my ($nick) = @_; 2406 my ($irc_nick, $server_tag) = split('@', $nick); 2407 my $qn = $fs_users{$nick}{queue}; 2408 my $dir = $fs_queues[$qn]->{cache}{$fs_users{$nick}{dir}}; 2409 my @filelist = (); 2410 2411 $_ = $fs_users{$nick}{dir}; 2412 s/\/+$//; 2413 send_user_msg($server_tag, $irc_nick, 2414 "Listing [$fs_prefs{clr_hi}$_/*.*$fs_prefs{clr_txt}]"); 2415 2416 # print the directories sorted 2417 send_user_msg($server_tag, $irc_nick, $fs_prefs{clr_dir}."..") 2418 if ($fs_users{$nick}{dir} ne "/"); 2419 send_user_msg($server_tag, $irc_nick, 2420 $fs_prefs{clr_dir}.$_.$fs_prefs{clr_txt}.'/') 2421 foreach (sort(@{${$dir}{dirs}})); 2422 2423 # prepare filelist 2424 foreach (0 .. $#{${$dir}{files}}) { 2425 push(@filelist, ${$dir}{files}[$_]." ". 2426 size_to_str(${$dir}{sizes}[$_])); 2427 } 2428 2429 # print the files sorted 2430 send_user_msg($server_tag, $irc_nick, $fs_prefs{clr_file}.$_) 2431 foreach(sort(@filelist)); 2432 send_user_msg($server_tag, $irc_nick, 2433 "End [$fs_prefs{clr_hi}$fs_users{$nick}{dir}$fs_prefs{clr_txt}]"); 2434} 2435 2436############################################################################### 2437# srv_queue_file($nick_id, $file, $qn): queues to queue $qn file for $nick_id, 2438# server use only 2439# (no max_queue and/or duplicate check) 2440############################################################################### 2441sub srv_queue_file 2442{ 2443 my ($nick_id, $path, $qn) = @_; 2444 my ($nick, $server_tag) = split('@', $nick_id); 2445 $path =~ s/~/$ENV{"HOME"}/; 2446 2447 unless (-e $path || -f $path) { 2448 print_msg("Invalid file: '$path'"); 2449 return; 2450 } 2451 2452 my $size = (stat($path))[7]; 2453 $path =~ /(.*)\/(.*)/; 2454 $path = $1; 2455 my $file = $2; 2456 2457 push(@{$fs_queues[$qn]->{queue}}, { queue => $qn, nick => $nick, 2458 file => $file, size => $size, 2459 dir => $path, resends => 0, warns => 0, server_tag => $server_tag }); 2460 2461 print_msg($fs_prefs{clr_hi}.'#'.@{$fs_queues[$qn]->{queue}}. 2462 $fs_prefs{clr_txt}.": Queuing '$fs_prefs{clr_hi}$file". 2463 "$fs_prefs{clr_txt}' for $fs_prefs{clr_hi}$nick". 2464 "$fs_prefs{clr_txt} ($server_tag) in queue ". 2465 "$fs_prefs{clr_hi}$qn$fs_prefs{clr_txt}!"); 2466} 2467 2468############################################################################### 2469# srv_move_slot($slot, $dest, [ @queue ]): moves queue slots around 2470############################################################################### 2471sub srv_move_slot 2472{ 2473 my ($slot, $dest, $fsq) = @_; 2474 2475 $slot--; 2476 $dest--; 2477 2478 unless (defined ${$fsq}[$slot] || defined ${$fsq}[$dest]) { 2479 print_msg("Error: Invalid slot numbers!"); 2480 return; 2481 } 2482 print_debug("srv_move_slot: Will move $slot to $dest"); 2483 2484 my %rec = %{${$fsq}[$slot]}; 2485 splice(@{$fsq}, $slot, 1); 2486 splice(@{$fsq}, $dest, 0, { %rec }); 2487 2488 print_msg("Moved slot $fs_prefs{clr_hi}#".($slot+1).$fs_prefs{clr_txt}. 2489 " to $fs_prefs{clr_hi}#".($dest+1)); 2490} 2491 2492############################################################################### 2493# get_user_flag($server, $nick,$qn): returns highest user flag 2494# (normal/voice/halfop/op) among all channels from fs_queues[$qn]->{channels} 2495############################################################################### 2496sub get_user_flag { 2497 my ($server,$nick,$qn) = @_; 2498 2499 my $bestflag = "normal"; 2500 foreach my $channelName (split(' ', $fs_queues[$qn]->{channels})) { 2501 my $channel = $server->channel_find($channelName); 2502 next if !$channel; 2503 my $n = $channel->nick_find($nick); 2504 next if !$n; 2505 if ($n->{op}) { 2506 return "op"; 2507 } elsif ($n->{halfop}) { 2508 $bestflag = "halfop"; 2509 } elsif ($n->{voice} and $bestflag ne "halfop") { 2510 $bestflag = "voice"; 2511 } 2512 # max 4 categories - see sort_queue() also 2513 } 2514 return $bestflag; 2515} 2516 2517############################################################################### 2518# sort_queue($qn): sorts queue according to queue_priority 2519# returns where was moved last position 2520############################################################################### 2521 # queue_priority format: 2522 # group1 group2 ... groupN 2523 # where groupX is one of: others, normal, voice, halfop, op 2524 # for example: 2525 # normal voice others 2526 # means that first in queue are "normal" people, then people who are +v, 2527 # and then the rest - ops and halfops 2528 # 2529 # When some server is disconnected then all people on this server are 2530 # sorted last in the queue. 2531sub sort_queue { 2532 my ($qn) = @_; 2533 2534 print_debug ("sort_queue: $qn"); 2535 return ($#{$fs_queues[$qn]->{queue}}) 2536 if (!$fs_queues[$qn]->{queue_priority}); 2537 2538 my %prio; 2539 my $n = 1; # highest priority is 0 - resended queue 2540 foreach (split (/ +/, $fs_queues[$qn]->{queue_priority})) { 2541 if (/others/) { 2542 foreach my $type ("normal", "voice", "halfop", "op") { 2543 if (not exists $prio{$type}) { 2544 $prio{$type} = $n; 2545 } 2546 } 2547 } else { 2548 $prio{$_} = $n; 2549 } 2550 $n++; 2551 } 2552 # in case there is no 'others' in queue_priority we assume it's last 2553 foreach my $type ("normal", "voice", "halfop", "op") { 2554 if (not exists $prio{$type}) { 2555 $prio{$type} = $n; 2556 } 2557 } 2558 my $max_prio = $n; 2559 2560 my @uprio = (0, 0, 0, 0, 0); # assume max 4 categories + resends :) 2561 my $fsq = $fs_queues[$qn]->{queue}; 2562 my $dmsg = 'Sorting...'; 2563 # now do sorting 2564 foreach (0 .. $#{$fsq}) { 2565 if (${$fsq}[$_]->{resends}) { 2566 $n = 0; 2567 } else { 2568 my $server = Irssi::server_find_tag(${$fsq}[$_]->{server_tag}); 2569 if (!$server || !$server->{connected}) { 2570 $n = $max_prio; 2571 } else { 2572 $n = $prio{get_user_flag($server, ${$fsq}[$_]->{nick}, $qn)}; 2573 } 2574 } 2575 2576 # re-sort these positions 0 .. $_ 2577 splice(@{$fsq}, $uprio[$n], 0, splice(@{$fsq}, $_, 1)) 2578 if ($uprio[$n] != $_); 2579 2580 $dmsg .= " $_:$uprio[$n]"; 2581 # update @uprio 2582 $uprio[$_]++ foreach ($n .. $#uprio); 2583 } 2584 print_debug($dmsg); 2585 2586 # $n now has prio for last moved position 2587 return $uprio[$n]-1; 2588} 2589 2590############################################################################### 2591# queue_file($nick, $file): queues $file for $nick. 2592############################################################################### 2593sub queue_file 2594{ 2595 my ($nick, $ufile) = @_; 2596 $ufile =~ s/\s+$//; 2597 my $qn = $fs_users{$nick}{queue}; 2598 my ($file, $size); 2599 my ($irc_nick, $server_tag) = split('@', $nick); 2600 2601 print_debug("queue_file: '$ufile' for $nick in queue $qn"); 2602 # try to find the filename in cache 2603 my $files = $fs_queues[$qn]->{cache}{$fs_users{$nick}{dir}}{files}; 2604 my $sizes = $fs_queues[$qn]->{cache}{$fs_users{$nick}{dir}}{sizes}; 2605 2606 my $fsq = $fs_queues[$qn]->{queue}; 2607 2608 foreach (0 .. $#{$files}) { 2609 if (uc(${$files}[$_]) eq uc($ufile)) { 2610 $file = ${$files}[$_]; 2611 $size = ${$sizes}[$_]; 2612 last; 2613 } 2614 } 2615 2616 unless (defined $file) { 2617 send_user_msg($server_tag, $irc_nick, 2618 "Invalid filename: '$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!"); 2619 return; 2620 } 2621 2622 my $server = Irssi::server_find_tag($server_tag); 2623 if (!$server || !$server->{connected}) { 2624 print_msg("Error: this should never happen!!! #002"); 2625 return; 2626 } 2627 2628 if ($size <= $fs_queues[$qn]{instant_send}) { 2629 my $sfile = $fs_queues[$qn]->{root_dir}.$fs_users{$nick}{dir}.'/'.$file; 2630 $sfile =~ s/\/+/\//g; 2631 if (-e $sfile && -f $sfile) { 2632 send_user_msg($server_tag, $irc_nick, 2633 "Sending '$fs_prefs{clr_hi}$file$fs_prefs{clr_txt}'"); 2634 $sfile =~ s/'/\\'/g; 2635 $server->command("DCC SEND $irc_nick $FD$sfile$FD"); 2636 return; 2637 } 2638 } 2639 2640 my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn); 2641 my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn); 2642 2643 if (count_user_files($server_tag, $irc_nick, $qn) >= 2644 $fs_queues[$qn]->{user_slots}) { 2645 send_user_msg($server_tag, $irc_nick, 2646 "No sends are available and you have ". 2647 "used all your queue slots ($fs_prefs{clr_hi}". 2648 "$fs_queues[$qn]->{user_slots}$fs_prefs{clr_txt})"); 2649 return; 2650 } elsif ($free_queues <= 0) { 2651 send_user_msg($server_tag, $irc_nick, 2652 "No send or queue slots are available!"); 2653 return; 2654 } else { 2655 foreach (0 .. $#{$fsq}) { 2656 if (${$fsq}[$_]->{nick} eq $irc_nick && 2657 ${$fsq}[$_]->{file} eq $file && 2658 ${$fsq}[$_]->{server_tag} eq $server_tag) { 2659 send_user_msg($server_tag, $irc_nick, 2660 "You have already queued '". 2661 "$fs_prefs{clr_hi}$file$fs_prefs{clr_txt}'". 2662 " in slot #$fs_prefs{clr_hi}".($_+1). 2663 "$fs_prefs{clr_txt}!"); 2664 return; 2665 } 2666 } 2667 } 2668 2669 push(@{$fsq}, { queue => $qn, nick => $irc_nick, file => $file, 2670 size => $size, dir => $fs_queues[$qn]->{root_dir}.$fs_users{$nick}{dir}, 2671 resends => 0, warns => 0, server_tag => $server_tag }); 2672 2673 my $place = sort_queue($qn); 2674 print_debug("queue_file: queued on place $place"); 2675 2676 send_user_msg($server_tag, $irc_nick, 2677 "Queued '$fs_prefs{clr_hi}$file$fs_prefs{clr_txt}". 2678 "' (".$fs_prefs{clr_hi}.size_to_str($size). 2679 $fs_prefs{clr_txt}.") in slot ".$fs_prefs{clr_hi}.'#'. 2680 ($place+1) .$fs_prefs{clr_txt}); 2681} 2682 2683############################################################################### 2684# dequeue_file($nick, $slot): dequeues file in slot $slot for $nick 2685############################################################################### 2686sub dequeue_file 2687{ 2688 my ($nick, $slot) = @_; 2689 my ($irc_nick, $server_tag) = split('@', $nick); 2690 my $fsq = $fs_queues[$fs_users{$nick}{queue}]->{queue}; 2691 2692 $slot -= 1; 2693 if (defined ${$fsq}[$slot]) { 2694 if (${$fsq}[$slot]->{nick} eq $irc_nick && 2695 ${$fsq}[$slot]->{server_tag} eq $server_tag) { 2696 my $filename = ${$fsq}[$slot]{file}; 2697 splice(@{$fsq}, $slot, 1); 2698 send_user_msg($server_tag, $irc_nick, "Removing '$fs_prefs{clr_hi}". 2699 "$filename$fs_prefs{clr_txt}', you now have $fs_prefs{clr_hi}". 2700 count_queued_files($server_tag, $irc_nick,$fs_users{$nick}{queue}). 2701 "$fs_prefs{clr_txt} file(s) queued!"); 2702 } else { 2703 send_user_msg($server_tag, $irc_nick, 2704 "You can't dequeue other peoples files!!!"); 2705 } 2706 } else { 2707 send_user_msg($server_tag, $irc_nick, 2708 "Queue slot $fs_prefs{clr_hi}#".($slot+1). 2709 $fs_prefs{clr_txt}." doesn't exist!"); 2710 } 2711} 2712 2713############################################################################### 2714# clear_queue($nick, $is_server, $qn): clears all queued files for $nick 2715############################################################################### 2716sub clear_queue 2717{ 2718 my ($nick, $is_server, $qn) = @_; 2719 my ($irc_nick, $server_tag) = split('@', $nick); 2720 my $fsq = $fs_queues[$qn]->{queue}; 2721 my $count = 0; 2722 2723 if (count_queued_files($server_tag, $irc_nick, $qn) == 0) { 2724 if ($is_server) { 2725 print_msg("$fs_prefs{clr_hi}$nick$fs_prefs{clr_txt} doesn't ". 2726 "have any files queued!"); 2727 } else { 2728 send_user_msg($server_tag, $irc_nick, "You don't have any queued files!"); 2729 } 2730 } else { 2731 for (my $i = $#{$fsq}; $i >= 0; $i--) { 2732 if (${$fsq}[$i]->{nick} eq $irc_nick && 2733 ${$fsq}[$i]->{server_tag} eq $server_tag) { 2734 splice(@{$fsq}, $i, 1); 2735 $count++; 2736 } 2737 } 2738 2739 $irc_nick = '!fserve!' if ($is_server); 2740 send_user_msg($server_tag, $irc_nick, 2741 "Successfully dequeued $fs_prefs{clr_hi}". 2742 "$count$fs_prefs{clr_txt} file(s)!"); 2743 } 2744} 2745 2746############################################################################### 2747# display_queue($nick, $qn): displays queue to $nick 2748############################################################################### 2749sub display_queue 2750{ 2751 my ($nick, $qn) = @_; 2752 my ($irc_nick, $server_tag) = split('@', $nick); 2753 my $queue = $fs_queues[$qn]; 2754 my $fsq = $queue->{queue}; 2755 my $m_server = (split(' ', $queue->{servers}) > 1); 2756 2757 my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn); 2758 if ($nick eq '!fserve!') { 2759 send_user_msg($server_tag, $irc_nick, 2760 "$curr_queues/$free_queues/$max_queues Current/Free/Max queues ". 2761 "for trigger #".$qn.":"); 2762 } else { 2763 send_user_msg($server_tag, $irc_nick, 2764 $fs_prefs{clr_hi}.$curr_queues.$fs_prefs{clr_txt}."/". 2765 $fs_prefs{clr_hi}.$max_queues.$fs_prefs{clr_txt}. 2766 " file(s) queued for this trigger. ".$fs_prefs{clr_hi}. 2767 $free_queues.$fs_prefs{clr_txt}." free slot(s) left."); 2768 } 2769 2770 foreach (0 .. $#{$fsq}) { 2771 my $msg = " $fs_prefs{clr_hi}#".($_+1)."$fs_prefs{clr_txt}". 2772 ": $fs_prefs{clr_hi}${$fsq}[$_]->{nick}$fs_prefs{clr_txt}". 2773 ($m_server?" (${$fsq}[$_]->{server_tag})":""). 2774 " queued $fs_prefs{clr_hi}${$fsq}[$_]->{file}$fs_prefs{clr_txt}". 2775 " (".$fs_prefs{clr_hi}.size_to_str(${$fsq}[$_]->{size}). 2776 $fs_prefs{clr_txt}.")"; 2777 if (${$fsq}[$_]->{resends}) { 2778 $msg .= " (Resend #".${$fsq}[$_]->{resends}.")"; 2779 } 2780 send_user_msg($server_tag, $irc_nick, $msg); 2781 } 2782} 2783 2784############################################################################### 2785# display_who($user_id): shows users connected to $user_id 2786############################################################################### 2787sub display_who 2788{ 2789 my ($user_id) = @_; 2790 my ($nick, $server_tag) = split('@', $user_id); 2791 2792 send_user_msg($server_tag, $nick, $fs_prefs{clr_hi}.keys(%fs_users). 2793 $fs_prefs{clr_txt}.' user(s) online!'); 2794 2795 foreach (keys(%fs_users)) { 2796 my ($n, $s_tag) = split('@', $_); 2797 if ($fs_users{$_}{status} == -1) { 2798 send_user_msg($server_tag, $nick, 2799 " $fs_prefs{clr_hi}$n$fs_prefs{clr_txt} ($s_tag):". 2800 " connecting..."); 2801 } else { 2802 send_user_msg($server_tag, $nick, 2803 " $fs_prefs{clr_hi}$n$fs_prefs{clr_txt} ($s_tag):". 2804 " online $fs_prefs{clr_hi}$fs_users{$_}{time}s". 2805 "$fs_prefs{clr_txt} idle: $fs_prefs{clr_hi}". 2806 "$fs_users{$_}{status}s"); 2807 } 2808 } 2809} 2810 2811############################################################################### 2812# display_sends($nick): shows active sends to $nick 2813############################################################################### 2814sub display_sends 2815{ 2816 my ($nick) = @_; 2817 my ($irc_nick, $server_tag) = split('@', $nick); 2818 my $guaranted_sends; 2819 my $qtext = ""; 2820 my $qn = -1; 2821 2822 if (defined $fs_users{$nick}) { 2823 $qn = $fs_users{$nick}{queue}; 2824 } 2825 2826 2827 if ($qn != -1) { # user - show only this queue sends 2828 my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn); 2829 send_user_msg($server_tag, $irc_nick, 2830 "Sending $fs_prefs{clr_hi}".$curr_sends.'/'. 2831 $max_sends.$fs_prefs{clr_txt}." file(s) for this trigger. ". 2832 $fs_prefs{clr_hi}.$free_sends.$fs_prefs{clr_txt}." free sends left."); 2833 } else { # me - show all sends 2834 send_user_msg($server_tag, $irc_nick, 2835 "Sending $fs_prefs{clr_hi}".@fs_sends.'/'. 2836 $fs_prefs{max_sends}.$fs_prefs{clr_txt}." file(s)!"); 2837 } 2838 2839 foreach my $dcc (Irssi::Irc::dccs()) { 2840 next if ($dcc->{type} ne 'SEND'); 2841 2842 foreach (0 .. $#fs_sends) { 2843 next if ($dcc->{nick} ne $fs_sends[$_]{nick} || 2844 $dcc->{arg} ne $fs_sends[$_]{file} || 2845 $dcc->{servertag} ne $fs_sends[$_]{server_tag}); 2846 2847 if ($qn < 0) { 2848 $qtext = " for queue #".$fs_sends[$_]->{queue}; 2849 } else { 2850 last if ($fs_sends[$_]->{queue} != $qn); 2851 } 2852 2853 if ($dcc->{starttime} == 0 || 2854 ($dcc->{transfd}-$dcc->{skipped}) == 0) { 2855 send_user_msg($server_tag, $irc_nick, 2856 " $fs_prefs{clr_hi}#".($_+1). 2857 "$fs_prefs{clr_txt}: Waiting for ". 2858 $fs_prefs{clr_hi}.$dcc->{nick}.$fs_prefs{clr_txt}. 2859 " ($dcc->{servertag}) to accept $fs_prefs{clr_hi}". 2860 "$dcc->{arg}". 2861 $fs_prefs{clr_txt}." (".$fs_prefs{clr_hi}. 2862 size_to_str($fs_sends[$_]->{size}). 2863 $fs_prefs{clr_txt}.")".$qtext); 2864 last; 2865 } 2866 2867 my $perc = sprintf("%.1f%%", ($dcc->{transfd}/$dcc->{size})*100); 2868 my $speed = ($dcc->{transfd}-$dcc->{skipped})/(time() - $dcc->{starttime} + 1); 2869 my $left = ($dcc->{size} - $dcc->{transfd}) / $speed; 2870 send_user_msg($server_tag, $irc_nick, 2871 " $fs_prefs{clr_hi}#".($_+1)."$fs_prefs{clr_txt}:". 2872 " $fs_prefs{clr_hi}$dcc->{nick}$fs_prefs{clr_txt} ". 2873 "($dcc->{servertag}) has ". 2874 $fs_prefs{clr_hi}.$perc.$fs_prefs{clr_txt}. 2875 " of '$fs_prefs{clr_hi}$dcc->{arg}$fs_prefs{clr_txt}'". 2876 " at ".$fs_prefs{clr_hi}.size_to_str($speed)."/s". 2877 $fs_prefs{clr_txt}." (".$fs_prefs{clr_hi}. 2878 time_to_str($left).$fs_prefs{clr_txt}." left)". 2879 $qtext); 2880 last; 2881 } 2882 } 2883 2884} 2885 2886############################################################################### 2887# display_stats($nick): displays server statistics to $nick 2888############################################################################### 2889sub display_stats 2890{ 2891 my ($nick) = @_; 2892 my ($irc_nick, $server_tag) = split('@', $nick); 2893 2894 send_user_msg($server_tag, $irc_nick, "-=[ Server Statistics ]=-"); 2895 send_user_msg($server_tag, $irc_nick, " Online for ".$fs_prefs{clr_hi}.time_to_str($online_time)); 2896 send_user_msg($server_tag, $irc_nick, " Access Count: ".$fs_prefs{clr_hi}.$fs_stats{login_count}); 2897 send_user_msg($server_tag, $irc_nick, " "); 2898 send_user_msg($server_tag, $irc_nick, " Successful Sends: ".$fs_prefs{clr_hi}.$fs_stats{sends_ok}); 2899 send_user_msg($server_tag, $irc_nick, " Bytes Transferred: ".$fs_prefs{clr_hi}.size_to_str($fs_stats{transfd})); 2900 send_user_msg($server_tag, $irc_nick, " Failed Sends: ".$fs_prefs{clr_hi}.$fs_stats{sends_fail}); 2901 send_user_msg($server_tag, $irc_nick, " Record CPS: ".$fs_prefs{clr_hi}.size_to_str($fs_stats{record_cps})."/s"); 2902} 2903 2904############################################################################### 2905## Shows a small file to the user 2906############################################################################### 2907sub display_file ($$) { 2908 my ($nick, $ufile) = @_; 2909 my ($irc_nick, $server_tag) = split('@', $nick); 2910 my $queue = $fs_queues[$fs_users{$nick}{queue}]; 2911 my ($file, $size, $dir, $filepath); 2912 2913 # try to find the filename in cache 2914 my $files = $queue->{cache}{$fs_users{$nick}{dir}}{files}; 2915 my $sizes = $queue->{cache}{$fs_users{$nick}{dir}}{sizes}; 2916 2917 foreach (0 .. $#{$files}) { 2918 if (uc(${$files}[$_]) eq uc($ufile)) { 2919 $file = ${$files}[$_]; 2920 $size = ${$sizes}[$_]; 2921 last; 2922 } 2923 } 2924 2925 $dir = $queue->{root_dir} . $fs_users{$nick}{dir}; 2926 $filepath = "$dir" . "/" . "$ufile"; 2927 2928 unless (defined $file) { 2929 send_user_msg($server_tag, $irc_nick, "Invalid filename: " . 2930 "'$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!"); 2931 return; 2932 } 2933 2934 if ($size > 30000) { 2935 send_user_msg($server_tag, $irc_nick, "File too large: " . 2936 "'$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!"); 2937 return; 2938 } 2939 2940 unless (open (RFILE, "<", $filepath)) { 2941 send_user_msg($server_tag, $irc_nick, "Couldn't open file: " . 2942 "'$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!"); 2943 print_msg("Could not open file $filepath"); 2944 return; 2945 } 2946 2947 while (my $line = <RFILE>) { 2948 chomp $line; 2949 send_user_msg($server_tag, $irc_nick, $line); 2950 } 2951 2952 unless (close (RFILE)) { 2953 print_debug("Couldn't close file: $filepath"); 2954 return; 2955 } 2956 2957 return 1; 2958} 2959 2960############################################################################### 2961# send_next_file(): send a file from not forced queues 2962############################################################################### 2963sub send_next_file 2964{ 2965 my ($ignore_free_sends) = @_; 2966 2967 # first step: reorder queues 2968 my @que_numb = (0 .. $#fs_queues); 2969 splice (@que_numb, 0, 0, (splice(@que_numb, $next_queue))); 2970 2971 # First use queues with lowest 'nice', then queues with least sends. 2972 my @min_queue = sort { 2973 $fs_queues[$a]->{nice} <=> $fs_queues[$b]->{nice} or 2974 $fs_queues[$a]->{sends} <=> $fs_queues[$b]->{sends} 2975 } @que_numb; 2976 2977 # step 2b: select a queue 2978 foreach my $i (@min_queue) { 2979 my $free_sends = (get_max_sends($i))[1]; 2980 next if ($free_sends == 0 and !$ignore_free_sends); 2981 2982 2983 if (!run_queue($fs_queues[$i])) { 2984 $next_queue++; 2985 $next_queue = 0 if ($next_queue >= scalar(@fs_queues)); 2986 print_debug("send_next_file(): next queue will be $next_queue"); 2987 return 0; 2988 } 2989 } 2990 return 1; 2991} 2992 2993############################################################################### 2994# run_queue($queue): try to send the next file in $queue 2995############################################################################### 2996sub run_queue 2997{ 2998 my ($queue) = @_; 2999 my %entry = (); 3000 my ($next, $nextcount, $nextfile) = (-1); 3001 3002 # step through the queue 3003 for (my $i = 0; $i < @{$queue->{queue}}; ) { 3004 %entry = %{ ${$queue->{queue}}[$i] }; 3005 my $server = Irssi::server_find_tag($entry{server_tag}); 3006 if (!$server || !$server->{connected}) { 3007 $i++; 3008 next; 3009 } 3010 3011 my $in_channel = user_in_channel($server, $entry{nick}, $queue); 3012 my $send_active = send_active_for($entry{server_tag}, $entry{nick}); 3013 my $file = $entry{dir}.'/'.$entry{file}; 3014 $file =~ s/\/+/\//g; 3015 3016 # rand() returns [0,1) so if distro is == 0 this is always false, 3017 # and if distro == 1 this is allways true 3018 my $use_distro = (rand() < $fs_prefs{distro}) ? 1 : 0; 3019 3020 # send file if user in channel and has no sends active 3021 if (!$send_active && $in_channel && -e $file && -f $file) { 3022 if (!$use_distro) { 3023 $next = $i; 3024 $nextfile = $file; 3025 last; 3026 } 3027 my $count = $fs_distro{$entry{file}}{$entry{size}}; 3028 if ($next < 0 or $nextcount > $count) { 3029 $next = $i; 3030 $nextcount = $count; 3031 $nextfile = $file; 3032 } 3033 $i++; 3034 next; 3035 } 3036 3037 # remove entry if user wasn't in channel of file didn't exist 3038 if (!$send_active) { 3039 Irssi::print("User $fs_prefs{clr_hi}$entry{nick} ". 3040 "$fs_prefs{clr_txt} not in channel or file doesn't exists,". 3041 " removing $entry{file}". 3042 $fs_prefs{clr_txt}." from queue..."); 3043 splice(@{$queue->{queue}}, $i, 1); 3044 # next slot will have same index 3045 } else { 3046 $i++; 3047 } 3048 } 3049 3050 return 1 if ($next == -1); 3051 3052 %entry = %{ ${$queue->{queue}}[$next] }; 3053 my $server = Irssi::server_find_tag($entry{server_tag}); 3054 $server->command("^NOTICE $entry{nick} ".$fs_prefs{clr_txt}. 3055 "Sending you your queued file (".$fs_prefs{clr_hi}. 3056 size_to_str($entry{size}).$fs_prefs{clr_txt}.")"); 3057 print_what_we_did("NOTICE $entry{nick} ".$fs_prefs{clr_txt}. 3058 "Sending you your queued file (".$fs_prefs{clr_hi}. 3059 size_to_str($entry{size}).$fs_prefs{clr_txt}.")"); 3060 $nextfile =~ s/'/\\'/g; 3061 $server->command("DCC SEND $entry{nick} $FD$nextfile$FD"); 3062 push(@fs_sends, { %entry }); 3063 splice(@{$queue->{queue}}, $next, 1); 3064 return 0; 3065} 3066 3067############################################################################### 3068# update_files(): update the cache from $fs_prefs{root_dir} 3069############################################################################### 3070sub update_files 3071{ 3072 my $filecount; 3073 my $bytecount; 3074 3075 print_msg("Caching files, please wait!"); 3076 # update the cache 3077 foreach my $qn (0 .. $#fs_queues) { 3078 delete $fs_queues[$qn]->{cache}; 3079 cache_dir($fs_queues[$qn]->{root_dir},$fs_queues[$qn]); 3080 3081 $filecount = 0; 3082 $bytecount = 0; 3083 foreach my $dir (keys %{$fs_queues[$qn]->{cache}}) { 3084 $filecount += @{$fs_queues[$qn]->{cache}{$dir}{files}}; 3085 $bytecount += $_ foreach (@{$fs_queues[$qn]->{cache}{$dir}{sizes}}); 3086 } 3087 3088 $fs_queues[$qn]->{filecount} = $filecount; 3089 $fs_queues[$qn]->{bytecount} = $bytecount; 3090 3091 print_msg("Queue $qn: cached $filecount file(s) (".size_to_str($bytecount).") in ". 3092 (keys(%{$fs_queues[$qn]->{cache}}))." dir(s)!"); 3093 } 3094} 3095 3096############################################################################### 3097# cache_dir($dir): recursive filecaching subroutine 3098############################################################################### 3099sub cache_dir 3100{ 3101 my ($dir, $queue) = @_; 3102 my @dirs = (); 3103 my @files = (); 3104 my @sizes = (); 3105 3106 opendir($dir, "$dir"); 3107 while (my $entry = readdir($dir)) { 3108 if (!($entry eq '.') && !($entry eq '..')) { 3109 my $full_path = $dir.'/'.$entry; 3110 if (-d $full_path) { 3111 push(@dirs, $entry); 3112 cache_dir($full_path, $queue); 3113 } elsif (-f $full_path) { 3114 push(@sizes, (stat($full_path))[7]); 3115 push(@files, $entry); 3116 } 3117 } 3118 } 3119 3120 closedir($dir); 3121 3122 $dir =~ s/$queue->{root_dir}//; 3123 $dir = '/' if (length($dir) == 0); 3124 3125 $queue->{cache}{$dir} = { dirs => [ @dirs ], files => [ @files ], 3126 sizes => [ @sizes ] }; 3127} 3128 3129############################################################################### 3130# count_queued_files($server_tag, $nick,$qn): returns number of queued files 3131# for $nick 3132############################################################################### 3133sub count_queued_files 3134{ 3135 my ($server_tag, $nick, $qn) = @_; 3136 my $count = 0; 3137 3138 foreach (0 .. $#{$fs_queues[$qn]->{queue}}) { 3139 $count++ 3140 if (${$fs_queues[$qn]->{queue}}[$_]->{nick} eq $nick && 3141 ${$fs_queues[$qn]->{queue}}[$_]->{server_tag} eq $server_tag); 3142 } 3143 3144 return $count; 3145} 3146 3147############################################################################### 3148# count_user_files($server_tag, $nick, $qn): returns number of queued and 3149# sended files for $nick 3150############################################################################### 3151sub count_user_files { 3152 my ($server_tag, $nick, $qn) = @_; 3153 3154 if (!$fs_prefs{count_send_as_queue}) { 3155 return count_queued_files($server_tag, $nick, $qn); 3156 } 3157 3158 my $count = count_queued_files($server_tag, $nick, $qn); 3159 foreach (0 .. $#fs_sends) { 3160 $count++ 3161 if ($fs_sends[$_]->{nick} eq $nick && 3162 $fs_sends[$_]->{server_tag} eq $server_tag); 3163 } 3164 3165 return $count; 3166} 3167 3168############################################################################### 3169# send_active_for($server_tag, $nick): true if currently sending file to 3170# $nick 3171############################################################################### 3172sub send_active_for 3173{ 3174 my ($server_tag, $nick) = @_; 3175 3176 foreach (0 .. $#fs_sends) { 3177 return 1 if ($fs_sends[$_]{nick} eq $nick && 3178 $fs_sends[$_]{server_tag} eq $server_tag); 3179 } 3180 3181 return 0; 3182} 3183 3184############################################################################### 3185# user_in_channel($server,$nick,$queue): true if user is on any 3186# $queue->{channels} 3187############################################################################### 3188sub user_in_channel 3189{ 3190 my ($server, $nick, $queue) = @_; 3191 3192 foreach (split(' ', $queue->{channels})) { 3193# print_debug("Checking channel $_"); 3194 my $channel = $server->channel_find($_); 3195 if ($channel && $channel->{joined} && $channel->nick_find($nick)) { 3196 return 1; 3197 } 3198 } 3199 3200 return 0; 3201} 3202 3203############################################################################### 3204# send_user_msg($servertag, $nick, $msg): sends a msg to $nick using dcc if 3205# available 3206############################################################################### 3207sub send_user_msg 3208{ 3209 my ($servertag, $nick, $msg) = @_; 3210 3211 if ($nick eq "!fserve!") { 3212 print_msg($msg); 3213 } else { 3214 my $server = Irssi::server_find_tag($servertag); 3215 if (!$server || !$server->{connected}) { 3216 return; 3217 } 3218 3219 my $cmd = ((defined $fs_users{$nick."@".$servertag})?"MSG =$nick":"MSG $nick"); 3220 $server->command("$cmd $fs_prefs{clr_txt}$msg"); 3221 } 3222} 3223 3224############################################################################### 3225# size_to_str($size): returns a formatted size string 3226############################################################################### 3227sub size_to_str 3228{ 3229 my ($size) = @_; 3230 3231 if ($size < 1024) { 3232 $size = int($size) . " B"; 3233 } elsif ($size < 1048576) { 3234 $size = sprintf("%.1f kB", $size/1024); 3235 } elsif ($size < 1073741824) { 3236 $size = sprintf("%.2f MB", $size/1048576); 3237 } elsif ($size < 1099511627776) { 3238 $size = sprintf("%.2f GB", $size/1073741824); 3239 } else { 3240 $size = sprintf("%.3f TB", $size/1099511627776); 3241 } 3242 3243 return $size; 3244} 3245 3246############################################################################### 3247# time_to_str($time): returns a formatted time string 3248############################################################################### 3249sub time_to_str 3250{ 3251 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(shift(@_)); 3252 3253 return sprintf("%dd %dh %dm %ds", $yday, $hour, $min, $sec) if ($yday); 3254 return sprintf("%dh %dm %ds", $hour, $min, $sec) if ($hour); 3255 return sprintf("%dm %ds", $min, $sec) if ($min); 3256 return sprintf("%ds", $sec); 3257} 3258 3259############################################################################### 3260# save_config(): saves preferences & statistics to file 3261############################################################################### 3262sub save_config 3263{ 3264 my $f = $conffile; 3265 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 3266 if (!open(FILE, ">", $f)) { 3267 print_msg("Unable to open $f for writing!"); 3268 return 1; 3269 } 3270 3271 print (FILE "[ConfigFileVersion 1.0]\n"); 3272 3273 # save preferences 3274 print(FILE "[common]\n"); 3275 foreach (sort(keys %fs_prefs)) { 3276 print(FILE "$_=$fs_prefs{$_}\n"); 3277 } 3278 3279 # save statistics 3280 print(FILE "[stats]\n"); 3281 foreach (sort(keys %fs_stats)) { 3282 print(FILE "$_=$fs_stats{$_}\n"); 3283 } 3284 3285 #save queues settings 3286 foreach my $qn (0 .. $#fs_queues) { 3287 print(FILE "[queue $qn]\n"); 3288 foreach (sort(keys %{$fs_queues[$qn]})) { 3289 next if ($_ eq 'queue' || $_ eq 'cache' || $_ eq 'sends' || 3290 $_ eq 'filecount' || $_ eq 'bytecount'); 3291 print(FILE "$_=$fs_queues[$qn]->{$_}\n"); 3292 } 3293 } 3294 3295 close(FILE); 3296 return 0; 3297} 3298 3299############################################################################### 3300# load_distro($file) 3301############################################################################### 3302sub load_distro { 3303 my $file = $_[0]; 3304 if (!open(FILE, "<", $file)) { 3305 print_msg("Unable to open $file for reading!"); 3306 return 0; 3307 } 3308 3309 # file format: 3310 # sent_count file_size file_name 3311 3312 my ($count, $size, $name); 3313 while (<FILE>) { 3314 chomp; 3315 ($count, $size, $name) = split(/ /, $_, 3); 3316 if (($count !~ /\d+/) or ($size !~ /\d+/) or (!$name)) { 3317 print_msg("Error in $file in line $."); 3318 close(FILE); 3319 return 0; 3320 } 3321 $fs_distro{$name}{$size} = $count; 3322 } 3323 3324 close(FILE); 3325 return 1; # ok 3326} 3327 3328 3329############################################################################### 3330# save_distro() 3331############################################################################### 3332sub save_distro 3333{ 3334 return 0 if (!$fs_prefs{distro_file}); 3335 3336 my $f = $fs_prefs{distro_file}; 3337 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 3338 3339 if (!open(FILE, ">", $f)) { 3340 print_msg("Unable to open $f for writing!"); 3341 return 1; 3342 } 3343 3344 foreach (sort keys %fs_distro) { 3345 foreach my $size (sort keys %{$fs_distro{$_}}) { 3346 print FILE "$fs_distro{$_}{$size} $size $_\n"; 3347 } 3348 } 3349 3350 close(FILE); 3351 return 0; 3352} 3353 3354############################################################################### 3355# load_config(): loads preferences & statistics from file 3356############################################################################### 3357sub load_config 3358{ 3359 3360 my $f = $conffile; 3361 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 3362 if (!open(FILE, "<", $f)) { 3363 print_msg("Unable to open $f for reading!"); 3364 return 1; 3365 } 3366 3367 local $/ = "\n"; 3368 3369 my $config_version = <FILE>; 3370 chomp $config_version; 3371 if ($config_version !~ /^\[ConfigFileVersion 1\.[0-9]+]$/) { 3372 print_msg("Config file format not recognized!"); 3373 print_msg("FServe 2.0 and newer won't work with config file"); 3374 print_msg(" created by earlier versions on FServe."); 3375 return 1; 3376 } 3377 3378 my $hash = \%fs_prefs; 3379 my %garbage = (); 3380 3381 while (<FILE>) { 3382 chomp; 3383 if (/^\[(.*)\]$/) { # next chapter 3384 if ($1 eq "common") { 3385 $hash = \%fs_prefs; 3386 } elsif ($1 eq "stats") { 3387 $hash = \%fs_stats; 3388 } elsif ($1 =~ /queue (.*)$/) { 3389 while (!defined $fs_queues[$1]) { 3390 push (@fs_queues, { %fs_queue_defaults }); 3391 @{$fs_queues[$#fs_queues]->{queue}} = (); 3392 } 3393 $hash = $fs_queues[$1]; 3394 } else { 3395 print_msg("Unknown config section: $_"); 3396 $hash = \%garbage; 3397 } 3398 next; 3399 } 3400 my ($entry, $value) = split('=', $_, 2); 3401 if (defined $hash->{$entry}) { 3402 $hash->{$entry} = $value; 3403 } else { 3404 print_msg("unknown entry: $_"); 3405 } 3406 } 3407 3408 close(FILE); 3409 return 0; 3410} 3411 3412 3413############################################################################### 3414# save_queue(): saves the current sends & queue to file 3415############################################################################### 3416sub save_queue 3417{ 3418 my $f = $fs_prefs{queuefile}; 3419 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 3420 3421 if (!open(FILE, ">", $f)) { 3422 print_msg("Unable to open $f for writing!"); 3423 return 1; 3424 } 3425 3426 print (FILE "[QueueFileVersion 1.0]\n"); 3427 3428 # save the sends (for resuming) 3429 foreach my $slot (0 .. $#fs_sends) { 3430 foreach (sort keys %{$fs_sends[$slot]}) { 3431 next if ($_ eq "dontwarn"); 3432 next if ($_ eq "transfd"); 3433 if ($_ eq "warns") { 3434 print(FILE "$_=>0\0"); 3435 } else { 3436 print(FILE "$_=>$fs_sends[$slot]->{$_}\0"); 3437 } 3438 } 3439 print(FILE "\n"); 3440 } 3441 3442 # save the queues 3443 foreach (0 .. $#fs_queues) { 3444 my $fsq = $fs_queues[$_]->{queue}; 3445 foreach my $slot (0 .. $#{$fsq}) { 3446 foreach (sort keys %{${$fsq}[$slot]}) { 3447 next if ($_ eq "dontwarn"); 3448 next if ($_ eq "transfd"); 3449 if ($_ eq "warns") { 3450 print(FILE "$_=>0\0"); 3451 } else { 3452 print(FILE "$_=>${$fsq}[$slot]->{$_}\0"); 3453 } 3454 } 3455 print(FILE "\n"); 3456 } 3457 } 3458 3459 close(FILE); 3460 return 0; 3461} 3462 3463############################################################################### 3464# load_queue(): (re)loads the queue from file 3465############################################################################### 3466sub load_queue 3467{ 3468 my $f = $fs_prefs{queuefile}; 3469 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 3470 3471 if (!open(FILE, "<", $f)) { 3472 print_msg("Unable to open $f for reading!"); 3473 return 1; 3474 } 3475 3476 my $queue_version = <FILE>; 3477 chomp $queue_version; 3478 if ($queue_version !~ /^\[QueueFileVersion 1\.[0-9]+]$/) { 3479 print_msg("Queue file format not recognized!"); 3480 print_msg("FServe 2.0 and newer won't work with queue file"); 3481 print_msg(" created by earlier versions on FServe."); 3482 return 1; 3483 } 3484 3485 if (!@fs_queues) { 3486 # create a very first queue :) 3487 push (@fs_queues, { %fs_queue_defaults }); 3488 @{$fs_queues[$#fs_queues]->{queue}} = (); 3489 } 3490 3491 # empty all queues 3492 foreach (0 .. $#fs_queues) { 3493 @{$fs_queues[$_]->{queue}} = (); 3494 } 3495 3496 while (<FILE>) { 3497 s/\n//g; 3498 my %rec = (); 3499 my $ignore = 0; 3500 3501 foreach my $line (split("\0", $_)) { 3502 my ($entry, $value) = split('=>', $line, 2); 3503 $rec{$entry} = $value; 3504 } 3505# print_debug("Read: $rec{nick}|$rec{server_tag}|$rec{file}|$rec{queue}"); 3506 3507 # don't put it in queue if it is sending 3508 foreach (0 .. $#fs_sends) { 3509# print_debug("Checking if it's not in fs_sends with: $fs_sends[$_]->{nick}|$fs_sends[$_]->{server_tag}|$fs_sends[$_]->{file}|$fs_sends[$_]->{queue}"); 3510 if ($rec{nick} eq $fs_sends[$_]->{nick} && 3511 $rec{file} eq $fs_sends[$_]->{file} && 3512 $rec{queue} eq $fs_sends[$_]->{queue} && 3513 $rec{server_tag} eq $fs_sends[$_]->{server_tag}) { 3514 $ignore = 1; 3515 } 3516 } 3517 3518 if (!$ignore) { 3519 # check if it's sending already but isn't in %fs_sends 3520 foreach (Irssi::Irc::dccs()) { 3521# print_debug("Checking if it's not sending with: $_->{nick}|$_->{servertag}|$_->{arg}"); 3522 if ($_->{type} eq 'SEND' && $_->{nick} eq $rec{nick} && 3523 $_->{arg} eq $rec{file} && 3524 $rec{server_tag} eq $_->{servertag}) { 3525 print_debug("send of '$rec{file}' for $rec{nick}\@$rec{server_tag} was lost, adding to fs_sends"); 3526 push(@fs_sends, { %rec }); 3527 $ignore = 1; 3528 last; 3529 } 3530 } 3531 } 3532 if (!$ignore) { 3533 my $fsq; 3534 if (defined $rec{queue}) { 3535 if (!defined $fs_queues[$rec{queue}]) { 3536 print_msg("unknown queue #$rec{queue}"); 3537 next; 3538 } 3539 $fsq = $fs_queues[$rec{queue}]->{queue}; 3540 } else { 3541 $fsq = $fs_queues[0]->{queue}; 3542 } 3543 # add to queue 3544 if ($rec{resends}) { 3545 # count resended files 3546 my $place = 0; 3547 foreach (0 .. $#{$fsq}) { 3548 $place++ if (${$fsq}[$_]->{resends}); 3549 } 3550 splice(@{$fsq}, $place, 0, { %rec }); 3551 } else { 3552 push(@{$fsq}, { %rec }); 3553 } 3554 } 3555 } 3556 3557 close(FILE); 3558 return 0; 3559} 3560 3561############################################################################### 3562# print_log(): write line to log file 3563############################################################################### 3564sub print_log 3565{ 3566 my $f = $fs_prefs{log_name}; 3567 $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/; 3568 if (!$logfp && $fs_prefs{log_name} && open(LOGFP, ">>", $f)) { 3569 $logfp = \*LOGFP; 3570 select((select($logfp), $|++)[0]); 3571 } 3572 return if !$logfp; 3573 my ($msg) = @_; 3574 $msg =~ s/^\s*|\s*$//gs; 3575 print $logfp localtime()." $msg\n"; 3576} 3577 3578# vim:noexpandtab:ts=4 3579