X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/e3a612df5e53adb76632fa1e9b32770e83bf8eff..192be0abe5fb17e24b17342407893bb2c7607d78:/modules/Command.pm diff --git a/modules/Command.pm b/modules/Command.pm index cc996ca..12f876c 100644 --- a/modules/Command.pm +++ b/modules/Command.pm @@ -6,14 +6,14 @@ package Command; # Execute Dev-Editor's commands # # Author: Patrick Canterino -# Last modified: 2005-05-11 +# Last modified: 2011-02-11 # # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann -# Copyright (C) 2003-2009 Patrick Canterino +# Copyright (C) 2003-2011 Patrick Canterino # All Rights Reserved. # # This file can be distributed and/or modified under the terms of -# of the Artistic License 1.0 (see also the LICENSE file found at +# of the Artistic License 2.0 (see also the LICENSE file found at # the top level of the Dev-Editor distribution). # @@ -42,9 +42,11 @@ my $users = eval('getpwuid(0)') && eval('getgrgid(0)'); my %dispatch = ('show' => \&exec_show, 'beginedit' => \&exec_beginedit, 'endedit' => \&exec_endedit, + 'download' => \&exec_download, 'mkdir' => \&exec_mkdir, 'mkfile' => \&exec_mkfile, 'upload' => \&exec_upload, + 'unpack' => \&exec_unpack, 'copy' => \&exec_copy, 'rename' => \&exec_rename, 'remove' => \&exec_remove, @@ -211,6 +213,8 @@ sub exec_show($$) $ftpl->parse_if_block('users',$users && -o $phys_path); + $ftpl->parse_if_block('archive',$File::Access::has_archive_extract && is_archive($file)); + $ftpl->parse_if_block('even',($count % 2) == 0); $dirlist .= $ftpl->get_template; @@ -444,6 +448,32 @@ sub exec_endedit($$) return devedit_reload({command => 'beginedit', file => $virtual}); } +# exec_download() +# +# Execute a HTTP download of a file +# +# Params: 1. Reference to user input hash +# 2. Reference to config hash +# +# Return: Output of the command (Scalar Reference) + +sub exec_download($$) +{ + my ($data,$config) = @_; + my $physical = $data->{'physical'}; + my $virtual = $data->{'virtual'}; + my $dir = upper_path($virtual); + + return return error($config->{'errors'}->{'no_download'},$dir,{FILE => $virtual}) if((not -r $physical) || (-d $physical || -l $physical)); + + my $filename = file_name($virtual); + + my $output = header(-type => 'application/octet-stream', -attachment => $filename); + $output .= ${ file_read($physical,1) }; + + return \$output; +} + # exec_mkfile() # # Create a file and return to directory view @@ -466,7 +496,15 @@ sub exec_mkfile($$) return error($config->{'errors'}->{'file_exists'},$dir,{FILE => $new_virtual}) if(-e $new_physical); file_create($new_physical) or return error($config->{'errors'}->{'mkfile_failed'},$dir,{FILE => $new_virtual}); - return devedit_reload({command => 'show', file => $dir}); + + if($data->{'cgi'}->param('edit')) + { + return devedit_reload({command => 'beginedit', file => $new_virtual}); + } + else + { + return devedit_reload({command => 'show', file => $dir}); + } } else { @@ -576,6 +614,15 @@ sub exec_upload($$) $data =~ s/\015\012|\012|\015/\n/g if($ascii); # Replace line separators if transferring in ASCII mode file_save($file_phys,\$data,not $ascii) or return error($config->{'errors'}->{'mkfile_failed'},$virtual,{FILE => $file_virt}); + if($cgi->param('unpack') && $File::Access::has_archive_extract) + { + return error($config->{'errors'}->{'no_archive'},$virtual,{FILE => encode_html($file_virt)}) unless(is_archive($file_phys)); + + my $return_unpack = archive_unpack($file_phys,$physical); + + return error($config->{'errors'}->{'unpack_failed'},$virtual,{FILE => encode_html($file_virt), AE_ERROR => ''}) unless($return_unpack); + } + return devedit_reload({command => 'show', file => $virtual}); } else @@ -588,6 +635,58 @@ sub exec_upload($$) $tpl->fillin('URL',encode_html(equal_url($config->{'httproot'},$virtual))); $tpl->fillin('SCRIPT',$script); + $tpl->parse_if_block('PERL_ARCHIVE_EXTRACT',$File::Access::has_archive_extract); + + my $output = header(-type => 'text/html'); + $output .= $tpl->get_template; + + return \$output; + } +} + +# exec_unpack() +# +# Unpack an archive +# +# Params: 1. Reference to user input hash +# 2. Reference to config hash +# +# Return: Output of the command (Scalar Reference) + +sub exec_unpack($$) +{ + my ($data,$config) = @_; + my $physical = $data->{'physical'}; + my $virtual = $data->{'virtual'}; + my $dir = upper_path($virtual); + my $new_physical = $data->{'new_physical'}; + 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) + { + 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 => encode_html($File::Access::archive_extract_error)}) unless($return_unpack); + + return devedit_reload({command => 'show', file => $new_virtual}); + } + else + { + my $tpl = new Template; + $tpl->read_file($config->{'templates'}->{'unpack'}); + + $tpl->fillin('FILE',encode_html($virtual)); + $tpl->fillin('DIR',encode_html($dir)); + $tpl->fillin('DIR_URL',escape($dir)); + $tpl->fillin('URL',encode_html(equal_url($config->{'httproot'},$virtual))); + $tpl->fillin('SCRIPT',$script); + my $output = header(-type => 'text/html'); $output .= $tpl->get_template; @@ -1135,6 +1234,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 $tpl->fillin('HTTPD',encode_html($ENV{'SERVER_SOFTWARE'}));