| Current File : //var/wcp4/demo1812/public_html/file/private/lib/GT/FileMan/Commands.pm |
# ==================================================================
# File manager - enhanced web based file management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
#
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
package GT::FileMan::Commands;
# ===============================================================
use strict;
use GT::TempFile;
use vars qw/@ISA $COPIED $ICONS $DEBUG $AUTOLOAD $READ_SIZE %LANGUAGE/;
use GT::Base qw/:all/; # Imports $MOD_PERL $SPEEDY $PERSIST
use GT::AutoLoader;
# 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 <i>%s</i> 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_COPY_CANCEL => "<font color=red>Copy of %s file(s) has been canclled.</font>",
MSG_COPIED => "<font color=green> %s selected file(s) have been %s.</font>",
MSG_MOVED => "<font color=green> %s selected file(s) have been %s (%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.</b></font></body>",
MSG_PWD_CHANGED => "<font color=green>Your password was changed. </font>",
MSG_DEMO => "<font color=red><b>Disabled in Demo.</b></font>",
ERR_DEL => "<font color=red><b>Can not remove file(s)</b></font>",
ERR_CHMOD => "<font color=red><b>Can not change mode </b></font>",
ERR_FILE_OPEN => "<font color=red><b>Can not open file: %s</b></font>",
ERR_FILE_EMPTY => "<font color=red><b>File <i>%s</i> is empty: $!</b></font>",
ERR_FILE_EXISTS => "<font color=red><b>File <i>%s</i> exists.</b></font>",
ERR_FILE_NOT_EXISTS => "<font color=red><b>File <i>%s</i> not exists.</b></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'</b></font></BODY>",
ERR_FILE_PEM => "<font color=red><b>The <i>%s</i> directory is not writeable.</b></font>",
ERR_NOT_TEXT_FILE => "<font color=red><b>File <i>%s</i> is not a text file.</b></font>",
ERR_DIR_NOT_EXISTS => "<font color=red><b>Directory <i>%s</i> not exists.</b></font>",
ERR_DIR_PEM => "<font color=red><b>The <i>%s</i> file is not writeable.</b></font>",
ERR_DIR_PERM => "<font color=red><b>Please check permission.</b></font>",
ERR_NOT_ISFILE => "<font color=red><b><i>%s</i> is a directory.</b></font>",
ERR_TMP_FILE => "<font color=red><b>Can not open temp file.</b></font>",
ERR_FREE_SPC => "<font color=red><b>Upload: Not enough free space to upload that file.</b></font>",
ERR_RM_FILE => "<font color=red><b>Unable to remove file: %s. Reason: %s</b></font>",
ERR_UPLOAD => "<font color=red><b>Unable to upload file: %s. Reason: %s.</b></font>",
ERR_FILE_SAVE => "<font color=red><b>Cannot save file %s. Check permissions.</b></font>",
ERR_DIR_EXISTS => "<font color=red><b>Directory %s already exists.</b></font>",
ERR_NAME => "<font color=red><b>Illegal Characters in Directory. Please use letters, numbers, - and _ only.</b></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><b>Not enough space to save it (free space is %s kb)</b></font>",
ERR_UNCOMPRESS => "<font color=red><b>Select files or directories before to uncompress.</b></font>",
ERR_TAR => "<font color=red><b>Error: %s.</b></font>",
ERR_TAR_NOT_EXISTS => "<font color=red><b>Can not create a tar file: %s</b></font>",
ERR_TAR_PEM => "<font color=red><b>Can not create a tar file <i>%s</i>. Check permission.</b></font>",
ERR_DOWNLOAD => "<font color=red><b>You selected a directory !</b></font>",
ERR_LOGIN => "<font color=red><b>Invalid Username and Password.</b></font>",
ERR_INVALID => "<font color=red><b>Input value has invalid characters : %s</font></b> ",
ERR_NOT_FILE => "<font color=red><b>The %s is not a file</font>",
ERR_OLD_PASSWORD => "<font color=red><b>Invalid Old password</font>",
ERR_NEW_PASSWORD => "<font color=red><b>New password must be more than 3 character</font>",
ERR_OPEN_FILE => "<font color=red><b>Can not open %s file, reason: %s</font></b> ",
ERR_WRITEABLE => "<font color=red><b>Can not save %s file, reason: %s</font></b> ",
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>",
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' => ['sound1.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) = @_;
$self->list_files();
$self->{cgi}->{cmd_do} = 'cmd_command' if ($type);
$self->page('main.html',$args);
}
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 $path = [];
$path = [split /\//, $self->{work_path}] if ($self->{work_path});
my ($string, $spath);
my $parent = '';
$string = '<a href = javascript:top.js_open_link(\'cmd_main_display\',\'mainfrm\',\'\',1)>root</a>: ' ;
for my $ii ( 0.. $#$path) {
(@$path[$ii] eq '') and next;
$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) {
($file eq '.') and next;
($file eq '..') and next;
(!$self->{in}->cookie('hidden_file') and $file =~ /^\./) and next; #don't show hidden file
my $fullfile = "$real_work_path/$file";
($only_dir and (!-d $fullfile)) and next; # 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) {
($file =~ /^\./ or !-x $fullfile) and $hash->{disabled} = 1;
$hash->{nsize} = 0;
push @$list_dir, $hash;
}
else {
$hash->{type} = _get_icon($file)->{type};
(-r $fullfile) or $hash->{disabled} = 1;
$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 > 0) and $list_file = $self->qsort($list_file,$orderby,$sortdown);
($#$list_dir > 0) and $list_dir = $self->qsort($list_dir,$orderby,$sortdown);
# 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;
my $output;
@$sorted = ($sortdown) ? (@$list_dir, @$list_file) : (@$list_file, @$list_dir);
my $speed_bar;
# 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 $count = 0;
my $def_files = $self->{in}->cookie('def_files_page') || '';
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);
($skip < $r_start) and next;
$count++;
($count > $r_pg) and last;
}
push @$output,$_;
}
$speed_bar = $self->speed_bar($#$sorted) if (($#$sorted + 1) > $r_pg);
}
# else all rows
else {
$speed_bar = $self->speed_bar($#$sorted) if (($#$sorted + 1) > $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' : $_);
( $_ eq $orderby or $_ eq 'view' ) and $temp .= "&sd=$sortdown";
$temp .= '><font color=white>'.$cols->{$_}.'</font></a>' ;
$temp .= ( ( $_ eq $orderby ) ? ( ($sortdown) ? " ^" : " v" ) : '' );
$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
};
}
$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';
my $ie = ($ENV{HTTP_USER_AGENT} =~ m,MSIE 5.5, or $ENV{HTTP_USER_AGENT} =~ m,MSIE 6,) ? 1 : 0;
if ($template eq 'file_editor.html') {
($args->{use_html}) 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 ($self->{cgi}->{content});
return $self->page($template,{ use_html => ( !$self->{in}->cookie('editor_mode') and $ie ) ? 1 : 0,
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_passwd_dir => ($def_passwd_dir eq '0') ? '' : $def_passwd_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},
ie => $ie, %$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();
($result->{status}) and return $self->cmd_main_display({reload => 1, status => $result->{status}},1); # not safe
$self->{work_path} = $result->{work_path};
$self->cmd_main_display();
}
END_OF_SUB
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});
($fulldir == -1) and return {status => sprintf($LANGUAGE{ERR_INVALID},$input), work_path => ''}; # not safe
$fulldir->{exist} or return {status => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS},$input),work_path => ''}; # not exist
my $dir = $fulldir->{fulldir};
$dir =~ s,$root_path/,,;
return { status => '', work_path => $dir};
}
$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};
$pg = 'all' if ($r_pg eq 'all');
my $r_start;
$search =~ s/[\*\/\\]//g;
my $url_opts= $self->{url_opts} || '';
# 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];
# Select files from selected files
my $files;
if (! $scope) { # All of root
my $fulldir = $self->_safe_dir();
$files = ($repl)? subdir(1,1, $fulldir) : subdir(0,1, $fulldir);
}
# Selected files
else {
my $selected = [$self->{in}->param('c_edit')];
foreach (@$selected) {
my $fulldir = $self->_safe_dir($_);
next if ($fulldir == -1);
my $tmp = ($repl)? subdir(1,1, $fulldir->{fulldir}) : subdir(0,1, $fulldir->{fulldir});
push @$files, @$tmp;
$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 (@$files) {
my $name = $_->{name};
if ($self->{cgi}->{c_case}) { # None Case Sensitive
push @$results, $self->_file_info("$_->{parent}/$_->{name}") if ($name =~ m,$search,);
}
else {
push @$results, $self->_file_info("$_->{parent}/$_->{name}") if ($name =~ m,$search,i);
}
}
}
else { # contents
$results = $self->_search($files);
}
}
#Push data of current page into an output array.
my ($skip,$output,$total_space);
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) {
(@$path[$ii] eq '') and next;
$spath .= (($spath)? '/':'') . @$path[$ii];
$string .= "/<a href='$url&work_path=$spath' target=mainfrm>".@$path[$ii]."</a>";
}
my $msg;
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);
@$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' : $_);
( $_ eq $orderby or $_ eq 'view') and $temp .= "&sd=$sortdown";
$temp .= "'><font color=white>".$cols->{$_}."</font></a>" ;
$temp .= ( ( $_ eq $orderby ) ? ( ($sortdown) ? " ^" : " v" ) : '' );
$sort_title->{'s'.$_} = $temp;
}
# Create speed bar
my $speed_bar;
$speed_bar = $self->speed_bar($#$results,"$url_pg&sb=$orderby") if (($#$results - 1) > $r_pg and $r_pg > 0);
($#$output>1) and $output = $self->qsort($output,$orderby,$sortdown);
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,
reload => '1',
total_space=> $total_space,
num_objects=> (($#$results >=0)? $#$results+1:0),
status => "<font color=green>$msg</font>",
speed_bar => $speed_bar,
search => 1};
$self->page('main.html',{reload=>1});
}
sub _search {
#-------------------------------------------------------------------
# search contents
#
my ($self,$files) = @_;
my $results;
my $search = $self->{cgi}->{txt_input};
if ($self->{cgi}->{c_regex}) { $search = quotemeta($search); }
foreach (@$files) {
my $file = ($_->{name})? "$_->{parent}/$_->{name}" : $_->{parent};
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 ";
}
if ($self->{cgi}->{c_regex}) { $search = quotemeta($search); }
foreach (@$files) {
my $file = ($_->{name})? "$_->{parent}/$_->{name}" : $_->{parent};
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 $prompt;
my $run_file;
my $full_path = $self->{cfg}->{root_dir}.(($work_path)? "/$work_path" : '');
$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
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;
my $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'>
<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 "</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>
<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>$output</pre>
<pre><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}">
</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;
if ($self->{cfg}->{allowed_space} > 0) {
my $disk_space;
@$disk_space = $self->_checkspace($self->{cfg}->{root_dir});
$free_space = @$disk_space[0];
}
my $filename = $data;
my $mode = $self->{cgi}->{type};
$filename =~ s/.*?([^\\\/:]+)$/$1/;
$filename =~ s/[\[\]\s\$\#\%'"]/\_/g;
# 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});
($file == -1) and return $self->cmd_main_display({ reload => 1, stastus => sprintf($LANGUAGE{ERR_INVALID},$filename)}); # not safe
$fullfile = $file->{file};
if (!$self->{cfg}->{winnt}) {
$fullfile =~ m,^([\/\w.-]+)$,;
$fullfile = $1; #untainted
}
if (!$self->{in}->param('txt_input')) { #multi upload
($file->{exist} and !$self->{cgi}->{overwrite}) and return (0, sprintf($LANGUAGE{ERR_FILE_EXISTS},$filename));
($file->{exist} and !$file->{write} and $self->{cgi}->{overwrite}) and return (0, sprintf($LANGUAGE{ERR_FILE_PEM},$filename));
}
else {
($file->{exist} and !$self->{cgi}->{overwrite}) and return $self->cmd_main_display({ reload => 1 , status =>sprintf($LANGUAGE{ERR_FILE_EXISTS},$filename)});
($file->{exist} and !$file->{write} and $self->{cgi}->{overwrite}) and return $self->cmd_main_display({ reload => 1 , status =>sprintf($LANGUAGE{ERR_FILE_PEM},$filename)});
}
$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';
}
}
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->{in}->param('txt_input')) and $self->cmd_main_display({ reload=>1 , status => $status});
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});
($file == -1) and return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_INVALID},$filename)}); # not safe
($file->{isfile}) or return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_NOT_FILE},$filename)}); # 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 = _valid_name_check($filename);
($msg) and return $self->cmd_show({msg => $msg, old => $old, use_html => $self->{cgi}->{use_html}});
$self->{cgi}->{content} = $self->{in}->html_escape($data);
my $file = $self->_safe_file($filename,{ fullfile => 1, exist => 1});
($file == -1) and return $self->cmd_show({msg => sprintf($LANGUAGE{ERR_INVALID},$filename), old => $old}); # 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}});
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}); # not safe
}
my $fullfile = $file->{file};
# Strip windows linefeeds.
$contents =~ s,\r\n,\n,g;
open(FILE,">$fullfile") or return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_FILE_OPEN},$filename),
old => $old});
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 = _valid_name_check($new);
($msg) and return $self->cmd_main_display({ reload => '1', status => $msg});
my $work_path = $self->{work_path} || '';
my $fulldir = $self->_safe_dir($new, { exist => 1} );
$fulldir == -1 and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID} ,$new)});
$fulldir->{exist} and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_DIR_EXISTS},$new)});
if ( mkdir ($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 $readme_position = $self->{cgi}->{readme_position};
my $hidden_file = $self->{cgi}->{hidden_file};
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>";
($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/(\.\.)+//g;
$def_passwd_dir =~ s/(\.\.)+//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};
($old_pass) or return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD});
($new_pass and length($new_pass) >= 3) or return $self->user_form($LANGUAGE{ERR_NEW_PASSWORD});
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}->{root_path}/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};
($old) or return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD});
($new and length($new) >= 3) or return $self->user_form($LANGUAGE{ERR_NEW_PASSWORD});
($old eq $self->{cfg}->{password}) or return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD});
$self->{cfg}->{password} = $new;
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) 2000 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});
($file == -1) and return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$filename)}); # not safe
my $url_opts = $self->{url_opts} || '';
my $work_path = $self->{work_path} || '';
my $fullfile = $file->{file};
# Image 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,) 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});
($file == -1) and return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_INVALID},$filename)},1); # not safe
($file->{isfile}) or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_NOT_FILE},$filename)},1); # not a file
my $url_opts = $self->{url_opts} || '';
my $work_path = $self->{work_path} || '';
my $fullfile = $file->{file};
my ($ext) = $fullfile =~ /\.([^.]+)$/;
my $browser;
$browser = 1 if ($ENV{HTTP_USER_AGENT} =~ m,MSIE 5, or $ENV{HTTP_USER_AGENT} =~ m,MSIE 6,);
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 ( $browser and (($ext eq 'html') or ($ext eq 'htm')) and !defined $use_html and !$self->{in}->cookie('editor_mode') ) { #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,);
my $doc = "doc xls pdf DOC XLS PDF";
return $self->_view_file($filename) if ($doc =~ m,$ext,); # .doc, .xls, .pdf file
return $self->_tar_information($filename) if ($ext eq 'tar'); # .tar file
return $self->_tar_information($filename) if ($ext eq 'gz' and $GT::FileMan::HAVE_GZIP); # .gz file
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 $filename = $self->{in}->param('c_edit');
my $file = $self->_safe_file($filename,{ fullfile => 1});
($file == -1) and return $self->cmd_main_display({ reload => 1, stastus => sprintf($LANGUAGE{ERR_INVALID},$filename)}); # not safe
my $full_name = $file->{file};
$self->{cgi}->{cmd_do} = 'cmd_command';
return $self->cmd_main_display({reload => 1, status => $LANGUAGE{ERR_DOWNLOAD}}) if (-d $full_name);
$self->_send_to_browser($full_name);
}
END_OF_SUB
sub _send_to_browser {
#----------------------------------------------------------------
# send the contents of a file to browser for downloading
#
my $self = shift;
my $send_file = shift;
if(open(SENDFILE, $send_file)) {
$self->history("cmd_download|$send_file") if ( $self->{cfg}->{multi} ); #save log file
my $file_size = -s $send_file;
my ($file) = $send_file =~ m,/([^/]+)$,;
print $self->{in}->header(
'-type' => 'application/download',
'-Content-Length' => $file_size,
'-Content-Transfer-Encoding' => 'binary',
'-Content-Disposition' => \"attachment; filename=$file"
);
($self->{cfg}->{winnt}) and binmode STDOUT;
binmode SENDFILE;
my $buffer;
print $buffer while (read(SENDFILE, $buffer, $READ_SIZE));
close SENDFILE;
}
else { # failed to open file
$send_file =~ s,$self->{cfg}->{root_path},,;
die sprintf($LANGUAGE{ERR_FILE_OPEN}, $send_file, "$!");
}
}
$COMPILE{cmd_copy} = __LINE__ . <<'END_OF_SUB';
sub cmd_copy {
#---------------------------------------------------
# Copy and move files and directories
#
my $self = shift;
# Check diskspace, permission, total size will copy
my $status = $self->_copy_prepare();
($status) and return $self->cmd_main_display({reload => 1, status => $status});
$COPIED = 0;
$self->page('progress_bar.html');
$self->cmd_copy_process();
}
END_OF_SUB
$COMPILE{cmd_copy_process} = __LINE__ . <<'END_OF_SUB';
sub cmd_copy_process {
#------------------------------------------------------------------------------
# Confirm when exits files or directory
#
my ($self,$action) = @_;
$action ||= $self->{cgi}->{action};
if ($self->{cgi}->{cancel}) { #copy cancel
$self->{cgi}->{cmd_do} = 'cmd_copy';
return $self->cmd_main_display( {reload => 1, status => sprintf($LANGUAGE{MSG_COPY_CANCEL},($action)? 'move':'copy')});
}
#confirm variables
my $over = $self->{cgi}->{over};
my $skip = $self->{cgi}->{skip};
my $all = $self->{cgi}->{all};
my $file_cur = $self->{cgi}->{file_cur} || '';
my $total_size= $self->{cgi}->{total_size};
#root, work path variable
my $root_path = $self->{cfg}->{root_dir};
my $work_path = $self->{work_path};
my $from_path = $self->_safe_dir();
#input variables
my $input = $self->{cgi}->{txt_input};
my $fulldir = $self->_safe_dir($input,{ exist => 1, write => 1});
($fulldir == -1) and return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $input) }); # not safe
my $to_path = $fulldir->{fulldir};
my $files = [$self->{in}->param('c_edit')];
my $file_copied = $self->{cgi}->{copied} || 0;
my $not_ok = 0;
my $history = ($action) ? 'cmd_move|' : 'cmd_copy|';
for my $ii ( 0.. $#$files) {
my $file = @$files[$ii];
if ($file eq $file_cur and $skip) {
my $skiped = _space_used("$from_path/$file");
my $progress = _load_progress_bar($COPIED,$skiped,$total_size);
$self->page('copy_status.html', { msg => "Skiped $file",
pxs => $progress->{pxs},
percent => $progress->{percent}});
next;
}
if ( (-e "$to_path/$file") and ($file ne $file_cur) and (!$all) ) {
my $results;
for my $jj ( $ii.. $#$files) {
push @$results, {name => @$files[$jj]};
}
return $self->page('progress_bar.html',{confirm => 1,
from => "$work_path/$file",
to => "$input/$file",
results => $results,
file_cur => $file,
txt_input => $input,
action => $action,
copied => $file_copied});
}
my $data;
my $fulldir = $self->_safe_dir($file);
next if ($fulldir == -1);
$data = subdir(0, 0, $fulldir->{fulldir});
if ($self->{cgi}->{search}) {
my $dir = $fulldir->{fulldir};
my ($file) = $dir =~ /\/([^\/]+)$/;
$dir =~ s/\/$file//;
$self->_copy_wanted($data, $from_path, $to_path, $dir);
$history .= "$from_path:";
}
else {
$self->_copy_wanted($data,"$from_path/$file",($self->{cgi}->{cp_type}) ? $to_path : "$to_path/$file");
$history .= "$from_path/$file:";
}
$file_copied++;
if ($action) { #remove files and directories
$not_ok += $self->_move_wanted($data);
}
}
chop $history;
$history .= "|$to_path";
$self->history($history) if ( $self->{cfg}->{multi} );#save log info
$self->{cgi}->{cmd_do} = ($action)? 'cmd_move' : 'cmd_copy';
my $status = sprintf($LANGUAGE{MSG_COPIED}, $file_copied, ($action) ? 'moved' : 'copied');
$status = sprintf($LANGUAGE{MSG_MOVED}, $file_copied, ($action) ? 'moved' : 'copied', $not_ok) if ( $not_ok );
$self->cmd_main_display({ reload => 1, status => $status, search => 0});
}
END_OF_SUB
sub _copy_prepare {
#------------------------------------------------------
# Check diskspace, writeable ... before save
#
my ($self,$action) = @_;
$self->{cgi}->{total_size} = 0;
$self->{cgi}->{copied} = 0;
my $root_path = $self->{cfg}->{root_dir};
my $work_path = $self->{work_path};
my $from_path = $self->_safe_dir();
my $files = [$self->{in}->param('c_edit')];
#input variables
my $input = $self->{cgi}->{txt_input};
my $fulldir = $self->_safe_dir($input, { exist => 1, write => 1});
($fulldir == -1) and return sprintf($LANGUAGE{ERR_INVALID},$input); # not safe
my $to_path = $fulldir->{fulldir};
# Create a file if selected a file that it does not exists.
if ($#$files == 0) {
if (!$fulldir->{exist}) {
my $obj = "$from_path/@$files[0]";
if (-l $obj) { # links
local($SIG{__DIE__}, $@);
eval {
my $link = readlink($obj) or die $!;
link($link, $to_path) or return $self->cmd_main_display({ reload => 1, status => $!});
};
} elsif (-d $obj) { # Directories
mkdir($to_path, 0775) or return $LANGUAGE{ERR_DIR_PERM};
$self->{cgi}->{cp_type} = 1;
}
else { # Files
open(TARGET, ">$to_path") or return $LANGUAGE{ERR_DIR_PERM};
open(SOURCE, "<$obj") or return printf($LANGUAGE{ERR_FILE_OPEN},@$files[0]);
binmode SOURCE;
binmode TARGET;
my $buffer;
while (read SOURCE, $buffer, 1024) { print TARGET $buffer; }
close SOURCE;
close TARGET;
_init_chmod($obj,$to_path);
unlink($obj) if ($action);
return sprintf($LANGUAGE{MSG_COPIED}, 1, ($action) ? 'moved' : 'copied');
}
}
}
else {
$fulldir->{exist} or return sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS},$input); # not exist
$fulldir->{write} or return sprintf($LANGUAGE{ERR_DIR_PEM},($input eq '/')? 'Root' : $input); #permission
}
# Calculate total size of the copy file.
my $total_size = 0;
foreach my $file (@$files) {
$total_size += _space_used("$from_path/$file");
}
$self->{cgi}->{total_size} = $total_size;
# Check free space.
if ($self->{cfg}->{allowed_space} > 0) {
my @disk_space = $self->_checkspace($to_path);
my $free_space = $disk_space[0];
($total_size > $free_space * 1024 ) and return sprintf($LANGUAGE{ERR_DISK_SPACE}, $free_space);
}
}
sub _copy_wanted {
#------------------------------------------------------------
# Copy files and directories
#
my ($self, $data, $from, $to, $replace) = @_;
my $total_size = $self->{cgi}->{total_size};
my ($msg,$s,$progress);
foreach (@$data) {
my $target = $_;
($self->{cgi}->{search}) ? ($target =~ s,$replace,$to,) : ($target =~ s,$from,$to,);
$s = (-s $_);
$COPIED += $s;
if (!$self->{cfg}->{winnt}) {
$target =~ m,^([\/\w.-]+)$,;
$target = $1; #untainted
}
if (-l $_) { # links
local($SIG{__DIE__}, $@);
eval {
my $link = readlink($_) or die $!;
link($link, $target) ? ($msg = 'ok') : ($msg ='not ok');
};
}
elsif (-d $_) { # Directories
mkdir("$target", 0775) ? ($msg = "ok") : ($msg = "not ok");
_init_chmod($_, $target) if ($msg eq 'ok');
}
else { # Files
next if (!$target);
if(!open(SOURCE, "<$_")) {
$progress = _load_progress_bar($COPIED, $s, $total_size);
$self->page('copy_status.html',{ msg => "$_...$!",
pxs => $progress->{pxs},
percent => $progress->{percent}});
next;
}
if (!open(TARGET, ">$target")) {
$progress = _load_progress_bar($COPIED,$s,$total_size);
$self->page('copy_status.html',{ msg => "$_...$!",
pxs => $progress->{pxs},
percent => $progress->{percent}});
next;
}
binmode SOURCE;
binmode TARGET;
my $buffer;
while (read SOURCE, $buffer, 1024) { print TARGET $buffer; }
close SOURCE;
close TARGET;
_init_chmod($_,$target);
}
$progress = _load_progress_bar($COPIED,$s,$total_size);
$self->page('copy_status.html',{ msg => "$_...ok",
pxs => $progress->{pxs},
percent => $progress->{percent}});
}
}
$COMPILE{cmd_delete} = __LINE__ . <<'END_OF_SUB';
sub cmd_delete {
# --------------------------------------------------------
# Delete files or directories
#
my $self = shift;
my ($files,$notdeleted);
#List files and dirs need to remove
@$files = $self->{in}->param('c_edit');
my $count_file = 0;
my $count_dir = 0;
my $history = '';
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 && !-l $full_name ) {
if ( rmdir($full_name) ) {
$count_dir++;
}
else {
push @$notdeleted,$_;
}
}
else {
if ( unlink($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
sub del_recursively {
# --------------------------------------------------------
# List subdir of a directory
#
my ($self, $directory) = @_;
my $error = 0;
my $list = subdir(0,0,$directory);
foreach my $file (reverse @$list) {
if ( !$self->{cfg}->{winnt} ) { #untaint if unix
$file =~ m,^([/\w.-]+)$,;
$file = $1;
}
if (-d $file) {
rmdir($file) or $error = 1;
}
else {
unlink($file) or $error = 1;
}
}
return $error;
}
$COMPILE{cmd_del_confirm} = __LINE__ . <<'END_OF_SUB';
sub cmd_del_confirm {
# --------------------------------------------------------
# confirm before delete a directory have subdir
#
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});
($file == -1) and return $self->cmd_main_display({ reload => 1, stastus => sprintf($LANGUAGE{ERR_INVALID},$_)}); # not safe
my $full_name = $file->{file};
$self->del_recursively($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 = shift(@$files);
my $file = $self->_safe_file($file_cur,{ fullfile => 1 });
( $file == -1 ) and return $self->cmd_main_display({ reload => 1, stastus => sprintf($LANGUAGE{ERR_INVALID}, $file_cur) }); # not safe
my $full_name = $file->{file};
$self->del_recursively($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} ) {
shift(@$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_move} = __LINE__ . <<'END_OF_SUB';
sub cmd_move {
#--------------------------------------------------------------------------------
# Move files and directories function
#
my $self = shift;
my $status = $self->_copy_prepare(1);
($status) and return $self->cmd_main_display({reload => 1, status => $status});
$COPIED = 0;
$self->page('progress_bar.html');
$self->cmd_copy_process(1);
}
END_OF_SUB
sub _move_wanted {
#--------------------------------------------------------------------------------
# Move files and directories
#
my ($self,$data) = @_;
my $count = 0;
foreach my $ii (0 .. $#$data) {
my $file = @$data[$#$data - $ii];
if (!$self->{cfg}->{winnt}) {
$file =~ m,^([/\w.-]+)$,;
$file = $1;
}
if (-d $file) {
if (!rmdir($file)) {
$count++;
next;
}
}
else {
unlink($file);
}
}
return $count;
}
$COMPILE{cmd_chmod} = __LINE__ . <<'END_OF_SUB';
sub cmd_chmod {
# --------------------------------------------------------
# Changes the permission attributes of a file
my $self = shift;
my ($full_filename,$octal_perm);
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 $filesnot;
#if only one file
(ref $files eq 'ARRAY') or $files = [$files];
foreach (@$files) {
my $file = $self->_safe_file($_, { fullfile => 1 });
($file == -1) and return $self->cmd_main_display({ reload => 1, stastus => sprintf($LANGUAGE{ERR_INVALID},$_)}); # not safe
$full_filename = $file->{file};
$octal_perm = oct($newperm); # Permissions have to be in octal.
$history .= "$full_filename:";
chmod ($octal_perm, $full_filename) 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});
($file == -1) and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID},$filename)}); #not safe
my $fullfile = $file->{file};
my $retime = $self->{cgi}->{retime};
my $contents = '';
($file->{exist}) or return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS},$filename)});
($file->{isfile}) or return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_ISFILE},$filename)});
my $lines = $self->{cgi}->{txt_input} || 10;
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='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>
<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>
<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 $params = $self->{cgi}->{txt_input};
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></b></font>";
my $check_now = $self->{cfg}->{path_to_perl} . ' -c '.$full_name.' '.$params.' '.$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};
($file2->{exist}) or return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS},$filename2)});
($file1->{text}) or return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_TEXT_FILE} ,$filename1)});
($file2->{text}) or return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_TEXT_FILE} ,$filename2)});
my ($f1, $f2);
open (F1, $fullfile1) or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile1, "$!");
chomp(@$f1 = <F1>);
close F1;
open (F2, $fullfile2) or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile1, "$!");
chomp(@$f2 = <F2>);
close F2;
require GT::FileMan::Diff;
my $diff = GT::FileMan::Diff::main_diff($f1, $f2);
$diff &&= $self->{in}->html_escape($diff);
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}">
<pre>$diff</pre></form></body>
!;
}
END_OF_SUB
$COMPILE{cmd_tar} = __LINE__ . <<'END_OF_SUB';
sub cmd_tar {
#----------------------------------------------------
# Create tar file
#
my ($self, $fl) = @_;
return $self->_tar_information($fl) if ($fl); #show information of this file
my $input = $self->{cgi}->{txt_input};
my $opt_gz = $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
(-e $to_path) or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_TAR_NOT_EXISTS},$input)}); # check exists the directory
(-w $to_path) or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_TAR_PEM},$input)}); # check permission on this directory
if ($opt_gz) {
$tar_file =~ s,.tar,,;
($tar_file =~ m,.tar.gz,) or ($tar_file .= '.tar.gz');
}
else {
($tar_file =~ m,.tar,) or ($tar_file .= '.tar');
}
$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});
}
}
$self->_tar_process($fullfile);
}
sub _tar_process {
#--------------------------------------------------------------
# Create tar file
#
my ($self,$to) = @_;
my $opt_gz = $self->{cgi}->{opt_gz};
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});
$history .= "$fulldir->{fulldir}:";
}
chop $history;
my $items = $tar->files;
foreach my $fl (@$items) {
$fl->{name} =~ s/$from\///;
}
$tar->write("$to");
$history .= "|$to";
}
$self->{cgi}->{cmd_do} = 'cmd_tar';
$to =~ s/$self->{cfg}->{root_dir}//;
$self->history($history) if ( $self->{cfg}->{multi} ); #save log info
$self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{MSG_TAR_CREATED},$to)});
}
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} || "/$work_path";
my $total_size = $self->{cgi}->{total_size};
my $fullfile = $self->_safe_file($self->{cgi}->{cmp_file}, {fullfile => 1, exist => 1});
($fullfile == -1) and die (sprintf($LANGUAGE{ERR_INVALID},$self->{cgi}->{cmp_file}));
($fullfile->{exist}) or die (sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS},$self->{cgi}->{cmp_file}));
my $cmp_file = $fullfile->{file};
my $fulldir = $self->_safe_dir($input, { exist => 1, write => 1 });
($fulldir == -1) and return $self->_tar_information($cmp_file, sprintf($LANGUAGE{ERR_INVALID}, $input));
my $full_path = $fulldir->{fulldir};
# check free space and writeable
if ( $self->{cfg}->{allowed_space} > 0 ) {
my @disk_space = $self->_checkspace($full_path);
my $free_space = $disk_space[0];
($total_size > $free_space*1024 ) and return $self->_tar_information($cmp_file,sprintf($LANGUAGE{ERR_DISK_SPACE},$free_space));
}
# Check the directory is exists, permission
($fulldir->{exist}) or return $self->_tar_information($self->{cgi}->{cmp_file},sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS},$input || $work_path || 'Root'));
($fulldir->{write}) or return $self->_tar_information($self->{cgi}->{cmp_file},sprintf($LANGUAGE{ERR_DIR_PEM} ,$input || $work_path || 'Root'));
my $files = [$self->{in}->param('c_edit')];
return $self->_tar_information($cmp_file,$LANGUAGE{ERR_UNCOMPRESS}) if ($#$files == -1);
$COPIED = 0;
my $filename = $cmp_file;
$filename =~ s/$full_path\///;
$self->page('progress_bar.html', { bar_name => "Un-tarring:", msg => sprintf($LANGUAGE{MSG_READING}, $filename) });
# Make sure tar file goes out of scope before loading directory.
{
my ($fl_tars,$tar);
require GT::Tar;
$tar = GT::Tar->open ($cmp_file);
$fl_tars = $tar->files;
foreach my $fl ( @$fl_tars ) {
my $found = 0;
foreach my $file (@$files) {
if ($file eq $fl->{name}) {
$found = 1;
last;
}
}
my $s = $fl->{size};
$COPIED += $s;
if ( $found ) {
my $name = "$full_path/$fl->{name}";
$fl->{name} = $name;
$fl->write();
}
my $progress = _load_progress_bar($COPIED, $s, $total_size);
$self->page('copy_status.html', { msg => "$fl->{name} file...",
pxs => $progress->{pxs},
percent => $progress->{percent}
});
}
}
$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_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;
}
}
_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->page('protect_directory.html',{msg => $LANGUAGE{MSG_PROTECT}});
}
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 = "$to_delete user deleted.";
}
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 = "$username user added.";
}
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{cmd_show_passwd} = __LINE__ . <<'END_OF_SUB';
sub cmd_show_passwd {
# ------------------------------------------------------------------
# Show protect directory page
#
my ($self,$msg) = @_;
my $pass_path = $self->{in}->cookie('def_passwd_dir');
my ($htpasswd,$exist);
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};
my $delete_list;
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) . '</select>' if (@users);
}
$self->page('protect_directory.html',{delete_list => $delete_list, msg => $msg, pass_path => $pass_path});
}
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';
my $date_n = localtime time;
$content = $self->{cfg}->{wcp_user}.'|'.%ENV->{'REMOTE_ADDR'}.'|'.$date_n."|$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) SpeedyCGI ($SPEEDY)\n";
$info .= "Mod Perl Version: $mod_perl::VERSION\n" if (defined $ENV{GATEWAY_INTERFACE} and ($ENV{GATEWAY_INTERFACE} =~ /perl/i));
$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 _tar_information {
#----------------------------------------------------------------------
# Show information about a tar file
#
my ($self,$filename,$status) = @_;
my $fullfile = $self->_safe_file($filename, {fullfile => 1, exist => 1});
($fullfile == -1) and return $self->cmd_main_display({reload => 0, status => sprintf($LANGUAGE{ERR_INVALID},$filename)});
($fullfile->{exist}) or return $self->cmd_main_display({reload => 0, status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS},$filename)});
my $cmp_file = $fullfile->{file};
my $stat = [stat($cmp_file)];
if ($cmp_file =~ m,([^/]*[\.tar\.gz]$),) {
my ($files,$results);
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 $html_url = $self->{cfg}->{html_root_url} || '';
foreach my $file (@$files) {
$total_size += $file->{size};
my $spec = _get_icon($file->{name});
push @$results, {icon => "<img border=0 src='".$html_url.'/icons/'.$spec->{icon}."' width=14 height=16>",
name => $file->{name},
size => ($file->{type} eq '5')? '': _print_filesize($file->{size}),
date => _make_date_string($file->{mtime}),
chmod => _print_permissions($file->{mode}),
uid => eval { getpwuid($file->{uid}); } || '',
type => $file->{type},
nsize => ($file->{type} eq '5')? '': $file->{size}
};
}
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;
my $filename = $cmp_file;
$filename =~ s/$full_path\///;
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});
}
}
sub _checkspace {
# -----------------------------------------------------
# Check for allowed disk space to determine whether we can allow
# editing or uploads.
#
my $self = shift;
my ($directory) = shift;
my ($size, $used_space, $free_space) = (0,0,0);
my $files = subdir(1,0,$directory);
foreach (@$files) {
$size += -s $_;
}
$used_space = int ($size / 1024);
$free_space = (($self->{cfg}->{'allowed_space'}/1024) - $used_space);
return ($free_space, $self->{cfg}->{'allowed_space'}/1024, $used_space);
}
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)?'/':'');
$name =~ s/$full_path//;
my $stat = [stat($fullfile)];
$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} = '';
}
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) = @_;
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 ($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 = ($cur_pg eq 'all')? "<b>All</b> " : "<a href='$url&pg=all'>All</a> " ;
$speed_bar .= "<a href='$url&pg=1'><<</a> <a href='$url&pg=".($pg - 1)."'><</a> " if ($pg > 1);
$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 .= "<a href='$url&pg=".($pg+1)."'>></a> <a href='$url&pg=$pages'>>></a>" if ($pg < $pages);
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};
if ($orderby eq 'size' or $orderby eq 'date') {
($sortdown)?($da <=> $db):($db <=> $da) #compare
}
else {
($sortdown)?($da cmp $db):($db cmp $da)
}
} @$list_file;
return $sorted;
}
sub _safe_file {
#------------------------------------------------------------------------
# Check a file make sure it safe
#
my ($self, $file, $options) = @_;
my $root = $self->{cfg}->{root_dir};
my $work = $self->{work_path} ;
unless ($file =~ m,^([-\w/. ]+)$, and $file !~ /(\.\.)+/) {
return -1;
}
my $fullfile = $root . ($work ? '/' : '') . $work . '/' . $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}">
</form>
<ul>
!;
print '<pre>' if (not $content_type =~ m/htm/);
}
else {
print $self->{in}->header({ '-force' => 1,
'-type' => $content_type,
'-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};
return ($work) ? "$root/$work" : $root if (!$dir);
unless ($dir =~ m,^([-\w/. ]+)$, and $dir !~ /(\.\.)+/) {
return -1;
}
my $fulldir;
($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 subdir {
#------------------------------------------------------------------------
# list subdir
#
my ($excepted_ln,$flag, $name, $stack, $callback) = @_;
if (!$callback) {
($flag)? push @$stack,{ name => '' , parent => $name}
: push @$stack,$name;
}
if (-d $name) {
opendir (DIR, $name) or warn sprintf($LANGUAGE{ERR_READ_DIR},$name,$!);
my $files;
@$files = readdir(DIR);
closedir (DIR);
foreach my $file (@$files) {
next if ($file eq '.');
next if ($file eq '..');
next if ($excepted_ln and -l "$name/$file");
($flag)? push @$stack, {name => $file, parent => $name}
: push @$stack,"$name/$file";
if (-d "$name/$file") {
subdir($excepted_ln,$flag,"$name/$file",$stack,1);
}
}
}
return $stack;
}
sub _load_progress_bar {
#---------------------------------------------------
# Load progress bar
#
my ($copied,$s,$total_size) = @_;
my ($px_bytes,$pxs,$percent);
require Math::BigFloat;
$px_bytes = int($total_size/500);
$percent = (($copied + $s)*100)/$total_size if ($total_size>0);
$pxs = int((500*$percent)/100);
my $f = new Math::BigFloat $percent;
$percent = $f->fround(2)*1;
$percent = 100 if ($percent > 100);
return {pxs => $pxs, percent => $percent};
}
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'} if (!$ext);
foreach (keys %{$ICONS}) {
next if (/folder/);
next if (/unknown/);
next if (/parent/);
($_ =~ /$ext/i) and return { icon => $ICONS->{$_}[0],type => $ICONS->{$_}[1]};
}
return {icon => 'unknown.gif', type => 'unknown'};
}
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 _space_used {
#----------------------------------------------------------
# Load space used of directory
#
my $file = shift;
my $total_size = 0 ;
my $files = subdir(1,0, $file);
foreach (@$files) {
$total_size += -s $_;
}
return $total_size;
}
sub _make_date_string ($) {
#------------------------------------------------------------
# format day
#
my $date = shift;
my @lt = localtime($date);
my @month = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my @day = qw/ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31/;
my @weekday = qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
return "$day[$lt[3]]-$month[$lt[4]]-".($lt[5]+1900)." ".sprintf("%02d:%02d",@lt[2,1,0]);
}
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 $name = shift;
my ($output);
$name =~ s/^\s+//;
$name =~ s/\s+$//;
my @name = split / /, $name;
if (!$name) { $output = "<font color=red><b>Please provide a valid name.</b></font>"; }
elsif ($#name > 0) { $output = "<font color=red><b>Spaces are not allowed in name.</b>"; }
return $output;
}
1;