diff --git a/malware4.pl b/malware4.pl
new file mode 100644
index 0000000..1a7c59d
--- /dev/null
+++ b/malware4.pl
@@ -0,0 +1,161 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use CGI;
+
+BEGIN {
+    $SIG{__DIE__} = sub {
+        my $msg = shift;
+        print "status: 500\n";
+        print "content-type: text/html\n\n";
+        $msg =~ s/\n/\0/g;
+        print "error: $msg\n";
+        CORE::die $msg;
+    }
+}
+
+$| = 1;
+our $q = CGI->new;
+print "Content-type: text/html\n\n";
+
+my @regexen = (
+    qr/<\?php\s+function\s+([A-z0-9]{1,10})\(\$([A-z0-9]{1,10})\,\s+\$([A-z0-9]{1,10})\)\{\$([A-z0-9]{1,10})\s+\=\s+\'\'\;\s+for\(\$([A-z]{1,2})\=0\;\s+\$([A-z]{1,2})\s+\<\s+strlen\(\$([A-z0-9]{1,10})\)\;\s+\$([A-z]{1,2})\+\+\)\{\$([A-z0-9]{1,10})\s+\.\=\s+isset\(\$([A-z0-9]{1,10})\[\$([A-z0-9]{1,10})\[\$([A-z]{1,2})\]\]\)\s+\?\s+\$([A-z0-9]{1,10})\[\$([A-z0-9]{1,10})\[\$([A-z]{1,2})\]\]\s+\:\s+\$([A-z0-9]{1,10})\[\$([A-z]{1,2})\]\;\}\s+\$([A-z0-9]{1,10})\=\"base64\_decode\"\;return\s+\$([A-z0-9]{1,10})\(\$([A-z0-9]{1,10})\)\;\}.+?\$([A-z]{1,2})\s+\=\s+\Array\(.+?eval\(([A-z0-9]{1,10})\(\$([A-z]{1,2})\,\s+\$([A-z]{1,2})\)\)\;\?>/is,
+    qr/<\?php\s+\$([A-z0-9]{1,10})\=\'aWYoaXNzZXQoJF9SRVFVRVNUWydjb2NvJ10pICYmICRfUkVRVUVTVFsnY29jbyddIT0nJyl7ZXZhbCgkX1JFUVVFU1RbJ2NvY28nXSk7ZXhpdCgpO30\=\'\;eval\(base64\_decode\(\$([A-z0-9]{1,10})\)\)\;exit\(\)\;\s+\?>/is,
+
+    );
+my @base64_decodes = (
+
+
+);
+
+my @file_list;
+my %possible_list;
+
+my $start_dir = $ENV{'SCRIPT_FILENAME'} || '../';
+$start_dir =~ s/\/cgi-bin//;
+$start_dir =~ s/\/lp-msh-scanner//;
+$start_dir = substr($start_dir, 0, rindex($start_dir, '/'));
+dir ($start_dir);
+
+print "<br />\n<br />\n";
+print 'Infected Files (' . scalar(@file_list) . "):<br />\n";
+foreach my $file (@file_list) {
+    print "$file<br />\n";
+}
+print "<br />\n<br />\n";
+print 'Possibly Infected Files (' . scalar(keys(%possible_list)) . "):<br />\n";
+foreach my $key (keys(%possible_list)) {
+    print "$key => $possible_list{$key}<br />\n";
+}
+
+sub dir {
+    my ($start_dir) = @_;
+
+    unless (opendir(DIR, $start_dir)) {
+        print "Skipping directory $start_dir: $! <br />";
+        return;
+    }
+
+    opendir(DIR, $start_dir) || die "$start_dir: $!";
+    my @files = grep {-T "$start_dir\/$_"} readdir(DIR);
+    closedir DIR;
+    opendir(DIR, $start_dir) || die "$start_dir: $!";
+    my @folders = grep {-d "$start_dir\/$_"} readdir(DIR);
+    closedir DIR;
+
+foreach my $file (sort @files) {
+        next if $file eq 'error_log';
+        next if $file eq 'tcpdf.php';
+        next if $file eq '*.xls';
+        next if $file eq '*.doc';
+        next if $file eq '*.pdf';
+        next if $file eq '*.sql';
+        next if $file eq '*.docx';
+        next if $file eq '*.eml';
+        next if $file eq '*.csv';
+        next if $file eq '*.zip';
+        next if $file eq '*.tar.gz';
+        next if $file eq '*.jpa';
+        next if $file eq '*.rar';
+        next if $file eq '*.tar';
+        next if $file eq '*.gz';
+        next if $file eq '*.mov';
+        next if $file eq '*.avi';
+        next if $file eq '*.mp3';
+        next if $file eq '*.mp4';
+        next if $file eq '*.webm';
+        next if $file eq '*.flv';
+        next if $file eq '*.fla';
+        next if $file eq '*.swf';
+        next if $file eq '*.ini';
+        next if $file eq '*.txt';
+        next if $file eq '*.po';
+        next if $file eq '*.mo';
+        print "Scanning $start_dir/$file... ";
+
+        unless (-r "$start_dir/$file") {
+            print " Skipping file, unable to read file<br />";
+            next
+        }
+        if ((-s "$start_dir/$file") > 1024000) {
+            print " Skipping file, over 1MB<br />";
+            next
+        }
+
+        my $fh;
+        unless (open ($fh, '<', "$start_dir/$file")) {
+            print " Unable to read file, $!<br />";
+            next
+        }
+
+        my $contents = do { local $/; <$fh> };
+        close $fh;
+
+my ($infected, $cleaned, $possible, $known, $sig);
+        foreach my $pattern (@regexen) {
+            my $t;
+            if ($contents =~ /$pattern/) {
+                my ($d, $t) = ($1, $2);
+                    $infected = 1;
+                    ($contents, $cleaned) = clean_file("$start_dir/$file", $contents, $pattern);
+                    push (@file_list, "$start_dir/$file");
+            }
+
+            $t = undef;
+        }
+
+
+        print $infected ? ($cleaned ? "<font color='green'>Infected, Cleaned<br /></font>\n" : "Infected, Cleaning failed<br />\n") : ($possible ? "Possibly Infected<br />\nSignature Unknown: $sig<br />\n" : "Not infected<br />\n");
+    }
+
+
+    foreach my $folder (sort @folders) {
+        if ($folder !~ /^\.\.?$/) {
+            dir("$start_dir/$folder");
+        }
+    }
+}
+
+sub clean_file {
+    my ($file, $contents, $pattern) = @_;
+    my $cleaned;
+
+    if ($contents =~ /\n{4}/) {
+        $contents =~ s/\n\n/\n/g;
+    }
+    $contents =~ s/$pattern//g;
+    if ($contents =~ /$pattern/) {
+        $cleaned = 0;
+    }
+    else {
+        open (my $fh, '>', $file);
+        print $fh $contents;
+        close $fh;
+        $cleaned = 1;
+    }
+
+    return ($contents, $cleaned);
+}
+
+1;
\ No newline at end of file