# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::FileMan::Commands
#   CVS Info :                          
#   $Id: Commands.pm,v 1.267 2005/04/11 17:24:03 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ====================================================================
#

package GT::FileMan::Commands;
# ===============================================================
    use strict;
    use GT::TempFile;
    use GT::Base qw/:persist/;
    use vars qw/$ICONS $READ_SIZE %LANGUAGE/;
    use GT::AutoLoader;
    use GT::File::Tools qw/:all/;

# Our nasty language hash.
    %LANGUAGE = (
        UPLOAD_MODE         => "<font color=green>File <b>%s</b> was successfully uploaded in <b>%s</b> mode.</font>",
        MSG_LOG_OFF         => "<font color=green>Please enter username and password to login.</font>",
        MSG_MULTI_UPLOAD    => "<font color=green><b>%s</b> files have been successfully uploaded.</font>",
        MSG_CHMOD_CHANGED   => "<font color=green>Permissions on <b>%s</b> file(s) have been updated successfully.</font>",
        MSG_SEACH_FOUND     => "<font color=green>Your search found <b>%s</b> results.</font>",
        MSG_REPLA_FOUND     => "<font color=green>Your search and replace updated <b>%s</b> files in %s</font>",
        MSG_SEACH_NOTFOUND  => "<font color=red>Your search did not produce any results.</font>",
        MSG_FILE_EDITING    => "<font color=green>%s <b>%s</b> file ...(size %s bytes)- </font><a href=\\\"javascript:top.js_download(\\\'%s\\\')\\\">Download</a>",
        MSG_FILE_CREATED    => "<font color=green><b>%s</b> has been created.</font>",
        MSG_FILE_EDITED     => "<font color=green>Changes to <b>%s</b> have been saved.</font>",
        MSG_DIR_CREATED     => "<font color=green><b>%s</b> directory has been created.</font>",
        MSG_PREFERENCES     => "<font color=green>Your options have been saved.</font>",
        MSG_UNCOMPRESS      => "<font color=green><b>%s</b> file has been unarchived.</font>",
        MSG_TAR_CANCEL      => "<font color=red>Creation of tar file has been cancelled.</font>",
        MSG_TAR_CREATED     => "<font color=green>Tar file <b>%s</b> has been created.</font>",
        MSG_COPIED          => "<font color=green> %s selected file/directory(s) have been copied (%s can not be copied).</font>",
        MSG_MOVED           => "<font color=green> %s selected file/directory(s) have been moved (%s can not be moved).</font>",
        MSG_DEL_SUCC        => "<font color=green><b>%s</b> files and <b>%s</b> directories have been removed.</font>",
        MSG_DEL_CURR        => "<font color=green>You've removed the directory: %s</font>",
        MSG_DEL_ALL         => "<font color=green>You've removed the directory, and all contents recursively.</font>",
        MSG_DEL_SKIP        => "<font color=green>You've skiped the directory :%s</font>",
        MSG_DEL_CANC        => "<font color=green>You've cancelled deleting the directory</font>",
        MSG_DEL_ALL_SUCC    => "<font color=green>All child dirs and files on the selected directorys has been removed. </font>",
        MSG_CONTINUE        => "<body bgcolor='#E9E9E9' text='#000066' leftmargin=5 topmargin=5><font color=red face=arial size=2> <b><a href='%s?fdo=cmd_show_passwd&work_path=%s&%s'>click here</a> to continue.</font></body>",
        MSG_PWD_CHANGED     => "<font color=green>Your password was changed. </font>",
        MSG_DEMO            => "<font color=red>Disabled in Demo.</font>",
        MSG_USER_ADDED      => "%s was added successfully.",
        MSG_USER_DELETED    => "%s was deleted successfully.",
        MSG_USER_RMALL      => "Users were deleted sucessfully.",
        ERR_DEL             => "<font color=red>Can not remove file(s)</font>",
        ERR_CHMOD           => "<font color=red>Can not change mode </font>",
        ERR_FILE_OPEN       => "<font color=red>Can not open file: %s</font>",
        ERR_FILE_EMPTY      => "<font color=red>File <b>%s</b> is empty.</font>",
        ERR_FILE_EXISTS     => "<font color=red>File <b>%s</b> exists.</font>",
        ERR_FILE_NOT_EXISTS => "<font color=red>File <b>%s</b> does not exist.</font>",
        ERR_FILE_PERM       => "<body bgcolor='#E9E9E9' text='#000066' leftmargin=5 topmargin=5><font color=red face=arial size=2> <b>Sorry, but we don't have write access to the htaccess files: '%s' and '%s'</font></BODY>",
        ERR_FILE_PEM        => "<font color=red>The <b>%s</b> directory is not writeable.</font>",
        ERR_NOT_TEXT_FILE   => "<font color=red>File <b>%s</b> is not a text file.</font>",
        ERR_DIR_NOT_EXISTS  => "<font color=red>Directory <b>%s</b> does not exist.</font>",
        ERR_DIR_PEM         => "<font color=red>The <b>%s</b> is not writeable.</font>",
        ERR_DIR_PERM        => "<font color=red>Please check permission.</font>",
        ERR_NOT_ISFILE      => "<font color=red><b>%s</b> is a directory.</font>",
        ERR_TMP_FILE        => "<font color=red>Can not open temp file.</font>",
        ERR_FREE_SPC        => "<font color=red>Upload: Not enough free space to upload that file.</font>",
        ERR_RM_FILE         => "<font color=red>Unable to remove file: %s. Reason: %s</font>",
        ERR_UPLOAD          => "<font color=red>Unable to upload file: %s. Reason: %s.</font>",
        ERR_FILE_SAVE       => "<font color=red>Cannot save file %s. Check permissions.</font>",
        ERR_DIR_EXISTS      => "<font color=red>Directory %s already exists.</font>",
        ERR_NAME            => "<font color=red>Illegal Characters in Directory. Please use letters, numbers, - and _ only.</font>",
        ERR_FILE_NAME1      => "No double .. allowed in file names.",
        ERR_FILE_NAME2      => "No leading . in file names.",
        ERR_READ_DIR        => "<font color=red>Can not open dir: %s. Reason: %s</font>",
        ERR_DIR_DEEP        => "Directory level too deep.",
        ERR_DISK_SPACE      => "<font color=red>Not enough space to save it (free space is %s kb)</font>",
        ERR_UNCOMPRESS      => "<font color=red>Select files or directories before to uncompress.</font>",
        ERR_TAR             => "<font color=red>Error: %s.</font>",
        ERR_TAR_NOT_EXISTS  => "<font color=red>Can not create a tar file: %s</font>",
        ERR_TAR_PEM         => "<font color=red>Can not create a tar file <b>%s</b>. Check permission.</font>",
        ERR_DOWNLOAD        => "<font color=red>You selected a directory !</font>",
        ERR_LOGIN           => "<font color=red>Invalid Username and Password.</font>",
        ERR_INVALID         => "<font color=red>Input value has invalid characters : <b>%s</b></font> ",
        ERR_NOT_FILE        => "<font color=red>The %s is not a file</font>",
        ERR_OLD_PASSWORD    => "<font color=red>Invalid Old password</font>",
        ERR_NEW_PASSWORD    => "<font color=red>New password must be more than 3 character</font>",
        ERR_OPEN_FILE       => "<font color=red>Can not open %s file, reason: %s</font>",
        ERR_WRITEABLE       => "<font color=red>Can not save %s file, reason: %s</font>",
        ERR_NO_AZIP         => "<font color=red>Please install the Archive::Zip library which is required.</font>",
        ERR_NO_GZIP         => "<font color=red>Please install the Compress::Zlib library which is required.</font>",
        COBALT_NOREMOTE     => "FileMan is not currently running under server authentication!",
        ERR_VERSION         => "<font color=red>This action does not support for your current version!</font>",
        ERR_PRINT           => "Please select the files which are required text or image files",
        PRINT_NEXT          => "<a href='%s'><font face='Verdana, Arial, Helvetica, sans-serif' size=2>Print Next</font></a>",
        COBALT_NOUSER       => "Unable to lookup user '%s'",
        COBALT_BADUID       => "Invalid user '%s' (%s)",
        COBALT_CANTSU       => "Can't switch to user '%s' (%s,%s). Reason: '%s'",
        COBALT_BADDIR       => "Invalid home directory '%s'. It does not look like a standard Raq director.",
        COBALT_BADGROUP     => "This program is restricted to site administrators only. You must be in the site administer group in order to use this."
    );

# Mapping of image name to icon files.
    $ICONS = {
        'gif jpg jpeg bmp'      => ['image2.gif' => 'Image File'],
        'txt'                   => ['text.gif' => 'Text File'],
        'cgi pl pm'             => ['text.gif' => 'Script File'],
        'zip gz tar'            => ['compressed.gif' => 'Compressed File'],
        'htm html shtm shtml'   => ['ie.gif' => 'Html File'],
        'wav au mid mod mp3'    => ['sound.gif' => 'Sound File'],
        'exe'                   => ['binary.gif' => 'Binary File'],
        'doc'                   => ['doc.gif' => 'MS Word'],
        'xls'                   => ['xls.gif' => 'MS Excel'],
        'pdf'                   => ['pdf.gif' => 'Adobe Acrobat'],
        'unknown'               => ['unknown.gif' => ''],
     };

# How large a chunk should we read into memory at once.
    $READ_SIZE = 500000;

sub DESTROY {}

$COMPILE{cmd_main_display} = __LINE__ . <<'END_OF_SUB';
sub cmd_main_display {
# ------------------------------------------------------------------
# Display main page
#
    my ($self, $args, $type) = @_;

# Load user list from .htpassword if it exists
    if ($args->{show_passwd} or $self->{cgi}->{show_passwd}) {
        $self->{url_opts} .= ';show_passwd=1' if ($self->{url_opts} !~ /show_passwd/);
        my $htpasswd       = $self->load_htpasswd();
        foreach (keys %$htpasswd) {
            $args->{$_} ||= $htpasswd->{$_};
        }
    }
    $self->list_files();
    $self->{cgi}->{cmd_do} = 'cmd_command' if ($type);
    $self->page('main.html', $args);
}
END_OF_SUB

$COMPILE{load_htpasswd} = __LINE__ . <<'END_OF_SUB';
sub load_htpasswd {
    my $self = shift;
    my $pass_path = $self->{in}->cookie('def_passwd_dir');

    my ($htpasswd, $exist, $delete_list);
    if (!$self->{cfg}->{passwd_dir_level} and !$pass_path =~ /^$self->{cfg}->{root_dir}/) {
         print $self->{in}->header (-cookie => [ $self->{in}->cookie ( -name    => 'def_passwd_dir',  -value   => '0', -expires => '+5y')]);
        $pass_path = '';
    }

    if ($pass_path) { # create .htaccess and .htpasswd in Password directory
        my $file_name = $self->_safe_dir();
        $file_name    =~ s/[\/ \:]/\_/g;
        $htpasswd     = "$pass_path/.htpass$file_name";
        $exist        = 1 if (-e $htpasswd);
    }
    else {
        my $fpasswd = $self->_safe_file(".htpasswd", {fullfile => 1, exist => 1});
        $htpasswd   = $fpasswd->{file};
        $exist      = 1 if ($fpasswd->{exist});
    }
    my $faccess  = $self->_safe_file(".htaccess", {fullfile => 1, exist => 1});
    my $htaccess = $faccess->{file};

    if ($exist and $faccess->{exist}) {
        open (HTPAS, "< $htpasswd") or die "Unable to open: $htpasswd ($!)";
        my @users = <HTPAS>;
        close HTPAS;
        $delete_list = "<select name='delete_user'><option>" . join('<option>', map { /^([^:]+)/ ? $1 : '' } @users) . "</option></select>" if (@users);
    }

    return { delete_list => $delete_list, pass_path => $pass_path };
}
END_OF_SUB

$COMPILE{list_files} = __LINE__ . <<'END_OF_SUB';
sub list_files {
# ------------------------------------------------------------------
# Displays a list of files for a given work_path.
#
    my $self            = shift;
    my $do              = shift || 'cmd_main_display';
    my $only_dir        = $self->{cfg}->{only_dir}; #only display directory listings
    my $work_path       = $self->{work_path};
    my $real_work_path  = $self->_safe_dir();
    my $html_url        = $self->{cfg}->{html_root_url} || '';
    my $url_opts        = $self->{url_opts}             || '';
    my $url             = "$self->{http_ref}?fdo=$do;$url_opts";
    my $list;

# Check if we have data already to list
    if (ref $self->{results} eq 'ARRAY') {
        $list = $self->{results};
    }
    else {
# Else get the list of files using readdir.
        opendir (DIR, $real_work_path) or die sprintf ($LANGUAGE{ERR_READ_DIR}, $real_work_path, "$!");
        @$list = readdir(DIR);
        closedir (DIR);
    }

# Create path string
    my ($string, $spath, $parent, $path) = ('', '', '', []);
    $path   = [split /\//, $self->{work_path}] if ($self->{work_path});
    $string = '<a href = javascript:top.js_open_link(\'cmd_main_display\',\'mainfrm\',\'\',1)>root</a>:  ' ;
    for my $ii (0.. $#$path) {
        next if (@$path[$ii] eq '');
        $spath  .= (($spath)  ? '/' : '').@$path[$ii];
        $parent .= (($parent) ? '/' : '').@$path[$ii] if ($ii < $#$path);
        $string .= "/<a href='$url;work_path=$spath' target=mainfrm>".$path->[$ii]."</a>";
    }

# Create data array to sort
    my ($list_dir, $list_file, $readme, $num_objects, $total_space);
    foreach my $file (@$list) {
        next if ($file eq '.');
        next if ($file eq '..');
        next if (!$self->{in}->cookie('hidden_file') and $file =~ /^\./); #don't show hidden file

        my $fullfile = "$real_work_path/$file";
        next if ($only_dir and (!-d $fullfile)); # next if not directory

        my @stat = stat($fullfile);
        my $hash;
        $readme = $file if (uc($file) eq 'README');
        @$hash{'name', 'size', 'date', 'perm', 'nsize'} = ($file, $stat[7], $stat[9], $stat[2], $stat[7]);
        $hash->{user} =  eval { getpwuid($stat[4]); } || '';
        $num_objects++;

        if (-d $fullfile) {
            $hash->{disabled} = 1 if not -x _;
            $hash->{nsize}    = 0;
            push @$list_dir, $hash;
        }
        else {
            $hash->{type}     = _get_icon($file)->{type};
            $hash->{disabled} = 1 if (!-r $fullfile);
            $total_space     += $hash->{size};
            push @$list_file,$hash;
        }
    }
    my $orderby  = $self->{cgi}->{sb} || $self->{in}->cookie('def_sort') || 'name';
    my $sortdown = !$self->{cgi}->{sd};
    $list_file = $self->qsort($list_file,$orderby,$sortdown) if ($#$list_file > 0);
    $list_dir  = $self->qsort($list_dir,$orderby,$sortdown)  if ($#$list_dir  > 0);

# Get the full filename, file size, file modification date and file permissions.
    foreach  (@$list_dir) {
        $_->{icon} = "<img border=0 src='$html_url/icons/folder.gif'>";
        $_->{isdir}= '1';
        $_->{type} = 'File Folder';
        $_->{size} = '';
        $_->{date} = _get_date($_->{date});
        $_->{perm} = _print_permissions($_->{perm});
    }
    foreach  (@$list_file) {
        my $spec   = _get_icon($_->{name});
        $_->{icon} = "<img border=0 src='$html_url/icons/$spec->{icon}' width=14 height=16>";
        $_->{isdir}= '0';
        $_->{size} = _print_filesize($_->{size});
        $_->{date} = _get_date($_->{date});
        $_->{perm} = _print_permissions($_->{perm});
    }

    my ($sorted, $speed_bar, $output);
    @$sorted = ($sortdown) ? (@$list_dir, @$list_file) : (@$list_file, @$list_dir);

# Prepare output after sort
# Skip pages
    my $pg        = $self->{cgi}->{pg} || 1; #current page
    my $r_pg      = $self->{in}->cookie('def_files_page') || 25;
    my $def_files = $self->{in}->cookie('def_files_page') || '';
    my $count     = 0;
    if ($def_files ne 'all' and $pg ne 'all'){
        my $skip = 0;
        foreach (@$sorted) {
            $skip++;
            if (($#$sorted >= $r_pg) and ($pg > 0)) {
                my $r_start = ($pg == 1) ? 1 : (($pg - 1) * $r_pg + 1);
                next if ($skip < $r_start);
                $count++;
                last if ($count == $r_pg);
            }
            push @$output, $_;
        }
        $speed_bar = $self->speed_bar($#$sorted + 1) if ($#$sorted >= $r_pg);
    }
# else all rows
    else {
        $speed_bar = $self->speed_bar($#$sorted + 1) if ($#$sorted >= $r_pg and $pg eq 'all');
        $output    = $sorted;
    }
    $self->{work_path} and unshift @$output, {
        'icon' => "<a href='$url;work_path=$parent'><img border=0 src='$html_url/icons/parent.gif' width=19 height=21></a>",
        'name' => "<a href='$url;work_path=$parent'>Parent Directory</a>",
        'type' => '', 'size' => '&nbsp', 'date' => '&nbsp', 'perm' => '', 'user' => '&nbsp'
    };

# Build columns title
    my $sort_title;
    my $cols;
    @$cols{'name', 'size', 'date', 'perm', 'user', 'type', 'view'} = ('Name', 'Size', 'Modified', 'Permissions', 'Owner', 'File Type', 'View');
    foreach  (keys %$cols) {
        my $temp = "<a href = $url";
        $temp .= "&work_path=$work_path&pg=$pg&sb=".(($_ eq 'view') ? 'type' : $_);
        $temp .= "&sd=$sortdown" if ($_ eq $orderby or $_ eq 'view');
        $temp .= '><font color=white>'.$cols->{$_}.'</font></a>' ;
        $temp .= (($_ eq $orderby) ? (($sortdown) ? "&nbsp;<img border=0 src='$html_url/icons/up.gif' width='13'>" : "&nbsp;<img border=0 src='$html_url/icons/down.gif' width='13'>") : '');
        $sort_title->{'s'.$_} = $temp;
    }

    my $msg_readme;
    if ($readme) {
        $msg_readme = "<p class=text_format><b>Readme File:</b>";
        open (DATA, "<$real_work_path/$readme") or return $self->cmd_main_display({reload => 1, status => "$!"});
        $count = 0;
        while (<DATA>) {
            chomp;
            next if ( $_ =~ /^\#/ or !$_);
            $msg_readme .= (($msg_readme)? "<BR>":"").$_;
            $count++;
            last if ($count == 10);
        }
        close DATA;
        $msg_readme .= "</p>";
    }

# Return data
    $self->{data} =  {
        pg             => $pg, %$sort_title,
        string         => $string,
        results        => $output,
        speed_bar      => $speed_bar,
        readme         => $msg_readme,
        num_objects    => $num_objects,
        total_space    => $total_space,
        count          => ($count) ? (($count > 10) ? $count - 1 : $count) : $#$output + 1,
    };

    if ($self->{cfg}->{allowed_space}){
        my $disk_space = $self->_checkspace();
        foreach (keys %$disk_space) {
            $self->{data}->{$_} = $disk_space->{$_};
        }
        $self->{data}->{allowed_space} = sprintf('%.1fMB', $self->{cfg}->{allowed_space} / (1024*1024)); # Format space limit
    }

    return 1;
}
END_OF_SUB

$COMPILE{cmd_show} = __LINE__ . <<'END_OF_SUB';
sub cmd_show {
# ------------------------------------------------------------------
# display with unusual template
#
    my ($self, $args) = @_;
    $args ||= {};
    my $template = $self->{cgi}->{page} || 'file_editor.html';

    if ($template eq 'file_editor.html') {
        ($self->{cgi}->{content} =~ /\<form/mi) and $self->{cgi}->{content} =~ s/<form/<FORM style="border: 1px dotted red; padding: 2px"/gi;

        $self->{cgi}->{content} = $self->{in}->html_escape($self->{cgi}->{content}) if (!$args->{error} and $self->{cgi}->{content});

        if (!defined $args->{use_html} and $self->get_browser(1) and !$self->{in}->cookie('editor_mode')) {
            $args->{use_html} = 1;
        }
        return $self->page($template, {
            editor_mode => (!$self->{in}->cookie('editor_mode')) ? 0 : 1,
            rows        => $self->{in}->cookie('rows') || 20,
            cols        => $self->{in}->cookie('cols') || 100,
            %$args
        });
    }
    elsif ($template eq 'preferences.html') {
        my $def_passwd_dir = $self->{in}->cookie('def_passwd_dir') || $self->{cgi}->{def_passwd_dir};
        $def_passwd_dir =~ s/$self->{cfg}->{root_dir}\/// if (!$self->{cfg}->{passwd_dir_level});

        return $self->page($template, {
            def_sort            => $self->{in}->cookie('def_sort')         || $self->{cgi}->{def_sort} ,
            def_working_dir     => $self->{in}->cookie('def_working_dir')  || $self->{cgi}->{def_working_dir},
            def_files_page      => $self->{in}->cookie('def_files_page')   || 25,
            def_pages_screen    => $self->{in}->cookie('def_pages_screen') || 20,
            readme_position     => $self->{in}->cookie('readme_position')  || 'Y',
            hidden_file         => $self->{in}->cookie('hidden_file')      || '0',
            editor_mode         => $self->{in}->cookie('editor_mode')      || '0',
            passwd_dir_level    => $self->{cfg}->{passwd_dir_level},
            def_passwd_dir      => ($def_passwd_dir eq '0') ? '' : $def_passwd_dir,
            %$args
        });
    }
    $self->page ($template,$args);
}
END_OF_SUB

$COMPILE{cmd_cd} = __LINE__ . <<'END_OF_SUB';
sub cmd_cd {
#------------------------------------------------------------------
# CD command
#
    my $self = shift;
    my $result = $self->_cd_check();
    return $self->cmd_main_display({ reload => 1, status => $result->{status} }, 1) if ($result->{status}); # not safe

    $self->{work_path}        = $result->{work_path};
    $self->{cgi}->{work_path} = $result->{work_path};
    $self->cmd_main_display();
}

sub _cd_check {
#----------------------------------------------------------------
# check cd command
#
    my $self = shift;

    my $input     = $self->{cgi}->{txt_input};
    my $root_path = $self->{cfg}->{root_dir};
    my $fulldir   = $self->_safe_dir($input,{ exist => 1, write => 1});

    return {status => sprintf($LANGUAGE{ERR_INVALID}, $input), work_path => ''}        if ($fulldir == -1); # not safe
    return {status => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $input), work_path => ''} if (ref $fulldir eq 'HASH' and !$fulldir->{exist}); # not exist

    (my $dir = $fulldir->{fulldir}) =~ s,$root_path/,,;
    return { status => '', work_path => $dir};
}
END_OF_SUB

$COMPILE{cmd_search} = __LINE__ . <<'END_OF_SUB';
sub cmd_search {
#----------------------------------------------------------------
#   Search command
#
    my ($self, $repl) = @_;

    my ($results, $string, $spath);
    my $sortdown  = !$self->{cgi}->{sd};
    my $work_path = $self->{work_path}                    || '';
    my $orderby   = $self->{cgi}->{sb}                    || $self->{in}->cookie('def_sort') || 'name';
    my $pg        = $self->{cgi}->{pg}                    || '1'; #current page
    my $r_pg      = $self->{in}->cookie('def_files_page') || '25';
    my $search    = $self->{cgi}->{txt_input};
    my $url_opts  = $self->{url_opts} || '';

    $pg = 'all' if ($r_pg eq 'all');

    my ($r_start, $files);
    $search =~ s/[\/\\]//g;
    $search =~ s,\*,.*?,g;
    $search =~ s,\?,.?,g;

# Initial value for url
    my $scope   = $self->{cgi}->{scope};
    my $src_opts= "scope=$scope&c_case=$self->{cgi}->{c_case}&c_content=$self->{cgi}->{c_content}";
    my $url     = "$self->{http_ref}?fdo=cmd_main_display&$url_opts";
    my $url_pg  = "$self->{http_ref}?cmd_do=cmd_search&cmd=search&txt_input=".(($repl) ? $self->{cgi}->{txt_with} : $search)."&work_path=$work_path&$url_opts";
    my $path    = [split /\//, $work_path];

    if (! $scope) { # All of root
        my $fulldir = $self->_safe_dir();
        find($fulldir, sub {push @$files, shift});
    }
    else { # Selected files
        my $selected = [$self->{in}->param('c_edit')];
        foreach (@$selected) {
            my $fulldir = $self->_safe_dir($_);
            next if ($fulldir == -1);
            find($fulldir->{fulldir}, sub {push @$files, shift});
            $src_opts .= "&c_edit=$_";
        }
    }
    $url_pg .= "&$src_opts";

# Search data
    if ($repl) { # replace
        $results = $self->_replace($files);
    }
    else { # search data
        if (!$self->{cgi}->{c_content}) { # file name
            foreach my $file (@$files) {
                my ($name) = $file =~ m,/([^/]+)$,; #just get only the file name
                next if ($name eq $self->{work_path}); # don't take the work_path

                if ($self->{cgi}->{c_case}) { # None Case Sensitive
                    push @$results, $self->_file_info($file) if ($name =~ m,$search,);
                }
                else {
                    push @$results, $self->_file_info($file) if ($name =~ m,$search,i);
                }
            }
        }
        else { # contents
            $results = $self->_search_content($files);
        }
    }

#Push data of current page into an output array.
    my ($skip, $output, $total_space, $msg);
    if ($pg eq 'all') {
        $output = $results;
    }
    else {
        $r_start = ($pg == 1) ? 0 : (($pg - 1) * $r_pg );
        for my $ii (0 .. $#$results) {
            $total_space +=  @$results[$ii]->{size};
            if ($ii >= $r_start and $#$output < $r_pg - 1) {
                push @$output, @$results[$ii];
            }
        }
    }
    $string = "<a href = '$url' target=mainfrm >root</a>:  ";
    for my $ii (0.. $#$path) {
        next if (@$path[$ii] eq '');
        $spath  .= (($spath) ? '/' : '') . @$path[$ii];
        $string .= "/<a href='$url&work_path=$spath' target=mainfrm>".@$path[$ii]."</a>";
    }

    if ($#$results >= 0) {
        $msg = ($repl) ? sprintf ($LANGUAGE{MSG_REPLA_FOUND}, $#$results + 1, ($scope)? '' : 'in ' . (($work_path) ? '/' : 'Root').$work_path)
                       : sprintf ($LANGUAGE{MSG_SEACH_FOUND}, $#$results + 1, ($scope)? '' : 'in ' . (($work_path) ? '/' : 'Root').$work_path);
    }
    else {
        $msg = $LANGUAGE{MSG_SEACH_NOTFOUND};
    }

# Sort data
    my ($cols, $sort_title, $speed_bar);
    @$cols{'name','size','date','perm','user','type','view'} = ('Name','Size','Modified','Permissions','Owner','File Type','View');

    foreach (keys %$cols) {
        my $temp = "<a href = '$url_pg&pg=$pg&sb=".(($_ eq 'view')? 'type' : $_);
        $temp .= "&sd=$sortdown" if ( $_ eq $orderby or $_ eq 'view');
        $temp .= "'><font color=white>".$cols->{$_}."</font></a>" ;
        $temp .= ( ( $_ eq $orderby ) ? ( ($sortdown) ? " &nbsp;^" : " &nbsp;v" ) : '' );
        $sort_title->{'s'.$_} = $temp;
    }

# Create speed bar
    $speed_bar = $self->speed_bar($#$results,"$url_pg&sb=$orderby") if (($#$results - 1) > $r_pg and $r_pg > 0);
    $output    = $self->qsort($output,$orderby,$sortdown) if ($#$output > 1);
    foreach (@$output) {
        $total_space += $_->{size} if ($pg eq 'all');
        $_->{size} = _print_filesize($_->{size});
        $_->{perm} = _print_permissions($_->{perm});
        $_->{date} = _get_date($_->{date});
    }
    $self->{data} = {
        url        => "$self->{http_ref}",
        results    => $output,%$sort_title,
        string     => $string,
        total_space=> $total_space,
        num_objects=> (($#$results >=0)? $#$results+1:0),
        status     => "<font color=green>$msg</font>",
        speed_bar  => $speed_bar,
        search     => 1,
        reload     => 1
    };
    $self->page('main.html',{reload=>1});
}

sub _search_content {
#-------------------------------------------------------------------
# search contents
#
    my ($self, $files) = @_;

    my $results;
    my $search = $self->{cgi}->{txt_input};
    $search    = quotemeta($search) if ($self->{cgi}->{c_regex});

    foreach my $file (@$files) {
        if (-T $file) { # Text file
            next if (!open(SOURCE, "< $file"));
            my $buffer;
            if (-s SOURCE < $READ_SIZE) {
                read (SOURCE, $buffer, -s SOURCE);
                if ($self->{cgi}->{c_case}) { # None Case Sensitive
                    push @$results, $self->_file_info($file) if ($buffer =~ m,$search,);
                }
                else {
                    push @$results, $self->_file_info($file) if ($buffer =~ m,$search,i);
                }
            }
            else {
                while (read SOURCE, $buffer, $READ_SIZE) {
                    if ($self->{cgi}->{c_case}) { #None Case Sensitive
                        if ($buffer =~ m,$search,) {
                            push @$results, $self->_file_info($file);
                            last;
                        }
                    }
                    else {
                        if ($buffer =~ m,$search,i) {
                            push @$results, $self->_file_info($file);
                            last;
                        }
                    }
                }
            }
            close SOURCE;
        }
    }
    return $results;
}
END_OF_SUB

$COMPILE{cmd_replace} = __LINE__ . <<'END_OF_SUB';
sub cmd_replace {
#-----------------------------------------------------------------
# Search and replace
#
    my $self = shift;
    $self->cmd_search(1);
}

sub _replace {
#-----------------------------------------------------------------
# Search and replace contents
#
    my ($self, $files) = @_;

    my ($write, $results);
    my $search = $self->{cgi}->{txt_input};
    my $with   = $self->{cgi}->{txt_with};
    if ($self->{cgi}->{c_word}) {
        $search = " $search ";
        $with   = " $with ";
    }
    $search = quotemeta($search) if ($self->{cgi}->{c_regex});

    foreach my $file(@$files) {
        if ((-T $file) and (-w $file)) {
            next if (!open(SOURCE, "<$file"));
            my ($buffer, $found, $tmp);
            while (read SOURCE, $buffer, $READ_SIZE) {
                if ($self->{cgi}->{c_case}) { #None Case Sensitive
                    if ($buffer =~ m,$search,) {
                        $found = 1;
                        last;
                    }
                }
                else {
                    if ($buffer =~ m,$search,i) {
                        $found = 1;
                        last;
                    }
                }
            }
            close SOURCE;
            if ($found) {
                my $tempfile = new GT::TempFile;
                if (!$self->{cfg}->{winnt}) {
                    $file  =~ m,^([\/\w.-]+)$,;
                    $file  = $1; #untainted
                }

                $tmp = _fcopy($file, "$$tempfile.tmp");
                $tmp = _fcopy("$$tempfile.tmp", $file, $search, $with, $self->{cgi}->{c_case});
                _fcopy("$$tempfile.tmp","$file.bak")    if ($self->{cgi}->{c_bak}); # create a .bak file
                push @$results, $self->_file_info($file) if ($tmp);

                $self->history("cmd_replace|$file|$search with $with") if ( $self->{cfg}->{multi} ); #save log inf
            }
        }
    }

    return $results;
}
END_OF_SUB

$COMPILE{cmd_command} = __LINE__ . <<'END_OF_SUB';
sub cmd_command {
#----------------------------------------------------------------
# execute a command
#
    my $self = shift;
    $ENV{'PATH'}    = '/bin:/usr/bin:/usr/local/bin'; #for taint mode


    my $server_name = $ENV{'SERVER_NAME'};
    my $html_url    = $self->{cfg}->{html_root_url};
    my $url_opts    = $self->{url_opts}           || '';
    my $work_path   = $self->{work_path}          || '';
    my $working_dir = $self->{cgi}->{working_dir} || $self->_safe_dir();
    my $cmd         = $self->{cgi}->{txt_input}   || '';
    my $css_file    = $self->{in}->cookie('scheme') || 'fileman';
    my $full_path   = $self->{cfg}->{root_dir}.(($work_path)? "/$work_path" : '');

    my ($prompt, $run_file);
    $self->history("cmd_command|$cmd") if ( $self->{cfg}->{multi} );#save log info

    if ($self->{cgi}->{c_edit}) {
        $run_file = $full_path.'/'.$self->{cgi}->{c_edit};
        $cmd = $run_file.' '.$cmd;
    }
    print $self->{in}->header;
    chdir ($working_dir);

# ping command
    my $font = $self->{in}->cookie('font');
    if ($cmd =~ m,^\s*ping\s*, or $self->{cgi}->{long}) {
        $prompt = $self->{cfg}->{winnt} ? "$working_dir> " : "[". eval { getpwuid($<) } ."\@$server_name ".($working_dir || '/')."]";
        my $command_time_out = $self->{cfg}->{command_time_out} || 60;
        my ($pid, $oldfh);
        if(!$self->{cfg}->{winnt}) {
            $SIG{ALRM} = sub { die "timeout"};
            alarm($command_time_out);
        }
        print qq!
            <link rel='stylesheet' href=$self->{cfg}->{html_root_url}/$css_file.css>
            <body class="bg_main" leftmargin=5 topmargin=5>
            <form name=frm_main>
            <a href="$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&$url_opts"><img src="$self->{cfg}->{html_root_url}/icons/back.gif" border=0></a>
            <input type=hidden name=work_path value='$work_path'>
            <input type=hidden name=working_dir value='$working_dir'>
            <input type=hidden name=txt_input value=''>
            <input type=hidden name=scope value=''>
            <input type=hidden name=c_regex value=''>
            <input type=hidden name=c_case value=''>
            <input type=hidden name=page value=''>
            <input type=hidden name=c_content value=''>
            <input type=hidden name=do value='fileman'>
            <input type=hidden name=cmd_do value='cmd_command'>
            <input type=hidden name="session_id" value="$self->{cgi}->{session_id}">
            <input type=hidden name='root_selected' value="$self->{cgi}->{root_selected}">
            </form>
            <p width=100% class='text_format'>$font
            <b>$prompt</b> $cmd
            <pre>
        !;
        eval {
                $pid   = open (TMP, "$cmd |");
                $oldfh = select(TMP); $| = 1; select($oldfh);
                while(<TMP>){
                    s/(\n|\r\n)$//;
                    print GT::CGI->html_escape($_), "\n";
                }
                close (TMP) or die $@;
        };
        if ($@) {
            if ($@ =~ /timeout/) {
                my $ret = kill ('INT', $pid);
                $ret ? print "Command timed out." : print "Command timed out. Unable to kill: $!";
            }
            else {
                die $@;
            }
        }
        print "</font></pre></p></body>";
    }
    else {
# Other command
        my ($output,$errors) = ('','');
        if ($cmd or $self->{cgi}->{runfile}) {
            my $tmp_output = new GT::TempFile; # create a result file
            my $tmp_errors = new GT::TempFile; # create a error file
            if ($self->{cfg}->{winnt}) { #for WinNT
                system ("$cmd 1> $$tmp_output 2> $$tmp_errors");
            }
            else {
                system ("$cmd 2> $$tmp_errors 1> $$tmp_output");
            }
            open (TMP, "< $$tmp_output") or return $self->cmd_main_display({reload => 1, status => $!});
            read (TMP, $output, -s TMP);
            close TMP;

            open (TMP, "< $$tmp_errors") or return $self->cmd_main_display({reload => 1, status => $!});
            read (TMP, $errors, -s TMP);
            close TMP;
            if (($cmd =~ m/^\s*cd\s+(.+)/) and !$errors) {
                ($self->{cfg}->{winnt} and $working_dir !~ m,^/,) and $working_dir = '/'.$working_dir;
                $working_dir = _command_show($working_dir,$cmd) || {};
                ($self->{cfg}->{winnt}) and $working_dir =~ s,/,,;
            }
            $output   = $self->{in}->html_escape($output) if ($output);
            $errors ||= '';
        }
        my $action = ($cmd)? '' : "onload='top.js_cmd_command(1)'";
        $prompt    = $self->{cfg}->{winnt} ? "$working_dir> " : "[". eval { getpwuid($<) } ."\@$server_name ".($working_dir || '/')."]";
        print qq!
            <link rel='stylesheet' href="$html_url/$css_file.css">
            <body class="bg_main" leftmargin=5 topmargin=5 $action>
            <span class='text_format'>$font
            <a href="$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&$url_opts"><img src="$html_url/icons/back.gif" border=0></a><P>
            <b>$prompt</b> $cmd
            <pre class="text_format">$output</pre>
            <pre class="text_format"><font color="red">$errors</font></pre>
            </td></tr></table>
            <form name=frm_main>
            <input type=hidden name=work_path value='$work_path'>
            <input type=hidden name=working_dir value='$working_dir'>
            <input type=hidden name=txt_input value=''>
            <input type=hidden name=scope value=''>
            <input type=hidden name=c_regex value=''>
            <input type=hidden name=c_case value=''>
            <input type=hidden name=page value=''>
            <input type=hidden name=c_content value=''>
            <input type=hidden name=do value='fileman'>
            <input type=hidden name=cmd_do value='cmd_command'>
            <input type=hidden name="session_id" value="$self->{cgi}->{session_id}">
            <input type=hidden name='root_selected' value="$self->{cgi}->{root_selected}">
            </font></span></form></body>
     !;
    }
}
END_OF_SUB

$COMPILE{cmd_upload} = __LINE__ . <<'END_OF_SUB';
sub cmd_upload {
# -----------------------------------------------------
# upload a files
#
    my ($self, $data) = @_;

#    $ENV{'PATH'}  = ''; #for taint mode warning
    $data ||= $self->{in}->param('txt_input');

    my $work_path = $self->{work_path};
    my $path      = $self->{cfg}->{root_dir}.(($work_path)? "/$work_path" : '');

    if (!-w $path) { # Current directory does not writeable
        my $msg = sprintf($LANGUAGE{ERR_FILE_PEM},($work_path) ? $work_path : 'Root');
        ($self->{in}->param('txt_input')) ? return $self->cmd_main_display({ reload => 1 , status => $msg }) : return (0, $msg);
    }

    my $free_space = 0;
    if ($self->{cfg}->{allowed_space} > 0) {
        my $disk_space = $self->_checkspace($self->{cfg}->{root_dir});
        $free_space    = $disk_space->{free_space};
    }

    my $filename = $data;
    my $mode     = $self->{cgi}->{type};
    $filename    =~ s/.*?([^\\\/:]+)$/$1/;
    $filename    =~ s/[\[\]\s\$\#\%'"]/\_/g;

# Change the name if needed
    if ($self->{cgi}->{name} eq 'uppercase') {
        $filename =~ s/(\w+)/\U$1/gi;
    }
    elsif ($self->{cgi}->{name} eq 'lowercase') {
        $filename =~ s/(\w+)/\L$1/gi;
    }

# Get the full file name and save the file.
    my ($bytesread, $buffer, $fullfile, $file_size);
    my $file = $self->_safe_file ($filename, { fullfile => 1, exist => 1, write => 1});
    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $filename)}) if ($file == -1); # not safe

    $fullfile = $file->{file};
    if (!$self->{cfg}->{winnt}) {
        $fullfile =~ m,^([\/\w.-]+)$,;
        $fullfile = $1; #untainted
    }
    if (!$self->{in}->param('txt_input')) { #multi upload
        return (0, sprintf($LANGUAGE{ERR_FILE_EXISTS}, $filename)) if ($file->{exist} and !$self->{cgi}->{overwrite});
        return (0, sprintf($LANGUAGE{ERR_FILE_PEM}, $filename))    if ($file->{exist} and !$file->{write} and $self->{cgi}->{overwrite});
    }
    else {
        return $self->cmd_main_display({ reload => 1 , status =>sprintf($LANGUAGE{ERR_FILE_EXISTS}, $filename)}) if ($file->{exist} and !$self->{cgi}->{overwrite});
        return $self->cmd_main_display({ reload => 1 , status =>sprintf($LANGUAGE{ERR_FILE_PEM}, $filename)})    if ($file->{exist} and !$file->{write} and $self->{cgi}->{overwrite});
    }

    $file_size = 0;
    open    (OUTFILE, ">$fullfile") ;
    binmode (OUTFILE);
    while ($bytesread=read($data,$buffer,1024)) {
        if ($mode eq 'ascii') {
            $buffer =~ s,\r\n,\n,g;
        }
        print OUTFILE $buffer;
        $file_size += 1024;
        if ($self->{cfg}->{allowed_space} > 0) {
            if (($file_size / 1024) > $free_space) {
                close OUTFILE;
                unlink ($fullfile);
                ($self->{in}->param('txt_input')) ? return $self->cmd_main_display({ reload => '1', status => $LANGUAGE{ERR_FREE_SPC}}) : return (0,$LANGUAGE{ERR_FREE_SPC});
            }
        }
    }

    close OUTFILE;
    if ($mode eq 'auto') {
        if (-T $fullfile) {
            open (FILE, "< $fullfile") or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile, "$!");
            read (FILE, my $data, -s FILE);
            close FILE;

            $data =~ s,\r\n,\n,g;
            open (FILE, "> $fullfile") or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile, "$!");
            print FILE $data;
            close FILE;
            $mode = 'ascii/text';
        }
    }

# Change mode
    if ($self->{cfg}->{upload_chmod}) {
        my $octal_perm = oct($self->{cfg}->{upload_chmod}); # Permissions have to be in octal
        chmod($octal_perm, $fullfile) if $octal_perm; # 0 _probably_ means not octal, because 0 is an odd permission to use
    }

    my $status;
    if (-s $fullfile == 0) {
        unlink ($fullfile);
        $status = sprintf($LANGUAGE{ERR_UPLOAD}, $filename, "File is 0 bytes.");
    }
    else {
        $status = sprintf($LANGUAGE{UPLOAD_MODE},$filename,$mode);
    }
    $self->cmd_main_display({ reload=>1 , status => $status}) if ($self->{in}->param('txt_input'));

    if (-e $fullfile || -s $fullfile != 0) {
        if ( $self->{cfg}->{multi} ) { #save log info
            my $from = $fullfile;
            $from    =~ s/$path\///;
            $self->history("cmd_upload|$from|$path");
        }
        return (1, $status);
    }
    else {
       return (0, $status);
    }
}
END_OF_SUB

$COMPILE{cmd_mul_upload} = __LINE__ . <<'END_OF_SUB';
sub cmd_mul_upload {
# -----------------------------------------------------
# upload nulti files
#
    my $self  = shift;
    my $count = 0;
    my $msg   = '';
    for my $i(1..10) {
        my $data = $self->{in}->param('file'.$i);
        next if (!$data);
        my ($result, $status) = $self->cmd_upload ($data);
        $result ? $count++ : ($msg .= $status . '<BR>');
    }
    $self->{cgi}->{cmd_do} = 'cmd_upload';
    $self->cmd_main_display ( { reload => 1 , status => $count ? sprintf($LANGUAGE{MSG_MULTI_UPLOAD},$count) : $msg } );
}
END_OF_SUB

$COMPILE{cmd_editor} = __LINE__ . <<'END_OF_SUB';
sub cmd_editor {
#-------------------------------------------------------------
#   Editor a text file
#
    my $self = shift;

    my $url_opts = $self->{url_opts}         || '';
    my $filename = $self->{cgi}->{filename}  || '';
    my $work_path= $self->{work_path}        || '';
    my $root_path= $self->{cfg}->{root_dir};
    my $data     = $self->{cgi}->{content}   || '';
    my $fullfile;

# Store number of rows and cols for TEXTAREA object into cookie
    if ($self->{cgi}->{resize}) {
        my $rows = $self->{cgi}->{rows} || 20;
        my $cols = $self->{cgi}->{cols} || 100;
        $rows    = 20 if ($rows > 50);
        $cols    = 100 if ($cols > 200);
        print $self->{in}->header(
            -cookie => [
                $self->{in}->cookie( -name => 'cols', -value => $cols),
                $self->{in}->cookie( -name => 'rows', -value => $rows)
            ]
        );
        my $size = 0;
        if ($filename) {
            my $file = $self->_safe_file($filename,{ size => 1});
            $size = $file->{size};
        }
        my $status = sprintf($LANGUAGE{MSG_FILE_EDITING}, 'Editing ', $filename, $size, $filename);
        return $self->cmd_show({
            content  => $self->{in}->html_escape($data),
            rows     => $rows,
            cols     => $cols,
            status   => $status,
            use_html => 0,
            old      => ($self->{cgi}->{filename})? 1 : 0
        });
    }

# Switch to HTML or TEXT layout
    elsif ($self->{cgi}->{switch_edit}) {
        my $switch   = ($self->{cgi}->{use_html}) ? 0 : 1;
        my $filename = $self->{cgi}->{filename};
        if ($filename) {
            my $file = $self->_safe_file($filename,{ write => 1, text => 1, fullfile => 1, size => 1, isfile => 1});
            return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_INVALID}, $filename)})  if ($file == -1); # not safe
            return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_NOT_FILE}, $filename)}) if (!$file->{isfile}); # not a file
            my $status = sprintf($LANGUAGE{MSG_FILE_EDITING},'Editing ', $filename, $file->{size}, $filename);
            return $self->cmd_show({
                use_html => $switch,
                filename => ($filename =~ m,^/,) ? '' : $filename,
                old      => ($filename =~ m,^/,) ? 0  : 1,
                use_html => $switch,
                writeable=> $file->{write}
            });
        }
        else {
             return $self->cmd_show({ use_html => $switch });
        }
    }

# Save the contents
    ($self->{cgi}->{save}) ? ($filename = $self->{cgi}->{filename})
                           : ($filename = $self->{cgi}->{filenew});

    my $old = $self->{cgi}->{fileold};
    my $msg = $self->_valid_name_check($filename);
    return $self->cmd_show({msg => $msg, old => $old, use_html => $self->{cgi}->{use_html}}) if ($msg);

    $self->{cgi}->{content} = $self->{in}->html_escape($data);

    my $file = $self->_safe_file($filename, { fullfile => 1, exist => 1});
    return $self->cmd_show({msg => sprintf($LANGUAGE{ERR_INVALID}, $filename), old => $old}) if ($file == -1); # not safe
    $fullfile = $file->{file};

    if (($file->{exist}) and (!$old or $filename eq $self->{cgi}->{filenew})) { #file already exists
        my $tempfile = new GT::TempFile;
        open (FILE, "> $$tempfile.tmp") or return $self->cmd_show({ msg => $LANGUAGE{ERR_TMP_FILE}, old => $old});
        print FILE $data;
        close FILE;
        return $self->page('file_editor_confirm.html', { filename => $filename, tmp_file => "$$tempfile.tmp"});
    }
    $self->editor_process($filename,$data);
}
END_OF_SUB

$COMPILE{editor_process} = __LINE__ . <<'END_OF_SUB';
sub editor_process {
#-------------------------------------------------------
#   Save the contents to a file
#
    my ($self, $filename, $contents) = @_;

    if (!$filename) {
        $filename      = $self->{cgi}->{filename};
        my $tmp_file ||= $self->{cgi}->{tmp_file};
        open (DATA,"<$tmp_file") or return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{ERR_TMP_FILE}, error => 1 });
        read (DATA, $contents, -s DATA);
        close DATA;
    }

    my $file = $self->_safe_file($filename,{ fullfile => 1});
    my $old  = $self->{cgi}->{fileold};

    if ($file == -1) {
        $self->{cgi}->{content} = $self->{in}->html_escape($contents);
        return $self->cmd_show({msg => sprintf($LANGUAGE{ERR_INVALID}, $filename), old => $old, error => 1 }); # not safe
    }
    my $fullfile = $file->{file};

    open(FILE,">$fullfile") or return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_FILE_OPEN}, $filename), old => $old, error => 1 });
# Strip windows linefeeds.
    $contents =~ s,\r\n,\n,g;
    print FILE $contents;
    close(FILE);

    if (-e $fullfile) {
        $self->history("cmd_edit|$fullfile") if ( $self->{cfg}->{multi} ); #save log info"
        $self->{cgi}->{cmd_do} = 'cmd_command';
        my $status = (!$old) ? sprintf($LANGUAGE{MSG_FILE_CREATED}, $filename) : sprintf($LANGUAGE{MSG_FILE_EDITED}, $filename);
        return $self->cmd_main_display({ reload => '1', status => $status});
    }
    return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_FILE_SAVE}, $filename)});
}
END_OF_SUB

$COMPILE{cmd_makedir} = __LINE__ . <<'END_OF_SUB';
sub cmd_makedir {
#-----------------------------------------------
#   Make directory
#
    my $self = shift;

# Get the full path.
    my $new = $self->{cgi}->{txt_input};
    my $msg = $self->_valid_name_check($new);
    return $self->cmd_main_display({ reload => '1', status => $msg}) if ($msg);

    my $work_path = $self->{work_path} || '';
    my $fulldir   = $self->_safe_dir($new, { exist => 1 } );

    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID}, $new)})    if $fulldir == -1;
    if ($fulldir->{exist}) {
        return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_DIR_EXISTS}, $new)});
    }
    else {
        my ($name) = $fulldir->{fulldir} =~ /\/([^\/]+)$/;
        (my $path = $fulldir->{fulldir}) =~ s,/$name$,,;
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $self->{cgi}->{txt_input}) }) if (!-e $path);
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_PEM}, $self->{cgi}->{txt_input}) }) if (!-w $path); #permission
    }


    if (rmkdir ($fulldir->{fulldir}, 0755)) {
        $self->history("cmd_makedir|$fulldir->{fulldir}") if ( $self->{cfg}->{multi} ); #save log info
        return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{MSG_DIR_CREATED}, $new) });
    }

    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_DIR_PEM},($new =~ m,^/,) ? $new : ($work_path || 'Root'))});
}
END_OF_SUB

$COMPILE{cmd_preferences} = __LINE__ . <<'END_OF_SUB';
sub cmd_preferences {
#---------------------------------------------------
#   Save options of system
#
    my $self = shift;
    ($self->{cgi}->{save}) or return $self->cmd_main_display();

    my $def_sort        = $self->{cgi}->{def_sort}          || 'Name';
    my $def_working_dir = $self->{cgi}->{def_working_dir}   || '/';
    my $def_passwd_dir  = $self->{cgi}->{def_passwd_dir};
    my $def_files_page  = $self->{cgi}->{def_files_page}    || (($self->{cgi}->{showall})? 'all': 25);
    my $def_pages_screen= $self->{cgi}->{def_pages_screen}  || (($self->{cgi}->{showall})? 'all': 20);
    my $hidden_file     = $self->{cgi}->{hidden_file}       || '0';
    my $editor_mode     = $self->{cgi}->{editor_mode}       || '0';
    my $scheme          = $self->{cgi}->{scheme}            || 'fileman';
    my $font            = $self->{cgi}->{font}              || "<font face='Verdana, Arial, Helvetica, sans-serif' size=2>";
    my $readme_position = $self->{cgi}->{readme_position};

    ($font =~ /^<font/ and $font=~ /\>$/) or $font = "<font face='Verdana, Arial, Helvetica, sans-serif' size=2>";
    $def_files_page   = 25 if ($def_files_page    > 100);
    $def_pages_screen = 20 if ($def_pages_screen  > 50);
    $def_working_dir  =~ s/$GT::FileMan::UNSAFE_PATH//g;
    $def_passwd_dir   =~ s/$GT::FileMan::UNSAFE_PATH//g;
    $def_passwd_dir   = "$self->{cfg}->{root_dir}/$def_passwd_dir" if ($def_passwd_dir and !$self->{cfg}->{passwd_dir_level});
    $def_passwd_dir ||= '0';

    if ($def_passwd_dir and (!-e $def_passwd_dir or !-w _)) {
        $self->{cgi}->{page} = 'preferences.html';
        (-e _) or return $self->cmd_show( {msg => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $def_passwd_dir)} );
        (-w _) or return $self->cmd_show( {msg => sprintf($LANGUAGE{ERR_DIR_PEM}, $def_passwd_dir)} );
    }
    print $self->{in}->header (
        -cookie => [
            $self->{in}->cookie ( -name    => 'def_sort',        -value   => $def_sort,          -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'def_passwd_dir',  -value   => $def_passwd_dir,    -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'def_working_dir', -value   => $def_working_dir,   -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'def_files_page',  -value   => $def_files_page,    -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'def_pages_screen',-value   => $def_pages_screen,  -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'readme_position', -value   => $readme_position,   -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'hidden_file'    , -value   => $hidden_file,       -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'scheme'        ,  -value   => $scheme,            -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'font'          ,  -value   => $font,              -expires => '+5y'),
            $self->{in}->cookie ( -name    => 'editor_mode'   ,  -value   => $editor_mode,       -expires => '+5y'),
        ]
    );
    $self->{cgi}->{cmd_do} = 'cmd_command';
    return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_PREFERENCES}, re_scheme => 1 });
}
END_OF_SUB

$COMPILE{user_form} = __LINE__ . <<'END_OF_SUB';
sub user_form {
#---------------------------------------------------
#   Save options of system
#
    my ($self, $msg) = @_;
    ($self->{cfg}->{multi} or $self->{cfg}->{single}) or die $LANGUAGE{ERR_VERSION};
    $self->page('user_form.html', { msg => $msg});
}
END_OF_SUB

$COMPILE{cmd_admin} = __LINE__ . <<'END_OF_SUB';
sub cmd_admin {
#---------------------------------------------------
#   Save  user password
#
    my $self = shift;
    ($self->{cfg}->{multi} or $self->{cfg}->{single}) or die $LANGUAGE{ERR_VERSION};
    ($self->{cfg}->{single}) and return $self->pwd_single();

    my $username = $self->{cgi}->{Username};
    my $old_pass = $self->{cgi}->{Old_Password};
    my $new_pass = $self->{cgi}->{New_Password};
    my $db_name  = $self->{cfg}->{db_name};

    return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}) if (!$old_pass);
    return $self->user_form($LANGUAGE{ERR_NEW_PASSWORD}) if (!$new_pass or length($new_pass) < 3);

    open (DATA, "<$self->{cfg}->{priv_path}/$db_name") or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN},$db_name, "$!")},1);
        flock(DATA, 1);
        my @lines = <DATA>;
    close DATA;
    my $found;

# check username and password
    LINE: foreach (@lines) {
        if ($_ =~ /^$/) { next LINE; }
        if ($_ =~ /^#/) { next LINE; }
        chomp ($_);
        $_ =~ s/\r//g;  # Remove Windows linefeed character.
        my @record = split (/\Q|\E/o, $_);
        if (($record[1] ne $username) or ($record[2] ne crypt($old_pass,$old_pass))) { next LINE;}
        $found = 1;
        last;
    }
    ($found) or return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD});

# Save user information
    my $rows;
    LINE: foreach (@lines) {
        if ($_ =~ /^$/) { next LINE; }
        if ($_ =~ /^#/) { next LINE; }
        chomp ($_);
        $_ =~ s/\r//g;  # Remove Windows linefeed character.
        my @record = split (/\Q|\E/o, $_);
        if ($username eq $record[1]) { # replace user information
            $record[2] = crypt($new_pass,$new_pass);
            $rows .= join("|",@record);
        }
        else {
            $rows .= $_;
        }
        $rows .= "\n";
    }
    open (NEW, ">$self->{cfg}->{priv_path}/$db_name") or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN},$db_name, "$!")}, 1);
        flock(NEW, 2);
        print NEW $rows;
    close NEW;
    return $self->cmd_main_display({reload => 1, status => $LANGUAGE{MSG_PWD_CHANGED}},1);
}
END_OF_SUB

sub pwd_single () {
#------------------------------------------------------
# Change password in single version
#
    my $self = shift;
    ($self->{cfg}->{single}) or die $LANGUAGE{ERR_VERSION};
    my $fn = "$self->{cfg}->{priv_path}/lib/ConfigData.pm";
    (-e $fn) or return $self->user_form(sprintf($LANGUAGE{ERR_OPEN_FILE},'ConfigData.pm',$!));
    (-w _)   or return $self->user_form(sprintf($LANGUAGE{ERR_WRITEABLE},'ConfigData.pm',$!));

    my $old = $self->{cgi}->{Old_Password};
    my $new = $self->{cgi}->{New_Password};
    return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}) if (!$old);
    return $self->user_form($LANGUAGE{ERR_NEW_PASSWORD}) if (!$new and length($new) < 3);
    return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}) if (crypt($old,$self->{cfg}->{password}) ne $self->{cfg}->{password});

# Encrypt password
    my @salt_chars = ('A' .. 'Z', 0 .. 9, 'a' .. 'z', '.', '/');
    my $salt = join '', @salt_chars[rand 64, rand 64];
    $self->{cfg}->{password} = crypt($new, $salt);
    my $time = localtime;
    open (FH, "> $fn") or return $self->user_form(sprintf($LANGUAGE{ERR_OPEN_FILE},'ConfigData.pm',$!));
    print FH <<END_OF_CONFIG;
# ==================================================================
# FileMan - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : support\@gossamer-threads.com
#   Updated  : $time
#   
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

END_OF_CONFIG
    require GT::Dumper;
    print FH GT::Dumper->dump ( var => '', data => $self->{cfg} );
    close FH;
    print $self->{in}->header (-cookie => [ $self->{in}->cookie ( -name => 'password', -value => crypt($self->{cfg}->{password}, $self->{cfg}->{username}), -expires => '') ]);
    return $self->cmd_main_display({reload => 1, status => $LANGUAGE{MSG_PWD_CHANGED}},1);
}

$COMPILE{log_off} = __LINE__ . <<'END_OF_SUB';
sub log_off {
#---------------------------------------------------
#   Log off
#
    my $self = shift;
    print $self->{in}->header( -cookie => [
        $self->{in}->cookie( -name => 'username', -value => '', -expires => ''),
        $self->{in}->cookie( -name => 'password', -value => '', -expires => '')
    ]);
    return $self->page('login_form.html', { msg => $LANGUAGE{MSG_LOG_OFF} });
}
END_OF_SUB

$COMPILE{cmd_view} = __LINE__ . <<'END_OF_SUB';
sub cmd_view {
#---------------------------------------------------
#   View a file
#
    my ($self,$filename) = @_;
    $filename ||= $self->{cgi}->{c_edit};
    my $file = $self->_safe_file($filename, { write => 1, text => 1, fullfile => 1, size => 1});
    return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$filename)}) if ($file == -1); # not safe

    my $url_opts  = $self->{url_opts}  || '';
    my $work_path = $self->{work_path} || '';
    my $fullfile  = $file->{file};
    my ($ext)     = $fullfile =~ /\.([^.]+)$/;
    my $img_type  = "bmp gif jpg jpeg tif tiff";
    my $status    = sprintf($LANGUAGE{MSG_FILE_EDITING}, 'View ', $filename, -s $fullfile, $filename);

    return $self->page('view_image.html', { filename => $filename, work_path=> $work_path, status => $status }) if (($img_type =~ m,$ext,i) and $ext);
    $self->_view_file($filename);
}
END_OF_SUB

$COMPILE{cmd_edit} = __LINE__ . <<'END_OF_SUB';
sub cmd_edit {
#-------------------------------------------------------------
#   Print the content of a file
#
    my ($self, $filename, $use_html) = @_;

    $filename ||= $self->{cgi}->{c_edit};
    my $file = $self->_safe_file($filename,{ write => 1, text => 1, fullfile => 1, size => 1, isfile => 1});
    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $filename) }, 1)  if ($file == -1); # not safe
    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_NOT_FILE}, $filename) }, 1) if (!$file->{isfile}); # not a file

    my $url_opts  = $self->{url_opts}  || '';
    my $work_path = $self->{work_path} || '';
    my $fullfile  = $file->{file};
    my ($ext)     = $fullfile =~ /\.([^.]+)$/;
    $use_html   ||= '';
    if ($file->{text} and $ext ne 'pdf') { # Text file
        open (DATA,"<$fullfile") or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN},$filename, "$!")},1);
        read (DATA, my $content, -s DATA);
        close DATA;
        if ( $self->get_browser(1) and !$use_html and !$self->{in}->cookie('editor_mode') and ((lc($ext) eq 'html') or (lc($ext) eq 'htm')) ) { #should show HTML mode
            $use_html = 1;
            $content  =~ s/<form/<FORM style="border: 1px dotted red; padding: 2px"/gi;
        }
        $content =~ s,\r\n,\n,g;
        $content = $self->{in}->html_escape($content);
        my $status = sprintf($LANGUAGE{MSG_FILE_EDITING}, 'Editing ', $filename, $file->{size}, $filename);
        $self->cmd_show({
            content  => $content,
            filename => ($filename =~ m,^/,)? '' : $filename,
            status   => $status,
            old      => ($filename =~ m,^/,)? 0 : 1,
            use_html => $use_html,
            writeable=> $file->{write}
        });
        return;
    }
# Image file
    my $img_type = "bmp gif jpg jpeg tif tiff";
    my $status   = sprintf($LANGUAGE{MSG_FILE_EDITING}, 'View ', $filename, -s $fullfile, $filename);
    return $self->page('view_image.html', { filename => $filename, work_path => $work_path, status => $status }) if ($img_type =~ m,$ext,i);

    my $doc = "doc xls pdf DOC XLS PDF mp3 MP3 mpga MPGA mpg MPG";
    return $self->_view_file($filename) if ($doc =~ m,$ext,i); # .doc, .xls, .pdf file
    return $self->cmd_tar($filename)    if ($ext =~ /tar|gz|zip/i);
    return $self->_send_to_browser($fullfile); # Download if it is an unknow file
}
END_OF_SUB

$COMPILE{cmd_print_img} = __LINE__ . <<'END_OF_SUB';
sub cmd_print_img {
#----------------------------------------------------------------
# print image file
#
    my $self = shift;

    my $filename  = $self->{cgi}->{filename};
    $self->_view_file($filename);
}
END_OF_SUB

$COMPILE{cmd_download} = __LINE__ . <<'END_OF_SUB';
sub cmd_download {
#----------------------------------------------------------------
#   download  a file
#
    my $self = shift;

    my $files    = [ $self->{in}->param('c_edit') ];
    my $mode     = $self->{cgi}->{chmode} || 'binary';
    my $zip_type = $self->{cgi}->{opt_gz};
    if ($#$files == 0) {
        my $file = $self->_safe_file($self->{in}->param('c_edit'), { fullfile => 1});
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $self->{in}->param('c_edit'))}) if ($file == -1); # not safe
        return $self->_send_to_browser($file->{file}, $mode) if (-f $file->{file} and !$zip_type);
    }
    $zip_type  ||= 1;
    my $tempfile = new GT::TempFile;
    my $ext;
    if ($zip_type == 3 and $GT::FileMan::HAVE_AZIP) {
        my $error = $self->_zip_process("$$tempfile.zip", $files);
        return $self->cmd_main_display({ reload => 1, status => "<font color='red'>$error</font>" }) if ($error);
        $ext = 'zip';
    }
    elsif ( $zip_type == 2 and $GT::FileMan::HAVE_GZIP ) {
        $self->_tar_process("$$tempfile.tar.gz", $files);
        $ext = 'tar.gz';
    }
    else {
        $self->_tar_process("$$tempfile.tar", $files);
        $ext = 'tar';
    }
    $self->_send_to_browser("$$tempfile.$ext", 'auto', "download.$ext");
}
END_OF_SUB

sub _send_to_browser {
#----------------------------------------------------------------
# send the contents of a file to browser for downloading
#
    my $self      = shift;
    my $send_file = shift;
    my $mode      = shift;
    my $name      = shift;

    if ($mode eq 'auto') {
        (-T $send_file) and $mode = 'ascii';
    }
    if(open(SENDFILE, $send_file)) {
        $self->history("cmd_download|$send_file") if ($self->{cfg}->{multi}); #save log file

        my $file_size = -s $send_file;
        if (! $name) { ($name) = $send_file =~ m,/([^/]+)$,; }
        print $self->{in}->header(
            '-type'                      => 'application/download',
            '-Content-Length'            => $file_size,
            '-Content-Transfer-Encoding' => 'binary',
            '-Content-Disposition'       => \"attachment; filename=\"$name\""
        );
        ($self->{cfg}->{winnt}) and binmode STDOUT;
        binmode SENDFILE;
        my $buffer;
        while (read(SENDFILE, $buffer, $READ_SIZE)){
            if ($mode eq 'ascii') {
                $buffer =~ s,\r\n,\n,g;
            }
            print $buffer;
        }
        close SENDFILE;
    }
    else { # failed to open file
       $send_file =~ s,$self->{cfg}->{root_path},,;
       $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN}, $send_file, "$!") });
    }
}

$COMPILE{cmd_copy} = __LINE__ . <<'END_OF_SUB';
sub cmd_copy {
# --------------------------------------------------------
# Copy files or/and directories
#
    my $self = shift;

    my $files;
    my ($count_copied, $not_copied, $history) = (0, 0, '');

# Prepare files and dirs need to copy
    @$files = $self->{in}->param('c_edit');
    my $to_dir = $self->_safe_file($self->{cgi}->{txt_input},{ exist => 1, write => 1, fullfile => 1 });
    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $self->{cgi}->{txt_input}) }) if ($to_dir == -1); # not safe
    if ($to_dir->{exist}) {
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_PEM}, $self->{cgi}->{txt_input}) }) if (!$to_dir->{write}); #permission
    }
    else {
        my ($file) = $to_dir->{file} =~ /\/([^\/]+)$/;
        (my $path = $to_dir->{file}) =~ s,/$file$,,g;
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $self->{cgi}->{txt_input}) }) if (!-e $path);
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_PEM}, $self->{cgi}->{txt_input}) }) if (!-w $path); #permission
    }

    foreach  ( @$files ) {
        my $from = $self->_safe_file($_, { fullfile => 1, size => 1 });
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$_) }) if ($from == -1); # not safe
        next if ($from->{file} eq $to_dir->{file}); # don't copy to itself or it will loop infinitely.

# Check free space.
        if ($self->{cfg}->{allowed_space} > 0) {
            my $need_space;
            (-d $from->{file})? find($from->{file}, sub {$need_space += -s shift}) : ($need_space = -s $from->{file}); #current file/dir size
            my $disk_space = $self->_checkspace();
            my $free_space = $disk_space->{free_space};
            return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DISK_SPACE}, $free_space) }) if ($free_space*1024 < $need_space);
        }

        if (copy($from->{file}, $to_dir->{file})) {
            $count_copied++;
        }
        else {
            $not_copied++;
        }

    }
    if ($history) {
        chop $history;
        $self->history("cmd_copy|$history") if ( $self->{cfg}->{multi} ); #save log info
    }

    $self->{cgi}->{cmd_do} = "cmd_copy";
    return $self->cmd_main_display( { reload => 1, status => sprintf($LANGUAGE{MSG_COPIED}, $count_copied, $not_copied) });
}
END_OF_SUB

$COMPILE{cmd_move} = __LINE__ . <<'END_OF_SUB';
sub cmd_move {
# --------------------------------------------------------
# Move files or/and directories
#
    my $self = shift;

    my ($count_moved, $not_moved, $history) = (0, 0, '');
    my $files;
    @$files = $self->{in}->param('c_edit');

# Prepare files and dirs need to move
    my $to_dir = $self->_safe_file($self->{cgi}->{txt_input}, { exist => 1, write => 1, fullfile => 1 });
    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $self->{cgi}->{txt_input}) }) if ($to_dir == -1); # not safe

    if ($to_dir->{exist}) {
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_PEM}, $self->{cgi}->{txt_input}) }) if (!$to_dir->{write}); #permission
    }
    else {
        my ($file) = $to_dir->{file} =~ /\/([^\/]+)$/;
        (my $path = $to_dir->{file}) =~ s,/$file$,,g;
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $self->{cgi}->{txt_input}) }) if (!-e $path);
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_PEM}, $self->{cgi}->{txt_input}) })        if (!-w $path); #permission
    }

    foreach  (@$files) {
        my $from = $self->_safe_file($_, { fullfile => 1 });
        return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$_) }) if ($from == -1); # not safe
        next if ($from->{file} eq $to_dir->{file}); # don't copy to itself or it will loop infinitely.
        if (move($from->{file},$to_dir->{file})) {
            $count_moved++;
        }
        else {
            $not_moved++;
        }
    }
    if ($history) {
        chop $history;
        $self->history("cmd_move|$history") if ( $self->{cfg}->{multi} ); #save log info
    }

    $self->{cgi}->{cmd_do} = "cmd_move";
    return $self->cmd_main_display( { reload => 1, status => sprintf($LANGUAGE{MSG_MOVED}, $count_moved, $not_moved) });
}
END_OF_SUB

$COMPILE{cmd_delete} = __LINE__ . <<'END_OF_SUB';
sub cmd_delete {
# --------------------------------------------------------
# Delete files or directories
#
    my $self = shift;

    my ($files, $notdeleted);
    my ($count_file, $count_dir, $history) = (0, 0, '');

#List files and dirs need to remove
    @$files = $self->{in}->param('c_edit');
    foreach (@$files) {
        my $file = $self->_safe_file($_, { fullfile => 1 });
        if ($file == -1) {
            $self->{cgi}->{cmd_do} = "cmd_command" ;
            return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$_) }); # not safe
        }
        my $full_name = $file->{file};
        if ( -d $full_name and !-l $full_name ) {
            if ( rmdir($full_name) ) {
                $count_dir++;
            }
            else {
                push @$notdeleted,$_;
            }
        }
        else {
            if ( del($full_name) ) {
               $count_file++;
               $history .= "$full_name:";
            }
        }
    }
    if ($history) {
        chop $history;
        $self->history("cmd_delete|$history") if ( $self->{cfg}->{multi} ); #save log info
    }

    $self->list_files();
    my $status = ( $count_file > 0 or $count_dir > 0 ) ? sprintf($LANGUAGE{MSG_DEL_SUCC}, $count_file, $count_dir) : $LANGUAGE{ERR_DEL};
    if ($notdeleted) {
# Return list file for loop if recursive diectory
        my $list_files;
        foreach  ( @$notdeleted ) {
            push @$list_files, { name => $_ };
        }
        $self->{cgi}->{cmd_do} = "cmd_del_confirm";
        return $self->page('confirm_delete.html', { reload => 1, list_files => $list_files, file_cur => @$files[0], status => $status });
    }
    else {
        $self->{cgi}->{cmd_do} = "cmd_command";
        $self->cmd_main_display({ reload => 1, status => $status });
    }
}
END_OF_SUB


$COMPILE{cmd_del_confirm} = __LINE__ . <<'END_OF_SUB';
sub cmd_del_confirm {
# --------------------------------------------------------
# confirm before delete a directory have sub dir
#
    my $self = shift;

    my $full_path = $self->_safe_dir();
    my ($files, $history);

    if ( $self->{in}->param('c_edit') ) {
        @$files = $self->{in}->param('c_edit');
#Confirm remove all recursive directorys
        if ( $self->{cgi}->{all} ) {
            foreach  ( @$files ) {
                my $file = $self->_safe_file($_,{fullfile => 1});
                return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$_)}) if ($file == -1); # not safe
                my $full_name = $file->{file};
                deldir($full_name);
                $history .= "$full_name:";
            }
            if ($history and $self->{cfg}->{multi}) {
                chop $history;
                $self->history("cmd_delete|$history"); #save log info
            }
            $self->{cgi}->{cmd_do} = "cmd_command";
            return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_DEL_ALL}});
        }

#Remove current recursive directory
        elsif ($self->{cgi}->{over}) {
            my $file_cur = pop(@$files);
            my $file = $self->_safe_file($file_cur,{ fullfile => 1 });
            return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $file_cur) }) if ($file == -1); # not safe

            my $full_name = $file->{file};
            deldir($full_name);
            $history .= "$full_name:";

            my $list_files;
            foreach  (@$files) {
                push @$list_files, { name => $_ };
            }
            if ($#$files >= 0) {
                $self->{cgi}->{cmd_do} = "cmd_del_confirm";
                my $status = sprintf($LANGUAGE{MSG_DEL_CURR}, $self->{cgi}->{file_cur});
                return $self->page('confirm_delete.html',{ reload => 1, list_files => $list_files, file_cur => @$files[0] }, status => $status);
            }
        }
#Skip remmoving current dir
        elsif ($self->{cgi}->{skip}) {
            pop(@$files);
            my $list_files;
            foreach (@$files) {
                push @$list_files, { name => $_ };
            }
            if ($#$files >= 0) {
                $self->{cgi}->{cmd_do} = "cmd_del_confirm";
                my $status = sprintf($LANGUAGE{MSG_DEL_SKIP}, $self->{cgi}->{file_cur});
                return $self->page('confirm_delete.html',{ reload => 1, list_files => $list_files, file_cur => @$files[0]}, status => $status);
            }
        }

#Cancel delete recursive
        elsif ($self->{cgi}->{cancel}) {
            $self->{cgi}->{cmd_do} = "cmd_command";
            return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_DEL_CANC} });
        }
    }
    if ($history and $self->{cfg}->{multi}) {
        chop $history;
        $self->history("cmd_delete|$history"); #save log info
    }
    $self->{cgi}->{cmd_do} = "cmd_command";
    return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_DEL_ALL_SUCC} });
}
END_OF_SUB

$COMPILE{cmd_print} = __LINE__ . <<'END_OF_SUB';
sub cmd_print {
# --------------------------------------------------------
# Print selected file(s)
#
    my $self = shift;

    my @input  = $self->{in}->param('c_edit');
    my $all    = $self->{cgi}->{print_all};

# Check the selected files
    my @files;
    foreach my $n ( @input ) {
        my $f = $self->_safe_file($n, { text => 1, fullfile => 1, size => 1, isfile => 1});
        next if ( $f == -1 );
        next if ( !$f->{isfile} );

        my ($ext) = $n =~ /\.([^.]+)$/;
        my $img   = ($ext =~ /^jpg|JPG|gif|GIF|bmp|BMP|mpga|MPGA/) ? 1 : 0;
        $all      = 0 if ($img);

        if ($f->{text} or $img) {
            push @files, { name => $n, fullfile => $f->{file}, image => $img };
        }
    }
    return $self->_js_alert($LANGUAGE{ERR_PRINT}) if ($#files < 0);

    my $output = qq!<html><header><script>
        function cmd_print() {
            window.print();
        }
        </script></header>
        <body onload="cmd_print()">
    !;

    if ($all) { # Print multiple files
        my $flag = '';
        foreach my $f (@files) {
            open (FILE, "< $f->{fullfile}") or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $f->{fullfile}, "$!");
            read (FILE, my $data, -s FILE);
            close FILE;

            my $style;
            $flag and $style = "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 ( $#files >= 0 ) {
            $next_url = $self->{in}->url (absolute => 1, query_string => 0)."?fdo=cmd_print&&work_path=$self->{work_path}&";
            $next_url .= ";$self->{url_opts};" if ($self->{url_opts});
            foreach ( @files ) {
                $next_url .= "c_edit=$_->{name}&";
            }
        }
        if ($file->{image}) {
            $self->page('image_print.html', {
                filename  => $file->{name},
                work_path => $self->{work_path},
                next_url  => $next_url
            });
        }
        else {
            open (FILE, "< $file->{fullfile}") or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $file->{fullfile}, "$!");
            read (FILE, my $data, -s FILE);
            close FILE;
            $output .= qq|<hr size=1><pre>$data</pre><br />|;
            $output = sprintf($LANGUAGE{PRINT_NEXT}, $next_url) .$output if ( $next_url );
        }
    }
    $output .= qq!</body></html>!;

    print $self->{in}->header;
    print $output;
}
END_OF_SUB

sub _js_alert {
#---------------------------------------------------------
#
    my ($self, $msg) = @_;
    print $self->{in}->header;
    print qq!
    <html><header>
        <script>
            alert("$msg");
            window.close();
        </script>
        </header>
    </html>
    !;
}

$COMPILE{cmd_chmod} = __LINE__ . <<'END_OF_SUB';
sub cmd_chmod {
# --------------------------------------------------------
# Changes the permission attributes of a file

    my $self = shift;

    my $newperm   = $self->{cgi}->{txt_input};
    my $count     = 0;
    my $full_path = $self->_safe_dir();
    my $files     = $self->{cgi}->{c_edit};
    my $history   = "cmd_chmod|";
    my $octal_perm= oct($newperm);

#if only one file
    (ref $files eq 'ARRAY') or $files = [$files];
    foreach  (@$files) {
        my $from = $self->_safe_file($_, { fullfile => 1 });
        next if ($from == -1); # not safe

        if ($self->{cgi}->{opt_gz} and -d $from->{file}) {
            find($from->{file}, sub {
                chmod($octal_perm, shift);
            });
            $count++;
        }
        else {
            $history .= "$from->{file}:";
            chmod($octal_perm, $from->{file}) and $count++;
        }
    }
    chop $history;

    $self->history($history) if ($self->{cfg}->{multi});#save log info

    my $status = ( $count ) ? sprintf($LANGUAGE{MSG_CHMOD_CHANGED}, $count) : $LANGUAGE{ERR_CHMOD};
    $self->cmd_main_display({ reload => 1, status => $status });
}
END_OF_SUB


$COMPILE{cmd_tail} = __LINE__ . <<'END_OF_SUB';
sub cmd_tail {
#-----------------------------------------------------
#   tail command
#
    my $self = shift;

    my $filename  = $self->{cgi}->{c_edit};
    my $url_opts  = $self->{url_opts}  || '';
    my $work_path = $self->{work_path} || '';
    my $file      = $self->_safe_file($filename,{fullfile => 1, exist => 1, isfile => 1, size => 1});
    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID},$filename)}) if ($file == -1); #not safe

    my $fullfile  = $file->{file};
    my $retime    = $self->{cgi}->{retime};
    my $contents  = '';
    my $lines     = $self->{cgi}->{txt_input} || 10;

    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS}, $filename) }) if (!$file->{exist});
    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_ISFILE}, $filename) })      if (!$file->{isfile});

    my $follow;
    @ARGV = grep { if ($_ eq "-f") { $follow++; 0 } else { 1 } } @ARGV;

    open FILE, "<$fullfile" or return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_OPEN},$filename)});
    my $file_size = $file->{size};
    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_EMPTY}, $filename)}) unless $file_size;

    print $self->{in}->header;
    if ($retime) {
        print qq!
<META HTTP-EQUIV=Refresh CONTENT="$retime; URL=$self->{http_ref}?txt_input=$lines&retime=$retime&cmd_do=cmd_tail&c_edit=$filename&work_path=$work_path&$url_opts">
!;
    }

    my $css_file = $self->{in}->cookie('scheme') || 'fileman';
    print qq!
        <link rel='stylesheet' href=$self->{cfg}->{html_root_url}/$css_file.css>
        <body class="bg_main" leftmargin=5 topmargin=4 onload="">
        <a href="$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&$url_opts"><img src='$self->{cfg}->{html_root_url}/icons/back.gif' border=0></a>
        <form name=frm_main action='$self->{http_ref}' method=post>
        <input type=hidden name='work_path' value='$work_path'>
        <input type=hidden name='root_selected' value="$self->{cgi}->{root_selected}">
        <input type=hidden name='cmd_do' value='cmd_tail'>
        <input type=hidden name='txt_input' value=''>
        <input type=hidden name=scope value=''>
        <input type=hidden name=c_regex value=''>
        <input type=hidden name=c_content value=''>
        <input type=hidden name=c_word value=''>
        <input type=hidden name='c_edit' value='$filename'>
        <input type=hidden name=page value=''>
        <input type=hidden name="type" value='1'>
        <input type=hidden name="retime" value="">
        <input type=hidden name=do value='fileman'>
        <input type=hidden name=session_id value='$self->{cgi}->{session_id}'>
        </form><pre>
!;
    my $read_size = 4096;
    my $to_read   = ($file_size > $read_size) ? $read_size : $file_size;
    my $buffer;
    seek FILE, -$to_read, 2;
    read FILE, $buffer, $to_read;
    my $read       = $to_read;
    my $need_lines = $lines - 1;
    while () {
        if ($buffer =~ /\n(.*(?:\n.*){$need_lines}\n?$)/) {
            print $self->{in}->html_escape($1);
            last;
        }
        $to_read = ($file_size - $read > $read_size) ? $read_size : $file_size - $read;
        unless ($to_read == 0) {
            print $self->{in}->html_escape($buffer);
            last;
        }
        seek FILE, -($to_read + $read), 2;
        $read += $to_read;
        my $new_buffer;
        my $bytes_read = read FILE, $new_buffer, $to_read;
        if ($bytes_read == 0) {
            print $self->{in}->html_escape($buffer);
            last;
        }
        $buffer = $new_buffer . $buffer;
    }

    my $cnt = 0;
    if ($follow) {
        seek FILE, 0, 2; # Seek to the end of the file
        while () {
            select undef, undef, undef, 1;
            seek FILE, 0, 1 or last; # Reset eof(FILE)
            print while <FILE>;
            seek FILE, 0, 2;
            last if ($cnt++ > 60); # Only run for one min max.
        }
    }
    print "</pre>";
}
END_OF_SUB


$COMPILE{cmd_perl} = __LINE__ . <<'END_OF_SUB';
sub cmd_perl {
#----------------------------------------------------------------
# check perl syntax
#
    my $self = shift;
    $ENV{'PATH'}    = '/bin:/usr/bin:/usr/local/bin'; #for taint mode

    my $url_opts    = $self->{url_opts}  || '';
    my $work_path   = $self->{work_path} || '';
    print $self->{in}->header;
    my $css_file    = $self->{in}->cookie('scheme') || 'fileman';
    print qq!
    <link rel='stylesheet' href=$self->{cfg}->{html_root_url}/$css_file.css>
    <body class="bg_main"  leftmargin=5 topmargin=4 rightmargin=0>
    <a href="$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&$url_opts"><img src="$self->{cfg}->{html_root_url}/icons/back.gif" border=0></a>
    <form name=frm_main><input type=hidden name=work_path value='$work_path'>
    <input type=hidden name='type' value='selected'>
    <input type=hidden name=txt_input value=''>
    <input type=hidden name=scope value=''>
    <input type=hidden name=c_regex value=''>
    <input type=hidden name=c_content value=''>
    <input type=hidden name=c_word value=''>
    <input type=hidden name=cmd_do value='cmd_perl'>
    <input type=hidden name=page value=''>
    <input type=hidden name=do value='fileman'>
    <input type=hidden name=session_id value='$self->{cgi}->{session_id}'>
    <input type=hidden name='root_selected' value="$self->{cgi}->{root_selected}">
    !;
    my $exts = 'cgi pl pm';
    my $files ;
    @$files         = $self->{in}->param('c_edit');
    my $redirector  = ($self->{cfg}->{winnt} ? " 2>&1 1>&2" : " 1>&1 2>&1");
    foreach (@$files) {
        my $file      = $self->_safe_file($_, { fullfile => 1, text => 1});
        my $full_name = $file->{file};
        next if (not $file->{text});
        my ($ext)  = $full_name =~ /\.([^.]+)$/;
        next if ($exts !~ /$ext/i);
        my $tmp = $full_name;
        $tmp =~ s,$self->{cfg}->{root_dir}/,,;
        print "<p>&nbsp;<font size =2 color=green><b><i>$tmp </i></font>";
        my $check_now = $self->{cfg}->{path_to_perl} . ' -cw -I'.$self->{cfg}->{priv_path}.'/lib '.$full_name.' '.$redirector;
        print '<pre>&nbsp;',`$check_now`,'</pre>';
        print "<input type=hidden name='c_edit' value='$_'>";
    }
    print '</form></body>';
}
END_OF_SUB

$COMPILE{cmd_diff} = __LINE__ . <<'END_OF_SUB';
sub cmd_diff {
#----------------------------------------------------
# Show difference between two files
#
    my $self = shift;
    my $filename1 = $self->{cgi}->{c_edit};
    my $filename2 = $self->{cgi}->{txt_input};
    my $file1     = $self->_safe_file($filename1, { fullfile => 1, text => 1, exist => 1 });
    my $file2     = $self->_safe_file($filename2, { fullfile => 1, text => 1, exist => 1 });
    ($file1 == -1) and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID}, $filename1) });
    ($file2 == -1) and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID}, $filename2) });

    my $work_path = $self->{work_path} || '';
    my $fullfile1 = $file1->{file};
    my $fullfile2 = $file2->{file};

    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS}, $filename2) }) if (!$file2->{exist});
    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_TEXT_FILE}  , $filename1) }) if (!$file1->{text});
    return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_TEXT_FILE}  , $filename2) }) if (!$file2->{text});

    require GT::FileMan::Diff;
    my $diff = GT::FileMan::Diff::html_diff($fullfile1, $fullfile2, 3);
    if (!ref $diff) {
        $diff == 1 ? return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile1, "$!") })
                   : return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile1, "$!") });
    }

    my $back_btn = ($self->{cgi}->{hide_back_button}) ? '' : "<a href='$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&$self->{url_opts}'><img src='$self->{cfg}->{html_root_url}/icons/back.gif' border=0></a>";
    print $self->{in}->header;
    my $css_file = $self->{in}->cookie('scheme') || 'fileman';
    print qq!
    <link rel='stylesheet' href=$self->{cfg}->{html_root_url}/$css_file.css>
    <body class="bg_main"  leftmargin=5 topmargin=4 rightmargin=0>
    <form name=frm_main>
    $back_btn
    <input type=hidden name=work_path value='$work_path'>
    <input type=hidden name='type' value='selected'>
    <input type=hidden name=txt_input value=''>
    <input type=hidden name=scope value=''>
    <input type=hidden name=c_regex value=''>
    <input type=hidden name=c_content value=''>
    <input type=hidden name=c_word value=''>
    <input type=hidden name=page value=''>
    <input type=hidden name=cmd_do value='cmd_diff'>
    <input type=hidden name=do value='fileman'>
    <input type=hidden name=session_id value='$self->{cgi}->{session_id}'>
    <input type=hidden name='root_selected' value="$self->{cgi}->{root_selected}">
    $$diff</form></body>
!;

}
END_OF_SUB

$COMPILE{cmd_tar} = __LINE__ . <<'END_OF_SUB';
sub cmd_tar {
#----------------------------------------------------
#   Create tar file
#
    my ($self, $fn, $error) = @_;

    if ($fn) {
        return $self->_zip_information($fn, $error) if ($fn =~ /.zip$/i and $GT::FileMan::HAVE_AZIP);
        return $self->_tar_information($fn, $error) if ($fn =~ /.gz$/i  and $GT::FileMan::HAVE_GZIP);
        return $self->_tar_information($fn, $error) if ($fn =~ /.tar$/i); # .tar file
    }

    my $input     = $self->{cgi}->{txt_input};
    my $zip_type  = $self->{cgi}->{opt_gz};
    my $from_path = $self->_safe_dir();
    my $fulldir   = $self->_safe_dir($input);
    ($fulldir == -1) and return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $input) }); # not safe

    my $fullfile = $fulldir->{fulldir};
    my $path     = [split /\//,$fullfile];
    my $tar_file = @$path[$#$path];
    my $to_path  = $fullfile;
    $to_path     =~ s/\/@$path[$#$path]//; #path to save tar file

    return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_TAR_NOT_EXISTS}, $input)}) if (!-e $to_path); # check exists the directory
    return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_TAR_PEM}, $input)})        if (!-w $to_path); # check permission on this directory

    if ($zip_type == 1) { # create a .tar.gz file        
        $tar_file .= '.gz'     if ($tar_file =~ m/.tar$/i);
        $tar_file .= '.tar.gz' if ($tar_file !~ m/.tar.gz$/i);
    }
    elsif ($zip_type == 2) { # create a .zip file
        $tar_file .= '.zip' if ($tar_file !~ /.zip$/i);
    }
    else { # create a .tar file
        $tar_file .= '.tar' if ($tar_file !~ /.tar$/i);
    }

# Check required modules
    my $err_check = _tar_check($tar_file);
    return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{ERR_NO_GZIP} }) if ($err_check); # check permission on this directory

    $fullfile = "$to_path/$tar_file";
    if (!$self->{cgi}->{confirm}) {
        if (-e $fullfile) {
            my $results;
            my $files = [$self->{in}->param('c_edit')];
            foreach my $file (@$files) {
                push @$results, { name => $file };
            }
            return $self->page('tar_confirm.html', { results => $results, file => $tar_file });
        }
    }
    if ( $zip_type == 2 ) {
        my $error = $self->_zip_process($fullfile, [$self->{in}->param('c_edit')]);
        return $self->cmd_main_display({ reload => 1, status => $error }) if ($error);
    }
    else {
        $self->_tar_process($fullfile);
    }
    $self->{cgi}->{cmd_do} = 'cmd_tar';

    $self->history($fullfile) if ( $self->{cfg}->{multi} ); #save log info
    $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{MSG_TAR_CREATED}, $tar_file) });
}
END_OF_SUB

$COMPILE{cmd_uncompress} = __LINE__ . <<'END_OF_SUB';
sub cmd_uncompress {
#--------------------------------------------------------
# Uncompress .tar or .gz file
#
    my $self = shift;

    my $root_path = $self->{cfg}->{root_dir};
    my $work_path = $self->{work_path};
    my $input     = $self->{cgi}->{txt_input};
    my $fullfile  = $self->_safe_file($self->{cgi}->{cmp_file}, {fullfile => 1, exist => 1});
    my $selected  = [$self->{in}->param('c_edit')];
    my $untar_pg  = $self->{cgi}->{uncomp_option};

    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $self->{cgi}->{cmp_file}) })         if ($fullfile == -1);
    return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS}, $self->{cgi}->{cmp_file}) }) unless ($fullfile->{exist});

# Check required modules
    my $error = _tar_check($fullfile->{file});
    return $self->cmd_main_display({ reload => 1, status => $error }) if ($error);

    my $cmp_file = $fullfile->{file};
    return $self->cmd_tar($self->{cgi}->{cmp_file}, $LANGUAGE{ERR_UNCOMPRESS}) if ($#$selected == -1);

# Check the directory is exists, permission
    my $fulldir = $self->_safe_dir($input, { exist => 1, write => 1 });
    return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_INVALID},        $input || $work_path))           if ($fulldir == -1); # not safe
    return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $input || $work_path || 'Root')) if (ref $fulldir eq 'HASH' and !$fulldir->{exist});
    return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_DIR_PEM}       , $input || $work_path || 'Root')) if (ref $fulldir eq 'HASH' and !$fulldir->{write});

# Get file size    
    my $full_path  = (ref $fulldir eq 'HASH') ? $fulldir->{fulldir} : $fulldir;
    my $total_size = _tar_size($cmp_file);

# Check free space and writeable
    if ($self->{cfg}->{allowed_space} > 0) {
        my $disk_space = $self->_checkspace($full_path);
        my $free_space = $disk_space->{free_space};
        return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_DISK_SPACE}, $free_space)) if ($total_size > $free_space * 1024);
    }

    my $filename = $cmp_file;
    $filename    =~ s/$full_path\///;
    $self->page('progress_bar.html', { bar_name => "Un-tarring:", msg => sprintf($LANGUAGE{MSG_READING}, $filename) });

    my ($last_width, $max_width, $copied) = (-1, 500, 0);
    if ($filename =~ /.zip$/i) {
        my $zip = Archive::Zip->new($cmp_file) or return $self->cmd_tar($self->{cgi}->{cmp_file}, $!);
        foreach ($zip->members) {
            my $name  = $_->fileName;
            my $found = $untar_pg ? 0 : 1;
            if ($untar_pg) {
                foreach my $f (@$selected) {
                    if ($f eq $name) {
                        $found = 1;
                        last;
                    }
                }
            }
            $copied += $_->uncompressedSize;
            if ($found) {
                $zip->extractMember($name, "$full_path/$name");
            }
            my $percent  = 1 - ($total_size - $copied) / $total_size;
            my $img_width= int($max_width * $percent);
            my $wpercent = sprintf '%.f%%', 100 * $percent;
            if ($img_width != $last_width) {
                $self->page('copy_status.html', {
                    msg     => "$name file...".(( $found ) ? 'ok' : 'skip'),
                    pxs     => $img_width,
                    percent => $wpercent
                });
                $last_width = $img_width;
            }
        }
    }
    else { # Make sure tar file goes out of scope before loading directory.
        require GT::Tar;
        my $tar   = GT::Tar->open ($cmp_file);
        my $files = $tar->files;
        foreach (@$files) {
            my $name = $_->{name};
            my $found = $untar_pg ? 0 : 1;
            if ($untar_pg) {
                foreach my $f (@$selected) {
                    if ($f eq $_->{name}) {
                        $found = 1;
                        last;
                    }
                }
            }

            $copied += $_->{size};
            if ($found) {
                $_->{name} = "$full_path/$name";
                $_->write();
            }

            my $percent  = 1 - ($total_size - $copied) / $total_size;
            my $img_width= int($max_width * $percent);
            my $wpercent = sprintf '%.f%%', 100 * $percent;
            if ($img_width != $last_width) {
                $self->page('copy_status.html', {
                    msg     => "$name file...".(( $found ) ? 'ok' : 'skip'),
                    pxs     => $img_width,
                    percent => $wpercent
                });
                $last_width = $img_width;
            }
        }
    }
    $self->history("cmd_untar|$filename|$full_path") if ($self->{cfg}->{multi}); #save log info
    $self->{cgi}->{cmd_do} = 'cmd_tar';
    $filename =~ s,$root_path/,,;
    $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{MSG_UNCOMPRESS}, $filename)});
}
END_OF_SUB

$COMPILE{cmd_show_passwd} = __LINE__ . <<'END_OF_SUB';
sub cmd_show_passwd {
    my ($self, $msg) = @_;
    $self->cmd_main_display({ msg => $msg, show_passwd => 1 });
}
END_OF_SUB

$COMPILE{cmd_passwd} = __LINE__ . <<'END_OF_SUB';
sub cmd_passwd {
# ------------------------------------------------------------------
# Save username and password
#
    my $self = shift;

    my $pass_path = $self->{in}->cookie('def_passwd_dir');
    my $work_path = $self->{work_path} || '';
    my $url_opts  = $self->{url_opts}  || '';

    my $htpasswd;
    if ($pass_path) { # create .htaccess and .htpasswd in Password directory
        my $file_name  = $self->_safe_dir();
        $file_name =~ s/[\/ \:]/\_/g;
        $htpasswd = "$pass_path/.htpass$file_name";
        if (!-e $htpasswd) {
            open (FILE, "> $htpasswd");
            close FILE;
        }
    }
    else {
        my $fpasswd  = $self->_safe_file(".htpasswd", { fullfile => 1, exist => 1, size => 1});
        $htpasswd = $fpasswd->{file};
        if (!$fpasswd->{exist}) {
            open (FILE, "> $htpasswd");
            close FILE;
        }
    }
    my $faccess  = $self->_safe_file(".htaccess", { fullfile => 1, exist => 1, size => 1});
    my $htaccess = $faccess->{file};
    if (!$faccess->{exist}) {
        open (FILE, "> $htaccess");
        close FILE;
    }

    unless (-w $htaccess and -w $htpasswd) { #check writeable
        print $self->{in}->header;
        print  sprintf($LANGUAGE{ERR_FILE_PERM},$htaccess,$htpasswd),'<BR>', sprintf($LANGUAGE{MSG_CONTINUE},$self->{http_ref},$work_path,$url_opts);
        return;
    }

    if ( !$faccess->{exist} or $faccess->{size} == 0 ) {
        _create_htaccess($htaccess, $htpasswd);
    }
    else {
        open (HTACC, "< $htaccess") or die "Unable to open: $htpasswd ($!)";
        my @info = <HTACC>;
        close HTACC;
        my $found;
        LINE: foreach ( @info ) {
            if ( $_ =~ /$htpasswd/ ) {
                $found = 1;
                last;<%delete_list%>
            }
        }
        _create_htaccess($htaccess, $htpasswd) if ( !$found );
    }

    if ($self->{cgi}->{remove_all}) {
        if (! unlink($htpasswd)) {
            open (HTPAS, "> $htpasswd") or die "Unable to open: $htpasswd ($!)";
            close HTPAS;
        }
        if (!unlink($htaccess)) {; # delete file
            open (HTACC, "> $htaccess") or die "Unable to open: $htaccess ($!)";
            close HTACC;
        }

        return $self->cmd_show_passwd($LANGUAGE{MSG_USER_RMALL});
    }
    my (@users,$msg);
    my $username  = $self->{cgi}->{p_username} || '';
    my $password  = $self->{cgi}->{p_password} || '';
    my $to_delete = ($self->{cgi}->{remove})? $self->{cgi}->{delete_user} : $username;

    if ($to_delete) {
        open (HTPAS, "< $htpasswd") or die "Unable to open: $htpasswd ($!)";
        @users = grep { $_ !~ /^$to_delete:/ } <HTPAS>;
        close HTPAS;
        $msg = sprintf($LANGUAGE{MSG_USER_DELETED}, $to_delete);
    }

    if ($username and $password) {
        my @salt_chars = ('A' .. 'Z', 0 .. 9, 'a' .. 'z', '.', '/');
        my $salt = join '', @salt_chars[rand 64, rand 64];
        my $encrypted = crypt($password, $salt);
        push @users, "$username:$encrypted\n";
        $msg = sprintf($LANGUAGE{MSG_USER_ADDED}, $username);
    }
    if (($username and $password) or $to_delete) {
        open (HTPAS, "> $htpasswd") or die "Unable to open: $htpasswd ($!)";
        print HTPAS join ("", @users);
        close HTPAS;
        if (!@users) {
            if (! unlink($htpasswd)) {
            open (HTPAS, "> $htpasswd") or die "Unable to open: $htpasswd ($!)";
            close HTPAS;
            }
            if (!unlink($htaccess)) {; # delete file
                open (HTACC, "> $htaccess") or die "Unable to open: $htaccess ($!)";
                close HTACC;
            }
        }
    }
    $self->cmd_show_passwd($msg);
}
END_OF_SUB

$COMPILE{printenv} = __LINE__ . <<'END_OF_SUB';
sub printenv {
# ------------------------------------------------------------------
    my $self = shift;
    ($self->{cfg}->{multi}) and die "<font color=red>It doesn't support for this version</font>";

    my $work_path   = $self->{work_path} || '';
    print $self->{in}->header ;
    print qq!
            <form name=frm_main>
            <input type=hidden name=work_path value='$work_path'>
            <input type=hidden name=txt_input value=''>
            <input type=hidden name=scope value=''>
            <input type=hidden name=c_regex value=''>
            <input type=hidden name=c_case value=''>
            <input type=hidden name=page value=''>
            <input type=hidden name=c_content value=''>
            <input type=hidden name=do value='fileman'>
            <input type=hidden name=cmd_do value=''>
            <a href="javascript:history.go(-1)" ><img src="$self->{cfg}->{html_root_url}/icons/back.gif" border=0></a>
            </form><p>
!;
    print $self->_environment();
}
END_OF_SUB

sub history {
#---------------------------------------------------------------------
# Save the history
#
    my ($self,$content) = @_;
    return if (!$content);

    my $priv_path = $self->{cfg}->{priv_path};
    my $db_name   = 'fileman_history.db';

    $content = $self->{cfg}->{username} . '|' . $ENV{'REMOTE_ADDR'} . '|' . time . "|$content\n";
    open (DATA,">>$priv_path/$db_name") or die sprintf($LANGUAGE{ERR_OPEN_FILE}, $db_name, $!);
        flock(DATA, 2);
        print DATA $content;
    close DATA;
}

sub _environment {
# --------------------------------------------------------------------
# Return HTML formatted environment for error messages.
#
    my $self = shift;
    my $info = '<PRE>';

# Print GT::SQL error if it exists.
    $info .= "<B>System Information</B>\n======================================\n";
    $info .= "Perl Version: $]\n";
    $info .= "FileMan Version: $self->{cfg}->{version}" if ($self->{cfg}->{version});
    $info .= "\n";
    my $cmds = $self->{commands};
    foreach  (keys %$cmds) {
        $info .= $_."\t:";
        $info .= ($cmds->{$_})?('enabled'):('disabled');
        $info .= "\n";
    }
    $info .= "Persistant Env: mod_perl (" . (MOD_PERL ? 1 : 0) . ") SpeedyCGI (" . (SPEEDY ? 1 : 0) . ")\n";
    $info .= "Mod Perl Version: " . MOD_PERL . "\n" if MOD_PERL;
    $info .= "\@INC = \n\t" . join ("\n\t", @INC) . "\n";
    $info .= "\$\@: $@\n" if ($@);
    $info .= "\n";

# CGI Parameters and Cookies.
    if (ref $self->{in} eq 'GT::CGI') {
        if ($self->{in}->param) {
            $info .= "<B>CGI INPUT</B>\n======================================\n";
            foreach (sort $self->{in}->param) { $info .= "$_ => " . $self->{in}->param($_) . "\n"; }
            $info .= "\n\n";
        }
        if ($self->{in}->cookie) {
            $info .= "<B>CGI Cookies</B>\n======================================\n";
            foreach (sort $self->{in}->cookie) { $info .= "$_ => " . $self->{in}->cookie($_) . "\n"; }
            $info .= "\n\n";
        }
    }

# Environement info.
    $info  .= "<B>ENVIRONMENT</B>\n======================================\n";
    foreach (sort keys %ENV) { $info .= "$_ => $ENV{$_}\n"; }
    $info .= "</PRE>";
    return $info;
}

sub _zip_information {
#----------------------------------------------------------------------
# Show the information about a zip file
#
    my ($self, $filename, $status) = @_;

    my $fullfile = $self->_safe_file($filename, { fullfile => 1, exist => 1, size => 1 });
    my $zip = new Archive::Zip($fullfile->{file}) or return $self->cmd_main_display({reload => 0, status => $!});

    my $cmp_file = $fullfile->{file};
    my $stat     = [stat($cmp_file)];

    my $hits = $zip->members + 1;
    my $pg   = $self->{cgi}->{pg} || 1;
    my $mh   = $self->{in}->cookie('def_files_page')  || 25;
    my $start= ($pg == 1) ? 1 : (($pg - 1) * $mh + 1);

    my @results;
    my $total_size = $fullfile->{size};
    my $skip       = 0;
    if ( $hits > 0 ) {
        foreach ( $zip->members ) {
            $skip++;
            next if ($skip < $start);
            my $s    = $_->compressedSize;
            my $icon = _get_icon($_->fileName);
            push @results, {
                icon   => "<img border=0 src='$self->{cfg}->{html_root_url}/icons/".(( $_->isDirectory ) ? 'folder.gif' : $icon->{icon} )."' width=14 height=16>",
                name   => $_->fileName,
                size   => ( $s ) ? _print_filesize($s) : '',
                date   => _get_date($_->lastModTime),
                chmod  => _print_permissions($_->unixFileAttributes),
                uid    => '',
                type   => '',
                nsize  => ( $s ) ? _print_filesize($s) : ''
            };
            last if ( $#results + 1 >= $mh );
        }
    }

# Creates the speed bar
    my $speed_bar;
    if ( $hits > ($self->{in}->cookie('def_files_page') || 25) ) {
        $speed_bar = $self->speed_bar($hits, "$self->{http_ref}?cmd_do=cmd_edit&work_path=$self->{work_path}&c_edit=$filename;$self->{url_opts}", 1);
    }
    if (!$status) {
        $status = sprintf($LANGUAGE{MSG_FILE_EDITING},'The content of ', $filename, -s $cmp_file, $filename);
    }
    $self->page('tar_information.html', {
        results     => \@results,
        count       => $#results + 1,
        cmp_file    => $filename,
        user        => eval { getpwuid(@$stat[4]); } || '',
        total_size  => $total_size,
        total_space => $total_size,
        num_objects => ($#results >= 0 ) ? $#results + 1 : 0,
        status      => $status,
        speed_bar   => $speed_bar
    });
}

sub _tar_information {
#----------------------------------------------------------------------
#   Show information about a tar file
#
    my ($self, $filename, $status) = @_;

    my $fullfile = $self->_safe_file($filename, {fullfile => 1, exist => 1, size => 1});
    return $self->cmd_main_display({reload => 0, status => sprintf($LANGUAGE{ERR_INVALID}, $filename)})         if ($fullfile == -1);
    return $self->cmd_main_display({reload => 0, status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS}, $filename)}) if (!$fullfile->{exist});

    my $cmp_file = $fullfile->{file};
    my $stat     = [stat($cmp_file)];
    if ($cmp_file =~ m,([^/]*[\.tar\.gz]$),) {
        my ($files, @results);

        my $pg   = $self->{cgi}->{pg} || 1;
        my $mh   = $self->{in}->cookie('def_files_page')  || 25;
        my $start= ($pg == 1) ? 1 : (($pg - 1) * $mh + 1);

        require GT::Tar;
        my $tar = GT::Tar->open ($cmp_file) or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN},$!)});
        $files   = $tar->files;
        my $total_size = 0;
        my $skip       = 0;
        foreach my $file (@$files) { # get uncompressedsize
            $total_size += $file->{size} if ( $file->{size} );
        }
        foreach my $file (@$files) {
            $skip++;
            next if ($skip < $start);
            my $spec     = _get_icon($file->{name});
            push @results, {
                icon   => "<img border=0 src='$self->{cfg}->{html_root_url}/icons/$spec->{icon}' width=14 height=16>",
                name   => $file->{name},
                size   => ($file->{type} eq '5')? '': _print_filesize($file->{size}),
                date   => _get_date($file->{mtime}),
                chmod  => _print_permissions($file->{mode}),
                uid    => eval { getpwuid($file->{uid}); } || '',
                type   => $file->{type},
                nsize  => ($file->{type} eq '5')? '': $file->{size}
            };
            last if ( $#results + 1 >= $mh );
        }
        my $root_path = $self->{cfg}->{root_dir};
        my $url_opts  = $self->{url_opts}  || '';
        my $work_path = $self->{work_path} || '';
        my $full_path = $root_path.(($work_path)?'/':'').$work_path;

# Creates the speed bar
        my $speed_bar;
        if ( $#$files + 1 > ($self->{in}->cookie('def_files_page') || 25) ) {
            $speed_bar = $self->speed_bar($#$files, "$self->{http_ref}?cmd_do=cmd_edit&work_path=$self->{work_path}&c_edit=$filename;$self->{url_opts}", 1);
        }

        if (!$status) {
            $status = sprintf($LANGUAGE{MSG_FILE_EDITING},'The content of ', $filename,-s $cmp_file, $filename);
        }
        $self->page('tar_information.html', {
            results     => \@results,
            count       => $#$files+1,
            cmp_file    => $filename,
            user        => eval { getpwuid(@$stat[4]); } || '',
            total_size  => $total_size,
            total_space => $total_size,
            num_objects => ($#results >=0)? $#results + 1:0,
            status      => $status,
            speed_bar   => $speed_bar
        });
    }
}

sub _tar_check {
    my $file = shift;
    if ($file =~ /.zip$/i) {
        return $LANGUAGE{ERR_NO_AZIP} unless $GT::FileMan::HAVE_AZIP;
    }
    elsif ($file =~ /.gz$/i) {
        return $LANGUAGE{ERR_NO_GZIP} unless $GT::FileMan::HAVE_GZIP;
    }
    return;
}

sub _tar_size {
    my $file = shift;

    my $size = 0;
    if ($file =~ /.zip$/i) {
        my $zip = Archive::Zip->new($file) or return;
        foreach ( $zip->members ) {
            $size += $_->uncompressedSize;
        }
    }
    else {
        require GT::Tar;
        my $tar   = GT::Tar->open($file);
        my $files = $tar->files;
        foreach (@$files) {
            $size += $_->{size};
        }
    }
    return $size;
}

sub _checkspace {
# -----------------------------------------------------
# Check for allowed disk space to determine whether we can allow
# editing or uploads.
#
    my $self = shift;
    my $directory = shift || $self->{cfg}->{root_dir};

    return if (!$self->{cfg}->{allowed_space});
    my ($used_space, $free_space, $allowed_space, $usage) = (0, 0, 0);
    find($directory, sub {$used_space += -s shift});

# Size in kb
    $allowed_space = $self->{cfg}->{allowed_space}/1024;
    $used_space /= 1024;
    $free_space = $allowed_space - $used_space;
    $usage = $used_space / $allowed_space * 100 if ($allowed_space > 0);
    return {
        free_space    => int($free_space),
        allowed_space => int($allowed_space),
        used_space    => int($used_space),
        usage         => int($usage)
    };
}

sub _file_info {
#------------------------------------------------------------------
# Show file information
#
    my ($self,$fullfile) = @_;
    my $hash;

    my $url_opts    = $self->{url_opts}  || '';
    my $url         = "$self->{http_ref}?fdo=cmd_main_display&$url_opts";
    my $html_url    = $self->{cfg}->{html_root_url};
    my $name        = $fullfile;
    my $work_path   = $self->{work_path} || '';
    my $full_path   = $self->{cfg}->{root_dir}.'/'.$work_path.(($work_path)?'/':'');
    my $stat        = [stat($fullfile)];
    $name           =~ s/$full_path//;
    $hash->{value}  = $fullfile;

    if (-d _) {
       $hash->{name} = $name;
       $hash->{icon} = "<img border=0 src='".$html_url."/icons/folder.gif'>";
       $hash->{type} = 'Folder';
       $hash->{isdir}= '1';
       $hash->{size} = 0;
    }
    else {
       my $spec       = _get_icon($fullfile);
       $hash->{name}  = $name;
       $hash->{icon}  = "<img border=0 src='".$html_url.'/icons/'.$spec->{icon}."' width=14 height=16>";
       $hash->{type}  = $spec->{type};
       $hash->{isdir} = '0';
       $hash->{size}  = @$stat[7];
       $hash->{nsize} = @$stat[7];
    }
    $hash->{date} = @$stat[9];
    $hash->{perm} = @$stat[2];
    my $user      = eval { getpwuid(@$stat[4]); } || '';
    $hash->{user} = $user;
    return $hash;
}

sub speed_bar {
# ------------------------------------------------------------------
# Create a speed bar
#
    my($self, $rows, $url, $off) = @_;
    return if ($self->{cgi}->{pg} eq 'all'); # display all

    my $work_path = $self->{work_path} || '';
    my $sb        = $self->{cgi}->{sb} || '';
    my $sd        = $self->{cgi}->{sd} || '';
    my $url_opts  = $self->{url_opts}  || '';
    $url        ||= "$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&sb=$sb&sd=$sd&$url_opts";
    my $cur_pg    = $self->{cgi}->{pg} || '1';
    my $pg        = ($cur_pg eq 'all')? 1 : $cur_pg;
    my $rows_pg   = $self->{in}->cookie('def_files_page') || 25;
    my $scre_pg   = $self->{in}->cookie('def_pages_screen') || 10;
    my $pages     = int($rows / $rows_pg) + (($rows % $rows_pg > 0) ? 1 : 0);
    my $next      = "<img src='$self->{cfg}->{html_root_url}/icons/next.gif' border='0' align='middle'>";
    my $next_grey = "<img src='$self->{cfg}->{html_root_url}/icons/next_grey.gif' border='0' align='middle'>";
    my $prev      = "<img src='$self->{cfg}->{html_root_url}/icons/prev.gif' border='0' align='middle'>";
    my $prev_grey = "<img src='$self->{cfg}->{html_root_url}/icons/prev_grey.gif' border='0' align='middle'>";
    my $first     = "<img src='$self->{cfg}->{html_root_url}/icons/first.gif' border='0' align='middle'>";
    my $first_grey= "<img src='$self->{cfg}->{html_root_url}/icons/first_grey.gif' border='0' align='middle'>";
    my $last      = "<img src='$self->{cfg}->{html_root_url}/icons/last.gif' border='0' align='middle'>";
    my $last_grey = "<img src='$self->{cfg}->{html_root_url}/icons/last_grey.gif' border='0' align='middle'>";

    my ($speed_bar, $pg_step, $start, $jj);
    if ( $scre_pg > 0 ) {
        $pg_step = ($pg % $scre_pg > 0) ? int($pg / $scre_pg) + 1 : ($pg / $scre_pg);
    }
    $start   = 1;

    if ($pages > $scre_pg) {
        $start = ($pg == $pages) ? ($pg - $scre_pg) + 1 : (($pg_step - 1) * $scre_pg)+1;
        $start = ($pages - $start + 1 < $scre_pg) ? $start - ($scre_pg - ($pages - $start + 1)) : $start;
    }

    $speed_bar  = ($pg > 1) ? "<a href='$url&pg=1'>$first</a>&nbsp;<a href='$url&pg=".($pg - 1)."'>$prev</a>&nbsp;" : "$first_grey&nbsp;$prev_grey&nbsp;";
    $speed_bar .= ($pg > $scre_pg)? '...' : '';

    for my $ii ( $start .. $pages) {
        $jj++;
        if ($cur_pg eq 'all') {
            $speed_bar .= "<a href='$url&pg=$ii'>$ii</a>&nbsp;"
        }
        else {
            $speed_bar .= ($cur_pg == $ii)? "<b>$ii</b>&nbsp" : "<a href='$url&pg=$ii'>$ii</a>&nbsp;";
        }
        if ($jj == $scre_pg) {
            $speed_bar .= ( ($pg_step * $scre_pg) < $pages) ? "..." : "";
            last;
        }
    }
    $speed_bar .= ($pg < $pages) ? "<a href='$url&pg=".($pg+1)."'>$next</a>&nbsp;<a href='$url&pg=$pages'>$last</a>" : "$next_grey&nbsp;$last_grey";
    $speed_bar .=  ($cur_pg eq 'all') ? "&nbsp;<b>All</b>&nbsp" : "&nbsp;<a href='$url&pg=all'>All</a>&nbsp;"  if ( !$off );
    return $speed_bar;
}

sub qsort {
# ------------------------------------------------------------------
    my ($self,$list_file,$orderby,$sortdown)  = @_;
    my $sorted;
    @$sorted =
               sort {
                    my $da = lc $a->{$orderby};         #lower case
                    my $db = lc $b->{$orderby};
                    my $res;
                    if ($orderby eq 'size' or $orderby eq 'date') {
                        $res = $db <=> $da;
                    }
                    else {
                        $res = $db cmp $da;
                    }
                    if ($res == 0 and $orderby ne 'name') {
                        lc $b->{name} cmp lc $a->{name};
                    }
                    else {
                        $res;
                    }
               } @$list_file;
    ($sortdown) and @$sorted = reverse @$sorted;
    return $sorted;
}

sub _zip_process {
#--------------------------------------------------------------
# Create a .zip file
#
    my ($self, $to, $files) = @_;
    my $from = $self->_safe_dir();

    if ($self->{cgi}->{cancel}) { #canceled create tar file
        $self->{cgi}->{cmd_do} = 'cmd_tar';
        return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_TAR_CANCEL}});
    }
    my $history = 'cmd_tar|';

    require Archive::Zip::Tree;
    my $zip = Archive::Zip->new();
    my $member;
    foreach my $file (@$files) {
        if ( -f "$from/$file" ) {
             $member = $zip->addFile("$from/$file", $file) or warn "$!";
        }
        elsif ( -d "$from/$file" ) {
            $member = $zip->addTree("$from/$file", $file) or warn "$!";
        }
    }
    return $zip->writeToFileNamed($to) ? "$!" : 0;
}

sub _tar_process {
#--------------------------------------------------------------
#   Create tar file
#
    my ($self, $to) = @_;
    my $from = $self->_safe_dir();

    if ($self->{cgi}->{cancel}) { #canceled create tar file
        $self->{cgi}->{cmd_do} = 'cmd_tar';
        return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_TAR_CANCEL}});
    }

    my $input   = $self->{cgi}->{txt_input};
    my $files   = [$self->{in}->param('c_edit')];
    my $history = 'cmd_tar|';
# Make sure tar file goes out of scope and cleans up temp files
    {
        my $tar;
        require GT::Tar;
        $tar = new GT::Tar($to) or return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_TAR},$GT::Tar::error)});
        foreach my $file (@$files) {
            my $fulldir = $self->_safe_dir($file);
            next if ($fulldir == 1);
            $tar->add_file($fulldir->{fulldir});
        }

        my $items = $tar->files;
        foreach my $fl (@$items) {
            $fl->{name} =~ s/$from\///;
        }
        $tar->write("$to");
        $history .= "|$to";
    }
}

sub _safe_file {
#------------------------------------------------------------------------
# Check a file make sure it safe
#
    my ($self, $file, $options) = @_;

    my $root = $self->{cfg}->{root_dir};
    return { file => $root } if ($file eq '/');

    return -1 if ($self->{cfg}->{filename_check} and $file !~ m,^([-\w/. ]+)$,);
    return -1 if ($file =~ /$GT::FileMan::UNSAFE_PATH/);

# Check if proper work_path (/ stands for root dir, otherwise use current dir)
    my $path_to_file = ($file =~ m,^/,) ? $file : "$self->{work_path}/$file";
    $path_to_file =~ s,^/,,;

    my $fullfile = $root.'/'.$path_to_file;
    my ($e, $w, $t, $s, $f);
    foreach my $key (keys % $options) {
        if ($options->{$key} == 1) {
            ($key eq 'exist')  and $e = -e $fullfile;
            ($key eq 'write')  and $w = -w $fullfile;
            ($key eq 'text')   and $t = -T $fullfile;
            ($key eq 'size')   and $s = -s $fullfile;
            ($key eq 'isfile') and $f = -f $fullfile;
        }
    }
    return {
        file   => ($options->{fullfile} == 1) ? $fullfile : $file,
        exist  => $e,
        write  => $w,
        text   => $t,
        size   => $s,
        isfile => $f,
    };
}

sub _view_file {
#------------------------------------------------------
# print the content of a file
#
    my ($self,$filename) = @_;
    my $file = $self->_safe_file($filename,{ fullfile => 1, size => 1});
    ($file == -1) and return; # not safe

# Load content-type of a image file.
    my $fullfile     = $file->{file};
    my $file_size    = $file->{size};
    my $content_type = _load_mime($fullfile);
    my ($ext)        = $fullfile =~ /\.([^.]+)$/;

    if(open(DATA, $fullfile)) {
        $self->{in}->reset_env();
        if ((($content_type =~ m/text/) or -T $fullfile) and (uc($ext) ne 'PDF')) {
            my $url_opts  = $self->{url_opts}  || '';
            my $work_path = $self->{work_path} || '';
            print $self->{in}->header;
            print qq!
                <form name=frm_main>
                <a href="$self->{http_ref}?fdo=cmd_main_display&work_path=$work_path&$url_opts"><img src="$self->{cfg}->{html_root_url}/icons/back.gif" border=0></a>
                <input type=hidden name=work_path value='$work_path'>
                <input type=hidden name=txt_input value=''>
                <input type=hidden name=scope value=''>
                <input type=hidden name=c_regex value=''>
                <input type=hidden name=c_case value=''>
                <input type=hidden name=page value=''>
                <input type=hidden name=c_content value=''>
                <input type=hidden name=do value='fileman'>
                <input type=hidden name=cmd_do value='cmd_command'>
                <input type=hidden name="session_id" value="$self->{cgi}->{session_id}">
                <input type=hidden name='root_selected' value="$self->{cgi}->{root_selected}">
                <input type=hidden name="main_screen">
                <input type=hidden name="view_file" value="1">
                <input type=hidden name="c_edit" value="$filename">

               </form>
               <ul>
            !;
             print '<pre>' if (not $content_type =~ m/htm/);
        }
        else {
            print $self->{in}->header({
                '-force'          => 1,
                '-type'           => $content_type,
                '-Content-Disposition' => \"filename=$filename",
                '-Content-Length' => $file_size,
            });
        }
        ($self->{cfg}->{winnt}) and binmode STDOUT;
        binmode DATA;
        my $buffer;
        print $buffer while (read(DATA, $buffer , $READ_SIZE));
        close(DATA);
    }
}

sub _safe_dir {
#------------------------------------------------------------------------
# Check a directory make sure it safe
#
    my ($self, $dir, $options) = @_;

    my $root = $self->{cfg}->{root_dir};
    my $work = $self->{work_path};

    my $fulldir;
    unless ($dir) {
        return ($work) ? "$root/$work" : $root;
    }
    elsif ($dir eq '/') {
        return $root;
    }

    return -1 if ($self->{cfg}->{filename_check} and $dir !~ m,^([-\w/. ]+)$,);
    return -1 if ($dir =~ /$GT::FileMan::UNSAFE_PATH/);

    ($dir =~ m,^/,) ? ($fulldir = $root . $dir)
                    : ($fulldir = $root. ($work ? '/' : '') . $work . '/' . $dir);
    my ($e, $d, $w);
    foreach my $key (keys % $options) {
        if ($options->{$key} == 1) {
            $e = -e $fulldir if ($key eq 'exist');
            $d = -d $fulldir if ($key eq 'isdir');
            $w = -w $fulldir if ($key eq 'write');
        }
    }
    return { fulldir => $fulldir, exist => $e, isdir => $d, write => $w };
}

sub _command_show {
#--------------------------------------------------------------------
# Show path when execute cd command
#
    my ($working_dir, $cmd) = @_;
    if ($cmd =~ m/^\s*cd\s*\.\./) { # cd ..
        my $tmp;
        my $parts = [split(/\//, $working_dir)];
        return '/' if ($#$parts == 1 or $working_dir eq '/');

        foreach my $ii( 0 .. $#$parts) {
            $tmp .= '/'.@$parts[$ii] if ($ii < $#$parts and @$parts[$ii]);
        }
        return $tmp;
    }
    return $working_dir if ($cmd =~ m/^\s*cd\s*\./); # cd.
    my $path = $cmd;
    $path    =~ s/\s*cd\s*//;
    return '/' if ($path =~ m,^(/+)$,);
    return ($path =~ m/^\//)? $path : $working_dir.(($working_dir and $working_dir ne '/')? '/' : '').$path;
}

sub _get_icon {
# ------------------------------------------------------------------
# Get the associated icon based on a files extension
#
    my ($file) = shift;
    my ($ext)  = $file =~ /\.([^.]+)$/;
    return {icon => 'unknown.gif', type => 'unknown File'} if (!$ext);
    foreach (keys %{$ICONS}) {
        next if (/folder/);
        next if (/unknown/);
        next if (/parent/);
        ($_ =~ /\b\Q$ext\E\b/i) and return { icon => $ICONS->{$_}[0],type => $ICONS->{$_}[1]};
    }
    return {icon => 'unknown.gif', type => "$ext File"};
}

sub _get_date {
# ------------------------------------------------------------------
    my $time = shift;
    $time or ($time = time);
    my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;

    my ($min, $hr, $day, $mon, $yr) = (localtime($time))[1,2,3,4,5];
    $yr = $yr + 1900;
    ($min < 10) and ($min = "0$min");
    ($hr  < 10) and ($hr  = "0$hr");
    ($day < 10) and ($day = "0$day");

    return "$day-$months[$mon]-$yr $hr:$min";
}

sub _print_filesize {
# ------------------------------------------------------------------
# Prints out the file size.
#
    my $size = shift;
    my $formatted_size = 0;
    $formatted_size = int($size / 1000) if ($size);
    return $formatted_size == 0 ? "$size bytes" : $formatted_size." kb";
}

sub _print_permissions {
# ------------------------------------------------------------------
# Takes permissions in octal and prints out in ls -al format.
#
    my $octal  = shift;
    my $string = sprintf "%lo", ($octal & 07777);
    my $result = '';
    foreach (split(//, $string)) {
        if    ($_ == 7) { $result .= "rwx "; }
        elsif ($_ == 6) { $result .= "rw- "; }
        elsif ($_ == 5) { $result .= "r-x "; }
        elsif ($_ == 4) { $result .= "r-- "; }
        elsif ($_ == 3) { $result .= "-wx "; }
        elsif ($_ == 2) { $result .= "-w- "; }
        elsif ($_ == 1) { $result .= "--x "; }
        elsif ($_ == 0) { $result .= "--- "; }
        else            { $result .= "unkown '$_'!"; }
    }
    return $result;
}

sub _load_mime {
# --------------------------------------------------------------------
# Load the config file into a hash.
#
    my $file = shift;
    require GT::MIMETypes;
    my $guess = GT::MIMETypes->guess_type($file);
    if (! $guess) {
        if (-e $file) {
            $guess = -T _ ? 'text/plain' : 'application/octet-stream';
        }
        else {
            $guess = 'application/octet-stream';
        }
    }
    return $guess;
}

sub _init_chmod {
#---------------------------------------------------------------------
# set chmod
#
    my($from,$to) = @_;
    $from =~ m,^([/\w.-]+)$,;
    $from = $1;

    $to =~ m,^([/\w.-]+)$,;
    $to = $1;

    my $stat = [stat($from)];
    chmod(@$stat[2],$to);
}

sub _create_htaccess {
# ------------------------------------------------------------------
# Creates the htaccess file.
#
    my ($htaccess, $htpasswd) = @_;
    my $raq = $ENV{GT_COBALT_RAQ} ? "AuthPAM_Enabled off\n" : '';
    open (HTAC, "> $htaccess") or die "Unable to open: $htaccess ($!)";
    print HTAC <<HTACCESS;
AuthUserFile   $htpasswd
AuthGroupFile  /dev/null
AuthType       Basic
AuthName       Protected
$raq
require valid-user
HTACCESS
    close HTAC;
}

sub _fcopy {
#----------------------------------------------------------------------
# Copy and replace a file
#
    my ($from,$to,$repl,$with,$cs) = @_;

    open(TARGET, ">$to") or return 0;
    open(SOURCE, "<$from") or return 0;
    binmode SOURCE;
    binmode TARGET;
    my $buffer;
    while (read SOURCE, $buffer, $READ_SIZE) {
        if ($repl) {
            ($cs)? ($buffer =~ s,$repl,$with,g)
                 : ($buffer =~ s,$repl,$with,ig);
        }
        print TARGET $buffer;
    }
    close SOURCE;
    close TARGET;
    _init_chmod($from,$to);
    return 1;
}

sub _valid_name_check {
# ---------------------------------------------------
# Checks to see if the input database/table name is a
# valid one.  The function checks the following:
# 1. if a name is entered at all;
# 2. if there are spaces in the name;
# 3. if the name is consisted of valid characters; and
# 4. if the name is consisted of only numbers.

    my ($self, $name) = @_;
    my ($output);

    $name =~ s/^\s+//;
    $name =~ s/\s+$//;
    if (!$name) {
        $output = "<font color=red>Please provide a valid name.</font>";
    }
    elsif ($self->{cfg}->{filename_check} and $name =~ /\s/) {
        $output = "<font color=red>Spaces are not allowed in name.</font>";
    }
    return $output;
}

1;
