2384 lines
80 KiB
Perl
2384 lines
80 KiB
Perl
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::FileMan::Commands
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: Commands.pm,v 1.383 2008/11/27 07:06:56 brewt Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
|
|
package GT::FileMan::Commands;
|
|
|
|
use strict;
|
|
use vars qw/%ICONS $READ_SIZE/;
|
|
use GT::TempFile;
|
|
use GT::Base qw/:persist/;
|
|
use GT::AutoLoader;
|
|
use GT::File::Tools qw/:all/;
|
|
use GT::Date;
|
|
use Cwd;
|
|
|
|
use constants KB => 1024, MB => 1024 * 1024, FOLDER => 1, FILE => 2, SYMLINK => 3;
|
|
|
|
%ICONS = (
|
|
'gif jpg jpeg bmp' => ['image' => 'Image File'],
|
|
'txt' => ['txt' => 'Text File'],
|
|
'cgi pl pm' => ['perl' => 'Script File'],
|
|
'zip gz tar' => ['compressed' => 'Compressed File'],
|
|
'htm html shtm shtml' => ['html' => 'HTML File'],
|
|
'wav au mid mod mp3 wmv'=> ['audio' => 'Sound File'],
|
|
'exe' => ['exe' => 'Binary File'],
|
|
'doc' => ['doc' => 'MS Word'],
|
|
'xls' => ['xls' => 'MS Excel'],
|
|
'pdf' => ['pdf' => 'Adobe Acrobat'],
|
|
'unknown' => ['unknown' => 'Unknown'],
|
|
'folder' => ['folder' => 'File Folder'],
|
|
'symlink' => ['symlink' => 'Symlink']
|
|
);
|
|
|
|
# How large a chunk should we read into memory at once.
|
|
$READ_SIZE = 500000;
|
|
|
|
$COMPILE{home} = __LINE__ . <<'END_OF_SUB';
|
|
sub home {
|
|
# -----------------------------------------------------------------------------
|
|
# Print out the home page
|
|
#
|
|
my ($self, %args) = @_;
|
|
|
|
my $page = $self->{cgi}{page} || '';
|
|
if ($page =~ /^help(_\w*)?.html/) {
|
|
return $self->print($page);
|
|
}
|
|
($self->{cgi}{ajax} and $args{error} and lc $ENV{REQUEST_METHOD} eq 'post') ? $self->print_json_error($args{error}) : $self->print('home.html', \%args);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{password} = __LINE__ . <<'END_OF_SUB';
|
|
sub password {
|
|
# -----------------------------------------------------------------------------
|
|
# Change password feature which is for single user version
|
|
#
|
|
my $self = shift;
|
|
|
|
return $self->print_json({ html => $self->print('password.html', { json => 1 }) }, 1) if $self->{cgi}{form};
|
|
|
|
my $old = $self->{cgi}{old_password};
|
|
my $new = $self->{cgi}{new_password};
|
|
my $confirm = $self->{cgi}{confirm_password};
|
|
|
|
return $self->print_json_error($self->language('ERR_PASSWD_INPUT')) unless $old and $new and $confirm;
|
|
return $self->print_json_error($self->language('ERR_INVALID_OLDPASSWD')) if $self->{cfg}{login}{password} ne crypt($old, $self->{cfg}{login}{password}) and $self->{cfg}{login}{password} ne GT::FileMan::encrypt($old, $self->{cfg}{login}{password});
|
|
return $self->print_json_error($self->language('ERR_PASSWD_NOMATCH')) if $new ne $confirm;
|
|
|
|
$self->{cfg}{login}{password} = GT::FileMan::encrypt($new);
|
|
$self->{cfg}->save();
|
|
|
|
$self->print_json(undef, 1, $self->language('MSG_PASSWD_UPDATED'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{cd} = __LINE__ . <<'END_OF_SUB';
|
|
sub cd {
|
|
# -----------------------------------------------------------------------------
|
|
# CD command. This must be a post request
|
|
#
|
|
my $self = shift;
|
|
|
|
my $dname = $self->{cgi}{f};
|
|
my $path = $self->check_path($dname);
|
|
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $dname)) unless $path->{exist};
|
|
|
|
$self->{cfg}{work_path} = $path->{work_path};
|
|
|
|
# Loading files
|
|
my $files = $self->files;
|
|
return $self->print_json_error($files) if ref $files ne 'HASH';
|
|
|
|
$self->print_json($files, 1);
|
|
}
|
|
|
|
sub files {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
|
|
my $fpath = $self->check_path();
|
|
return $self->language($fpath->{error}) if $fpath->{error};
|
|
|
|
my $path = $fpath->{full_path};
|
|
opendir (DIR, $path) or return $self->language('ERR_CANNOT_OPEN', $path, $!);
|
|
my @rows = readdir(DIR);
|
|
close DIR;
|
|
|
|
my (@files, $readme);
|
|
my $size = 0;
|
|
foreach my $f (@rows) {
|
|
next if ($f eq '.' or $f eq '..');
|
|
next if ($f =~ /^\./ and !$self->{default}{show_hidden});
|
|
|
|
my $file = $self->finfo("$path/$f", $f);
|
|
if ($self->{cgi}{filter} == 1 and $file->[0] != FOLDER) {
|
|
next;
|
|
}
|
|
elsif ($self->{cgi}{filter} == 2 and $file->[0] != FOLDER and !-T "$path/$f") {
|
|
next;
|
|
}
|
|
|
|
push @files, $file;
|
|
$size += $file->[3];
|
|
$readme = $f if lc $f eq 'readme';
|
|
}
|
|
|
|
# loading current path and hidden objects
|
|
my $hiddens = $self->hiddens();
|
|
my $paths = $self->current_path();
|
|
|
|
# Loading .htaccess and .htpassword
|
|
my $htaccess_users = $self->load_htpasswd();
|
|
my $readme_content = '';
|
|
if ($self->{default}{readme} != 3 and $readme) {
|
|
if (open(README, "< $path/$readme")) {
|
|
my $count = 0;
|
|
while (<README>) {
|
|
chomp;
|
|
next unless $_;
|
|
$readme_content .= "$_\n";
|
|
$count++;
|
|
last if $count == 10;
|
|
}
|
|
close README;
|
|
}
|
|
}
|
|
return {
|
|
hits => scalar @files,
|
|
files => \@files,
|
|
size => $size,
|
|
paths => $paths,
|
|
hiddens => $hiddens,
|
|
root_path => $self->{session}{user} ? $self->{session}{user}{current}{disp} : undef,
|
|
htaccess_users => $htaccess_users,
|
|
readme_content => $self->{in}->html_escape($readme_content)
|
|
};
|
|
}
|
|
|
|
END_OF_SUB
|
|
|
|
$COMPILE{search} = __LINE__ . <<'END_OF_SUB';
|
|
sub search {
|
|
my $self = shift;
|
|
|
|
return $self->print_json({ html => $self->print('search.html', { json => 1 }) }, 1) if $self->{cgi}{form};
|
|
|
|
my $result = $self->fsearch();
|
|
return $self->print_json_error($result->{error}) if $result->{error};
|
|
|
|
$self->flog("search|Search for: '$self->{cgi}{search_input}'");
|
|
$self->print_json($result, 1, $self->language('MSG_SEARCH', $result->{hits}));
|
|
}
|
|
|
|
sub fsearch {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
|
|
my $ftype = $self->{cgi}{search_type};
|
|
my $fmodified = $self->{cgi}{search_mod};
|
|
my $from_date = $self->{cgi}{fromdate};
|
|
my $to_date = $self->{cgi}{todate};
|
|
|
|
require GT::Date;
|
|
if ($fmodified eq 'past_week') {
|
|
$from_date = GT::Date::date_get(time - (7 * 86400), $self->{cfg}{date}{input});
|
|
$to_date = GT::Date::date_get(time, $self->{cfg}{date}{input});
|
|
}
|
|
elsif ($fmodified eq 'past_month') {
|
|
$from_date = GT::Date::date_get(time - (30 * 86400), $self->{cfg}{date}{input});
|
|
$to_date = GT::Date::date_get(time, $self->{cfg}{date}{input});
|
|
}
|
|
elsif ($fmodified eq 'past_year') {
|
|
$from_date = GT::Date::date_get(time - (365 * 86400));
|
|
$to_date = GT::Date::date_get(time, $self->{cfg}{date}{input});
|
|
}
|
|
|
|
return { error => $self->language('ERR_SEARCH_COND') } unless $self->{cgi}{search_input} or $from_date or $to_date or $ftype;
|
|
|
|
my (@files, @results);
|
|
unless ($self->{cgi}{search_scope}) {
|
|
my $fpath = $self->check_path();
|
|
unless ($fpath->{error}) {
|
|
find($fpath->{full_path}, sub { push @files, shift }, { untaint => 1 });
|
|
}
|
|
}
|
|
else {
|
|
my @selecteds = $self->{in}->param('cinput');
|
|
foreach (@selecteds) {
|
|
my $fpath = $self->check_name($_);
|
|
next if $fpath->{error};
|
|
|
|
if ($fpath->{isfile}) {
|
|
push @files, $fpath->{full_path};
|
|
}
|
|
else {
|
|
find($fpath->{full_path}, sub { push @files, shift }, { untaint => 1 });
|
|
}
|
|
}
|
|
}
|
|
|
|
my $src_term = $self->{cgi}{search_input} || '';
|
|
if (not $self->{cgi}{search_exp}) {
|
|
$src_term = quotemeta($src_term);
|
|
$src_term =~ s/\\\*/.*/g;
|
|
$src_term =~ s/\\\?/./g;
|
|
}
|
|
$src_term = "(?i)$src_term" unless $self->{cgi}{search_case};
|
|
|
|
# Search file and directory names
|
|
my $total_size = 0;
|
|
unless ($self->{cgi}{search_content}) {
|
|
$ftype =~ s/^\s+//;
|
|
$ftype =~ s/\s+$//;
|
|
my %ftype = map { $_ => 1 } split /\s*,\s*/, $ftype;
|
|
|
|
foreach my $file (@files) {
|
|
my ($fn) = $file =~ m,/([^/]+)$,;
|
|
next if $fn eq $self->{work_path} or $fn !~ /$src_term/;
|
|
|
|
if ($ftype) {
|
|
my ($ext) = $fn =~ /\.([^.]+)$/;
|
|
next unless $ext and $ftype{$ext};
|
|
}
|
|
|
|
my $f = $self->finfo($file, $fn);
|
|
next unless scalar @$f;
|
|
|
|
# Search on modify date
|
|
if ($fmodified) {
|
|
my $modified = GT::Date::date_get($f->[5], $self->{cfg}{date}{input});
|
|
if ($from_date and $to_date) {
|
|
next if GT::Date::date_is_smaller($modified, $from_date) or GT::Date::date_is_greater($modified, $to_date);
|
|
}
|
|
else {
|
|
next if ($from_date and $modified ne $from_date) or ($to_date and $modified ne $to_date);
|
|
}
|
|
}
|
|
|
|
push @results, $f;
|
|
$total_size += $f->[3];
|
|
}
|
|
}
|
|
# Search file contents
|
|
else {
|
|
foreach my $file (@files) {
|
|
# Only search the contents of files that are readable, have content and are non-binary
|
|
next unless -f $file and -r _ and -s _ and -T _;
|
|
my ($ext) = $file =~ /\.([^.]+)$/;
|
|
my ($fn) = $file =~ m,/([^/]+)$,;
|
|
# pdf files look like text files
|
|
next if lc $ext eq 'pdf';
|
|
|
|
open(DATA, "<$file") or next;
|
|
my ($buffer, $f, $bit);
|
|
while (my $rs = read DATA, $buffer, $READ_SIZE) {
|
|
$buffer = "$bit$buffer" if length $bit;
|
|
$bit = ($rs == $READ_SIZE and $buffer =~ s/(?:\r|\r?\n)([^\r\n]+)$//) ? $1 : '';
|
|
|
|
if ($buffer =~ /$src_term/) {
|
|
$f = $self->finfo($file, $fn);
|
|
last;
|
|
}
|
|
}
|
|
close DATA;
|
|
next unless $f;
|
|
|
|
push @results, $f;
|
|
$total_size += $f->[3];
|
|
}
|
|
}
|
|
|
|
return { files => \@results, hits => scalar @results, size => $total_size };
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{replace} = __LINE__ . <<'END_OF_SUB';
|
|
sub replace {
|
|
# -----------------------------------------------------------------------------
|
|
# Replace contents of text files
|
|
#
|
|
my $self = shift;
|
|
|
|
return $self->print_json_error($self->language('ERR_SEARCH_COND')) unless $self->{cgi}{replace_input};
|
|
|
|
my (@files, @results);
|
|
unless ($self->{cgi}{replace_scope}) {
|
|
my $fpath = $self->check_path();
|
|
unless ($fpath->{error}) {
|
|
find($fpath->{full_path}, sub { push @files, shift }, { untaint => 1 });
|
|
}
|
|
}
|
|
else {
|
|
my @selecteds = $self->{in}->param('cinput');
|
|
foreach (@selecteds) {
|
|
my $fpath = $self->check_name($_);
|
|
|
|
next if $fpath->{error};
|
|
if ($fpath->{isfile}) {
|
|
push @files, $fpath->{full_path};
|
|
}
|
|
else {
|
|
find($fpath->{full_path}, sub { push @files, shift }, { untaint => 1 });
|
|
}
|
|
}
|
|
}
|
|
|
|
my $search_for = $self->{cgi}{replace_input} || '';
|
|
my $replace_with = $self->{cgi}{replace_with} || '';
|
|
|
|
if (not $self->{cgi}{replace_exp}) {
|
|
$search_for = quotemeta($search_for);
|
|
$search_for =~ s/\\\*/.*/g;
|
|
$search_for =~ s/\\\?/./g;
|
|
}
|
|
|
|
$search_for = "\\b$search_for\\b" if $self->{cgi}{replace_wholeword};
|
|
$search_for = "(?i)$search_for" unless $self->{cgi}{replace_case};
|
|
|
|
my $total_size = 0;
|
|
foreach my $file (@files) {
|
|
# Only search the contents of files that are readable, have content and are non-binary
|
|
next unless -f $file and -r _ and -s _ and -T _;
|
|
my ($ext) = $file =~ /\.([^.]+)$/;
|
|
my ($fn) = $file =~ m,/([^/]+)$,;
|
|
next if lc $ext eq 'pdf';
|
|
|
|
open(DATA, "<$file") or next;
|
|
my ($buffer, $f, $bit);
|
|
while (my $rs = read DATA, $buffer, $READ_SIZE) {
|
|
$buffer = "$bit$buffer" if length $bit;
|
|
$bit = ($rs == $READ_SIZE and $buffer =~ s/(?:\r|\r?\n)([^\r\n]+)$//) ? $1 : '';
|
|
|
|
if ($buffer =~ /$search_for/) {
|
|
$f++;
|
|
last;
|
|
}
|
|
}
|
|
close DATA;
|
|
next unless $f;
|
|
|
|
my $tempfile = new GT::TempFile;
|
|
if (fcopy($file, "$$tempfile.tmp", $search_for, $replace_with)) {
|
|
move($file, "$file.bak", { untaint => 1 }) if $self->{cgi}{replace_bak};
|
|
move("$$tempfile.tmp", $file, { untaint => 1 });
|
|
}
|
|
|
|
push @results, $self->finfo($file, $fn);
|
|
$total_size += -s $file;
|
|
|
|
# Log the action
|
|
$self->flog("replace|Replace '$search_for' with '$replace_with'");
|
|
}
|
|
|
|
# loading current path and hidden objects
|
|
my $hiddens = $self->hiddens();
|
|
my $paths = $self->current_path();
|
|
my $hits = scalar @results;
|
|
|
|
$self->print_json({
|
|
hits => $hits,
|
|
files => \@results,
|
|
size => $total_size,
|
|
hiddens => $hiddens,
|
|
paths => $paths
|
|
}, 1, $self->language('MSG_REPLACED', $hits));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{command} = __LINE__ . <<'END_OF_SUB';
|
|
sub command {
|
|
# -----------------------------------------------------------------------------
|
|
# Execute a command in shell
|
|
#
|
|
my $self = shift;
|
|
|
|
# Untaint PATH
|
|
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
|
|
|
|
# Untaint the command
|
|
my $command = $self->{cgi}{command_input} || '';
|
|
($command) = $command =~ /^(.*)$/;
|
|
|
|
# Remove serial file which is nolonger used
|
|
my $serial = $self->{cgi}{serial};
|
|
($serial) = $serial =~ /^(\w+)$/;
|
|
|
|
if ($self->{cgi}{remove} and $serial) {
|
|
unlink "$self->{cfg}{tmp_path}/$serial";
|
|
print $self->{in}->header(-type => 'text/xml; charset=utf8', '-no-cache' => 1);
|
|
print qq!<xml>\n<body>\n<output>done</output></body>\n</xml>!;
|
|
|
|
# Log the action
|
|
$self->flog("command|$command");
|
|
return;
|
|
}
|
|
|
|
# Change to the working directory and then get the current path to ensure we
|
|
# get a 'clean looking' path
|
|
my $working_dir = $self->{cgi}{working_dir};
|
|
unless ($working_dir) {
|
|
my $fpath = $self->check_path();
|
|
$working_dir = $fpath->{full_path} unless $fpath->{error};
|
|
}
|
|
|
|
($working_dir) = $working_dir =~ /^(.*)$/;
|
|
chdir($working_dir);
|
|
|
|
$working_dir = cwd();
|
|
|
|
my $prompt = $GT::FileMan::MSWIN ? "$working_dir>" : "[" . eval { getpwuid($<) . '@' } . "$ENV{SERVER_NAME} $working_dir]";
|
|
my $next_prompt = $prompt;
|
|
return $self->print_json({ prompt => $prompt, working_dir => $working_dir }, 1) if $self->{cgi}{prompt} and !$self->{cgi}{retrieve};
|
|
return $self->print_json_error($self->language('ERR_COMMAND')) unless $command;
|
|
|
|
|
|
my ($output, $error) = ('', '');
|
|
if ($self->{cgi}{retrieve} and $serial) {
|
|
if (-f "$self->{cfg}{tmp_path}/$serial") {
|
|
open(DATA, "< $self->{cfg}{tmp_path}/$serial");
|
|
read DATA, $output, -s DATA;
|
|
close DATA;
|
|
}
|
|
|
|
# Getting the working directory
|
|
if ($command =~ m/^\s*cd\s+(.+)/) {
|
|
chdir($1);
|
|
$working_dir = cwd();
|
|
$next_prompt = $GT::FileMan::MSWIN ? "$working_dir>" : "[" . eval { getpwuid($<) . '@' } . "$ENV{SERVER_NAME} $working_dir]";
|
|
}
|
|
|
|
print $self->{in}->header(-type => 'text/xml; charset=utf8', '-no-cache' => 1);
|
|
print qq~<xml>\n<body>\n<prompt><![CDATA[$prompt]]></prompt>\n<next_prompt><![CDATA[$next_prompt]]></next_prompt>\n<command><![CDATA[$command]]></command>\n<output><![CDATA[$output]]></output><working><![CDATA[$working_dir]]></working></body>\n</xml>~;
|
|
return;
|
|
}
|
|
|
|
# Run the command and send out a temporary file
|
|
my $timeout = $self->{cfg}{command_timeout} || 60;
|
|
my ($pid, $oldfh);
|
|
$SIG{ALRM} = sub {
|
|
kill('INT', $pid);
|
|
die;
|
|
};
|
|
alarm($timeout);
|
|
|
|
eval {
|
|
$pid = open(TMP, "$command |");
|
|
$oldfh = select(TMP); $| = 1; select($oldfh);
|
|
while (<TMP>) {
|
|
s/(\n|\r\n)$//;
|
|
open DATA, ">> $self->{cfg}{tmp_path}/$serial" or die $!;
|
|
print DATA $_. "\n";
|
|
close DATA;
|
|
}
|
|
close TMP;
|
|
};
|
|
open DATA, ">> $self->{cfg}{tmp_path}/$serial" or die $!;
|
|
print DATA ($error ? $error : 'done');
|
|
close DATA;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{upload} = __LINE__ . <<'END_OF_SUB';
|
|
sub upload {
|
|
# -----------------------------------------------------------------------------
|
|
# Upload a file
|
|
#
|
|
my $self = shift;
|
|
|
|
# Handle upload progress
|
|
return $self->upload_progress() if $self->{cgi}{upload};
|
|
|
|
if ($self->{cgi}{num_files}) {
|
|
my $num_files = $self->{cgi}{num_files};
|
|
my $uploaded = 0;
|
|
my $declined = 0;
|
|
my $total_size = 0;
|
|
for (my $i = 1; $i <= $num_files; $i++) {
|
|
next unless $self->{cgi}{"file-$i"};
|
|
|
|
my %result = $self->fupload($self->{cgi}{"file-$i"}, $self->{cgi}{"mode-$i"});
|
|
if ($result{error}) {
|
|
return $self->print_json_error($result{error}) if $num_files == 1;
|
|
$declined++;
|
|
next;
|
|
}
|
|
$total_size += $result{size};
|
|
$uploaded++;
|
|
|
|
$self->{diskspace}{free} -= $result{size} if $self->{diskspace};
|
|
|
|
# Log the action
|
|
$self->flog("upload|$result{name}");
|
|
}
|
|
|
|
return $self->print_json(undef, 1, $self->language('MSG_MULT_UPLOADED', $uploaded, friendly_size($total_size), $declined));
|
|
}
|
|
else {
|
|
my %result = $self->fupload($self->{cgi}{upload_input}, $self->{cgi}{upload_mode});
|
|
return $self->print_json_error($result{error}) if $result{error};
|
|
|
|
# Log the action
|
|
$self->flog("upload|$result{name}");
|
|
return $self->print_json(undef, 1, $self->language('MSG_UPLOADED', $result{name}, friendly_size($result{size})));
|
|
}
|
|
}
|
|
|
|
sub fupload {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, $data, $mode) = @_;
|
|
|
|
my $fn = $data;
|
|
$fn =~ s/.*?([^\\\/:]+)$/$1/;
|
|
$fn =~ s/[\[\]\s\$\#\%'"]/\_/g;
|
|
|
|
unlink "$self->{cfg}{tmp_path}/$self->{serial}" if $self->{serial}; # Remove the log file
|
|
|
|
return (error => $self->language('ERR_NOUPLOAD')) unless $fn;
|
|
|
|
# Change the name if format
|
|
if ($self->{cgi}{name_format} eq 'uc') {
|
|
$fn =~ s/(\w+)/\U$1/gi;
|
|
}
|
|
elsif ($self->{cgi}{name_format} eq 'lc') {
|
|
$fn =~ s/(\w+)/\L$1/gi;
|
|
}
|
|
|
|
my $file = $self->check_name($fn);
|
|
return (error => $file->{error}) if $file->{error};
|
|
|
|
if ($file->{exist}) {
|
|
return (error => $self->language('ERR_EXISTING', $fn)) unless $self->{cgi}{opt_overwrite};
|
|
return (error => $self->language('ERR_NOT_WRITABLE', $fn)) unless $file->{write};
|
|
}
|
|
else {
|
|
my $folder = $self->check_path(undef);
|
|
return (error => $folder->{error}) if $folder->{error};
|
|
return (error => $self->language('ERR_NOT_FOUND', $self->{cfg}{work_path})) if $self->{cfg}{work_path} and !$folder->{exist};
|
|
return (error => $self->language('ERR_NOT_WRITABLE', $self->{cfg}{work_path})) unless $folder->{write};
|
|
}
|
|
|
|
# Check free space if appicable. If diskspace is null, there is no limit
|
|
return (error => $self->language('ERR_NOSPACE')) if $self->{diskspace} and !$self->{diskspace}{free};
|
|
|
|
my $full_path = $file->{full_path};
|
|
|
|
$mode ||= 'auto';
|
|
$mode = lc $mode;
|
|
$mode = 'ascii' if $mode eq 'auto' and lc substr($full_path, -4, 4) ne '.pdf' and -T $full_path;
|
|
|
|
my ($uploaded_size, $bytesread, $buffer) = (0, 0, '');
|
|
my $newlines = $GT::FileMan::MSWIN ? "\r\n" : "\n";
|
|
open(OUTFILE, "> $full_path");
|
|
binmode OUTFILE;
|
|
while ($bytesread = read($data, $buffer, 1024)) {
|
|
$buffer =~ s/$newlines/\n/g if $mode eq 'ascii';
|
|
print OUTFILE $buffer;
|
|
$uploaded_size += $bytesread;
|
|
}
|
|
close OUTFILE;
|
|
|
|
my $mod = $self->{cfg}{default}{upload_mode} || '644';
|
|
chmod(oct($mod), $full_path);
|
|
my $fsize = -s $full_path;
|
|
|
|
# Check free space if appicable. If diskspace is null, there is no limit
|
|
if ($self->{diskspace} and $self->{diskspace}{free} < $fsize) {
|
|
del($full_path, { untaint => 1 });
|
|
return $self->home(error => $self->language('ERR_NOSPACE'));
|
|
}
|
|
|
|
return (name => $file->{name}, size => $fsize);
|
|
}
|
|
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{file} = __LINE__ . <<'END_OF_SUB';
|
|
sub file {
|
|
# Create a new file
|
|
#
|
|
my $self = shift;
|
|
|
|
if ($self->{cgi}{form}) {
|
|
$self->print_json({ html => $self->print('editor.html', { json => 1, editor_mode => $self->{default}{editor_mode} ? 'html' : 'text' }) }, 1);
|
|
}
|
|
else {
|
|
$self->edit();
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{edit} = __LINE__ . <<'END_OF_SUB';
|
|
sub edit {
|
|
# -----------------------------------------------------------------------------
|
|
# Edit a file
|
|
#
|
|
my $self = shift;
|
|
|
|
# Print out editor form
|
|
if ($self->{cgi}{form}) {
|
|
my $fname = $self->{cgi}{f};
|
|
return $self->print_json_error($self->language('ERR_CANNOT_OPEN_MULT')) if ref $fname eq 'ARRAY';
|
|
|
|
my $file = $self->check_name($fname);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FILE', $file->{name})) unless $file->{isfile};
|
|
return $self->print_json_error($self->language('ERR_NOT_READABLE', $file->{name})) unless $file->{read};
|
|
return $self->open_compressed($file) if $file->{type} eq 'compress';
|
|
return $self->print_json({ file => $file }) unless $file->{type} =~ /text|html/;
|
|
|
|
# Get content of the file
|
|
open (DATA, "<$file->{full_path}") or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
read (DATA, my $content, -s DATA);
|
|
close DATA;
|
|
|
|
if ($file->{type} eq 'html') {
|
|
$file->{content} = $content;
|
|
}
|
|
else {
|
|
$content =~ s,\r\n,\n,g;
|
|
$file->{content} = $content;
|
|
}
|
|
|
|
return $self->print_json({
|
|
html => $self->print('editor.html', { file => $file, editor_mode => ($file->{type} eq 'html' and $self->{default}{editor_mode}) ? 'html' : 'text', json => 1 }),
|
|
type => $file->{type},
|
|
}, 1);
|
|
}
|
|
|
|
# Save file
|
|
my $old = $self->{cgi}{file};
|
|
my $content = $self->{cgi}{editor};
|
|
my $mode = $self->{cgi}{editor_mode};
|
|
|
|
return $self->print_json_error($self->language('ERR_NOSPACE')) if ($self->{diskspace} and (!$self->{diskspace}{free} or $self->{diskspace}{free} < length $content));
|
|
|
|
# Save content into a new file
|
|
my ($history, $file);
|
|
my $fname = $self->{cgi}{edit_input} || $self->{cgi}{file_input};
|
|
if ($fname and $fname ne $old) {
|
|
$file = $self->check_name($fname);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
return $self->print_json_error({ file => $file, confirm => 1 }) if $file->{exist} and !$self->{cgi}{overwrite_confirmed};
|
|
|
|
$history = "newfile|$self->{cgi}{name}";
|
|
}
|
|
|
|
# Update file with new content
|
|
else {
|
|
$file = $self->check_name($old);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITEABLE', $file->{name})) unless $file->{write};
|
|
|
|
$history = "edit|$old";
|
|
}
|
|
|
|
open(DATA, "> $file->{full_path}") or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
print DATA $content;
|
|
close DATA;
|
|
|
|
# Log the action
|
|
$self->flog($history);
|
|
return $self->print_json(undef, 1, $self->language('MSG_FILE_SAVED', $file->{name}));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{makedir} = __LINE__ . <<'END_OF_SUB';
|
|
sub makedir {
|
|
# -----------------------------------------------------------------------------
|
|
# Create a new directory
|
|
#
|
|
my $self = shift;
|
|
|
|
my $dname = $self->{cgi}{makedir_input};
|
|
return $self->print_json_error($self->language('ERR_INVALID_INPUT')) unless $dname;
|
|
|
|
my $new = $self->check_name($dname);
|
|
|
|
return $self->print_json_error($new->{error}) if $new->{error};
|
|
return $self->print_json_error($self->language('ERR_EXISTING', $dname)) if $new->{exist};
|
|
return $self->print_json_error($self->language('ERR_NOSPACE')) if $self->{diskspace} and !$self->{diskspace}{free};
|
|
|
|
rmkdir($new->{full_path}, 0755, { untaint => 1 }) or return $self->print_json_error($self->language('ERR_MAKDEDIR', $dname, $!));
|
|
$self->flog("makedir|$dname");
|
|
|
|
return $self->print_json(undef, 1, $self->language('MSG_MAKEDIR', $dname));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{chmod} = __LINE__ . <<'END_OF_SUB';
|
|
sub chmod {
|
|
# -----------------------------------------------------------------------------
|
|
# Change the permissions of a file
|
|
#
|
|
my $self = shift;
|
|
|
|
# Change mod
|
|
my @files = $self->{in}->param('cinput');
|
|
my $mod = $self->{cgi}{chmod_input};
|
|
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless scalar @files;
|
|
return $self->print_json_error($self->language('ERR_CHMOD_INPUT')) unless $mod;
|
|
|
|
# Untaint permission input
|
|
($mod) = $mod =~ /^([0-7]{3,4})$/;
|
|
return $self->print_json_error($self->language('ERR_INVALID_PERM')) unless $mod;
|
|
|
|
my $changed = 0;
|
|
my $oct_mod = oct($mod);
|
|
|
|
foreach my $f (@files) {
|
|
my $file = $self->check_name($f);
|
|
if ($file->{error}) {
|
|
return $self->print_json_error($file->{error}) if scalar @files == 1; # Return if error occurs for a single file
|
|
next;
|
|
}
|
|
|
|
if (-d $file->{full_path} and $self->{cgi}{chmod_recursive}) {
|
|
find($file->{full_path}, sub { chmod($oct_mod, shift) }, { untaint => 1 });
|
|
$changed++;
|
|
}
|
|
else {
|
|
chmod($oct_mod, $file->{full_path}) and $changed++;
|
|
}
|
|
}
|
|
return $self->print_json_error('cannot_chmod') unless $changed;
|
|
|
|
# Log the action
|
|
$self->flog("chmod|" . join(', ', @files));
|
|
$self->print_json(undef, 1, scalar @files == 1 ? $self->language('MSG_CHMODED', $files[0]) : $self->language('MSG_MULT_CHMODED', $changed));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{protect} = __LINE__ . <<'END_OF_SUB';
|
|
sub protect {
|
|
# -----------------------------------------------------------------------------
|
|
# Protect command: create .htaccess file
|
|
#
|
|
my $self = shift;
|
|
|
|
my $pwd_path = $self->{default}{pwd_path};
|
|
my ($htpwd, $htacc, $name_pwd, $name_acc);
|
|
|
|
# Create the .htpasswd
|
|
if ($pwd_path) {
|
|
my $path = $self->check_path($pwd_path);
|
|
if (!$path->{error} and $path->{exist}) {
|
|
my $current = $self->check_path();
|
|
unless ($current->{error}) {
|
|
$current->{full_path} =~ s/[\/ \:]/\_/g;
|
|
$htpwd = "$path->{full_path}/.htpass$current->{full_path}";
|
|
($htpwd) = $htpwd =~ /^(.*)$/; # Untaint the path
|
|
}
|
|
}
|
|
}
|
|
|
|
unless ($htpwd) {
|
|
my $fpassword = $self->check_name('.htpasswd');
|
|
return $self->print_json_error($fpassword->{error}) if $fpassword->{error};
|
|
$htpwd = $fpassword->{full_path};
|
|
}
|
|
|
|
($name_pwd) = $htpwd =~ /^$self->{cfg}{root_path}\/(.*)/;
|
|
|
|
unless (-e $htpwd) {
|
|
open (FILE, "> $htpwd") or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $name_pwd, $!));
|
|
close FILE;
|
|
}
|
|
|
|
# Create the .htaccess
|
|
my $faccess = $self->check_name('.htaccess');
|
|
return $self->print_json_error($faccess->{error}) if $faccess->{error};
|
|
|
|
$htacc = $faccess->{full_path};
|
|
($name_acc) = $htacc =~ /^$self->{cfg}{root_path}\/(.*)/;
|
|
|
|
unless ($faccess->{exist} and $faccess->{size}) {
|
|
my $error = $self->create_htaccess($htacc, $htpwd);
|
|
return $self->print_json_error($error) if $error;
|
|
}
|
|
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $name_pwd)) unless -w $htpwd;
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $name_acc)) unless -w $htacc;
|
|
|
|
# Overwrite existing .htaccess if AuthUserFile isn't matching with htpwd
|
|
open (HTACC, "< $htacc") or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $name_acc, $!));
|
|
my @info = <HTACC>;
|
|
close HTACC;
|
|
|
|
my $found;
|
|
LINE: foreach (@info) {
|
|
if ( $_ =~ /$htpwd/ ) {
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
|
|
unless ($found) {
|
|
my $error = $self->create_htaccess($htacc, $htpwd);
|
|
return $self->print_json_error($error) if $error;
|
|
}
|
|
|
|
# Delete all users
|
|
if ($self->{cgi}{'protect-delete-all'}) {
|
|
unlink $htpwd;
|
|
unlink $htacc;
|
|
return $self->print_json(undef, 1, $self->language('MSG_MULTUSER_DELETED', 'All'));
|
|
}
|
|
|
|
# Create/delete a user
|
|
my (@users, $msg);
|
|
my $username = $self->{cgi}{protect_username};
|
|
my $password = $self->{cgi}{protect_password};
|
|
my $del_user = $self->{cgi}{protect_user};
|
|
|
|
if (-s $htpwd) {
|
|
open (HTPWD, "< $htpwd") or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $name_pwd, $!));
|
|
@users = grep { $_ !~ /^$del_user:/} <HTPWD>;
|
|
close HTPWD;
|
|
}
|
|
|
|
my $message;
|
|
if ($username and $password) {
|
|
return $self->print_json_error($self->language('ERR_UID_INVALID', $username)) if $username =~ /:/;
|
|
|
|
foreach my $i (0 .. @users) {
|
|
my $u = $users[$i];
|
|
if ($u =~ /^$username:/) {
|
|
return $self->print_json_error($self->language('ERR_UID_EXISTING', $username)) unless $self->{cgi}{opt_protect_overwrite};
|
|
delete $users[$i];
|
|
}
|
|
}
|
|
|
|
my $crypted;
|
|
if ($self->{cgi}{opt_protect_apache}) {
|
|
require GT::MD5::Crypt;
|
|
my $salt = join '', ('A' .. 'Z', 0 .. 9, 'a' .. 'z', '.', '/')[map rand 64, 1 .. 8];
|
|
$crypted = GT::MD5::Crypt::apache_md5_crypt($password, $salt);
|
|
}
|
|
else {
|
|
my @salt_chars = ('A' .. 'Z', 0 .. 9, 'a' .. 'z', '.', '/');
|
|
my $salt = join '', @salt_chars[rand 64, rand 64];
|
|
$crypted = crypt($password, $salt);
|
|
}
|
|
push @users, "$username:$crypted\n";
|
|
$message = $self->language('MSG_USER_ADDED', $username);
|
|
}
|
|
elsif ($self->{cgi}{protect} and !$del_user) {
|
|
return $self->print_json_error($self->language('ERR_PROTECT_REQUIRED'));
|
|
}
|
|
elsif ($del_user) {
|
|
$message = $self->language('MSG_USER_DELETED', $del_user);
|
|
}
|
|
|
|
if (@users) {
|
|
open (HTPWD, "> $htpwd") or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $name_pwd, $!));
|
|
print HTPWD join("", @users);
|
|
close HTPWD;
|
|
foreach (@users) {
|
|
my ($u, $p) = split(/:/, $_);
|
|
}
|
|
}
|
|
else {
|
|
unlink $htpwd;
|
|
unlink $htacc;
|
|
}
|
|
return $self->print_json(undef, 1, $message);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{setup} = __LINE__ . <<'END_OF_SUB';
|
|
sub setup {
|
|
# -----------------------------------------------------------------------------
|
|
# Change configurations
|
|
#
|
|
my $self = shift;
|
|
|
|
return $self->print_json({ html => $self->print('setup.html', { json => 1 }) }, 1) if $self->{cgi}{form};
|
|
|
|
my %required_fields = (cgi_url => 1, static_url => 1, root_path => 1);
|
|
foreach (keys %required_fields) {
|
|
return $self->print_json_error($self->language('MSG_REQUIRED', $_)) unless $self->{cgi}{$_};
|
|
}
|
|
|
|
if ($self->{cfg}{fversion} eq 'multiple') {
|
|
return $self->print_json_error($self->language('ERR_MAIL_SERVER')) unless $self->{cgi}{email_smtp_server} or $self->{cgi}{email_mail_path};
|
|
return $self->print_json_error($self->language('ERR_INVALID_MAIL')) if $self->{cgi}{email_smtp_server} and $self->{cgi}{email_mail_path};
|
|
}
|
|
|
|
my $config = $self->{cfg};
|
|
foreach my $k (keys %$config) {
|
|
if (ref $config->{$k} eq 'HASH') {
|
|
my $hsh = $config->{$k};
|
|
$config->{$k} = $self->fsetup($hsh, $k);
|
|
}
|
|
elsif (!defined $self->{in}->param($k)) {
|
|
next;
|
|
}
|
|
else {
|
|
$config->{$k} = $self->{in}->param($k);
|
|
}
|
|
}
|
|
|
|
# Overwrite current configurations
|
|
$self->{cfg} = $config;
|
|
$self->{cfg}->save();
|
|
|
|
# Log the action
|
|
$self->flog("setup|Change the configuration");
|
|
$self->print_json(undef, 1, $self->language('MSG_CHANCES_SAVED'));
|
|
}
|
|
|
|
sub fsetup {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, $cfg, $key) = @_;
|
|
|
|
foreach my $k (keys %$cfg) {
|
|
my $val = $cfg->{$k};
|
|
if (ref $val eq 'HASH') {
|
|
$cfg->{$k} = $self->fsetup($val, "${key}_$k");
|
|
}
|
|
elsif (defined $self->{in}->param("${key}_$k")) {
|
|
$cfg->{$k} = $self->{in}->param("${key}_$k") || '';
|
|
}
|
|
}
|
|
return $cfg;
|
|
}
|
|
|
|
END_OF_SUB
|
|
|
|
$COMPILE{preferences} = __LINE__ . <<'END_OF_SUB';
|
|
sub preferences {
|
|
# -----------------------------------------------------------------------------
|
|
# Update preferences
|
|
#
|
|
my $self = shift;
|
|
|
|
return $self->print_json({ html => $self->print('preferences.html', { json => 1 }) }, 1) if $self->{cgi}{form};
|
|
|
|
my ($pwd_path, $default_path) = ('', '');
|
|
if ($self->{cgi}{pwd_path}) {
|
|
my $path = $self->check_path($self->{cgi}{pwd_path});
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $self->{cgi}{pwd_path})) unless $path->{exist};
|
|
return $self->print_json_error($self->lanugage('ERR_NOT_FOLDER', $self->{cgi}{pwd_path})) unless $path->{isdir};
|
|
$pwd_path = $path->{full_path};
|
|
}
|
|
|
|
if ($self->{cgi}{path}) {
|
|
my $path = $self->check_path($self->{cgi}{path});
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $self->{cgi}{path})) unless $path->{exist};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOLDER', $self->{cgi}{path})) unless $path->{isdir};
|
|
$default_path = $path->{full_path};
|
|
}
|
|
|
|
my %defaults = (
|
|
pwd_path => $pwd_path,
|
|
path => $default_path,
|
|
maxhits => $self->{cgi}{maxhits} || 25,
|
|
sb => $self->{cgi}{sb} || 'name',
|
|
so => $self->{cgi}{so} || 'asc',
|
|
readme => $self->{cgi}{readme} || 1,
|
|
show_hidden => $self->{cgi}{show_hidden} || 0,
|
|
editor_mode => $self->{cgi}{editor_mode} || 0,
|
|
effect => $self->{cgi}{effect} || 1
|
|
);
|
|
my $defaults = join ';', map "$_=$defaults{$_}" , (keys %defaults);
|
|
|
|
print $self->{in}->header(
|
|
-cookie => [
|
|
$self->{in}->cookie(-name => 'fileman_defaults', -value => $defaults, -expires => '+5y')
|
|
]
|
|
);
|
|
|
|
$self->{default} = $self->default(%defaults);
|
|
$self->print_json({ defaults => $self->{default} }, 1, $self->language('MSG_CHANCES_SAVED'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{download} = __LINE__ . <<'END_OF_SUB';
|
|
sub download {
|
|
# -----------------------------------------------------------------------------
|
|
# Download command
|
|
#
|
|
my $self = shift;
|
|
|
|
my @files = $self->{in}->param('cinput');
|
|
my $opt_zip = $self->{cgi}{download_compress};
|
|
my $opt_mode = $self->{cgi}{download_mode};
|
|
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless scalar @files;
|
|
|
|
# Download a single file
|
|
if (scalar @files == 1 and !$opt_zip) {
|
|
my $file = $self->check_name($files[0]);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_READABLE', $file->{name})) unless $file->{read};
|
|
|
|
if ($file->{isfile}) {
|
|
$self->flog("download|$file->{name}");
|
|
return $self->print_json({ file => $file, mode => $opt_mode }, 1);
|
|
}
|
|
else {
|
|
$opt_zip = 1;
|
|
}
|
|
}
|
|
|
|
# Download multiple files
|
|
require GT::TempFile;
|
|
my $tempfile = new GT::TempFile(tmp_dir => $self->{cfg}{tmp_path});
|
|
my $ext = 'tar';
|
|
|
|
if ($opt_zip == 3 and $GT::FileMan::HAVE_AZIP) {
|
|
$ext = 'zip';
|
|
$self->create_zip(\@files, "$$tempfile.$ext");
|
|
}
|
|
else {
|
|
$ext = ($opt_zip == 2 and $GT::FileMan::HAVE_GZIP) ? 'tar.gz' : 'tar';
|
|
$self->create_tar(\@files, "$$tempfile.$ext");
|
|
}
|
|
|
|
$self->flog("download|$$tempfile.$ext");
|
|
my $filename = "$$tempfile.$ext";
|
|
$filename =~ s,^$self->{cfg}{tmp_path}/,,;
|
|
|
|
return $self->print_json({
|
|
file => {
|
|
name => $filename,
|
|
source => $ext,
|
|
mode => 'binary'
|
|
},
|
|
}, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{cmdcopy} = __LINE__ . <<'END_OF_SUB';
|
|
sub cmdcopy {
|
|
# -----------------------------------------------------------------------------
|
|
# Copy command
|
|
#
|
|
my ($self, $action, $to) = @_;
|
|
|
|
$to ||= $self->{cgi}{copy_input};
|
|
my @files = $self->{in}->param('cinput');
|
|
my $copied = $self->{cgi}{num_done} || 0;
|
|
|
|
return $self->print_json_error($self->language('ERR_INVALID_PATH')) unless $to;
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless scalar @files or $self->{cgi}{'confirm-name'};
|
|
|
|
my $path = $self->check_path($to);
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
|
|
if ($path->{exist}) {
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $to)) unless $path->{write};
|
|
}
|
|
else {
|
|
my ($fname) = $path->{full_path} =~ /\/([^\/]+)$/;
|
|
(my $path_to = $path->{full_path}) =~ s/\/$fname$//;
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $to)) unless -e $path_to;
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $to)) unless -w $path_to;
|
|
}
|
|
|
|
if ($self->{diskspace} and !$action) { # check free space if appicable
|
|
my $need_space = $self->size(\@files);
|
|
return $self->print_json_error($self->language('ERR_NOSPACE')) unless ($self->{diskspace}{free} or $self->{diskspace}{free} > $need_space);
|
|
}
|
|
|
|
# Need a confirmation on overwrite existing files
|
|
my @loop_files;
|
|
if ($self->{cgi}{'confirm-name'}) {
|
|
return $self->print_json(undef, 1, $self->language('MSG_COPIED', $copied, $to)) if $self->{cgi}{'button-cancel'};
|
|
|
|
if ($self->{cgi}{'confirm-name'} eq 'copy-all') {
|
|
foreach my $f (@files) {
|
|
next unless $f;
|
|
my $file = $self->check_name($f);
|
|
next if $file->{error};
|
|
|
|
if ($action eq 'move') {
|
|
move($file->{full_path}, $path->{full_path}, { untaint => 1 }) and $copied++;
|
|
}
|
|
else {
|
|
copy($file->{full_path}, $path->{full_path}, { untaint => 1 }) and $copied++;
|
|
}
|
|
}
|
|
}
|
|
elsif ($self->{cgi}{'confirm-name'} !~ /button-cancel|button-skip/) {
|
|
my $fcurrent = $self->{cgi}{'confirm-name'};
|
|
my $file = $self->check_name($fcurrent);
|
|
unless ($file->{error}) {
|
|
if ($action eq 'move') {
|
|
move($file->{full_path}, $path->{full_path}, { untaint => 1 }) and $copied++;
|
|
}
|
|
else {
|
|
copy($file->{full_path}, $path->{full_path}, { untaint => 1 }) and $copied++;
|
|
}
|
|
}
|
|
|
|
foreach my $f (@files) {
|
|
next unless $f and $f ne $fcurrent;
|
|
push @loop_files, $f;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
foreach my $f (@files) {
|
|
my $file = $self->check_name($f);
|
|
next if $file->{error} or $file->{full_path} eq $path->{full_path};
|
|
|
|
if (-e "$path->{full_path}/$f") {
|
|
push @loop_files, $f;
|
|
next;
|
|
}
|
|
|
|
if ($action eq 'move') {
|
|
move($file->{full_path}, $path->{full_path}, { untaint => 1 }) and $copied++;
|
|
}
|
|
else {
|
|
copy($file->{full_path}, $path->{full_path}, { untaint => 1 }) and $copied++;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Need confirmation on overwrite existing files
|
|
return $self->print_json({ confirms => \@loop_files, num_done => $copied, input => $to }, 1) if scalar @loop_files;
|
|
|
|
my $history = $action eq 'move' ? "move" : "copy";
|
|
my $msg = $action eq 'move' ? $self->language('MSG_MOVED', $copied, $to) : $self->language('MSG_COPIED', $copied, $to);
|
|
$self->flog("$history|To: $path->{full_path} ($copied files)");
|
|
return $self->print_json(undef, 1, $msg);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{cmdmove} = __LINE__ . <<'END_OF_SUB';
|
|
sub cmdmove {
|
|
# -----------------------------------------------------------------------------
|
|
# Move command
|
|
#
|
|
my $self = shift;
|
|
return $self->cmdcopy('move', $self->{cgi}{'move_input'});
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{rename} = __LINE__ . <<'END_OF_SUB';
|
|
sub rename {
|
|
# -----------------------------------------------------------------------------
|
|
# Rename command
|
|
#
|
|
my $self = shift;
|
|
|
|
my $to = $self->{cgi}{rename_input};
|
|
my $f = $self->{cgi}{cinput};
|
|
|
|
return $self->print_json_error($self->language('ERR_RENAME_INPUT')) unless $to;
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless $f;
|
|
return $self->print_json_error($self->language('ERR_CANNOT_RENAME', $to)) if $to =~ /\//;
|
|
return $self->print_json_error($self->language('ERR_MULT_SELECTED')) if ref $f eq 'ARRAY';
|
|
|
|
my $path = $self->check_path($to);
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
return $self->print_json({ file => { name => $to }, confirm => 1 }, 1) if $path->{exist} and !$self->{cgi}{overwrite_confirmed};
|
|
|
|
my ($fname) = $path->{full_path} =~ /\/([^\/]+)$/;
|
|
(my $path_to = $path->{full_path}) =~ s/\/$fname$//;
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $to)) unless -e $path_to;
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $self->{cfg}{work_path})) unless -w $path_to;
|
|
|
|
my $file = $self->check_name($f);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
|
|
move($file->{full_path}, $path->{full_path}, { untaint => 1 });
|
|
|
|
$self->flog("Rename|From: $f - To:$fname");
|
|
$self->print_json(undef, 1, $self->language('MSG_RENAMED', $f, $fname));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{delete} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete {
|
|
# -----------------------------------------------------------------------------
|
|
# Delete files & directories
|
|
#
|
|
my $self = shift;
|
|
|
|
my @files = $self->{in}->param('cinput');
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless scalar @files or $self->{cgi}{'confirm-name'};
|
|
|
|
|
|
my $num_done = $self->{cgi}{num_done} || 0;
|
|
my $confirmed = $self->{cgi}{'confirm-name'} || '';
|
|
|
|
my (@deleted, @loop_files);
|
|
foreach my $f (@files) {
|
|
my $file = $self->check_name($f);
|
|
next if $file->{error} or !$file->{exist};
|
|
|
|
# Delete confirmed files and folders
|
|
if ($confirmed eq 'delete-all' or $confirmed eq $f) {
|
|
my $deleted = 0;
|
|
if ($file->{isfile}) {
|
|
del($file->{full_path}, { untaint => 1 }) and $deleted = 1;
|
|
}
|
|
else {
|
|
deldir($file->{full_path}, { untaint => 1 }) and $deleted = 1;
|
|
}
|
|
if ($deleted) {
|
|
$num_done++;
|
|
push @deleted, $file->{full_path};
|
|
}
|
|
}
|
|
elsif (!$confirmed or $confirmed !~ /button-skip|button-cancel/) {
|
|
push @loop_files, $f;
|
|
}
|
|
}
|
|
|
|
# Log deleted files
|
|
$self->flog("delete|".join("; ", @deleted)) if scalar @deleted;
|
|
|
|
# Need to confirm on deleting selected files
|
|
return $self->print_json({ confirms => \@loop_files, num_done => $num_done }, 1) if scalar @loop_files;
|
|
return $self->print_json(undef, 1, $self->language($num_done > 1 ? 'MSG_MULT_DELETED' : 'MSG_DELETED', $num_done));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{symlink} = __LINE__ . <<'END_OF_SUB';
|
|
sub symlink {
|
|
# -----------------------------------------------------------------------------
|
|
# Symlink command
|
|
#
|
|
my $self = shift;
|
|
|
|
my @files = $self->{in}->param('cinput');
|
|
my $to = $self->{cgi}{symlink_input};
|
|
return $self->print_json_error($self->language('ERR_SYMLINK_INPUT')) unless $to;
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless scalar @files;
|
|
|
|
my $path = $self->check_path($to);
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $to)) unless $path->{exist};
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $to)) unless $path->{write};
|
|
|
|
my $links = 0;
|
|
foreach my $f (@files) {
|
|
my $file = $self->check_name($f, 1);
|
|
next if $file->{error} or $file->{full_path} eq $path->{full_path};
|
|
|
|
# Untaint the path
|
|
my $p = "$path->{full_path}/$f";
|
|
($p) = $p =~ /^(.*)$/;
|
|
symlink($file->{full_path}, $p) and $links++;
|
|
}
|
|
|
|
return $self->print_json(undef, 1, $self->language('MSG_LINKED', $links, $to));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{compress} = __LINE__ . <<'END_OF_SUB';
|
|
sub compress {
|
|
# -----------------------------------------------------------------------------
|
|
# Compress files and directories
|
|
#
|
|
my $self = shift;
|
|
|
|
my @files = $self->{in}->param('cinput');
|
|
my $loc = $self->{cgi}{compress_input};
|
|
my $mode = $self->{cgi}{compress_mode} || 1;
|
|
|
|
return $self->print_json_error($self->language('ERR_GZIP_REQUIRED')) if $mode == 2 and !$GT::FileMan::HAVE_GZIP;
|
|
return $self->print_json_error($self->language('ERR_AZIP_REQUIRED')) if $mode == 3 and !$GT::FileMan::HAVE_AZIP;
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless scalar @files;
|
|
|
|
# Verify file name as well as location to store the compressed file
|
|
my $fname;
|
|
unless ($loc) {
|
|
my $path = $self->check_path(undef);
|
|
return $self->print_json_error($path->{error}) if $path->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $path->{full_path})) unless $path->{write};
|
|
return $self->print_json_error($self->language('ERR_COMPRESS_INPUT')) if scalar @files > 1;
|
|
|
|
($fname) = $files[0] =~ /([^.]+)/;
|
|
return $self->print_json_error($self->language('ERR_COMPRESS_INPUT')) unless $fname;
|
|
}
|
|
elsif ($loc =~ /\/$/) {
|
|
return $self->print_json_error($self->language('ERR_COMPRESS_INPUT')) if scalar @files > 1;
|
|
|
|
($fname) = $files[0] =~ /([^.]+)/;
|
|
return $self->print_json_error($self->language('ERR_COMPRESS_INPUT')) unless $fname;
|
|
$fname = "$loc$fname";
|
|
}
|
|
else {
|
|
$fname = $loc;
|
|
}
|
|
|
|
# Handling compressed file extension
|
|
($fname) = $fname =~ /([^.]+)/;
|
|
if ($mode > 1) {
|
|
$fname .= $mode == 2 ? '.tar.gz' : '.zip';
|
|
}
|
|
else {
|
|
$fname .= '.tar';
|
|
}
|
|
|
|
my $file = $self->check_name($fname);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
return $self->print_json_error($self->language('ERR_NOSPACE')) if $self->{diskspace} and !$self->{diskspace}{free};
|
|
return $self->print_json_error($self->language('ERR_FILENAME_EXISTING')) if scalar @files == 1 and $files[0] eq $fname;
|
|
|
|
return $self->print_json_error({ file => $file, confirm => 1 }) if $file->{exist} and !$self->{cgi}{overwrite_confirmed};
|
|
|
|
if ($mode == 3) {
|
|
$self->create_zip(\@files, $file->{full_path});
|
|
}
|
|
else {
|
|
$self->create_tar(\@files, $file->{full_path});
|
|
}
|
|
|
|
if ($self->{diskspace} and $self->{diskspace}{free} < -s $file->{full_path}) {
|
|
unlink $file->{full_path};
|
|
return $self->print_json_error('nospace');
|
|
}
|
|
|
|
$self->flog("compress|$file->{name}");
|
|
|
|
return $self->print_json(undef, 1, $self->language('MSG_COMPRESSED', $file->{name}));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{uncompress} = __LINE__ . <<'END_OF_SUB';
|
|
sub uncompress {
|
|
# -----------------------------------------------------------------------------
|
|
# uncompress a file
|
|
#
|
|
my $self = shift;
|
|
|
|
my @files = $self->{in}->param('compress');
|
|
my $to = $self->{cgi}{uncompress_input};
|
|
my $scope = $self->{cgi}{uncompress_scope};
|
|
my $fname = $self->{cgi}{compressed_file};
|
|
|
|
my $file = $self->check_name($fname);
|
|
my $path = $self->check_path($to);
|
|
|
|
return $self->print_json_error($file->{error} || $path->{error}) if $file->{error} or $path->{error};
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) if $scope and !scalar @files;
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $fname)) unless $file->{exist};
|
|
return $self->print_json_error($self->language('ERR_NOT_READABLE', $fname)) unless $file->{read};
|
|
return $self->print_json_error($self->language('ERR_NOT_WRITABLE', $to)) if $path->{exist} and !$path->{write};
|
|
return $self->print_json_error($self->language('ERR_NOSPACE')) if ($self->{diskspace} and !$self->{diskspace}{free});
|
|
|
|
# Untaint the path
|
|
($path->{full_path}) = $path->{full_path} =~ /^(.*)$/;
|
|
|
|
# Create the target folder if it does not exist
|
|
unless ($path->{exist}) {
|
|
rmkdir($path->{full_path}, 0755, { untaint => 1 }) or return $self->print_json_error($self->language('ERR_MAKEDIR', $to, $!));
|
|
}
|
|
|
|
my ($copied, $total_size, $hits) = (0, 0, 0);
|
|
my %error;
|
|
if ($file->{full_path} =~ /.zip$/i) {
|
|
require Archive::Zip;
|
|
my $zip = Archive::Zip->new($file->{full_path}) or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $fname, $!));
|
|
my @members = $zip->members();
|
|
$hits = scalar @members;
|
|
foreach my $f (@members) {
|
|
last if ($self->{diskspace} and $total_size + $f->uncompressedSize > $self->{diskspace}{free});
|
|
my $name = $f->fileName;
|
|
my $found = ($scope and scalar @files) ? 0 : 1;
|
|
if ($scope) {
|
|
foreach (@files) {
|
|
next if $_ ne $name;
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
next unless $found;
|
|
|
|
$copied++;
|
|
$total_size += $f->uncompressedSize;
|
|
|
|
# Untaint file name
|
|
($name) = $name =~ /^(.*)$/;
|
|
$zip->extractMember($name, "$path->{full_path}/$name");
|
|
}
|
|
}
|
|
else {
|
|
require GT::Tar;
|
|
my $tar = GT::Tar->open($file->{full_path}) or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $fname, $GT::Tar::error));
|
|
my $cfiles = $tar->files;
|
|
$hits = scalar @$cfiles;
|
|
|
|
foreach my $f (@$cfiles) {
|
|
last if ($self->{diskspace} and $total_size + $f->{size} > $self->{diskspace}{free});
|
|
my $name = $f->{name};
|
|
my $found = ($scope and scalar @files) ? 0 : 1;
|
|
if ($scope) {
|
|
foreach (@files) {
|
|
next if $_ ne $name;
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
next unless $found;
|
|
$total_size += $f->{size};
|
|
$copied++;
|
|
$f->write($path->{full_path}, { untaint => 1 });
|
|
}
|
|
}
|
|
|
|
$self->flog("cmd_uncompress|$fname");
|
|
$self->print_json(undef, 1, $self->language('MSG_UNCOMPRESSED', $fname, $hits, $copied));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{tail} = __LINE__ . <<'END_OF_SUB';
|
|
sub tail {
|
|
# -----------------------------------------------------------------------------
|
|
# tail command
|
|
#
|
|
my $self = shift;
|
|
|
|
my $lines = $self->{cgi}{tail_input} || 25;
|
|
my $retime = $self->{cgi}{tail_retime};
|
|
my $fname = $self->{cgi}{cinput};
|
|
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless $fname;
|
|
return $self->print_json_error($self->language('ERR_MULT_SELECTED')) if ref $fname eq 'ARRAY';
|
|
|
|
my $file = $self->check_name($fname);
|
|
return $self->print_json_error($file->{error}) if $file->{error};
|
|
return $self->print_json_error($self->language('ERR_NOTTEXT_FILE', $fname)) unless $file->{isfile} and $file->{text};
|
|
return $self->print_json_error($self->language('ERR_READABLE', $fname)) unless $file->{read};
|
|
return $self->print_json_error($self->language('ERR_EMPTY_FILE', $fname)) unless $file->{size};
|
|
|
|
my ($follow, $buffer, $content);
|
|
@ARGV = grep { if ($_ eq "-f") { $follow++; 0 } else { 1 } } @ARGV;
|
|
open DATA, "<$file->{full_path}" or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $fname, $!));
|
|
|
|
my $read_size = $file->{size} > $READ_SIZE ? $READ_SIZE : $file->{size};
|
|
seek DATA, -$read_size, 2;
|
|
read DATA, $buffer, $read_size;
|
|
my $read = $read_size;
|
|
$lines--;
|
|
|
|
while () {
|
|
if ($buffer =~ /\n(.*(?:\n.*){$lines}\n?$)/) {
|
|
$content .= $1;
|
|
last;
|
|
}
|
|
$read_size = ($file->{size} - $read > $READ_SIZE) ? $READ_SIZE : $file->{size} - $read;
|
|
unless ($read_size == 0) {
|
|
$content .= $buffer;
|
|
last;
|
|
}
|
|
seek DATA, -($read_size + $read), 2;
|
|
$read += $read_size;
|
|
my $new_buffer;
|
|
my $bytes_read = read DATA, $new_buffer, $read_size;
|
|
if ($bytes_read == 0) {
|
|
$content .= $buffer;
|
|
last;
|
|
}
|
|
$buffer = $new_buffer . $buffer;
|
|
}
|
|
|
|
my $count = 0;
|
|
if ($follow) {
|
|
seek DATA, 0, 2; # Seek to the end of the file
|
|
while () {
|
|
select undef, undef, undef, 1;
|
|
seek DATA, 0, 1 or last; # Reset eof(FILE)
|
|
print while <DATA>;
|
|
seek DATA, 0, 2;
|
|
last if ($count++ > 60); # Only run for one min max.
|
|
}
|
|
}
|
|
$self->print_json({ output => $self->{in}->html_escape($content), refresh => $retime }, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{perl} = __LINE__ . <<'END_OF_SUB';
|
|
sub perl {
|
|
# -----------------------------------------------------------------------------
|
|
# Perl command
|
|
#
|
|
my $self = shift;
|
|
|
|
my @files = $self->{in}->param('cinput');
|
|
return $self->print_json_error($self->language('ERR_PERL_SELECTED')) unless @files;
|
|
|
|
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin'; #for taint mode
|
|
|
|
my @output;
|
|
foreach my $f (@files) {
|
|
my $file = $self->check_name($f);
|
|
if ($file->{error}) {
|
|
push @output, { name => $f, error => $file->{error} };
|
|
next;
|
|
}
|
|
elsif (!$file->{read}) {
|
|
push @output, { name => $f, error => $self->language('ERR_NOT_READABLE', $file->{full_path}) };
|
|
next;
|
|
}
|
|
elsif (!$file->{isfile} or !$file->{text}) {
|
|
push @output, { name => $f, error => $self->language('ERR_NOTPERL_FILE', $file->{full_path}) };
|
|
next;
|
|
}
|
|
my ($ext) = $f =~ /\.([^.]+)$/;
|
|
if ($ext !~ /^(?:cgi|pl|pm)$/i) { push @output, { name => $f, error => $self->language('ERR_NOTPERL_FILE', $file->{full_path}) }; next; }
|
|
|
|
my ($fname) = $file->{full_path} =~ /^$self->{cfg}{root_path}(.*)/;
|
|
my $result = fsystem($self->{cfg}{path_to_perl},
|
|
'-cw -I',
|
|
"$self->{cfg}{private_path}/lib",
|
|
$file->{full_path},
|
|
);
|
|
push @output, { name => $f, %$result };
|
|
}
|
|
$self->print_json({ files => \@output }, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{diff} = __LINE__ . <<'END_OF_SUB';
|
|
sub diff {
|
|
# -----------------------------------------------------------------------------
|
|
# Diff Command
|
|
#
|
|
my $self = shift;
|
|
|
|
my $fname1 = $self->{cgi}{cinput};
|
|
my $fname2 = $self->{cgi}{diff_input};
|
|
return $self->print_json_error($self->language('ERR_NOSELECTED')) unless $fname1;
|
|
return $self->print_json_error($self->language('ERR_DIFF_INPUT')) unless $fname2;
|
|
return $self->print_json_error($self->language('ERR_MULT_SELECTED')) if ref $fname1 eq 'ARRAY';
|
|
|
|
my $file1 = $self->check_name($fname1);
|
|
my $file2 = $self->check_name($fname2);
|
|
return $self->print_json_error($file1->{error} || $file2->{error}) if $file1->{error} or $file2->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $fname1)) unless $file1->{exist};
|
|
return $self->print_json_error($self->language('ERR_NOT_FOUND', $fname2)) unless $file2->{exist};
|
|
return $self->print_json_error($self->language('ERR_NOTTEXT_FILE', $fname1)) unless $file1->{text};
|
|
return $self->print_json_error($self->language('ERR_NOTTEXT_FILE', $fname2)) unless $file2->{text};
|
|
|
|
require GT::FileMan::Diff;
|
|
my $diff = GT::FileMan::Diff::html_diff($file1->{full_path}, $file2->{full_path}, 3);
|
|
return $self->print_json_error($self->language('ERR_CANNOT_OPEN', ($diff == 1 ? $fname1 : $fname2), $!)) unless ref $diff;
|
|
|
|
$self->print_json({ output => $$diff }, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{preview} = __LINE__ . <<'END_OF_SUB';
|
|
sub preview {
|
|
my $self = shift;
|
|
|
|
my $file = $self->check_name($self->{cgi}{f});
|
|
return $self->print_json_error($self->language('ERR_INVALID_FILE')) if $file->{error};
|
|
return $self->print_json_error($self->language('ERR_NOT_FILE', $file->{name})) unless $file->{isfile};
|
|
return $self->print_json_error($self->language('ERR_NOT_READABLE', $file->{name})) unless $file->{read};
|
|
|
|
if ($file->{type} =~ /^(?:text|html)$/) {
|
|
open(TEXT, $file->{full_path}) or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
read TEXT, my $content, -s TEXT;
|
|
close TEXT;
|
|
|
|
$file->{content} = $self->{in}->html_escape($content);
|
|
}
|
|
elsif ($file->{type} eq 'compress') {
|
|
return $self->open_compressed($file);
|
|
}
|
|
return $self->print_json({ file => $file }, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{fdownload} = __LINE__ . <<'END_OF_SUB';
|
|
sub fdownload {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
|
|
my $fname = $self->{cgi}{f};
|
|
my $mode = $self->{cgi}{mode} || 'auto';
|
|
|
|
return if ref $fname eq 'ARRAY';
|
|
|
|
my $file;
|
|
if ($self->{cgi}{type}) {
|
|
# Untaint the path
|
|
my $full_path = "$self->{cfg}{tmp_path}/$fname";
|
|
($full_path) = $full_path =~ /^(.*)$/;
|
|
|
|
$file = {
|
|
full_path => $full_path,
|
|
name => 'download.' . $self->{cgi}{type},
|
|
size => -s $full_path
|
|
}
|
|
}
|
|
else {
|
|
$file = $self->check_name($fname);
|
|
return if $file->{error} or !$file->{isfile};
|
|
}
|
|
|
|
$mode = 'ascii' if ($mode and lc $mode eq 'auto' and $file->{text});
|
|
open(DATA, $file->{full_path}) or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
if ($file->{name} =~ /.zip$/i) {
|
|
print $self->{in}->header(
|
|
'-type' => 'application/octect-stream',
|
|
'-Content-Length' => $file->{size},
|
|
'-Content-Transfer-Encoding' => 'binary',
|
|
'-Content-Disposition' => \(qq/attachment; filename="$file->{name}"/ . (defined($file->{size}) ? "; size=$file->{size}" : ''))
|
|
);
|
|
}
|
|
else {
|
|
print $self->{in}->header($self->{in}->file_headers(
|
|
filename => $file->{name},
|
|
inline => 0,
|
|
size => $file->{size}
|
|
));
|
|
}
|
|
|
|
binmode STDOUT if $GT::FileMan::MSWIN;
|
|
binmode DATA;
|
|
|
|
my $newlines = $GT::FileMan::MSWIN ? "\r\n" : "\n";
|
|
my $buffer;
|
|
while (read(DATA, $buffer, $READ_SIZE)){
|
|
$buffer =~ s,$newlines,\n,g if $mode eq 'ascii';
|
|
print $buffer;
|
|
}
|
|
close DATA;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{env} = __LINE__ . <<'END_OF_SUB';
|
|
sub env {
|
|
# -----------------------------------------------------------------------------
|
|
# Print out environment
|
|
#
|
|
my $self = shift;
|
|
|
|
my $env = GT::FileMan::base_env($self->{in}, $self->{cfg}{version}, $self->{commands});
|
|
$self->print_json({ html => $self->print('env.html', { json => 1, env => \$env }) }, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{login} = __LINE__ . <<'END_OF_SUB';
|
|
sub login {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, %args) = @_;
|
|
|
|
return $self->print('home.html') unless $self->{cgi}{login};
|
|
return $self->print_json_error($self->language('ERR_INVALID_LOGIN')) unless $self->{cgi}{username} and $self->{cgi}{password};
|
|
return $self->print_json_error($self->language('ERR_INVALID_USERNAME')) if $self->{cfg}{login}{username} ne $self->{cgi}{username};
|
|
return $self->print_json_error($self->language('ERR_INVALID_PASSWORD')) if $self->{cfg}{login}{password} ne GT::FileMan::encrypt($self->{cgi}{password}, $self->{cfg}{login}{password}) and $self->{cfg}{login}{password} ne crypt($self->{cgi}{password}, $self->{cfg}{login}{password});
|
|
|
|
my $session = $self->session_create($self->{cfg}{login}, $self->{cgi}{cookie});
|
|
return $self->print_json_error($self->language('ERR_SESSION')) unless $session;
|
|
|
|
my $user = $self->{cfg}{login};
|
|
$user->{permission} = $self->{cfg}{permission};
|
|
$self->{session} = { id => $session->{id}, user => $user };
|
|
|
|
$self->flog("login|$user->{username}");
|
|
$self->print_json(undef, 1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{logout} = __LINE__ . <<'END_OF_SUB';
|
|
sub logout {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, $error) = @_;
|
|
|
|
$self->session_delete();
|
|
$self->flog('logout|Logged out');
|
|
|
|
$self->{session} = undef;
|
|
my %args = ( json => 1 );
|
|
if ($error) {
|
|
$args{error} = $error
|
|
}
|
|
else {
|
|
$args{message} = $self->language('MSG_LOGOUT');
|
|
}
|
|
$self->print_json({ html => $self->print('login.html', \%args) }, 1, undef, 'LOGGED_OUT');
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{help} = __LINE__ . <<'END_OF_SUB';
|
|
sub help {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
my $page = $self->{cgi}{page} || 'help.html';
|
|
|
|
$page = 'help.html' if $page ne 'help.html' and $page ne 'quicktip.html';
|
|
($page) = $page =~ /^(.*)$/;
|
|
|
|
$self->print($page);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{cmdprint} = __LINE__ . <<'END_OF_SUB';
|
|
sub cmdprint {
|
|
# -----------------------------------------------------------------------------
|
|
# Print selected file(s)
|
|
#
|
|
my $self = shift;
|
|
|
|
my @input = $self->{in}->param('cinput');
|
|
|
|
# Check the selected files
|
|
my @files;
|
|
foreach my $f (@input) {
|
|
my $file = $self->check_name($f);
|
|
next unless !$file->{error} and $file->{isfile} and $file->{text};
|
|
|
|
push @files, $file;
|
|
}
|
|
return $self->print_json_error($self->language('ERR_PRINT')) unless scalar @files;
|
|
return $self->print_json({ files => \@files }, 1) unless $self->{cgi}{print};
|
|
|
|
|
|
my $output = qq~
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|
<html><header><title>Gossamer Threads - FileMan</title></header><body onload="window.print()" style="">
|
|
~;
|
|
|
|
if ($self->{cgi}{all}) { # Print multiple files
|
|
my $flag = 0;
|
|
foreach my $f (@files) {
|
|
open (DATA, "< $f->{full_path}") or next;
|
|
read (DATA, my $data, -s DATA);
|
|
close DATA;
|
|
|
|
|
|
my $style = $flag ? 'style="page-break-before: always;"' : '';
|
|
$output .= qq|<div $style><hr size=1><pre>$data</pre><br /></div>|;
|
|
$flag++;
|
|
}
|
|
}
|
|
else { # Print single file
|
|
my $file = pop @files;
|
|
my $next_url = '';
|
|
if (scalar @files) {
|
|
my $hiddens = $self->hiddens();
|
|
$next_url = $self->{in}->url(absolute => 1, query_string => 0) . "?cmd=print$hiddens->{hidden_query};print=1";
|
|
foreach (@files) {
|
|
$next_url .= ";cinput=" . $self->{in}->escape($_->{name});
|
|
}
|
|
}
|
|
open (DATA, "< $file->{full_path}") or return $self->home(error => $self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
read (DATA, my $data, -s DATA);
|
|
close DATA;
|
|
|
|
$output .= qq|<hr size=1><pre>$data</pre><br />|;
|
|
$output = sprintf(qq|<a href="%s"><img src="$self->{cfg}{static_url}/$self->{cfg}{template}/images/paging-next.gif" border="0" /></a>|, $next_url) . $output if $next_url;
|
|
}
|
|
$output .= qq!</body></html>!;
|
|
|
|
print $self->{in}->header;
|
|
print $output;
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub open_compressed {
|
|
# -----------------------------------------------------------------------------
|
|
# Open a compressed file
|
|
#
|
|
my ($self, $file) = @_;
|
|
|
|
my ($ext) = $file->{name} =~ /\.([^.]+)$/;
|
|
|
|
my @files;
|
|
my $total_size = 0;
|
|
if (lc $ext eq 'zip') {
|
|
require Archive::Zip;
|
|
my $zip = new Archive::Zip($file->{full_path}) or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
foreach my $f ($zip->members) {
|
|
my $type = $f->isDirectory ? FOLDER : FILE;
|
|
my $name = $f->fileName;
|
|
my $spec = ficon($name, $type);
|
|
my $perm = $f->unixFileAttributes;
|
|
my $date = $f->lastModTime;
|
|
my $size = $f->compressedSize;
|
|
my @info = (
|
|
$type,
|
|
$spec->{icon},
|
|
$name,
|
|
$size,
|
|
$spec->{type},
|
|
$date,
|
|
'',
|
|
$perm,
|
|
permission($perm),
|
|
GT::Date::date_get($date, $self->{cfg}{date_format} || '%yyyy%-%mm%-%dd%'),
|
|
);
|
|
$total_size += $size;
|
|
push @files, \@info;
|
|
}
|
|
}
|
|
else {
|
|
require GT::Tar;
|
|
my $tar = GT::Tar->open($file->{full_path}) or return $self->print_json_error($self->language('ERR_CANNOT_OPEN', $file->{name}, $!));
|
|
my $files = $tar->files;
|
|
foreach my $f (@$files) {
|
|
my $type = $f->{type} == 5 ? FOLDER : FILE;
|
|
my $spec = ficon($f->{name}, $type);
|
|
my $owner = (eval {getpwuid($f->{uid})} || '') . ':' . (eval {getgrgid($f->{gid})} || '');
|
|
my @info = (
|
|
$type,
|
|
$spec->{icon},
|
|
$f->{name},
|
|
$f->{size},
|
|
$spec->{type},
|
|
$f->{mtime},
|
|
$owner,
|
|
$f->{mode},
|
|
permission($f->{mode}),
|
|
GT::Date::date_get($f->{mtime}, $self->{cfg}{date_format} || '%yyyy%-%mm%-%dd%'),
|
|
);
|
|
|
|
$total_size += $f->{size};
|
|
push @files, \@info;
|
|
}
|
|
}
|
|
|
|
return $self->print_json({ html => $self->print('compressed.html', { file => $file, json => 1 }), files => \@files, compressed => 1 }, 1);
|
|
}
|
|
|
|
sub create_zip {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, $files, $to) = @_;
|
|
|
|
require Archive::Zip::Tree;
|
|
my $zip = Archive::Zip->new();
|
|
|
|
foreach my $f (@$files) {
|
|
my $file = $self->check_name($f);
|
|
next unless !$file->{error} and $file->{read};
|
|
|
|
# Untaint the path
|
|
($file->{full_path}) = $file->{full_path} =~ /^(.*)$/;
|
|
($f) = $f =~ /^(.*)$/;
|
|
if (-d $file->{full_path}) {
|
|
my @files;
|
|
find($file->{full_path}, sub {
|
|
my $fp = shift;
|
|
my $fn = $fp;
|
|
$fn =~ s/$self->{cfg}{root_path}\///;
|
|
if (-d $fp) {
|
|
$zip->addDirectory($fp, $fn) or warn "$!";
|
|
}
|
|
else {
|
|
$zip->addFile($fp, $fn) or warn "$!";
|
|
}
|
|
}, { untaint => 1 });
|
|
}
|
|
elsif ($file->{isfile}) {
|
|
$zip->addFile($file->{full_path}, $f) or warn "$!";
|
|
}
|
|
}
|
|
my $error = $zip->writeToFileNamed($to) ? $! : '';
|
|
return $self->home({ error => { cannot_zip => 1, message => $error }}) if $error;
|
|
}
|
|
|
|
sub create_tar {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, $files, $to) = @_;
|
|
|
|
require GT::Tar;
|
|
my $fpath = $self->check_path();
|
|
my $tar = new GT::Tar($to);
|
|
|
|
my $from = $fpath->{error} ? '' : $fpath->{full_path};
|
|
foreach my $f (@$files) {
|
|
my $file = $self->check_name($f);
|
|
next unless !$file->{error} and $file->{read};
|
|
$tar->add_file($file->{full_path});
|
|
}
|
|
|
|
my $items = $tar->files;
|
|
foreach my $f (@$items) {
|
|
$f->{name} =~ s,$from/,,;
|
|
}
|
|
$tar->write($to);
|
|
}
|
|
|
|
sub current_path {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
|
|
my $work_path = $self->{cfg}{work_path};
|
|
return unless $work_path;
|
|
|
|
my (@paths, $parent);
|
|
my $work_folders = [split /\//, $work_path];
|
|
|
|
my $spath = '';
|
|
foreach my $f (@$work_folders) {
|
|
next unless $f;
|
|
push @paths, { folder => $f, path => $spath };
|
|
$spath .= $spath ? "/$f" : $f;
|
|
|
|
$parent = '/';
|
|
foreach my $i (0..$#$work_folders - 1) {
|
|
$parent .= ($parent =~ /\/$/) ? $work_folders->[$i] : "/$work_folders->[$i]";
|
|
}
|
|
}
|
|
return { parent => $parent, work_path => $work_path, loop => \@paths };
|
|
}
|
|
|
|
sub finfo {
|
|
# -----------------------------------------------------------------------------
|
|
# Load file information
|
|
#
|
|
my ($self, $full_path, $fname) = @_;
|
|
|
|
my $path = $self->check_path();
|
|
my $work_path = $path->{error} ? '' : $path->{full_path};
|
|
my ($located) = $full_path =~ /^$work_path\/(.*)/;
|
|
$located =~ s,/$fname$,,;
|
|
|
|
my (@stat, $type, $link);
|
|
if (-l $full_path) {
|
|
@stat = lstat($full_path);
|
|
$type = -d $full_path ? FOLDER : FILE;
|
|
$link = readlink $full_path;
|
|
}
|
|
else {
|
|
@stat = stat($full_path);
|
|
$type = -d $full_path ? FOLDER : FILE;
|
|
}
|
|
|
|
my $spec = ficon($full_path, $type);
|
|
my $owner = (eval {getpwuid($stat[4])} || '') . ':' . (eval {getgrgid($stat[5])} || '');
|
|
my @info = (
|
|
$type,
|
|
$link ? 'symlink' : $spec->{icon},
|
|
$self->{in}->html_escape($fname),
|
|
$type == FOLDER ? 0 : $stat[7],
|
|
$link ? $ICONS{symlink}->[1] : $spec->{type},
|
|
$stat[9],
|
|
$owner,
|
|
sprintf("%04o", ($stat[2] & 07777)),
|
|
permission($stat[2]),
|
|
GT::Date::date_get($stat[9], $self->{cfg}{date_format} || '%yyyy%-%mm%-%dd%'),
|
|
$located eq $fname ? '' : $located,
|
|
$link || $full_path,
|
|
);
|
|
return \@info;
|
|
}
|
|
|
|
sub friendly_size {
|
|
# -----------------------------------------------------------------------------
|
|
# Prints out the file size.
|
|
#
|
|
my $size = shift;
|
|
return $size <= 100
|
|
? "$size Bytes"
|
|
: $size < 10 * KB
|
|
? sprintf("%.2f ", $size / KB) . 'KB'
|
|
: $size < 100 * KB
|
|
? sprintf("%.2f ", $size / KB) . 'KB'
|
|
: $size < MB
|
|
? sprintf("%.2f ", $size / KB) . 'KB'
|
|
: $size < 10 * MB
|
|
? sprintf("%.2f ", $size / MB) . 'MB'
|
|
: $size < 100 * MB
|
|
? sprintf("%.2f ", $size / MB) . 'MB'
|
|
: sprintf("%.2f ", $size / MB) . 'MB';
|
|
}
|
|
|
|
sub permission {
|
|
# -----------------------------------------------------------------------------
|
|
# Takes permissions supplied from stat() and prints out in ls -al format.
|
|
#
|
|
my $octal = shift;
|
|
|
|
my $string = sprintf "%04o", ($octal & 07777);
|
|
my @perms = split '', $string;
|
|
|
|
my $result = '--- --- ---';
|
|
my @extra_map = (
|
|
{ mask => 0x4, char => 's' },
|
|
{ mask => 0x2, char => 's' },
|
|
{ mask => 0x1, char => 't' },
|
|
);
|
|
|
|
for (my $i = 1; $i < @perms; $i++) {
|
|
my $j = $i - 1;
|
|
|
|
substr($result, $j * 4 + 0, 1, 'r') if 0x4 & $perms[$i];
|
|
substr($result, $j * 4 + 1, 1, 'w') if 0x2 & $perms[$i];
|
|
|
|
# The display of execute needs to be handled differently as it also shows the
|
|
# additional permissions
|
|
my $exec = 0x1 & $perms[$i];
|
|
my $char;
|
|
$char = 'x' if $exec;
|
|
$char = $extra_map[$j]->{char} if $extra_map[$j]->{mask} & $perms[0];
|
|
$char = uc $char if !$exec and $char ne 'x';
|
|
substr($result, $j * 4 + 2, 1, $char) if $char;
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub ficon {
|
|
# -----------------------------------------------------------------------------
|
|
# Get the associated icon based on a files extension
|
|
#
|
|
my ($file, $type) = @_;
|
|
|
|
return { icon => $ICONS{folder}[0], type => $ICONS{folder}[1] } if $type == FOLDER;
|
|
|
|
my ($ext) = $file =~ /\.([^.]+)$/;
|
|
return { icon => $ICONS{unknown}[0], type => $ICONS{unknown}[1] } unless $ext;
|
|
|
|
foreach (keys %ICONS) {
|
|
next if $_ =~ /^(?:folder|unknown|parent)$/;
|
|
return { icon => $ICONS{$_}[0], type => $ICONS{$_}[1]} if $_ =~ /\b\Q$ext\E\b/i;
|
|
}
|
|
|
|
return { icon => $ICONS{unknown}[0], type => $ICONS{unknown}[1] };
|
|
}
|
|
|
|
sub load_htpasswd {
|
|
# -----------------------------------------------------------------------------
|
|
# Load .htpasswd
|
|
#
|
|
my $self = shift;
|
|
|
|
my $pwd_path = $self->{default}{pwd_path};
|
|
my $htpwd;
|
|
if ($pwd_path) {
|
|
my $path = $self->check_path($pwd_path);
|
|
if (!$path->{error} and $path->{exist}) {
|
|
my $current = $self->check_path();
|
|
$current->{full_path} =~ s/[\/ \:]/\_/g;
|
|
$htpwd = "$path->{full_path}/.htpass$current->{full_path}";
|
|
($htpwd) = $htpwd =~ /^(.*)$/; # Untaint the path
|
|
}
|
|
}
|
|
|
|
unless ($htpwd) {
|
|
my $fpassword = $self->check_name('.htpasswd');
|
|
return if $fpassword->{error};
|
|
$htpwd = $fpassword->{full_path};
|
|
}
|
|
|
|
my $faccess = $self->check_name(".htaccess");
|
|
return unless !$faccess->{error} and $htpwd;
|
|
|
|
my $htacs = $faccess->{full_path};
|
|
if (-e $htpwd and $faccess->{exist}) {
|
|
my ($name_pwd) = $htpwd =~ /^$self->{cfg}{root_path}\/(.*)/;
|
|
open (HTPWD, "< $htpwd") or return;
|
|
my @users = map { /^([^:]+)/ ? qq:$1: : qq:'': } <HTPWD>;
|
|
close HTPWD;
|
|
return \@users;
|
|
}
|
|
}
|
|
|
|
sub create_htaccess {
|
|
# -----------------------------------------------------------------------------
|
|
# Creates the htaccess file.
|
|
#
|
|
my ($self, $htaccess, $htpasswd) = @_;
|
|
|
|
my $raq = $ENV{GT_COBALT_RAQ} ? "AuthPAM_Enabled off\n" : '';
|
|
open (HTAC, "> $htaccess") or return "open_file: $htaccess - $!";
|
|
print HTAC <<HTACCESS;
|
|
AuthUserFile $htpasswd
|
|
AuthGroupFile /dev/null
|
|
AuthType Basic
|
|
AuthName Protected
|
|
$raq
|
|
require valid-user
|
|
HTACCESS
|
|
close HTAC;
|
|
return;
|
|
}
|
|
|
|
sub fcopy {
|
|
# -----------------------------------------------------------------------------
|
|
# Copy and replace a file
|
|
#
|
|
my ($from, $to, $replace, $with) = @_;
|
|
|
|
open(TARGET, ">$to") or return 0;
|
|
open(SOURCE, "<$from") or return 0;
|
|
binmode SOURCE;
|
|
binmode TARGET;
|
|
|
|
my ($buffer, $bit);
|
|
while (my $rs = read SOURCE, $buffer, $READ_SIZE) {
|
|
if ($replace) {
|
|
$buffer = "$bit$buffer" if length $bit;
|
|
$bit = ($rs == $READ_SIZE and $buffer =~ s/(?:\r|\r?\n)([^\r\n]+)$//) ? $1 : '';
|
|
|
|
$buffer =~ s/$replace/$with/g;
|
|
}
|
|
print TARGET $buffer;
|
|
}
|
|
close SOURCE;
|
|
close TARGET;
|
|
fchmod($from, $to);
|
|
return 1;
|
|
}
|
|
|
|
sub fchmod {
|
|
# -----------------------------------------------------------------------------
|
|
# set chmod
|
|
#
|
|
my($from, $to) = @_;
|
|
$from =~ m,^([/\w.-]+)$,;
|
|
$from = $1;
|
|
|
|
$to =~ m,^([/\w.-]+)$,;
|
|
$to = $1;
|
|
|
|
my $stat = [stat($from)];
|
|
chmod(@$stat[2], $to);
|
|
}
|
|
|
|
sub size {
|
|
# -----------------------------------------------------------------------------
|
|
# Load size of files and directories
|
|
#
|
|
my ($self, $files) = @_;
|
|
|
|
my $total_size = 0;
|
|
|
|
foreach my $f (@$files) {
|
|
next unless $f;
|
|
my $file = $self->check_name($f);
|
|
next if $f->{error};
|
|
if ($file->{isfile}) {
|
|
$total_size += $file->{size};
|
|
}
|
|
else {
|
|
find($file->{full_path}, sub { $total_size += -s shift }, { untaint => 1 });
|
|
}
|
|
}
|
|
return $total_size;
|
|
}
|
|
|
|
sub check_path {
|
|
# -----------------------------------------------------------------------------
|
|
# Check a directory make sure it safe
|
|
# It returns a full path or a hash
|
|
#
|
|
my ($self, $dir) = @_;
|
|
|
|
my $root = $self->{cfg}{root_path};
|
|
my $work = $self->{cfg}{work_path};
|
|
$work =~ s/^\/// if $work;
|
|
|
|
my $full_path;
|
|
unless ($dir) {
|
|
$full_path = $work ? "$root/$work" : $root;
|
|
}
|
|
elsif ($dir eq '/') {
|
|
$full_path = $root;
|
|
}
|
|
else {
|
|
$full_path = $dir =~ m,^/, ? "$root$dir" : "$root/". ($work ? "$work/" : "") . "$dir";
|
|
}
|
|
|
|
# Untaint the path
|
|
($full_path) = $full_path =~ /^(.*)$/;
|
|
|
|
if (-e $full_path) {
|
|
my $current_path = cwd();
|
|
chdir($full_path);
|
|
|
|
$full_path = cwd();
|
|
|
|
# Untaint the path
|
|
($current_path) = $current_path =~ /^(.*)$/;
|
|
chdir($current_path);
|
|
|
|
if ($full_path =~ /^$root(.*)$/) {
|
|
$work = $1;
|
|
}
|
|
else {
|
|
return { error => $self->language('ERR_OUT_BOUNCE', $dir) };
|
|
}
|
|
}
|
|
|
|
return { error => $self->language('ERR_INVALID_INPUT', $full_path) } if ($self->{cfg}{filename_check} and $full_path !~ m,^([-\w/. ]+)$,);
|
|
|
|
return {
|
|
work_path => $work,
|
|
full_path => $full_path,
|
|
exist => -e $full_path,
|
|
isdir => -d $full_path,
|
|
write => -w $full_path,
|
|
read => -r $full_path
|
|
};
|
|
}
|
|
|
|
sub check_name {
|
|
# -----------------------------------------------------------------------------
|
|
# Check a file/directory name make sure
|
|
# - Not contain an special characters if the option is on
|
|
# - Not out side root directory
|
|
#
|
|
|
|
my ($self, $file) = @_;
|
|
|
|
my ($fname, $fpath);
|
|
if ($file =~ /^(.*)\/([^\/]+)$/) {
|
|
$fpath = $1;
|
|
$fname = $2;
|
|
}
|
|
else {
|
|
$fname = $file;
|
|
}
|
|
return { error => $self->language('ERR_INVALID_INPUT') } unless $fname;
|
|
|
|
my $path = $self->check_path($fpath);
|
|
return { error => $path->{error} } if $path->{error};
|
|
|
|
return { error => $self->language('ERR_INVALID_INPUT') } if $self->{cfg}{filename_check} and $fname !~ m,^([-\w/. ]+)$,;
|
|
|
|
my $full_path = $path->{full_path} . '/' . $fname;
|
|
|
|
# Untaint the path
|
|
($full_path) = $full_path =~ /^(.*)$/;
|
|
|
|
my ($ext) = $fname =~ /\.([^.]+)$/;
|
|
my $type;
|
|
if ($ext =~ /^(?:bmp|gif|jpg|tif|tiff|ico|png)$/i) {
|
|
$type = 'image';
|
|
}
|
|
elsif (-T $full_path and $ext =~ /^(?:html|htm|shtml|shtm)$/i) {
|
|
$type = 'html';
|
|
}
|
|
elsif (-T $full_path and lc $ext ne 'pdf') { # Open a text file e.g: *.txt, *.html, ect...
|
|
$type = 'text';
|
|
}
|
|
elsif ($ext =~ /^(?:doc|xls|pdf|mp3|mpga|mpg)$/i) {
|
|
$type = 'doc';
|
|
}
|
|
elsif ($ext =~ /^(?:tar|gz|zip)$/i) {
|
|
$type = 'compress';
|
|
}
|
|
else {
|
|
$type = 'unknown';
|
|
}
|
|
|
|
return {
|
|
name => $file,
|
|
type => $type,
|
|
full_path => $full_path,
|
|
exist => -e $full_path,
|
|
write => -w $full_path,
|
|
read => -R $full_path,
|
|
text => ($ext !~ /^(?:pdf|doc|xls)$/ and -T $full_path),
|
|
size => -s $full_path,
|
|
isfile => -f $full_path,
|
|
};
|
|
}
|
|
|
|
sub flog {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my ($self, $log) = @_;
|
|
return unless $self->{cfg}{fversion} eq 'multiple';
|
|
|
|
$self->history($log);
|
|
}
|
|
|
|
sub upload_progress {
|
|
# Upload progress
|
|
# It returns a json object with all progess numbers
|
|
#
|
|
my $self = shift;
|
|
|
|
my ($serial) = $self->{cgi}{upload};
|
|
|
|
# Untaint the path
|
|
my $logfile = "$self->{cfg}{tmp_path}/$serial";
|
|
($logfile) = $logfile =~ /^(.*)$/;
|
|
return $self->print_json_error(undef) unless -e $logfile;
|
|
|
|
my ($progress, $currentfile, $totalprogress, $totalsize, $end_time, $start_time, $elapsedtime, $filename, $allowed_space, $free_space) = ();
|
|
|
|
open(READLOGFILE,"< $logfile") or return $self->print_json_error(undef);
|
|
flock READLOGFILE, 1;
|
|
seek READLOGFILE, 0, 0;
|
|
my $line = <READLOGFILE>;
|
|
chomp $line;
|
|
close READLOGFILE or return $self->print_json_error(undef);
|
|
unlink $logfile;
|
|
|
|
($progress, $totalsize, $start_time, $end_time, $filename, $allowed_space, $free_space) = split(/:\|:/, $line);
|
|
$self->print_json({
|
|
uploaded => $progress,
|
|
upload_size => $totalsize,
|
|
elapsed_time => $end_time - $start_time,
|
|
allowed_space => $allowed_space,
|
|
free_space => $free_space,
|
|
filename => $filename,
|
|
}, 1);
|
|
}
|
|
|
|
sub fsystem {
|
|
my (@args) = @_;
|
|
|
|
my ($output, $error) = ('', '');
|
|
my $tmp_output = new GT::TempFile;
|
|
my $tmp_errors = new GT::TempFile;
|
|
|
|
open(OLDOUT, ">&STDOUT");
|
|
open(OLDERR, ">&STDERR");
|
|
open(STDOUT, ">$$tmp_output") or return { error => "Can't redirect STDOUT" };
|
|
open(STDERR, ">$$tmp_errors") or return { error => "Can't redirect STDERR" };
|
|
|
|
select(STDERR);
|
|
$| = 1;
|
|
select(STDOUT);
|
|
$| = 1;
|
|
|
|
my $snum = system(@args);
|
|
|
|
# Close and restore STDOUT and STDERR
|
|
close STDOUT;
|
|
close STDERR;
|
|
open(STDOUT, ">&OLDOUT");
|
|
open(STDERR, ">&OLDERR");
|
|
|
|
open (TMP, "< $$tmp_output") or return { error => $! };
|
|
read (TMP, $output, -s TMP);
|
|
close TMP;
|
|
open (TMP, "< $$tmp_errors") or return { error => $! };
|
|
read (TMP, $error, -s TMP);
|
|
close TMP;
|
|
|
|
unlink $$tmp_output;
|
|
unlink $$tmp_errors;
|
|
|
|
return $snum ? { error => $output || $error } : { message => $output || $error };
|
|
}
|
|
1
|