http://www.perlmonks.org?node_id=357806

phenom has asked for the wisdom of the Perl Monks concerning the following question:

Hello all, I've been working on my first "real" perl project: a front-end (Tk) for the File::Scan module (READMORE), which is for virus scanning. I'm doing it for two reasons: it's interesting, and it's a good learning experience for a beginner (I still have less than a year's experience with perl). Anyway, here are some questions I've come up with:

1) does size matter? (insert witty comment here) I still have this perception that perl code should be able to be written in a one-liner - this is getting huge!
2) I'm having problems with encrypted rar detection. Unlike Archive::Zip, there is no

if($blah->isEncrypted) {
function for Archive::Rar. So I've resorted to other means of detection - which appears to work, but I'm wondering if there are better ways of doing it (see the subroutine "unrar"). I considered emailing the author, but the module itself hasn't been worked on in awhile. I am not using the Archive::Rar module - the benefit would be making this script more cross-platform, but I am currently using a system call instead.
3) I'm having trouble with handling zip files within zips. Currently, a zip is unzipped into a temporary directory. If another is found, it is not unzipped: it just moves on to the next file. I tried to tweak this to handle additional zips, but I ended up in a loop, since the initial zip within the zip was still there...
4) Not a question, just a comment: I realize this could be more cross-platform. I'll fix that in the next service pack. :)

Anyway, I appreciate any insight. Screenshots are available here

#!/usr/bin/perl use strict; use warnings; use File::Scan; use File::Find::Rule; use File::Basename; use File::Type; use IO::File; use Archive::Zip qw/:CONSTANTS :MISC_CONSTANTS :ERROR_CODES/; use Tk; use Tk::Text; use Tk::DialogBox; use Tk::Menu; use Tk::HList; use LWP::UserAgent; my %skipcodes = ( 0 => "File Not Skipped", 1 => "File Not Vulnerable", 2 => "File Has Zero Size", 3 => "Small File Size", 4 => "File Exceeds Max Test Size", 5 => "File Exceeds Max Binary Size", ); ####GLOBALS#### my $virus_log = ''; my ($key, $value); my $ren = 0; my $save_log = 0; my $recursive = 0; my $fullpath = 0; my $filetype = 0; my $status = 0; my $count = 0; my $z_op = 0; my $hidden = 0; my $num_found = 0; my $VERSION = 'v0.9g'; my %found; my @popup_text; my $cdir = Cwd::getcwd(); my $mm = File::Type->new(); ####BEGIN TK STUFF#### my $mw = new MainWindow; $mw->geometry('600x400'); $mw->title("vXscan, $VERSION"); my $rf = $mw->Scrolled( 'HList', -head => 1, -columns => 3, -scrollbars => 'osoe', -width => 80, -height => 80, -background => 'white', )->pack(); $mw->configure(-menu => my $menubar = $mw->Menu); my $File = $menubar->cascade(-label => '~File'); my $options = $menubar->cascade(-label => '~Scan Options'); my $advanced = $menubar->cascade(-label => '~Advanced'); my $help = $menubar->cascade(-label => '~Help'); $File->command( -label => 'Scan File Now', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+F', -underline => 0, -command => sub { \&getfile(1) }, ); $File->command( -label => 'Directory Scan', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+D', -underline => 0, -command => sub { \&getfile(3) }, ); $File->command( -label => 'Recursive Scan', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+R', -underline => 0, -command => sub { \&getfile(2) }, ); $File->command( -label => 'Exit', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+X', -underline => 1, -command => \&exit, ); $options->checkbutton( -label => 'Save To Log', -activebackground => 'LightSteelBlue', -variable => \$save_log, ); $options->checkbutton( -label => 'Show Filetype', -activebackground => 'LightSteelBlue', -underline => 0, -variable => \$filetype, ); $options->checkbutton( -label => 'Scan Hidden', -activebackground => 'LightSteelBlue', -variable => \$hidden, ); $options->checkbutton( -label => 'Show Fullpath', -activebackground => 'LightSteelBlue', -underline => 0, -variable => \$fullpath, ); $options->command( -label => 'Clear Output', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+O', -underline => 6, -command => sub { $rf->delete('all'); $rf->header('configure', 2, -headerbackground => 'gray +'); } ); $advanced->radiobutton( -label => 'Take No Action', -activebackground => 'LightSteelBlue', -variable => \$ren, -value => 0, ); $advanced->radiobutton( -label => 'Rename Infected', -activebackground => 'LightSteelBlue', -variable => \$ren, -value => 'rename', ); $advanced->radiobutton( -label => 'Delete Infected', -activebackground => 'LightSteelBlue', -variable => \$ren, -value => 'delete', ); $help->command( -label => 'Get Latest File::Scan', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+G', -underline => 0, -command => \&update, ); $help->command( -label => 'About vXscan...', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+A', -underline => 0, -command => sub { \&popup($popup_text[0]); }, ); $help->command( -label => 'Version', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+V', -underline => 0, -command => sub { \&popup($popup_text[1]); }, ); $help->command( -label => 'Output Help', -activebackground => 'LightSteelBlue', -accelerator => 'Ctrl+H', -underline => 7, -command => sub { \&popup($popup_text[2]); }, ); ####KEY BINDINGS#### $mw->bind('<Control-Key-f>', sub { \&getfile(1); }); $mw->bind('<Control-Key-x>', sub { exit; }); $mw->bind('<Control-Key-o>', sub { $rf->delete('all'); $rf->header('configure', 2, -headerbackground => 'gray'); }); $mw->bind('<Control-Key-g>', sub { update();} ); $mw->bind('<Control-Key-a>', sub { \&popup($popup_text[0]); }); $mw->bind('<Control-Key-v>', sub { \&popup($popup_text[1]); }); $mw->bind('<Control-Key-h>', sub { \&popup($popup_text[2]); }); $rf->pack(qw/-side right -fill both -expand 1/); my @headers = qw/ File Type Status /; foreach my $x ( 0 .. $#headers ) { $rf->header( 'create', $x, -text => $headers[$x], -headerbackground => 'gray', ); } @popup_text = ( "vXscan, $VERSION\nby Dave M\nThis program is free software.\nYou may +modify it and/or redistribute it under the same terms\nas Perl itself +.\ndave_nerd AT myway DOT com\n\nFile::Scan is (c) 2004, Henrique Dia +s\n", "vXscan, $VERSION\nby Dave M\nCheck http://www.rootshell.be/~phen0m fo +r updates", "From left to right:\nFILE: Shows the file scanned. A filename in pare +ns shows either the \"parent\" zip file,\n or the file inside the zip +, if it was an encrypted zip file.\nTYPE: Takes a stab at what filety +pe the scanned file is.\nSTATUS: Will reflect either a virus name, if + it was suspicious,\nor one of several skipcodes, meaning it wasn't s +canned for one of several reasons.\n"); MainLoop; ####GET THE FILE(S)#### sub getfile { my $option = shift; my ($single_file, $dir); my @files = (); if($option == 1) { my $types = [ ['Executables', ['.exe', '.pif', '.scr +', '.com' ]], ['vbs, html, eml', ['.vbs', '.html', '.em +l']], ['Compressed Files', ['.zip', '.rar' ]], ['All Files', '.*', ], ]; $single_file = $mw->getOpenFile(-filetypes=>$types); if(!$single_file) { return; } else { $dir = dirname("$single_file"); push(@files, $single_file); } } else { $dir = $mw->chooseDirectory(-initialdir => $cdir, -title => "Select a Directory..."); if($dir) { if($option == 2) { @files = File::Find::Rule->file() ->readable ->in($dir); } elsif($option == 3) { @files = File::Find::Rule->file() ->readable ->maxdepth(1) ->in($dir); } } else { return; } } foreach my $scanthis (@files) { next if(basename($scanthis) =~ /^\./) && (!$hidden); $status = $mm->mime_type($scanthis); if($status =~ /zip/ && $status !~ /(gzip|bzip)/) { unzip($scanthis, $dir); } elsif($status =~ /rar/) { unrar($scanthis, $dir); } else { scan($scanthis, $dir); } } clean_up(); } ####UGLY WAY OF DOING ZIP-FILES#### sub unzip { my ($file, $dir) = @_; my $sendname; my $tmpdir = "/tmp/$$"; my @args = ("/usr/bin/unzip", "-qq", "$file", "-d", "$tmpdir") +; my $zip = Archive::Zip->new($file) or return; my @members = $zip->members(); for my $m (@members) { my $membername = $m->fileName(); $sendname = basename($file); if($m->isEncrypted()) { display("$sendname ($membername)", "Encrypted +Zip", "Unreadable"); return; } if ($zip->eocdOffset()) { display($sendname, "Corrupt Zip", "Unreadable" +); return; } } system(@args); my @scanthese = <$tmpdir/*>; foreach (@scanthese) { scan($_, $tmpdir, $sendname, $dir); } system("rm", "-rf", "$tmpdir"); } ####ATTEMPTING RAR STUFF#### sub unrar { my ($file, $dir) = @_; my $sendname; my $tmpdir = "/tmp/$$"; my $fh = IO::File->new($file); my ($data, $substr); $fh->read($data, 16*1024); $fh->close; $substr = substr($data, 20, 4); if($substr =~ /\x24/ || $substr =~ /\x44/ || $substr =~ /\x84/ +) { display("$file", "Encrypted RAR", "Unreadable"); return; } my @args = ("/usr/bin/unrar", "e", "-inul", "$file", "$tmpdir/ +"); $sendname = basename($file); system(@args); my @scanthese = <$tmpdir/*>; foreach (@scanthese) { scan($_, $tmpdir, $sendname, $dir); } system("rm", "-rf", "$tmpdir"); } ####THE SCAN FUNCTION#### sub scan { my ($file, $dir, $z_op, $orig_dir) = @_; my ($fs, $e, $c, $virus, @holdem); $status = $mm->mime_type($file); $status =~ s/^application\///; if(!$ren) { $fs = File::Scan->new( ); } elsif ($ren eq 'rename') { $fs = File::Scan->new( extension => 'VIRUS', ); } elsif ($ren eq 'delete') { $fs = File::Scan->new( delete => 1, ); } if($dir) { chdir($dir) || die "Couldn't change to $dir! $!\n"; } $virus = $fs->scan($file); $file =~ s/\s+//g; if($z_op) { my @format = split/\//, $file; $file = "$orig_dir/$format[-1]"; $file .= " (from $z_op)"; } push(@holdem, $file, ($filetype)? $status : "---"); push(@holdem, $e) if($e = $fs->error); push(@holdem, $skipcodes{$c}) if($c = $fs->skipped); if($fs->suspicious) { push(@holdem, "Suspicious!"); $found{$file} = "Suspicious"; } if($virus) { $rf->header('configure', 2, -headerbackground => 'red' +); push(@holdem, $virus); $found{$file} = $virus; } if(!$e && !$c && !$fs->suspicious && !$virus) { push(@holdem, "Skipping"); } display(@holdem); } ####OUTPUT#### sub clean_up { $count ||= 0; $num_found = scalar keys (%found); if($save_log) { my ($day, $mon, $year) = (localtime)[3..5]; $year += 1900; $virus_log = "virus." . "$day-$mon-$year" . ".log"; open STDOUT, ">>$ENV{HOME}/$virus_log" || die "$!\n"; print STDOUT "vXscan $VERSION\nFile::Scan version $Fil +e::Scan::VERSION, File::Type version $File::Type::VERSION\n", scalar +localtime; print STDOUT "\n"; print STDOUT "Scanned $count file(s).\n"; print STDOUT "Found $num_found viruses or suspicious f +ile(s).\n"; } if(!$num_found) { print STDOUT "No viruses found.\n" if($save_log); $rf->header('configure', 2, -headerbackground => 'gree +n'); } else { if($save_log) { while(( $key, $value) = each %found) { write(STDOUT); } } } ##GUI POPUP## my $popup = $mw->DialogBox( -title => 'End Report', -buttons => ["OK"], ); $popup->add('Label', -padx => 40, -pady => 40, -relief => 'raised', -text => "Scanning finished.\nFound $num_found virus +es.\nTotal files scanned: $count\n") ->pack(); $popup->Show(); ##RESET COUNTERS## $count = 0; %found = (); close(STDOUT) if($save_log); } sub display { my @this = @_; my $flag = 0; $rf->add($count); $rf->itemCreate($count, 0, -text => ($fullpath)? $this[0] : ba +sename($this[0])); $rf->itemCreate($count, 1, -text => $this[1]); $rf->itemCreate($count, 2, -text => $this[2]); $mw->after(1, sub { $flag++ }); $mw->waitVariable(\$flag); $count++; #thanks to bbfu (perlmonks.org) for this!! } sub popup { my $message = shift; my $about = $mw->DialogBox( -title => 'vXscan', -buttons => ["OK"], ); $about->add('Label', -padx => 25, -pady => 25, -relief => 'raised', -text => $message) ->pack(); $about->Show(); } format STDOUT_TOP = File St +atus ---------------------------------------------------------------------- +---- . format STDOUT = @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<@>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>> $key, $v +alue . sub update { my $url = "http://search.cpan.org/~hdias/"; my $ua = LWP::UserAgent->new; $ua->timeout(7); my $message; my $response = $ua->get( $url ); if($response->is_success) { $response->content =~ /File-Scan-(\d+\.\d+)/i; my $file = "File-Scan-$1.tar.gz"; my $new = $ua->get ( "http://search.cpan.org/CPAN/auth +ors/id/H/HD/HDIAS/$file", ':content_file' => $file ); if($new->is_success) { $message = "The file $file was successfully re +trieved."; popup($message); } else { $message = "Connected, but couldn't retrive $f +ile:\n$new->status_line"; popup($message); } } else { $message = "Unable to connect: $response->status_line" +; popup($message); return; } }