การเขียนmoduleสำหรับ irssi เพื่อโหลด xdcc แบบต่อเนื่อง

-

irssi

irssi คือ console interface IRC client ที่ถือว่าดีติดอัดดับ 1ใน 10 ของ IRC client ใน linux เลยก็ว่าได้เพราะความสามารถหลากหลายเช่น

  • สามารถ bind คำสั่งใหม่ได้
  • สามารถสร้าง script auto run
  • สามารถสร้าง plugin (ในโปรแกรมจะเรียก script )ซึ่งเป็นภาษา perl
  • ใช้ร่วมกับคำสั่ง screen run ค้างไว้ที่ server ได้
  • ตั้งค่าอะไรได้อีกหลายอย่าง

พอดีวันก่อนอยากจะโหลด xdcc จาก bot ที่อยู่ใน internet แต่ผมมันพวกขี้เกียจ ขี้เกียจมานั่งโหลดทีละ file ก็ลองหาๆดูว่า มี IRC client ตัวไหนที่มันทำ plugin พวก โหลด xdcc แบบต่อเนื่องหรือเปล่า ใน xchat หาไม่ค่อยมีถ้าให้เขียนเองก็คงนั่งดู API อีกนานกว่าจะเขียนได้พอดีไปเจอของ irssi จาก 

http://www.irssi.be/scripts/

น่าแปลกว่า irssi.org/scripts ไม่มี xdccget.pl ให้ พอลองเอามาใช้จริงปรากฏว่าไม่สามารถทำงานได้100% เพราะโหลดได้อย่างเดียว ทำ คิวไม่ได้ -_-"

แก้code

ลองมา debug ดูปรากฏว่าใน code ของเก่าที่เขียนมามันใช้ signal ที่ชื่อว่า message irc notice จับ event ว่ามีคำว่า xxxx อยู่ใน line นั้นๆหรือเปล่าแล้ว parser ออกมาทำตาม case แต่ !!! รู้สึกว่า irssi version ใหม่มัน ปรับให้ signal ของ dcc แยกออกมาจาก message irc notic แล้วเพราะ มันจับไม่ได้ เลยเขียน handeling signal ขึ้นมาจับ ใหม่ตัวหนึ่งก็ใช้งานได้ปรกติ 

http://www.irssi.org/documentation/signals

code 

#
# by Stefan "tommie" Tomanek 
#
# History:
#
# 26.02.2002
# *first release, report bugs :)
#
# 01.03.2002
# *CHanged to GPL
#
# 08.03.200
# *some bugfixes
#
# 13.04.2002
# *major improvements
# *cosmetic changes
#
# 14.04.2002
# *internal redesign
# *feature enhancements
#
# 17.04.2002
# * improved queuing code
# * changed to $server->{tag}
# * improved communication with server
#
# 21.04.2002
# *improved ETA listing
#
# 27.04.2002
# *handling of gone bots added
#
# 28.04.2002
# *fixed handling of servers that are not in an ircnet
#
# 23.1.2008
# * original source from Stefan 'tommie' Tomanek
# *fixed handling for xdccget from new version can't use message irc notice for change status
#  use dcc close for cnange
# * todo handling more signal from dcc now only close connection for program work

use strict;
#use warnings;

use vars qw($VERSION %IRSSI);
$VERSION = "200801023";
%IRSSI = (
   authors     => "Stefan 'tommie' Tomanek",
   contact     => "stefan\@kann-nix.org",
   name        => "XDCCget",
   description => "advances downloading from XDCC bots",
   license     => "GPLv2",
   changed     => "$VERSION",
   commands => "xdccget"
);

use Irssi 20020324;

use vars qw(@queue $timer $debug %lists);

$debug=0;

sub show_help() {
   my $help="XDCCget $VERSION
/xdccget queue Nickname  ...
   Queue the specified packs of the server 'Nickname'
/xdccget list
   List the download queue..In sourcecode it list package list from bot
   use xdccget list 
/xdccget cancel 
   Remove pack  from the local queue
/xdccget help
   Display this help
/xdccget
   List the download queue
";
   my $text = '';
   foreach (split(/\n/, $help)) {
       $_ =~ s/^\/(.*)$/%9\/$1%9/;
       $text .= $_."\n";
   }
   print CLIENTCRAP &draw_box("XDCCget", $text, "help", 1);
}

sub draw_box ($$$$) {
   my ($title, $text, $footer, $colour) = @_;
   my $box = '';
   my $exp_flags = Irssi::EXPAND_FLAG_IGNORE_EMPTY | Irssi::EXPAND_FLAG_IGNORE_REPLACES;
   $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
   foreach (split(/\n/, $text)) {                                                      $box .= '%R|%n '.$_."\n";
   }                                                                               $box .= '%R`--<%n'.$footer.'%R>->%n';
   $box =~ s/%.//g unless $colour;
   return $box;
}

sub contains {
   my ($item, @list) = @_;
   foreach (@list) {
     ($item eq $_) && return 1;
   }
   return 0;
}

sub event_dcc_closed {
my ($dcc) = @_;
 if ($debug)
 {
  print CLIENTCRAP "%R>>%n --DEBUG-msg-->Close<---";
 }
 # Mark the transfer as completed
 $queue[0]->{'status'}=4;
 process_queue();
}

sub event_message_irc_notice {
   my ($server, $msg, $nick, $address, $target) = @_;
   $_ = $msg;
#print CLIENTCRAP "%R>>%n --DEBUG-msg-->$msg<---";
   if ($queue[0] &&  $nick eq $queue[0]->{'nick'}) {
 if (/\*\*\* Closing Connection:/) {
     print CLIENTCRAP "%R>>%n XDCC-Transfer closed";
     # Is it a canceled transger?
     if ($queue[0]->{'status'} == 5) {
  $queue[0]->{'status'} = 4;
     } else {
  # We should try again
  $queue[0]->{'status'} = 0;
     }
# } elsif (/\*\*\* Transfer Completed/i) {
 } elsif (/\*\*\* received file/i) {
        print CLIENTCRAP "%R>>%n XDCC-Transfer completed";
     # Mark the transfer as completed
     $queue[0]->{'status'} = 4;
 } elsif (/\*\*\* You already requested that pack/i) {
     $queue[0]->{'status'} = 4;
 } elsif (/\*\*\* Sending You Pack/i || /\*\*\* Sending You Your Queued Pack|DCC Send .*? \(.*?\)/i) {
     $queue[0]->{'status'} = 3;
     print CLIENTCRAP "%R>>%n XDCC-Transfer starting";
 } elsif (/\*\*\* All Slots Full, Added (|you to the main )queue in position ([0-9]*)/i) {
     $queue[0]->{'pos'} = $2;
     $queue[0]->{'etr'} = 0;
     $queue[0]->{'status'} = 2;
 } elsif (/You have been queued for ([0-9]*?) hr ([0-9]*?) min, currently in main queue position ([0-9]*?) of ([0-9]*?)\.  Estimated remaining time is ([0-9]*?) hr ([0-9]*?) min or (less|more)\./i) {
     $queue[0]->{'pos'} = $3;
     $queue[0]->{'etr'} = time() + (($5*60)+$6)*60;
     $queue[0]->{'status'} = 2;
 } elsif (/You have been queued for ([0-9]*?) hours ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./i) {
     $queue[0]->{'pos'} = $3;
     $queue[0]->{'status'} = 2;
 } elsif (/You have been queued for ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./) {
     $queue[0]->{'status'} = 2;
     # FIXME unite somehow with regexp above
     $queue[0]->{'pos'} = $2;
 } elsif (/It has been placed in queue slot #(\d+), it will send when sends are available/) {
     $queue[0]->{'pos'} = $1;
     $queue[0]->{'status'} = 2;
 } elsif (/\*\*\* Invalid Pack Number/) {
     $queue[0]->{'status'} = 4;
 } elsif (/\*\*\* The Owner Has Requested That No New Connections Are Made/) {
     $queue[0]->{'status'} = 4;
 } elsif (/\*\*\* All Slots Full,(| Main) queue of size [0-9]* is Full, Try Again Later/i || /\*\*\* You can only have 1 transfer at a time/i) {
     if (Irssi::settings_get_int('xdccget_retry_time') > 0) {
  my $retry = Irssi::settings_get_int('xdccget_retry_time')*1000;
  $queue[0]->{'status'} = 6;
  $queue[0]->{'timer'} = Irssi::timeout_add($retry, 'retry_transfer', undef);
  $queue[0]->{'etr'} = time()+$retry/1000;
     } else {
  $queue[0]->{'status'} = 4;
     }
 } elsif (/Removed you from the queue/) {
     $queue[0]->{'status'} = 4;
 } else { Irssi::print($_) if ($debug); }
 
 process_queue();
   }
   if (/#(\d+).+?\d+x \[ *( my ($pack, $size, $name) = ($1, $2, $3);
    if (defined $lists{lc $server->{tag}}{lc $nick}) {
     $lists{lc $server->{tag}}{lc $nick}{$pack} = $name;
 }
 foreach (@queue) {
     next unless lc $nick eq lc $_->{nick};
     next unless lc $server->{tag} eq lc $_->{net};
     next unless $_->{pack} eq $pack;
     $_->{filename} = $name;
 }
   }
}

sub process_queue {
   unless (scalar(@queue) > 0) {return 0};
   my %current = %{$queue[0]};
   shift @queue if ( $current{'status'} == 4 );
   unless (scalar(@queue) > 0) {return 0};
   %current = %{$queue[0]};
   if ( $current{'status'} == 0 ) {
 my $server = Irssi::server_find_tag($current{'net'});
    $server->command('MSG '.$current{'nick'}.' xdcc send '.$current{'pack'});
 $queue[0]->{'try'}++;
 $queue[0]->{'status'} = 1;
   }
}

sub retry_transfer {
   if (defined $queue[0] && $queue[0]->{'status'} == 6) {
 Irssi::timeout_remove($queue[0]->{'timer'});
 #print CLIENTCRAP "%R>>%n Retrying XDCC-transfer...";
 $queue[0]->{'status'} = 0;
 process_queue();
   }
}

sub queue_pack {
   my ($args, $server, $witem) = @_;
   my @args = split(/ /, $args, 2);
   my ($nick, $packs);
   if (ref $witem && $witem->{type} eq 'QUERY' && $args[0] =~ /^\d+$/) {
 ($nick, $packs) = ($witem->{name}, $args[0]);
   } else {
 ($nick, $packs) = @args;
   }
   my @packs = split(/ /, $packs);
   foreach (@packs) {
 # 0: Waiting, 1: Processing, 2: Doenloading
 my $status = 0;
 my $chatnet = $server->{tag};
 my %transfer = ('nick'    => $nick,
   'pack'    => $_,
   'status'  => $status,
   'net'     => $chatnet,
   'pos'     => 0,
   'try'     => 0,
   'etr'     => 0,
   'timer'   => undef,
   );
 if (defined $lists{lc $server->{tag}}{lc $nick}{$_}) {
     $transfer{filename} = $lists{lc $server->{tag}}{lc $nick}{$_};
 }
 push @queue, \%transfer;
   }
   process_queue()
}

sub list_xdcc_queue {
   my $text;
   my %progress = (0=>'waiting',
      1=>'requesting',
      2=>'queued',
      3=>'transferring',
      4=>'completed',
      5=>'canceling',
      6=>'retrying');
   my $i = 1;
   foreach (@queue) {
 my $current = $_;
 my $botname = $current->{'nick'};
 my $ircnet = $current->{'net'};
 my $pack = $current->{'pack'};
 my $status = $progress{$current->{'status'}};
 my $info = '';
 my $etr = '';
 if ($current->{'status'}==2) {
     my $time = $current->{'etr'}-time();
           my $hours = int($time / (60*60));
           my $minutes = int( ($time-($hours*60*60))/60 );
           my $seconds = int( ($time-($hours*60*60)-($minutes*60))  );

           $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
     $info = "[".$current->{'pos'}."]".' '.$etr;
 } elsif ($current->{'status'}==6) {
     my $time = $current->{'etr'}-time();
     my $hours = int($time / (60*60));
     my $minutes = int( ($time-($hours*60*60))/60 );
     my $seconds = int( ($time-($hours*60*60)-($minutes*60))  );
    
     $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
     $info = '['.$current->{'try'}.']'.' '.$etr;
 }
 $text .= "%9".$i."%9 ".$botname."<".$ircnet.">: Pack ".$pack;
 $text .= " (".$current->{filename}.")" if defined $current->{filename};
 $text .= " => ".$status.' '.$info;
 $text .= "\n";
 $i++;
   }
   print CLIENTCRAP draw_box("XDCCget", $text, "queued packs", 1);
}

sub cancel_pack {
   my (@numbers) = @_;
   @numbers = sort {$b cmp $a} @numbers;
   foreach (@numbers) {
 my $item = @queue->[$_-1];

 if ($item->{'status'} == 2) {
     # Remove the order from the bots queue
     my $server = Irssi::server_find_tag($item->{'net'});
     $server->command('MSG '.$item->{'nick'}.' xdcc remove');
     print CLIENTCRAP "%R>>>%n Removing pack ".$_." from server queue";
     $item->{'status'} = 5;
     #splice(@queue, $_,$_+1);
 } elsif ($item->{'status'} == 3) {
     $item->{'status'} = 5;
     Irssi::command('DCC close get '.$item->{'nick'});
     print CLIENTCRAP "%R>>>%n Transfer aborted, waiting for acknowledgement";
 } else {
     splice(@queue, $_-1, $_);
 }
 process_queue();
   }
}

sub list_packs ($$) {
   my ($server, $bot) = @_;
   $server->command('MSG '.$bot.' xdcc list');
   $lists{lc $server->{tag}}{lc $bot} = {};
}

sub cmd_xdccget {
   my ($args, $server, $witem) = @_;
   my @arg = split(/ /, $args);

   if ((scalar(@arg) == 0) or ($arg[0] eq '-l')) {
 list_xdcc_queue();
   } elsif ($arg[0] eq 'queue') {
 # queue files
 shift @arg;
 queue_pack("@arg", $server, $witem);
   } elsif ($arg[0] eq 'list' && defined $arg[1]) {
 list_packs($server, $arg[1]);
   } elsif ($arg[0] eq 'cancel') {
 shift @arg;
 cancel_pack(@arg);
   } elsif ($arg[0] eq 'help') {
 show_help();
   }
}

sub event_private_message {
   my ($server, $text, $nick, $address) = @_;
   event_message_irc_notice($server, $text, $nick, $address, undef);
}

sub event_no_such_nick {
   my ($server, $args, $sender_nick, $sender_address) = @_;
   my ($myself, $nick) = split(/ /, $args, 3);
  
   unless (scalar(@queue) == 0) {
 if ($nick eq $queue[0]->{'nick'}) {
     if ($queue[0]->{'status'} == 1 || $queue[0]->{'status'} == 5) {
  $queue[0]->{'status'} = 4;
     }
 }
 process_queue();
   }
}


Irssi::command_bind('xdccget', \&cmd_xdccget);
foreach my $cmd ('queue', 'cancel', 'list', 'help', 'list') {
   Irssi::command_bind('xdccget '.$cmd => sub {
                       cmd_xdccget("$cmd ".$_[0], $_[1], $_[2]); });
}


Irssi::signal_add('message irc notice', 'event_message_irc_notice');
Irssi::signal_add('dcc closed', 'event_dcc_closed');
Irssi::signal_add("message private", "event_private_message");
Irssi::signal_add("event 401", "event_no_such_nick");

Irssi::settings_add_int($IRSSI{'name'}, 'xdccget_retry_time', 30);

print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /xdccget help for help';

จริงๆ function event_message_irc_notice ตัดทิ้งไปเลยก็ได้เพราะ มัน handling ได้แต่ทำงานไม่ถูก

การใช้งาน

  • สำหรับ irssi ที่เป็น ubuntu base จะเอาscript ไปไว้ใน ~/.irssi/script/
  • สำหรับค่อยอื่นเช่น debian จะเอาไปไว้ใน /usr/share/irssi/scripts/

การใช้งาน script ของ irssi จะใช้ได้โดยใช้คำสั่ง 

/load xdccget.pl

เวลาใช้ก็ง่ายๆ 

/xdccget ชื่อบอท package1 package2 package3 ...

proxy

เท่าที่ test การใช้งาน proxy ใช้ได้ปรกติแต่ถ้าเป็น socks โดยตัว irssi เองมีข้อจำกัดหลายอย่างควรจะใช้ร่วมกับ คำสั่ง tsocks จะดีกว่า

โพสต์ยอดนิยมจากบล็อกนี้

ปัญหาและเฉลยวิชาธรรม นักธรรมชั้นตรี สอบในสนามหลวง วันอังคาร ที่ ๒๙ กันยายน พ.ศ.๒๕๕๒

-
๑ .      บุพพการีและกตัญญูกตเวที ได้แก่บุคคลเช่นไร ? จงยกตัวอย่างมาสัก ๒ คู่ ๑ .       บุพพการี   ได้แก่บุคคลผู้ทำอุปการะก่อน กตัญญูกตเวที   ได้แก่บุคคลผู้รู้อุปการะที่ท่านทำแล้ว   และตอบแทน ( ตอบเพียง ๒ คู่ ) คู่ที่ ๑    มารดาบิดากับบุตรธิดา คู่ที่ ๒   ครูอาจารย์กับศิษย์ คู่ที่ ๓    พระราชากับราษฎร คู่ที่ ๔    พระพุทธเจ้ากับพุทธบริษัท ฯ ๒ .      อาการที่พระพุทธเจ้าทรงสั่งสอนมีกี่อย่าง ?    ข้อที่ว่า “ ทรงสั่งสอนเป็นอัศจรรย์ ” นั้นคืออย่างไร ? ๒ .       มี ๓ อย่าง ฯ คือ ผู้ปฏิบัติตามย่อมได้ประโยชน์โดยสมควรแก่ความปฏิบัติ ฯ ๓ .      มูลเหตุที่ทำให้บุคคลทำความชั่ว เรียกว่าอะไร ?   มีอะไรบ้าง ?            เมื่อเกิดขึ้นแล้วควรปฏิบัติอย่างไร ? ๓ .       เรียกว่า อกุศลมูล ฯ           มี      ๑ . โลภะ อยากได้                  ๒ . โทสะ คิดประทุษร้ายเขา                  ๓ . โมหะ หลงไม่รู้จริง ฯ           เมื่อเกิดขึ้นแล้วควรละเสีย   ด้วยทาน ศีล ภาวนา ฯ ๔ .      ปัญญาอันเห็นชอบอย่างไร จึงชื่อว่ามรรคในอริยสัจ ๔ ? เพราะเหตุไร ? ๔ .       ปัญญาอันเห็นชอบว่าสิ่งนี้ทุกข์   สิ่งนี้เหตุให้ทุกข์เกิด  
bannk

I miss you all กับ I miss all of you ต่างกันอย่างไร

-
สวัสดีค่ะคุณแอนดรูว์ หนูอยากทราบความแตกต่างระหว่าง I miss you all. กับ I miss all of you. ขอบคุณที่ตอบด้วยค่ะ จาก Kittiorns ดีใจ จังที่คุณ Kittiorns ได้เติม s ลงท้ายชื่อเพราะเรื่องที่คุณถาม เป็นเรื่องเกี่ยวกับคำพหูพจน์ เราคงทราบดีแล้วว่าภาษาอังกฤษมีคำว่า you ในความหมายว่า คุณ ไม่ว่าคุณคนเดียวหรือพวกคุณที่นับเป็นพันคน ใช้ you ในทุกกรณี ไม่มี yous ในภาษาอังกฤษ (ยก เว้นประเทศออสเตรเลียซึ่งมีบางคนที่ใช้คำว่า youse ในความหมายว่า คุณทั้งหลาย แต่ถือว่าผิดอย่างมหันต์ ห้ามเลียนแบบโดยเด็ดขาด … ฟังแล้วน่าเกลียดมาก) แต่ในบางกรณีเราอยากจะระบุว่า มีมากกว่าหนึ่งคนที่พูดถึงก็เลยใช้ you all แทน you ในความหมายว่า คุณทั้งหลาย เช่น I miss you all. (ผมคิดถึงพวกคุณทั้งหลาย) หรือ I love you all! (ผมรักคุณทุกคน) เรา มีอีกวิธีหนึ่งที่จะพูดหรือเขียนว่า you all คือ all of you เช่น I miss all of you. หรือ I love all of you! ซึ่งความหมายไม่เปลี่ยนไป นี่คือเสน่ห์ของภาษาอังกฤษครับ เราสามารถพูดประโยคหนึ่งได้หลายวิธี สนุกมากคุณว่าไหม
bannk

ปัญหาและเฉลยวิชาอนุพุทธประวัติ นักธรรมชั้นโท สอบในสนามหลวง วันอาทิตย์ ที่ ๒๐ พฤศจิกายน พ.ศ. ๒๕๔๘

-
   ๑ .   ประวัติอนุพุทธบุคคลมีความสำคัญต่อผู้ศึกษาอย่างไร ?   ๑ .   ทำให้ผู้ศึกษาได้รับความรู้ในจริยาวัตรและคุณความดีที่ท่านได้บำเพ็ญมา ตลอด        จนถึงผลงานในการช่วยเผยแผ่พระพุทธศาสนาอันทำให้เจริญสืบมาถึงทุกวันนี้        นำให้เกิดความเลื่อมใสและความนับถือ เป็นทิฏฐานุคติอันดี สามารถน้อมนำมา        ปฏิบัติตามได้ ฯ ๒ .   คำที่มีอยู่ในธัมมจักกัปปวัตตนสูตรต่อไปนี้ ได้แก่อะไร ?            ก. ส่วนสุด ๒ อย่าง            ข. มัชฌิมาปฏิปทา   ๒.        ก. ส่วนสุด ๒ อย่าง คือ                 ๑. กามสุขัลลิกานุโยค ความหมกมุ่นอยู่ในกาม                 ๒. อัตตกิลมถานุโยค ความทำตนให้ลำบาก            ข. มัชฌิมาปฏิปทา ได้แก่ข้อปฏิบัติสายกลาง   คือ มรรคมีองค์ ๘ ฯ   ๓.   ความเป็นผู้สำรวมกิริยาอาการให้เรียบร้อยดีงามสมความเป็นสมณะ เป็นการ        เผยแผ่พระพุทธศาสนาได้ทางหนึ่ง ในข้อนี้มีปฏิปทาของพระสาวกองค์ใดเป็น        ตัวอย่าง ?   จงเล่าประวัติโดยสังเขปมาประกอบ   ๓.   พระอรหันตสาวกทุกรูปล้วนเป็นผู้สำรวมกิริยาอาการเรียบร้อยดีงามทั้งสิ้น แต่ที่        ได้รับยกย่องเป็นพิเศษคือพระอัสสชิเถระ ท่านมีกิริยาอ
bannk