# 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