From df1e8791c8d9aa7c56f686490ac18a4fd1a43aa5 Mon Sep 17 00:00:00 2001
From: pcanterino <>
Date: Thu, 30 Dec 2010 16:07:56 +0000
Subject: [PATCH] Catch some errors that might occur when unpacking an archive
---
errors.conf | 4 ++++
modules/Command.pm | 14 ++++++++++++--
templates/about.htm | 5 +++++
3 files changed, 21 insertions(+), 2 deletions(-)
diff --git a/errors.conf b/errors.conf
index 87c8914..7da9eca 100644
--- a/errors.conf
+++ b/errors.conf
@@ -30,6 +30,8 @@ link_edit = For security reasons, you cannot edit the target file of a s
link_replace = You are not allowed to overwrite symbolic links.
mkdir_failed = Could not create directory '{DIR}'.
mkfile_failed = Could not create file '{FILE}'.
+no_ae = Perl module Archive::Extract is not available.
+no_archive = '{FILE}' is not an archive file.
no_copy = You have not enough permissions to copy this file.
no_delete = You have not enough permissions to delete this file.
no_dir_access = You have not enough permissions to access this directory.
@@ -47,5 +49,7 @@ remove_root = You are not allowed to remove the root directory.
rename_failed = Could not move/rename '{FILE}' to '{NEW_FILE}'.
rename_root = You are not allowed to move/rename the root directory.
text_to_binary = You are not allowed to write text data into a binary file.
+unpack_failed = Unpacking of archive file '{FILE}' failed.
+unpack_no_dir = You cannot unpack archive file '{FILE}' to an ordinary file or a symbolic ('{NEW_FILE}' is not a directory).
# End of configuration file
\ No newline at end of file
diff --git a/modules/Command.pm b/modules/Command.pm
index 0880c8c..ec7ca69 100644
--- a/modules/Command.pm
+++ b/modules/Command.pm
@@ -6,7 +6,7 @@ package Command;
# Execute Dev-Editor's commands
#
# Author: Patrick Canterino
-# Last modified: 2010-10-26
+# Last modified: 2010-10-30
#
# Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann
# Copyright (C) 2003-2009 Patrick Canterino
@@ -652,9 +652,17 @@ sub exec_unpack($$)
my $new_virtual = $data->{'new_virtual'};
my $cgi = $data->{'cgi'};
+ return error($config->{'errors'}->{'no_ae'},$dir) unless($File::Access::has_archive_extract);
+ return error($config->{'errors'}->{'no_archive'},$dir,{FILE => encode_html($virtual)}) unless(is_archive($physical));
+
if($new_physical)
{
- archive_unpack($physical,$new_physical);
+ return error($config->{'errors'}->{'unpack_no_dir'},$dir,{FILE => encode_html($virtual), NEW_FILE => encode_html($new_virtual)}) if(-l $new_physical || not -d $new_physical);
+
+ my $return_unpack = archive_unpack($physical,$new_physical);
+
+ return error($config->{'errors'}->{'unpack_failed'},$dir,{FILE => encode_html($virtual), AE_ERROR => ''}) unless($return_unpack);
+
return devedit_reload({command => 'show', file => $new_virtual});
}
else
@@ -1214,6 +1222,8 @@ sub exec_about($$)
$tpl->fillin('PERL_PROG',encode_html($^X));
$tpl->fillin('PERL_VER', sprintf('%vd',$^V));
+
+ $tpl->parse_if_block('PERL_ARCHIVE_EXTRACT',$File::Access::has_archive_extract);
# Information about the server
diff --git a/templates/about.htm b/templates/about.htm
index a3cf38a..da7de13 100644
--- a/templates/about.htm
+++ b/templates/about.htm
@@ -182,6 +182,11 @@ WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.