3116 lines
123 KiB
Perl
3116 lines
123 KiB
Perl
|
# 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' => ' ', 'date' => ' ', 'perm' => '', 'user' => ' '
|
||
|
|
};
|
||
|
|
|
||
|
|
# 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) ? " <img border=0 src='$html_url/icons/up.gif' width='13'>" : " <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) ? " ^" : " 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> <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> ',`$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> <a href='$url&pg=".($pg - 1)."'>$prev</a> " : "$first_grey $prev_grey ";
|
||
|
|
$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> "
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
$speed_bar .= ($cur_pg == $ii)? "<b>$ii</b> " : "<a href='$url&pg=$ii'>$ii</a> ";
|
||
|
|
}
|
||
|
|
if ($jj == $scre_pg) {
|
||
|
|
$speed_bar .= ( ($pg_step * $scre_pg) < $pages) ? "..." : "";
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$speed_bar .= ($pg < $pages) ? "<a href='$url&pg=".($pg+1)."'>$next</a> <a href='$url&pg=$pages'>$last</a>" : "$next_grey $last_grey";
|
||
|
|
$speed_bar .= ($cur_pg eq 'all') ? " <b>All</b> " : " <a href='$url&pg=all'>All</a> " 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;
|