Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

first "project"

by phenom (Chaplain)
on May 31, 2004 at 15:28 UTC ( #357806=perlquestion: print w/ replies, xml ) Need Help??
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; } }

Comment on first "project"
Select or Download Code
Re: first "project"
by davidj (Priest) on May 31, 2004 at 15:52 UTC
    I don't know about questions 2 and 3, so I will respond only to questions 1: "does size matter?"

    I still have this perception that perl code should be able to be written in a one-liner

    If your concern is to write a minimum amount of code, then there may be ways to make it "better". However, if your concern is efficiency, remember, less code does not necessarily equate to greater efficiency. Efficiency is guaranteed by using the best algorithm. (I learned this the hard way when learning C in college).

    I have written a few Tk front-ends so I know what you mean about code getting long. It's the nature of Tk since you have to manually configure each widget. One thing I have done to reduce the bulkiness of my code is to store the widget configuration information in a .conf file. Then when I load the application, I read from the .conf file and use the $widget->configure() method to configure the widgets. Granted it takes a little extra time to load the application, but it does make the code more manageable.

    hope this helps,
    davidj
      It's the nature of Tk since you have to manually configure each widget.
      You don't have to, rather use the option database. See the Tk::option manpage.
Re: first "project"
by zentara (Archbishop) on Jun 01, 2004 at 13:22 UTC
    "1) does size matter?"

    The size that matters, is the memory usage and cpu usage of the running process ID. The code size dosn't really matter, and as you keep working on your project, you will probably see where you can put redundant code into subroutines.

    In a program that scans alot of files, I would be concerned with "speed". Not to disparage File::Scan, but it is awfully slow compared to a c program like clamav

    Personally I would make a Tk frontend for running clamav, through backticks, or IPC::Open3

    Looks nice though. :-)


    I'm not really a human, but I play one on earth. flash japh
      Thanks for the input! But actually, I did tweak this front-end to work with clamav, which is also on the website here. I don't work on it much, but it does work - although VERY slowly! If you can see any reason why it runs slow for me, let me know and I'll change it.
        "I don't work on it much, but it does work - although VERY slowly! If you can see any reason why it runs slow for me, let me know and I'll change it."

        Ok I see you are running a perl module interface to clamav

        use Mail::ClamAV qw/:all/;
        I'm talking about running the clamscan program itself directly:
        my $results = `clamscan $dir`;
        or something using Tk::Fileevent like:
        my $dir = "/var/spool/mail"; my $program = "/usr/local/bin/clamscan $dir"; open(SCAN, "$program 2>&1 |") or die "Can't open: $!"; $mw->fileevent(\*SCAN, 'readable', [\&fill_text_widget,$t]); MainLoop; sub fill_text_widget { my($widget) = @_; $_ = <SCAN>; $widget->insert('end', $_); $widget->yview('end'); }

        Its almost always faster to run properly designed c programs when doing alot of file access and reading, so let clamscan do it.


        I'm not really a human, but I play one on earth. flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://357806]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (5)
As of 2014-09-17 22:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (100 votes), past polls