code บอท irc ของผม

เกริ่นนำกันก่อน ...
ปกติแล้ว พอพูดถึงบอท iRC หลายๆ คน มักจะคิดว่ามันเอาไว้แฮก
หรือเป็น zombie ไว้แฮกเครื่องชาวบ้าน อีกต่อ
(ซึ่ง code ที่กล่าวถึง นั้นคือ บอท ที่ ICT ห้ามเขียน)

แต่โดยส่วนตัว ผมว่า .. ไอ้บอทพวกเนี้ย เป็นพื้นฐานให้เด็กไทย รู้จักกับการทำงานของ socket เลยนะ

ซึ่งมันไม่จำเป็นจะต้องเขียนเป็นบอท เพื่อใช้แฮก เสมอไป
ลองนึกถึง บอท อับดุล (บอทใน msn ของ NECTEC) ที่เอาไว้ถาม-ตอบ
รวมไปถึงเจ้า ลูกไก่ SIMSIMI
ไอ้ของพวกนี้ผมว่ามันก็คือ บอททั้งนั้น

ดังนั้น กฏหมาย ที่ห้ามเขียนบอท
ผมว่าน่าจะระบุรายละเอียดให้มากกว่านี้หน่อย
(แต่ผมว่า คนออกกฏหมายเค้าจะรู้จักการทำงานของ socket มั้ยหว่า)


ส่วนเรื่อง ผลการตัดสิน ว่าผิดกฏหมายหรือไม่ ผมค่อนข้างมองว่า

"ตอนนี้ไม่ได้ใช้ตัวกฏหมายตัดสินผิด-ถูก .. แต่ใช้ตัวผู้บังคับใช้กฏหมายตัดสิน"
(ผมก็ไม่ได้ตั้งใจ ด่า ตำรวจ นะเคิฟ)



ปล. บอทตัวนี้เอาไว้ อ่าน+แสดง title ของ link ที่โพสๆ กันใน iRC เพื่อให้ความสะดวก ในการตัดสินใจว่าจะ คลิก ตามไปอ่านหรือไม่ มากกว่า
(ลิงค์ดักเกย์ ยิ่งเยอะๆ อยู่ .. จะคลิกที คิดแล้วคิดอีก)

#!/usr/bin/perl

use IO::Socket;
use Data::Dumper;
use HTTP::Cookies;
use LWP::UserAgent;
use Digest::MD5 qw(md5_hex);
use Encode::Detect::Detector;
use Encode qw(encode decode);

my $CTK = "\x03";#ctrl+k
my $CTB = "\x02";#ctrl+b
my $CTU = "\x1F";#ctrl+u
my $LANG = "TIS-620";#IRC SERVER ENCODING

my @tmp_msg;
my $tmp_msg_limit = 10;

my $nick = 'thdz';
my $server = 'www.thaishadow.com';
my $port = '6667';
my @chans = ('#thaishadow');

my $cookie_jar = HTTP::Cookies->new(autosave =>1, hide_cookie2=>1);

my $browser = LWP::UserAgent->new(
  agent=>'Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)',
  timeout=>15,
  cookie_jar=>$cookie_jar
);

my $socket = IO::Socket::INET->new(
  PeerAddr => $server,
  PeerPort => $port,
  Proto => 'tcp',
  Timeout => '60'
) or die("[!] Couldnt Connect To $irc $!\n");
$socket->autoflush(1);
sleep 1;


print $socket "NICK $nick\r\n";
print $socket "USER thdz thdz-mini thdz\@thdz.com by windows98SE\r\n";
joinchan();

while(my $line = <$socket>){
  $line =~ s/\r\n$//;
  # PING - PONG
  if($line =~ m/^PING (.*?)$/gi){
 msg("PONG $1");
  # rejoin when kick
  }elsif($line =~ m/^\:(.*?)\!(.*?)\@(.*?) KICK\s(.*?)\s(.*?)/i){
 msg("JOIN $4");
  # rejoin
  }elsif($line =~ m/rejoining/i){
 joinchan();
 sleep(3);
  # gen new nick
  }elsif($line =~ m/^\:(.+?)\s+433/i) {
 $nick = $nick.int rand(999);
 msg("NICK $nick\r\n");
 joinchan();
  # pare chat msg
  }elsif($line =~ /^\:(.+?)\!(.+?)\@(.+?) PRIVMSG (.+?) \:(.+)/){
 my ($user, $where, $chat_msg) = ($1, $4, $5);
 #ignore bot msg
 next if($user eq $nick);

 # protect flood
 if(match_eq($chat_msg, \@tmp_msg)){
   next;
 }else{
   push(@tmp_msg, $chat_msg);
   if(scalar(@tmp_msg)>=$tmp_msg_limit){
  shift(@tmp_msg);
   }
 }

 # response to room or private msg
 if($where !~ /^#/){
   $where = $user;
 }
 &pare($where, $chat_msg);
  }
}

sub pare {
  my $where = $_[0];
  my $chat_msg = $_[1];
  if(my $pid = fork){
 waitpid($pid, 0);
  }else{
 if(fork){
   exit;
 }else{
   &work($where, $chat_msg);
 }
 exit;
  }
}

sub work{
  my $where = $_[0];
  my $chat_msg = $_[1];
  if($chat_msg =~/^(https?:\/\/([^\s]+))/i){
 my $url = $1;
 if($url =~ /youtu(\.be\/|be\.com\/.+?v=)([^\&\s]+)/){
   &youtube_data($where, $2);
 }else{
   &get_title($where, $url);
 }
  }
}

sub msg{
  if($#_ == '1'){
 my $msg = &toLANG($_[1]);
 print $socket "PRIVMSG $_[0] :$msg\r\n";
  }else{
 print $socket "$_[0]\r\n";
  }
}

sub joinchan{
  foreach my $chan(@chans){
 print $socket "JOIN $chan\r\n";
  }
}

sub get_title {
  my $url = add_http($_[1]);
  my $domain = domain($url);
  if(check_allow_domain($domain)){
 my $resp = $browser->get($url);
 if($resp->status_line=~m/(200.*)/i){
   my $title = $resp->headers->{'title'};
   if($title){
  msg($_[0], "[${CTK}12Title${CTK}] $title");
   }
 }
  }
}

sub youtube_data{
  my $content = $browser->get('http://gdata.youtube.com/feeds/api/videos/'.$_[1])->content;
  my ($title) = $content =~/<media\:title type=\'plain\'>(.+?)<\/media\:title>/;
  my ($favoriteCount, $viewCount) = $content =~/<yt:statistics favoriteCount='(\d+)' viewCount='(\d+)'\/>/;
  my ($duration) = $content =~/<yt\:duration seconds=\'(\d+)\'\/>/;
  my ($author) = $content =~/<author><name>(.+?)<\/name>/;
  my ($rating) = $content =~/<gd:rating average='([^']+)'/;

  if($title){
 msg($_[0], "[${CTK}1,16You${CTK}${CTK}16,4Tube${CTK}] ${CTB}Title:${CTB} $title, ${CTB}Author:${CTB} $author, ${CTB}Time:${CTB} ".
   time_format($duration).", ${CTB}View:${CTB} ".number_format($viewCount).", ${CTB}Fav:${CTB} ".
   number_format($favoriteCount).", ${CTB}Rating Arg:${CTB} ".sprintf("%.2f", $rating)
 );
  }
}

sub number_format{
  my $number = $_[0];
  $number =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g;
  return $number;
}

sub time_format{
  my $return;
  my $in = $_[0];
  my $sec = int($in%60);
  my $min = int($in/60);
  my $hr = int($in/(60*60));
  $return .= "${hr}H:" if($hr);
  $return .= "${min}m:" if($min);
  $return .= "${sec}s" if($sec);
  return $return;
}

sub add_http {
  my $in = $_[0];
  $in =~ s/\/$//gi;
  $in =~ s/http(s)?\:\/\///gi;
  $in = 'http://'.$in;
  return $in;
}

sub no_http{
  my $in = $_[0];
  $in =~ s/http(s)?\:\/\/|\/$//gi;
  return $in;
}

sub domain {
  my $in = no_http($_[0]);
  $in =~ s/([^\/]+).*/$1/gi;
  $in =~ s/^www\.//gi;
  return $in;
}

sub check_allow_domain {
  my $domain = domain($_[0]);
  my @allow_domain = (
 'board.blackbuntu.com', 'thaishadow.com', 'piratepeer.com', 'opkwin.com', 'stephack.com',

 #'facebook.com',

 'sanook.com', 'kapook.com', 'mthai.com', 'dek-d.com',

 'thaiseoboard.com', 'drama-addict.com',

 'thairath.co.th', 'manager.co.th',

 'pantip.com', 'blognone.com', 'blogspot.com',

 'stackoverflow.com', 'unix.com', 'h-online.com', 'thehackernews.com', 'perlmonks.org',

 'exploit-db.com', '1337day.com', 'packetstormsecurity.org',

 'sritown.com',

 'pastebin.com',
  );
  return $domain if(match($domain, \@allow_domain));
}

sub match {
  my $string = $_[0];
  my @array= @{$_[1]};
  foreach my $tmp (@array){
 return $string if($string =~ /$tmp/i);
  }
}

sub match_eq {
  my $string = $_[0];
  my @array = @{$_[1]};
  foreach my $tmp (@array){
 return $string if(uc($string) eq uc($tmp));
  }
}

sub toLANG {
  my $msg = $_[0];
  my $encoding_name = Encode::Detect::Detector::detect($msg);
  if($encoding_name ne $LANG){
 return Encode::encode($LANG, Encode::decode($encoding_name, $msg));
  }else{
 return $msg;
  }
}

<Pirate> http://www.youtube.com/watch?v=wFuaZqyGDsI
<thdz> [YouTube] Title: TerraCotta - เคมี, Author: MusictabI4, Time: 4m:53s, View: 564, Fav: 2, Rating Arg: 5.00