";
$_->{isdir}= '1';
$_->{type} = 'File Folder';
$_->{size} = '';
$_->{date} = _get_date($_->{date});
$_->{perm} = _print_permissions($_->{perm});
}
foreach (@$list_file) {
my $spec = _get_icon($_->{name});
$_->{icon} = "
",
'name' => "Parent Directory",
'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 = "{$_}.'' ;
$temp .= (($_ eq $orderby) ? (($sortdown) ? " 
" : " 
") : '');
$sort_title->{'s'.$_} = $temp;
}
my $msg_readme;
if ($readme) {
$msg_readme = "Readme File:";
open (DATA, "<$real_work_path/$readme") or return $self->cmd_main_display({reload => 1, status => "$!"});
$count = 0;
while () {
chomp;
next if ( $_ =~ /^\#/ or !$_);
$msg_readme .= (($msg_readme)? "
":"").$_;
$count++;
last if ($count == 10);
}
close DATA;
$msg_readme .= "
$font $prompt $cmd
!;
eval {
$pid = open (TMP, "$cmd |");
$oldfh = select(TMP); $| = 1; select($oldfh);
while(){
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 " ";
}
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!
$font
$prompt $cmd
$output
$errors!; } } END_OF_SUB $COMPILE{cmd_upload} = __LINE__ . <<'END_OF_SUB'; sub cmd_upload { # ----------------------------------------------------- # upload a files # my ($self, $data) = @_; # $ENV{'PATH'} = ''; #for taint mode warning $data ||= $self->{in}->param('txt_input'); my $work_path = $self->{work_path}; my $path = $self->{cfg}->{root_dir}.(($work_path)? "/$work_path" : ''); if (!-w $path) { # Current directory does not writeable my $msg = sprintf($LANGUAGE{ERR_FILE_PEM},($work_path) ? $work_path : 'Root'); ($self->{in}->param('txt_input')) ? return $self->cmd_main_display({ reload => 1 , status => $msg }) : return (0, $msg); } my $free_space = 0; if ($self->{cfg}->{allowed_space} > 0) { my $disk_space = $self->_checkspace($self->{cfg}->{root_dir}); $free_space = $disk_space->{free_space}; } my $filename = $data; my $mode = $self->{cgi}->{type}; $filename =~ s/.*?([^\\\/:]+)$/$1/; $filename =~ s/[\[\]\s\$\#\%'"]/\_/g; # Change the name if needed if ($self->{cgi}->{name} eq 'uppercase') { $filename =~ s/(\w+)/\U$1/gi; } elsif ($self->{cgi}->{name} eq 'lowercase') { $filename =~ s/(\w+)/\L$1/gi; } # Get the full file name and save the file. my ($bytesread, $buffer, $fullfile, $file_size); my $file = $self->_safe_file ($filename, { fullfile => 1, exist => 1, write => 1}); return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $filename)}) if ($file == -1); # not safe $fullfile = $file->{file}; if (!$self->{cfg}->{winnt}) { $fullfile =~ m,^([\/\w.-]+)$,; $fullfile = $1; #untainted } if (!$self->{in}->param('txt_input')) { #multi upload return (0, sprintf($LANGUAGE{ERR_FILE_EXISTS}, $filename)) if ($file->{exist} and !$self->{cgi}->{overwrite}); return (0, sprintf($LANGUAGE{ERR_FILE_PEM}, $filename)) if ($file->{exist} and !$file->{write} and $self->{cgi}->{overwrite}); } else { return $self->cmd_main_display({ reload => 1 , status =>sprintf($LANGUAGE{ERR_FILE_EXISTS}, $filename)}) if ($file->{exist} and !$self->{cgi}->{overwrite}); return $self->cmd_main_display({ reload => 1 , status =>sprintf($LANGUAGE{ERR_FILE_PEM}, $filename)}) if ($file->{exist} and !$file->{write} and $self->{cgi}->{overwrite}); } $file_size = 0; open (OUTFILE, ">$fullfile") ; binmode (OUTFILE); while ($bytesread=read($data,$buffer,1024)) { if ($mode eq 'ascii') { $buffer =~ s,\r\n,\n,g; } print OUTFILE $buffer; $file_size += 1024; if ($self->{cfg}->{allowed_space} > 0) { if (($file_size / 1024) > $free_space) { close OUTFILE; unlink ($fullfile); ($self->{in}->param('txt_input')) ? return $self->cmd_main_display({ reload => '1', status => $LANGUAGE{ERR_FREE_SPC}}) : return (0,$LANGUAGE{ERR_FREE_SPC}); } } } close OUTFILE; if ($mode eq 'auto') { if (-T $fullfile) { open (FILE, "< $fullfile") or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile, "$!"); read (FILE, my $data, -s FILE); close FILE; $data =~ s,\r\n,\n,g; open (FILE, "> $fullfile") or die sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile, "$!"); print FILE $data; close FILE; $mode = 'ascii/text'; } } # Change mode if ($self->{cfg}->{upload_chmod}) { my $octal_perm = oct($self->{cfg}->{upload_chmod}); # Permissions have to be in octal chmod($octal_perm, $fullfile) if $octal_perm; # 0 _probably_ means not octal, because 0 is an odd permission to use } my $status; if (-s $fullfile == 0) { unlink ($fullfile); $status = sprintf($LANGUAGE{ERR_UPLOAD}, $filename, "File is 0 bytes."); } else { $status = sprintf($LANGUAGE{UPLOAD_MODE},$filename,$mode); } $self->cmd_main_display({ reload=>1 , status => $status}) if ($self->{in}->param('txt_input')); if (-e $fullfile || -s $fullfile != 0) { if ( $self->{cfg}->{multi} ) { #save log info my $from = $fullfile; $from =~ s/$path\///; $self->history("cmd_upload|$from|$path"); } return (1, $status); } else { return (0, $status); } } END_OF_SUB $COMPILE{cmd_mul_upload} = __LINE__ . <<'END_OF_SUB'; sub cmd_mul_upload { # ----------------------------------------------------- # upload nulti files # my $self = shift; my $count = 0; my $msg = ''; for my $i(1..10) { my $data = $self->{in}->param('file'.$i); next if (!$data); my ($result, $status) = $self->cmd_upload ($data); $result ? $count++ : ($msg .= $status . '
'); } $self->{cgi}->{cmd_do} = 'cmd_upload'; $self->cmd_main_display ( { reload => 1 , status => $count ? sprintf($LANGUAGE{MSG_MULTI_UPLOAD},$count) : $msg } ); } END_OF_SUB $COMPILE{cmd_editor} = __LINE__ . <<'END_OF_SUB'; sub cmd_editor { #------------------------------------------------------------- # Editor a text file # my $self = shift; my $url_opts = $self->{url_opts} || ''; my $filename = $self->{cgi}->{filename} || ''; my $work_path= $self->{work_path} || ''; my $root_path= $self->{cfg}->{root_dir}; my $data = $self->{cgi}->{content} || ''; my $fullfile; # Store number of rows and cols for TEXTAREA object into cookie if ($self->{cgi}->{resize}) { my $rows = $self->{cgi}->{rows} || 20; my $cols = $self->{cgi}->{cols} || 100; $rows = 20 if ($rows > 50); $cols = 100 if ($cols > 200); print $self->{in}->header( -cookie => [ $self->{in}->cookie( -name => 'cols', -value => $cols), $self->{in}->cookie( -name => 'rows', -value => $rows) ] ); my $size = 0; if ($filename) { my $file = $self->_safe_file($filename,{ size => 1}); $size = $file->{size}; } my $status = sprintf($LANGUAGE{MSG_FILE_EDITING}, 'Editing ', $filename, $size, $filename); return $self->cmd_show({ content => $self->{in}->html_escape($data), rows => $rows, cols => $cols, status => $status, use_html => 0, old => ($self->{cgi}->{filename})? 1 : 0 }); } # Switch to HTML or TEXT layout elsif ($self->{cgi}->{switch_edit}) { my $switch = ($self->{cgi}->{use_html}) ? 0 : 1; my $filename = $self->{cgi}->{filename}; if ($filename) { my $file = $self->_safe_file($filename,{ write => 1, text => 1, fullfile => 1, size => 1, isfile => 1}); return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_INVALID}, $filename)}) if ($file == -1); # not safe return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_NOT_FILE}, $filename)}) if (!$file->{isfile}); # not a file my $status = sprintf($LANGUAGE{MSG_FILE_EDITING},'Editing ', $filename, $file->{size}, $filename); return $self->cmd_show({ use_html => $switch, filename => ($filename =~ m,^/,) ? '' : $filename, old => ($filename =~ m,^/,) ? 0 : 1, use_html => $switch, writeable=> $file->{write} }); } else { return $self->cmd_show({ use_html => $switch }); } } # Save the contents ($self->{cgi}->{save}) ? ($filename = $self->{cgi}->{filename}) : ($filename = $self->{cgi}->{filenew}); my $old = $self->{cgi}->{fileold}; my $msg = $self->_valid_name_check($filename); return $self->cmd_show({msg => $msg, old => $old, use_html => $self->{cgi}->{use_html}}) if ($msg); $self->{cgi}->{content} = $self->{in}->html_escape($data); my $file = $self->_safe_file($filename, { fullfile => 1, exist => 1}); return $self->cmd_show({msg => sprintf($LANGUAGE{ERR_INVALID}, $filename), old => $old}) if ($file == -1); # not safe $fullfile = $file->{file}; if (($file->{exist}) and (!$old or $filename eq $self->{cgi}->{filenew})) { #file already exists my $tempfile = new GT::TempFile; open (FILE, "> $$tempfile.tmp") or return $self->cmd_show({ msg => $LANGUAGE{ERR_TMP_FILE}, old => $old}); print FILE $data; close FILE; return $self->page('file_editor_confirm.html', { filename => $filename, tmp_file => "$$tempfile.tmp"}); } $self->editor_process($filename,$data); } END_OF_SUB $COMPILE{editor_process} = __LINE__ . <<'END_OF_SUB'; sub editor_process { #------------------------------------------------------- # Save the contents to a file # my ($self, $filename, $contents) = @_; if (!$filename) { $filename = $self->{cgi}->{filename}; my $tmp_file ||= $self->{cgi}->{tmp_file}; open (DATA,"<$tmp_file") or return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{ERR_TMP_FILE}, error => 1 }); read (DATA, $contents, -s DATA); close DATA; } my $file = $self->_safe_file($filename,{ fullfile => 1}); my $old = $self->{cgi}->{fileold}; if ($file == -1) { $self->{cgi}->{content} = $self->{in}->html_escape($contents); return $self->cmd_show({msg => sprintf($LANGUAGE{ERR_INVALID}, $filename), old => $old, error => 1 }); # not safe } my $fullfile = $file->{file}; open(FILE,">$fullfile") or return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_FILE_OPEN}, $filename), old => $old, error => 1 }); # Strip windows linefeeds. $contents =~ s,\r\n,\n,g; print FILE $contents; close(FILE); if (-e $fullfile) { $self->history("cmd_edit|$fullfile") if ( $self->{cfg}->{multi} ); #save log info" $self->{cgi}->{cmd_do} = 'cmd_command'; my $status = (!$old) ? sprintf($LANGUAGE{MSG_FILE_CREATED}, $filename) : sprintf($LANGUAGE{MSG_FILE_EDITED}, $filename); return $self->cmd_main_display({ reload => '1', status => $status}); } return $self->cmd_show({ msg => sprintf($LANGUAGE{ERR_FILE_SAVE}, $filename)}); } END_OF_SUB $COMPILE{cmd_makedir} = __LINE__ . <<'END_OF_SUB'; sub cmd_makedir { #----------------------------------------------- # Make directory # my $self = shift; # Get the full path. my $new = $self->{cgi}->{txt_input}; my $msg = $self->_valid_name_check($new); return $self->cmd_main_display({ reload => '1', status => $msg}) if ($msg); my $work_path = $self->{work_path} || ''; my $fulldir = $self->_safe_dir($new, { exist => 1 } ); return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID}, $new)}) if $fulldir == -1; if ($fulldir->{exist}) { return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_DIR_EXISTS}, $new)}); } else { my ($name) = $fulldir->{fulldir} =~ /\/([^\/]+)$/; (my $path = $fulldir->{fulldir}) =~ s,/$name$,,; return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $self->{cgi}->{txt_input}) }) if (!-e $path); return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_DIR_PEM}, $self->{cgi}->{txt_input}) }) if (!-w $path); #permission } if (rmkdir ($fulldir->{fulldir}, 0755)) { $self->history("cmd_makedir|$fulldir->{fulldir}") if ( $self->{cfg}->{multi} ); #save log info return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{MSG_DIR_CREATED}, $new) }); } return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_DIR_PEM},($new =~ m,^/,) ? $new : ($work_path || 'Root'))}); } END_OF_SUB $COMPILE{cmd_preferences} = __LINE__ . <<'END_OF_SUB'; sub cmd_preferences { #--------------------------------------------------- # Save options of system # my $self = shift; ($self->{cgi}->{save}) or return $self->cmd_main_display(); my $def_sort = $self->{cgi}->{def_sort} || 'Name'; my $def_working_dir = $self->{cgi}->{def_working_dir} || '/'; my $def_passwd_dir = $self->{cgi}->{def_passwd_dir}; my $def_files_page = $self->{cgi}->{def_files_page} || (($self->{cgi}->{showall})? 'all': 25); my $def_pages_screen= $self->{cgi}->{def_pages_screen} || (($self->{cgi}->{showall})? 'all': 20); my $hidden_file = $self->{cgi}->{hidden_file} || '0'; my $editor_mode = $self->{cgi}->{editor_mode} || '0'; my $scheme = $self->{cgi}->{scheme} || 'fileman'; my $font = $self->{cgi}->{font} || ""; my $readme_position = $self->{cgi}->{readme_position}; ($font =~ /^$/) or $font = ""; $def_files_page = 25 if ($def_files_page > 100); $def_pages_screen = 20 if ($def_pages_screen > 50); $def_working_dir =~ s/$GT::FileMan::UNSAFE_PATH//g; $def_passwd_dir =~ s/$GT::FileMan::UNSAFE_PATH//g; $def_passwd_dir = "$self->{cfg}->{root_dir}/$def_passwd_dir" if ($def_passwd_dir and !$self->{cfg}->{passwd_dir_level}); $def_passwd_dir ||= '0'; if ($def_passwd_dir and (!-e $def_passwd_dir or !-w _)) { $self->{cgi}->{page} = 'preferences.html'; (-e _) or return $self->cmd_show( {msg => sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $def_passwd_dir)} ); (-w _) or return $self->cmd_show( {msg => sprintf($LANGUAGE{ERR_DIR_PEM}, $def_passwd_dir)} ); } print $self->{in}->header ( -cookie => [ $self->{in}->cookie ( -name => 'def_sort', -value => $def_sort, -expires => '+5y'), $self->{in}->cookie ( -name => 'def_passwd_dir', -value => $def_passwd_dir, -expires => '+5y'), $self->{in}->cookie ( -name => 'def_working_dir', -value => $def_working_dir, -expires => '+5y'), $self->{in}->cookie ( -name => 'def_files_page', -value => $def_files_page, -expires => '+5y'), $self->{in}->cookie ( -name => 'def_pages_screen',-value => $def_pages_screen, -expires => '+5y'), $self->{in}->cookie ( -name => 'readme_position', -value => $readme_position, -expires => '+5y'), $self->{in}->cookie ( -name => 'hidden_file' , -value => $hidden_file, -expires => '+5y'), $self->{in}->cookie ( -name => 'scheme' , -value => $scheme, -expires => '+5y'), $self->{in}->cookie ( -name => 'font' , -value => $font, -expires => '+5y'), $self->{in}->cookie ( -name => 'editor_mode' , -value => $editor_mode, -expires => '+5y'), ] ); $self->{cgi}->{cmd_do} = 'cmd_command'; return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_PREFERENCES}, re_scheme => 1 }); } END_OF_SUB $COMPILE{user_form} = __LINE__ . <<'END_OF_SUB'; sub user_form { #--------------------------------------------------- # Save options of system # my ($self, $msg) = @_; ($self->{cfg}->{multi} or $self->{cfg}->{single}) or die $LANGUAGE{ERR_VERSION}; $self->page('user_form.html', { msg => $msg}); } END_OF_SUB $COMPILE{cmd_admin} = __LINE__ . <<'END_OF_SUB'; sub cmd_admin { #--------------------------------------------------- # Save user password # my $self = shift; ($self->{cfg}->{multi} or $self->{cfg}->{single}) or die $LANGUAGE{ERR_VERSION}; ($self->{cfg}->{single}) and return $self->pwd_single(); my $username = $self->{cgi}->{Username}; my $old_pass = $self->{cgi}->{Old_Password}; my $new_pass = $self->{cgi}->{New_Password}; my $db_name = $self->{cfg}->{db_name}; return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}) if (!$old_pass); return $self->user_form($LANGUAGE{ERR_NEW_PASSWORD}) if (!$new_pass or length($new_pass) < 3); open (DATA, "<$self->{cfg}->{priv_path}/$db_name") or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN},$db_name, "$!")},1); flock(DATA, 1); my @lines = ; close DATA; my $found; # check username and password LINE: foreach (@lines) { if ($_ =~ /^$/) { next LINE; } if ($_ =~ /^#/) { next LINE; } chomp ($_); $_ =~ s/\r//g; # Remove Windows linefeed character. my @record = split (/\Q|\E/o, $_); if (($record[1] ne $username) or ($record[2] ne crypt($old_pass,$old_pass))) { next LINE;} $found = 1; last; } ($found) or return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}); # Save user information my $rows; LINE: foreach (@lines) { if ($_ =~ /^$/) { next LINE; } if ($_ =~ /^#/) { next LINE; } chomp ($_); $_ =~ s/\r//g; # Remove Windows linefeed character. my @record = split (/\Q|\E/o, $_); if ($username eq $record[1]) { # replace user information $record[2] = crypt($new_pass,$new_pass); $rows .= join("|",@record); } else { $rows .= $_; } $rows .= "\n"; } open (NEW, ">$self->{cfg}->{priv_path}/$db_name") or return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_FILE_OPEN},$db_name, "$!")}, 1); flock(NEW, 2); print NEW $rows; close NEW; return $self->cmd_main_display({reload => 1, status => $LANGUAGE{MSG_PWD_CHANGED}},1); } END_OF_SUB sub pwd_single () { #------------------------------------------------------ # Change password in single version # my $self = shift; ($self->{cfg}->{single}) or die $LANGUAGE{ERR_VERSION}; my $fn = "$self->{cfg}->{priv_path}/lib/ConfigData.pm"; (-e $fn) or return $self->user_form(sprintf($LANGUAGE{ERR_OPEN_FILE},'ConfigData.pm',$!)); (-w _) or return $self->user_form(sprintf($LANGUAGE{ERR_WRITEABLE},'ConfigData.pm',$!)); my $old = $self->{cgi}->{Old_Password}; my $new = $self->{cgi}->{New_Password}; return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}) if (!$old); return $self->user_form($LANGUAGE{ERR_NEW_PASSWORD}) if (!$new and length($new) < 3); return $self->user_form($LANGUAGE{ERR_OLD_PASSWORD}) if (crypt($old,$self->{cfg}->{password}) ne $self->{cfg}->{password}); # Encrypt password my @salt_chars = ('A' .. 'Z', 0 .. 9, 'a' .. 'z', '.', '/'); my $salt = join '', @salt_chars[rand 64, rand 64]; $self->{cfg}->{password} = crypt($new, $salt); my $time = localtime; open (FH, "> $fn") or return $self->user_form(sprintf($LANGUAGE{ERR_OPEN_FILE},'ConfigData.pm',$!)); print FH <
!;
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 ;
seek FILE, 0, 2;
last if ($cnt++ > 60); # Only run for one min max.
}
}
print " ";
}
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!
{cfg}->{html_root_url}/$css_file.css>
';
}
END_OF_SUB
$COMPILE{cmd_diff} = __LINE__ . <<'END_OF_SUB';
sub cmd_diff {
#----------------------------------------------------
# Show difference between two files
#
my $self = shift;
my $filename1 = $self->{cgi}->{c_edit};
my $filename2 = $self->{cgi}->{txt_input};
my $file1 = $self->_safe_file($filename1, { fullfile => 1, text => 1, exist => 1 });
my $file2 = $self->_safe_file($filename2, { fullfile => 1, text => 1, exist => 1 });
($file1 == -1) and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID}, $filename1) });
($file2 == -1) and return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_INVALID}, $filename2) });
my $work_path = $self->{work_path} || '';
my $fullfile1 = $file1->{file};
my $fullfile2 = $file2->{file};
return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS}, $filename2) }) if (!$file2->{exist});
return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_TEXT_FILE} , $filename1) }) if (!$file1->{text});
return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_NOT_TEXT_FILE} , $filename2) }) if (!$file2->{text});
require GT::FileMan::Diff;
my $diff = GT::FileMan::Diff::html_diff($fullfile1, $fullfile2, 3);
if (!ref $diff) {
$diff == 1 ? return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile1, "$!") })
: return $self->cmd_main_display({ reload => '1', status => sprintf($LANGUAGE{ERR_FILE_OPEN}, $fullfile1, "$!") });
}
my $back_btn = ($self->{cgi}->{hide_back_button}) ? '' : "";
print $self->{in}->header;
my $css_file = $self->{in}->cookie('scheme') || 'fileman';
print qq!
{cfg}->{html_root_url}/$css_file.css>
!;
}
END_OF_SUB
$COMPILE{cmd_tar} = __LINE__ . <<'END_OF_SUB';
sub cmd_tar {
#----------------------------------------------------
# Create tar file
#
my ($self, $fn, $error) = @_;
if ($fn) {
return $self->_zip_information($fn, $error) if ($fn =~ /.zip$/i and $GT::FileMan::HAVE_AZIP);
return $self->_tar_information($fn, $error) if ($fn =~ /.gz$/i and $GT::FileMan::HAVE_GZIP);
return $self->_tar_information($fn, $error) if ($fn =~ /.tar$/i); # .tar file
}
my $input = $self->{cgi}->{txt_input};
my $zip_type = $self->{cgi}->{opt_gz};
my $from_path = $self->_safe_dir();
my $fulldir = $self->_safe_dir($input);
($fulldir == -1) and return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $input) }); # not safe
my $fullfile = $fulldir->{fulldir};
my $path = [split /\//,$fullfile];
my $tar_file = @$path[$#$path];
my $to_path = $fullfile;
$to_path =~ s/\/@$path[$#$path]//; #path to save tar file
return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_TAR_NOT_EXISTS}, $input)}) if (!-e $to_path); # check exists the directory
return $self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{ERR_TAR_PEM}, $input)}) if (!-w $to_path); # check permission on this directory
if ($zip_type == 1) { # create a .tar.gz file
$tar_file .= '.gz' if ($tar_file =~ m/.tar$/i);
$tar_file .= '.tar.gz' if ($tar_file !~ m/.tar.gz$/i);
}
elsif ($zip_type == 2) { # create a .zip file
$tar_file .= '.zip' if ($tar_file !~ /.zip$/i);
}
else { # create a .tar file
$tar_file .= '.tar' if ($tar_file !~ /.tar$/i);
}
# Check required modules
my $err_check = _tar_check($tar_file);
return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{ERR_NO_GZIP} }) if ($err_check); # check permission on this directory
$fullfile = "$to_path/$tar_file";
if (!$self->{cgi}->{confirm}) {
if (-e $fullfile) {
my $results;
my $files = [$self->{in}->param('c_edit')];
foreach my $file (@$files) {
push @$results, { name => $file };
}
return $self->page('tar_confirm.html', { results => $results, file => $tar_file });
}
}
if ( $zip_type == 2 ) {
my $error = $self->_zip_process($fullfile, [$self->{in}->param('c_edit')]);
return $self->cmd_main_display({ reload => 1, status => $error }) if ($error);
}
else {
$self->_tar_process($fullfile);
}
$self->{cgi}->{cmd_do} = 'cmd_tar';
$self->history($fullfile) if ( $self->{cfg}->{multi} ); #save log info
$self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{MSG_TAR_CREATED}, $tar_file) });
}
END_OF_SUB
$COMPILE{cmd_uncompress} = __LINE__ . <<'END_OF_SUB';
sub cmd_uncompress {
#--------------------------------------------------------
# Uncompress .tar or .gz file
#
my $self = shift;
my $root_path = $self->{cfg}->{root_dir};
my $work_path = $self->{work_path};
my $input = $self->{cgi}->{txt_input};
my $fullfile = $self->_safe_file($self->{cgi}->{cmp_file}, {fullfile => 1, exist => 1});
my $selected = [$self->{in}->param('c_edit')];
my $untar_pg = $self->{cgi}->{uncomp_option};
return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_INVALID}, $self->{cgi}->{cmp_file}) }) if ($fullfile == -1);
return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_FILE_NOT_EXISTS}, $self->{cgi}->{cmp_file}) }) unless ($fullfile->{exist});
# Check required modules
my $error = _tar_check($fullfile->{file});
return $self->cmd_main_display({ reload => 1, status => $error }) if ($error);
my $cmp_file = $fullfile->{file};
return $self->cmd_tar($self->{cgi}->{cmp_file}, $LANGUAGE{ERR_UNCOMPRESS}) if ($#$selected == -1);
# Check the directory is exists, permission
my $fulldir = $self->_safe_dir($input, { exist => 1, write => 1 });
return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_INVALID}, $input || $work_path)) if ($fulldir == -1); # not safe
return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_DIR_NOT_EXISTS}, $input || $work_path || 'Root')) if (ref $fulldir eq 'HASH' and !$fulldir->{exist});
return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_DIR_PEM} , $input || $work_path || 'Root')) if (ref $fulldir eq 'HASH' and !$fulldir->{write});
# Get file size
my $full_path = (ref $fulldir eq 'HASH') ? $fulldir->{fulldir} : $fulldir;
my $total_size = _tar_size($cmp_file);
# Check free space and writeable
if ($self->{cfg}->{allowed_space} > 0) {
my $disk_space = $self->_checkspace($full_path);
my $free_space = $disk_space->{free_space};
return $self->cmd_tar($self->{cgi}->{cmp_file}, sprintf($LANGUAGE{ERR_DISK_SPACE}, $free_space)) if ($total_size > $free_space * 1024);
}
my $filename = $cmp_file;
$filename =~ s/$full_path\///;
$self->page('progress_bar.html', { bar_name => "Un-tarring:", msg => sprintf($LANGUAGE{MSG_READING}, $filename) });
my ($last_width, $max_width, $copied) = (-1, 500, 0);
if ($filename =~ /.zip$/i) {
my $zip = Archive::Zip->new($cmp_file) or return $self->cmd_tar($self->{cgi}->{cmp_file}, $!);
foreach ($zip->members) {
my $name = $_->fileName;
my $found = $untar_pg ? 0 : 1;
if ($untar_pg) {
foreach my $f (@$selected) {
if ($f eq $name) {
$found = 1;
last;
}
}
}
$copied += $_->uncompressedSize;
if ($found) {
$zip->extractMember($name, "$full_path/$name");
}
my $percent = 1 - ($total_size - $copied) / $total_size;
my $img_width= int($max_width * $percent);
my $wpercent = sprintf '%.f%%', 100 * $percent;
if ($img_width != $last_width) {
$self->page('copy_status.html', {
msg => "$name file...".(( $found ) ? 'ok' : 'skip'),
pxs => $img_width,
percent => $wpercent
});
$last_width = $img_width;
}
}
}
else { # Make sure tar file goes out of scope before loading directory.
require GT::Tar;
my $tar = GT::Tar->open ($cmp_file);
my $files = $tar->files;
foreach (@$files) {
my $name = $_->{name};
my $found = $untar_pg ? 0 : 1;
if ($untar_pg) {
foreach my $f (@$selected) {
if ($f eq $_->{name}) {
$found = 1;
last;
}
}
}
$copied += $_->{size};
if ($found) {
$_->{name} = "$full_path/$name";
$_->write();
}
my $percent = 1 - ($total_size - $copied) / $total_size;
my $img_width= int($max_width * $percent);
my $wpercent = sprintf '%.f%%', 100 * $percent;
if ($img_width != $last_width) {
$self->page('copy_status.html', {
msg => "$name file...".(( $found ) ? 'ok' : 'skip'),
pxs => $img_width,
percent => $wpercent
});
$last_width = $img_width;
}
}
}
$self->history("cmd_untar|$filename|$full_path") if ($self->{cfg}->{multi}); #save log info
$self->{cgi}->{cmd_do} = 'cmd_tar';
$filename =~ s,$root_path/,,;
$self->cmd_main_display({reload => 1, status => sprintf($LANGUAGE{MSG_UNCOMPRESS}, $filename)});
}
END_OF_SUB
$COMPILE{cmd_show_passwd} = __LINE__ . <<'END_OF_SUB';
sub cmd_show_passwd {
my ($self, $msg) = @_;
$self->cmd_main_display({ msg => $msg, show_passwd => 1 });
}
END_OF_SUB
$COMPILE{cmd_passwd} = __LINE__ . <<'END_OF_SUB';
sub cmd_passwd {
# ------------------------------------------------------------------
# Save username and password
#
my $self = shift;
my $pass_path = $self->{in}->cookie('def_passwd_dir');
my $work_path = $self->{work_path} || '';
my $url_opts = $self->{url_opts} || '';
my $htpasswd;
if ($pass_path) { # create .htaccess and .htpasswd in Password directory
my $file_name = $self->_safe_dir();
$file_name =~ s/[\/ \:]/\_/g;
$htpasswd = "$pass_path/.htpass$file_name";
if (!-e $htpasswd) {
open (FILE, "> $htpasswd");
close FILE;
}
}
else {
my $fpasswd = $self->_safe_file(".htpasswd", { fullfile => 1, exist => 1, size => 1});
$htpasswd = $fpasswd->{file};
if (!$fpasswd->{exist}) {
open (FILE, "> $htpasswd");
close FILE;
}
}
my $faccess = $self->_safe_file(".htaccess", { fullfile => 1, exist => 1, size => 1});
my $htaccess = $faccess->{file};
if (!$faccess->{exist}) {
open (FILE, "> $htaccess");
close FILE;
}
unless (-w $htaccess and -w $htpasswd) { #check writeable
print $self->{in}->header;
print sprintf($LANGUAGE{ERR_FILE_PERM},$htaccess,$htpasswd),'', 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 =
!; print $self->_environment(); } END_OF_SUB sub history { #--------------------------------------------------------------------- # Save the history # my ($self,$content) = @_; return if (!$content); my $priv_path = $self->{cfg}->{priv_path}; my $db_name = 'fileman_history.db'; $content = $self->{cfg}->{username} . '|' . $ENV{'REMOTE_ADDR'} . '|' . time . "|$content\n"; open (DATA,">>$priv_path/$db_name") or die sprintf($LANGUAGE{ERR_OPEN_FILE}, $db_name, $!); flock(DATA, 2); print DATA $content; close DATA; } sub _environment { # -------------------------------------------------------------------- # Return HTML formatted environment for error messages. # my $self = shift; my $info = '
';
# Print GT::SQL error if it exists.
$info .= "System Information\n======================================\n";
$info .= "Perl Version: $]\n";
$info .= "FileMan Version: $self->{cfg}->{version}" if ($self->{cfg}->{version});
$info .= "\n";
my $cmds = $self->{commands};
foreach (keys %$cmds) {
$info .= $_."\t:";
$info .= ($cmds->{$_})?('enabled'):('disabled');
$info .= "\n";
}
$info .= "Persistant Env: mod_perl (" . (MOD_PERL ? 1 : 0) . ") SpeedyCGI (" . (SPEEDY ? 1 : 0) . ")\n";
$info .= "Mod Perl Version: " . MOD_PERL . "\n" if MOD_PERL;
$info .= "\@INC = \n\t" . join ("\n\t", @INC) . "\n";
$info .= "\$\@: $@\n" if ($@);
$info .= "\n";
# CGI Parameters and Cookies.
if (ref $self->{in} eq 'GT::CGI') {
if ($self->{in}->param) {
$info .= "CGI INPUT\n======================================\n";
foreach (sort $self->{in}->param) { $info .= "$_ => " . $self->{in}->param($_) . "\n"; }
$info .= "\n\n";
}
if ($self->{in}->cookie) {
$info .= "CGI Cookies\n======================================\n";
foreach (sort $self->{in}->cookie) { $info .= "$_ => " . $self->{in}->cookie($_) . "\n"; }
$info .= "\n\n";
}
}
# Environement info.
$info .= "ENVIRONMENT\n======================================\n";
foreach (sort keys %ENV) { $info .= "$_ => $ENV{$_}\n"; }
$info .= "";
return $info;
}
sub _zip_information {
#----------------------------------------------------------------------
# Show the information about a zip file
#
my ($self, $filename, $status) = @_;
my $fullfile = $self->_safe_file($filename, { fullfile => 1, exist => 1, size => 1 });
my $zip = new Archive::Zip($fullfile->{file}) or return $self->cmd_main_display({reload => 0, status => $!});
my $cmp_file = $fullfile->{file};
my $stat = [stat($cmp_file)];
my $hits = $zip->members + 1;
my $pg = $self->{cgi}->{pg} || 1;
my $mh = $self->{in}->cookie('def_files_page') || 25;
my $start= ($pg == 1) ? 1 : (($pg - 1) * $mh + 1);
my @results;
my $total_size = $fullfile->{size};
my $skip = 0;
if ( $hits > 0 ) {
foreach ( $zip->members ) {
$skip++;
next if ($skip < $start);
my $s = $_->compressedSize;
my $icon = _get_icon($_->fileName);
push @results, {
icon => "![](".$html_url."/icons/folder.gif){kind=icon}
";
$hash->{type} = 'Folder';
$hash->{isdir}= '1';
$hash->{size} = 0;
}
else {
my $spec = _get_icon($fullfile);
$hash->{name} = $name;
$hash->{icon} = "
";
my $next_grey = "
";
my $prev = "
";
my $prev_grey = "
";
my $first = "
";
my $first_grey= "
";
my $last = "
";
my $last_grey = "
";
my ($speed_bar, $pg_step, $start, $jj);
if ( $scre_pg > 0 ) {
$pg_step = ($pg % $scre_pg > 0) ? int($pg / $scre_pg) + 1 : ($pg / $scre_pg);
}
$start = 1;
if ($pages > $scre_pg) {
$start = ($pg == $pages) ? ($pg - $scre_pg) + 1 : (($pg_step - 1) * $scre_pg)+1;
$start = ($pages - $start + 1 < $scre_pg) ? $start - ($scre_pg - ($pages - $start + 1)) : $start;
}
$speed_bar = ($pg > 1) ? "$first $prev " : "$first_grey $prev_grey ";
$speed_bar .= ($pg > $scre_pg)? '...' : '';
for my $ii ( $start .. $pages) {
$jj++;
if ($cur_pg eq 'all') {
$speed_bar .= "$ii "
}
else {
$speed_bar .= ($cur_pg == $ii)? "$ii " : "$ii ";
}
if ($jj == $scre_pg) {
$speed_bar .= ( ($pg_step * $scre_pg) < $pages) ? "..." : "";
last;
}
}
$speed_bar .= ($pg < $pages) ? "$next $last" : "$next_grey $last_grey";
$speed_bar .= ($cur_pg eq 'all') ? " All " : " All " if ( !$off );
return $speed_bar;
}
sub qsort {
# ------------------------------------------------------------------
my ($self,$list_file,$orderby,$sortdown) = @_;
my $sorted;
@$sorted =
sort {
my $da = lc $a->{$orderby}; #lower case
my $db = lc $b->{$orderby};
my $res;
if ($orderby eq 'size' or $orderby eq 'date') {
$res = $db <=> $da;
}
else {
$res = $db cmp $da;
}
if ($res == 0 and $orderby ne 'name') {
lc $b->{name} cmp lc $a->{name};
}
else {
$res;
}
} @$list_file;
($sortdown) and @$sorted = reverse @$sorted;
return $sorted;
}
sub _zip_process {
#--------------------------------------------------------------
# Create a .zip file
#
my ($self, $to, $files) = @_;
my $from = $self->_safe_dir();
if ($self->{cgi}->{cancel}) { #canceled create tar file
$self->{cgi}->{cmd_do} = 'cmd_tar';
return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_TAR_CANCEL}});
}
my $history = 'cmd_tar|';
require Archive::Zip::Tree;
my $zip = Archive::Zip->new();
my $member;
foreach my $file (@$files) {
if ( -f "$from/$file" ) {
$member = $zip->addFile("$from/$file", $file) or warn "$!";
}
elsif ( -d "$from/$file" ) {
$member = $zip->addTree("$from/$file", $file) or warn "$!";
}
}
return $zip->writeToFileNamed($to) ? "$!" : 0;
}
sub _tar_process {
#--------------------------------------------------------------
# Create tar file
#
my ($self, $to) = @_;
my $from = $self->_safe_dir();
if ($self->{cgi}->{cancel}) { #canceled create tar file
$self->{cgi}->{cmd_do} = 'cmd_tar';
return $self->cmd_main_display({ reload => 1, status => $LANGUAGE{MSG_TAR_CANCEL}});
}
my $input = $self->{cgi}->{txt_input};
my $files = [$self->{in}->param('c_edit')];
my $history = 'cmd_tar|';
# Make sure tar file goes out of scope and cleans up temp files
{
my $tar;
require GT::Tar;
$tar = new GT::Tar($to) or return $self->cmd_main_display({ reload => 1, status => sprintf($LANGUAGE{ERR_TAR},$GT::Tar::error)});
foreach my $file (@$files) {
my $fulldir = $self->_safe_dir($file);
next if ($fulldir == 1);
$tar->add_file($fulldir->{fulldir});
}
my $items = $tar->files;
foreach my $fl (@$items) {
$fl->{name} =~ s/$from\///;
}
$tar->write("$to");
$history .= "|$to";
}
}
sub _safe_file {
#------------------------------------------------------------------------
# Check a file make sure it safe
#
my ($self, $file, $options) = @_;
my $root = $self->{cfg}->{root_dir};
return { file => $root } if ($file eq '/');
return -1 if ($self->{cfg}->{filename_check} and $file !~ m,^([-\w/. ]+)$,);
return -1 if ($file =~ /$GT::FileMan::UNSAFE_PATH/);
# Check if proper work_path (/ stands for root dir, otherwise use current dir)
my $path_to_file = ($file =~ m,^/,) ? $file : "$self->{work_path}/$file";
$path_to_file =~ s,^/,,;
my $fullfile = $root.'/'.$path_to_file;
my ($e, $w, $t, $s, $f);
foreach my $key (keys % $options) {
if ($options->{$key} == 1) {
($key eq 'exist') and $e = -e $fullfile;
($key eq 'write') and $w = -w $fullfile;
($key eq 'text') and $t = -T $fullfile;
($key eq 'size') and $s = -s $fullfile;
($key eq 'isfile') and $f = -f $fullfile;
}
}
return {
file => ($options->{fullfile} == 1) ? $fullfile : $file,
exist => $e,
write => $w,
text => $t,
size => $s,
isfile => $f,
};
}
sub _view_file {
#------------------------------------------------------
# print the content of a file
#
my ($self,$filename) = @_;
my $file = $self->_safe_file($filename,{ fullfile => 1, size => 1});
($file == -1) and return; # not safe
# Load content-type of a image file.
my $fullfile = $file->{file};
my $file_size = $file->{size};
my $content_type = _load_mime($fullfile);
my ($ext) = $fullfile =~ /\.([^.]+)$/;
if(open(DATA, $fullfile)) {
$self->{in}->reset_env();
if ((($content_type =~ m/text/) or -T $fullfile) and (uc($ext) ne 'PDF')) {
my $url_opts = $self->{url_opts} || '';
my $work_path = $self->{work_path} || '';
print $self->{in}->header;
print qq!
-
!;
print '
' if (not $content_type =~ m/htm/);
}
else {
print $self->{in}->header({
'-force' => 1,
'-type' => $content_type,
'-Content-Disposition' => \"filename=$filename",
'-Content-Length' => $file_size,
});
}
($self->{cfg}->{winnt}) and binmode STDOUT;
binmode DATA;
my $buffer;
print $buffer while (read(DATA, $buffer , $READ_SIZE));
close(DATA);
}
}
sub _safe_dir {
#------------------------------------------------------------------------
# Check a directory make sure it safe
#
my ($self, $dir, $options) = @_;
my $root = $self->{cfg}->{root_dir};
my $work = $self->{work_path};
my $fulldir;
unless ($dir) {
return ($work) ? "$root/$work" : $root;
}
elsif ($dir eq '/') {
return $root;
}
return -1 if ($self->{cfg}->{filename_check} and $dir !~ m,^([-\w/. ]+)$,);
return -1 if ($dir =~ /$GT::FileMan::UNSAFE_PATH/);
($dir =~ m,^/,) ? ($fulldir = $root . $dir)
: ($fulldir = $root. ($work ? '/' : '') . $work . '/' . $dir);
my ($e, $d, $w);
foreach my $key (keys % $options) {
if ($options->{$key} == 1) {
$e = -e $fulldir if ($key eq 'exist');
$d = -d $fulldir if ($key eq 'isdir');
$w = -w $fulldir if ($key eq 'write');
}
}
return { fulldir => $fulldir, exist => $e, isdir => $d, write => $w };
}
sub _command_show {
#--------------------------------------------------------------------
# Show path when execute cd command
#
my ($working_dir, $cmd) = @_;
if ($cmd =~ m/^\s*cd\s*\.\./) { # cd ..
my $tmp;
my $parts = [split(/\//, $working_dir)];
return '/' if ($#$parts == 1 or $working_dir eq '/');
foreach my $ii( 0 .. $#$parts) {
$tmp .= '/'.@$parts[$ii] if ($ii < $#$parts and @$parts[$ii]);
}
return $tmp;
}
return $working_dir if ($cmd =~ m/^\s*cd\s*\./); # cd.
my $path = $cmd;
$path =~ s/\s*cd\s*//;
return '/' if ($path =~ m,^(/+)$,);
return ($path =~ m/^\//)? $path : $working_dir.(($working_dir and $working_dir ne '/')? '/' : '').$path;
}
sub _get_icon {
# ------------------------------------------------------------------
# Get the associated icon based on a files extension
#
my ($file) = shift;
my ($ext) = $file =~ /\.([^.]+)$/;
return {icon => 'unknown.gif', type => 'unknown File'} if (!$ext);
foreach (keys %{$ICONS}) {
next if (/folder/);
next if (/unknown/);
next if (/parent/);
($_ =~ /\b\Q$ext\E\b/i) and return { icon => $ICONS->{$_}[0],type => $ICONS->{$_}[1]};
}
return {icon => 'unknown.gif', type => "$ext File"};
}
sub _get_date {
# ------------------------------------------------------------------
my $time = shift;
$time or ($time = time);
my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;
my ($min, $hr, $day, $mon, $yr) = (localtime($time))[1,2,3,4,5];
$yr = $yr + 1900;
($min < 10) and ($min = "0$min");
($hr < 10) and ($hr = "0$hr");
($day < 10) and ($day = "0$day");
return "$day-$months[$mon]-$yr $hr:$min";
}
sub _print_filesize {
# ------------------------------------------------------------------
# Prints out the file size.
#
my $size = shift;
my $formatted_size = 0;
$formatted_size = int($size / 1000) if ($size);
return $formatted_size == 0 ? "$size bytes" : $formatted_size." kb";
}
sub _print_permissions {
# ------------------------------------------------------------------
# Takes permissions in octal and prints out in ls -al format.
#
my $octal = shift;
my $string = sprintf "%lo", ($octal & 07777);
my $result = '';
foreach (split(//, $string)) {
if ($_ == 7) { $result .= "rwx "; }
elsif ($_ == 6) { $result .= "rw- "; }
elsif ($_ == 5) { $result .= "r-x "; }
elsif ($_ == 4) { $result .= "r-- "; }
elsif ($_ == 3) { $result .= "-wx "; }
elsif ($_ == 2) { $result .= "-w- "; }
elsif ($_ == 1) { $result .= "--x "; }
elsif ($_ == 0) { $result .= "--- "; }
else { $result .= "unkown '$_'!"; }
}
return $result;
}
sub _load_mime {
# --------------------------------------------------------------------
# Load the config file into a hash.
#
my $file = shift;
require GT::MIMETypes;
my $guess = GT::MIMETypes->guess_type($file);
if (! $guess) {
if (-e $file) {
$guess = -T _ ? 'text/plain' : 'application/octet-stream';
}
else {
$guess = 'application/octet-stream';
}
}
return $guess;
}
sub _init_chmod {
#---------------------------------------------------------------------
# set chmod
#
my($from,$to) = @_;
$from =~ m,^([/\w.-]+)$,;
$from = $1;
$to =~ m,^([/\w.-]+)$,;
$to = $1;
my $stat = [stat($from)];
chmod(@$stat[2],$to);
}
sub _create_htaccess {
# ------------------------------------------------------------------
# Creates the htaccess file.
#
my ($htaccess, $htpasswd) = @_;
my $raq = $ENV{GT_COBALT_RAQ} ? "AuthPAM_Enabled off\n" : '';
open (HTAC, "> $htaccess") or die "Unable to open: $htaccess ($!)";
print HTAC <$to") or return 0;
open(SOURCE, "<$from") or return 0;
binmode SOURCE;
binmode TARGET;
my $buffer;
while (read SOURCE, $buffer, $READ_SIZE) {
if ($repl) {
($cs)? ($buffer =~ s,$repl,$with,g)
: ($buffer =~ s,$repl,$with,ig);
}
print TARGET $buffer;
}
close SOURCE;
close TARGET;
_init_chmod($from,$to);
return 1;
}
sub _valid_name_check {
# ---------------------------------------------------
# Checks to see if the input database/table name is a
# valid one. The function checks the following:
# 1. if a name is entered at all;
# 2. if there are spaces in the name;
# 3. if the name is consisted of valid characters; and
# 4. if the name is consisted of only numbers.
my ($self, $name) = @_;
my ($output);
$name =~ s/^\s+//;
$name =~ s/\s+$//;
if (!$name) {
$output = "Please provide a valid name.";
}
elsif ($self->{cfg}->{filename_check} and $name =~ /\s/) {
$output = "Spaces are not allowed in name.";
}
return $output;
}
1;