Merge branch 'master' into WebGUI8. Merged up to 7.9.12

lib/WebGUI/Asset/File/ZipArchive.pm

@@ -46,7 +46,7 @@ use Archive::Tar;
 use Archive::Zip;
 use Cwd ();
 use Scope::Guard ();
-
+use WebGUI::Utility qw/isIn/;
 
 
 =head1 NAME
@@ -96,19 +96,21 @@ sub unzip {
     my $dir_guard = Scope::Guard->new(sub { chdir $cwd });
    
 	my $i18n = WebGUI::International->new($self->session,"Asset_ZipArchive");
-	if ($filename =~ m/\.zip/i) {
+	if ($filename =~ m/\.zip$/i) {
 		my $zip = Archive::Zip->new();
 		unless ($zip->read($filename) == $zip->AZ_OK){
 			$self->session->errorHandler->warn($i18n->get("zip_error"));
 			return 0;
 		}
-		$zip->extractTree();  
-	} elsif ($filename =~ m/\.tar/i) {
+		$zip->extractTree();
+        $self->fixFilenames;
+	} elsif ($filename =~ m/\.tar$/i) {
 		Archive::Tar->extract_archive($filepath.'/'.$filename,1);
 		if (Archive::Tar->error) {
 			$self->session->errorHandler->warn(Archive::Tar->error);
 			return 0;
 		}
+        $self->fixFilenames;
 	} else {
 		$self->session->errorHandler->warn($i18n->get("bad_archive"));
 	}
@@ -118,6 +120,28 @@ sub unzip {
 
 #-------------------------------------------------------------------
 
+=head2 fixFilenames ( )
+
+Fix any files with dangerous extensions, in all files that were extracted.  This is done
+locally, because if we used a method from Storage, then it would also rename HTML files.
+
+=cut
+
+sub fixFilenames {
+	my $self    = shift;
+    my $storage = $self->getStorageLocation;
+    my $files   = $storage->getFiles('all');
+    FILE: foreach my $file (@{ $files }) {
+        my $extension = $storage->getFileExtension($file);
+        next FILE unless isIn($extension, qw/pl perl pm cgi php asp sh/);
+        my $newFile = $file;
+        $newFile =~ s/\.$extension/_$extension.txt/;
+        $storage->renameFile($file, $newFile);
+    }
+}
+
+#-------------------------------------------------------------------
+
 =head2 prepareView ( )
 
 See WebGUI::Asset::prepareView() for details.
@@ -159,7 +183,7 @@ override processEditForm => sub {
 		return undef;
 	}
 	
-	unless ($file =~ m/\.tar/i || $file =~ m/\.zip/i) {
+	unless ($file =~ m/\.tar$/i || $file =~ m/\.zip$/i) {
 		$storage->delete;
 		$self->session->db->write("update FileAsset set filename=NULL where assetId=".$self->session->db->quote($self->getId));
 		$self->session->scratch->set("za_error",$i18n->get("za_error"));

lib/WebGUI/Asset/Template.pm

@@ -113,6 +113,7 @@ use WebGUI::Asset::Template::HTMLTemplate;
 use WebGUI::Utility;
 use WebGUI::Form;
 use WebGUI::Exception;
+use List::MoreUtils qw{ any };
 use Tie::IxHash;
 use Clone qw/clone/;
 use HTML::Packer;
@@ -410,14 +411,23 @@ A parser class to use. Defaults to "WebGUI::Asset::Template::HTMLTemplate"
 sub getParser {
     my $class = shift;
     my $session = shift;
-    my $parser = shift || $session->config->get("defaultTemplateParser") || "WebGUI::Asset::Template::HTMLTemplate";
+    my $parser = shift;
 
-    if ($parser eq "") {
-        return WebGUI::Asset::Template::HTMLTemplate->new($session);
-    } else {
-        eval("use $parser");
-        return $parser->new($session);
+    # If parser is not in the config, throw an error message
+    if ( $parser && $parser ne $session->config->get('defaultTemplateParser') 
+                && !any { $_ eq $parser } @{$session->config->get('templateParsers')} ) {
+        WebGUI::Error::NotInConfig->throw(
+            error       => "Attempted to load template parser '$parser' that is not in config file",
+            module      => $parser,
+            configKey   => 'templateParsers',
+        );
     }
+    else {
+        $parser ||= $session->config->get("defaultTemplateParser") || "WebGUI::Asset::Template::HTMLTemplate";
+    }
+
+    WebGUI::Pluggable::load( $parser );
+    return $parser->new($session);
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/Content/Asset.pm

@@ -62,7 +62,6 @@ The URL for this request.
 sub dispatch {
     my $session      = shift;
 	my $assetUrl     = shift;
-    return undef unless $assetUrl;
     my $permutations = getUrlPermutations($assetUrl);
     foreach my $url (@{ $permutations }) {
         if (my $asset = getAsset($session, $url)) {
@@ -137,14 +136,17 @@ The URL to permute.
 
 sub getUrlPermutations {
     my $url          = shift;
+    ##Handle empty urls (sitename only)
+    return ['/'] if !$url
+                 ||  $url eq '/';
     my @permutations = ();
-    return \@permutations if !$url;
     if ($url =~ /\.\w+$/) {
         push @permutations, $url;
         $url =~ s/\.\w+$//;
     }
     my $uri       = URI->new($url);
     my @fragments = $uri->path_segments();
+    use Data::Dumper;
     FRAG: while (@fragments) {
         last FRAG if $fragments[-1] eq '';
         push @permutations, join "/", @fragments;

lib/WebGUI/DatabaseLink.pm

@@ -382,6 +382,9 @@ sub queryIsAllowed {
 	my $self  = shift;
 	my $query = shift;
 
+    # Remove all comments before checking validity
+    $query =~ s{/[*].*?[*]/}{}g;
+
     my ($firstWord) = $query =~ /(\w+)/;
     $firstWord = lc $firstWord;
     return isIn($firstWord, split(/\s+/, lc $self->{_databaseLink}{allowedKeywords})) ? 1 : 0;

lib/WebGUI/Exception.pm

@@ -284,6 +284,12 @@ use Exception::Class (
         isa             => 'WebGUI::Error',
         description     => 'A database error',
     },
+
+    'WebGUI::Error::NotInConfig' => {
+        isa             => 'WebGUI::Error',
+        description     => 'A module was requested that does not exist in the configuration file.',
+        fields          => [qw{ module configKey }],
+    },
 );
 
 {

lib/WebGUI/Operation/Help.pm

@@ -41,18 +41,16 @@ been already and logs errors during the load.
 sub _loadHelp {
 	my $session = shift;
 	my $helpPackage = shift;
+        eval { WebGUI::Pluggable::load( $helpPackage ); };
+	if ($@) {
+		$session->errorHandler->error("Help failed to compile: $helpPackage. ".$@);
+		return {};
+	}
 	if (defined *{"$helpPackage\::HELP"}) {  ##Symbol table lookup
 		our $table;
 		*table = *{"$helpPackage\::HELP"};  ##Create alias into symbol table
 		return $table;  ##return whole hashref
 	}
-	my $load = sprintf 'use %-s; $%-s::HELP', $helpPackage, $helpPackage;
-	my $help = eval($load);
-	if ($@) {
-		$session->errorHandler->error("Help failed to compile: $helpPackage. ".$@);
-		return {};
-	}
-	return $help;
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/Storage.pm

@@ -316,10 +316,7 @@ sub addFileFromFilesystem {
         return undef;
     }
     my $filename = (File::Spec->splitpath( $pathToFile ))[2];
-    if (isIn($self->getFileExtension($filename), qw(pl perl sh cgi php asp pm))) {
-        $filename =~ s/\./\_/g;
-        $filename .= ".txt";
-    }
+    $filename = $self->block_extensions($filename);
     $filename = $self->session->url->makeCompliant($filename);
     my $source;
     my $dest;
@@ -382,11 +379,7 @@ sub addFileFromFormPost {
             if ($upload->size > 1024 * $self->session->setting->get("maxAttachmentSize"));
         $clientFilename =~ s/.*[\/\\]//;
         $clientFilename =~ s/^thumb-//;
-        my $type = $self->getFileExtension($clientFilename);
-        if (isIn($type, qw(pl perl sh cgi php asp html htm))) { # make us safe from malicious uploads
-            $clientFilename =~ s/\./\_/g;
-            $clientFilename .= ".txt";
-        }
+        $clientFilename = $self->block_extensions($clientFilename);
         $filename = $session->url->makeCompliant($clientFilename);
         my $filePath = $self->getPath($filename);
         $attachmentCount++;
@@ -451,10 +444,7 @@ The content to write to the file.
 
 sub addFileFromScalar {
 	my ($self, $filename, $content) = @_;
-    if (isIn($self->getFileExtension($filename), qw(pl perl sh cgi php asp html htm))) { # make us safe from malicious uploads
-        $filename =~ s/\./\_/g;
-        $filename .= ".txt";
-    }
+    $filename = $self->block_extensions($filename);
     $filename = $self->session->url->makeCompliant($filename);
 	if (open(my $FILE, ">", $self->getPath($filename))) {
 		print $FILE $content;
@@ -500,6 +490,32 @@ sub adjustMaxImageSize {
 
 #-------------------------------------------------------------------
 
+=head2 block_extensions ( $file )
+
+Rename files so they can't be used for malicious purposes.  The list of bad extensions
+includs shell script, perl scripts, php, ASP, perl modules and HTML files.
+
+Any file found with a bad extension will be renamed from file.ext to file_ext.txt
+
+=head3 $file
+
+The file to check for bad extensions.
+
+=cut 
+
+sub block_extensions {
+    my $self = shift;
+    my $file = shift;
+    my $extension = $self->getFileExtension($file);
+    if (isIn($extension, qw(pl perl sh cgi php asp pm html htm))) {
+        $file =~ s/\.$extension/\_$extension/;
+        $file .= ".txt";
+    }
+    return $file;
+}
+
+#-------------------------------------------------------------------
+
 =head2 clear ( )
 
 Clears a storage location of all files.  If configured for CDN, add
@@ -1827,6 +1843,13 @@ sub untar {
     }, ".");
     $self->_changeOwner(@files);
 
+    ##Prevent dangerous files from being added to the storage location via untar
+    FILE: foreach my $file (@files) {
+        my $blockname = $temp->block_extensions($file);
+        next FILE if $blockname eq $file;
+        $temp->renameFile($file, $blockname);
+    }
+
     chdir $originalDir;
     return $temp;
 }