286 lines
12 KiB
Perl
286 lines
12 KiB
Perl
# ==================================================================
|
|
# File manager - enhanced web based file management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# CVS Info :
|
|
# Revision : $Id: FileMan.pm,v 1.121 2005/04/11 17:24:03 jagerman Exp $
|
|
#
|
|
# 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;
|
|
#--------------------------------------------------------------------
|
|
use strict;
|
|
use vars qw/@ISA $DEBUG $HAVE_GZIP $HAVE_AZIP $UNSAFE_PATH/;
|
|
use GT::Base qw/:persist/;
|
|
use GT::Template;
|
|
use GT::FileMan::Commands;
|
|
|
|
# Check if Compress::Zlib is available
|
|
$HAVE_GZIP = eval { local $SIG{__DIE__}; require Compress::Zlib; 1; } ? 1 : 0;
|
|
|
|
# Check if Archive::Zip is available
|
|
$HAVE_AZIP = eval { local $SIG{__DIE__}; require Archive::Zip; 1; } ? 1 : 0;
|
|
|
|
$DEBUG = 0;
|
|
|
|
@ISA = qw/GT::FileMan::Commands GT::Base/;
|
|
|
|
$UNSAFE_PATH = $^O =~ /mswin/i ? '(^|[/\\\\])\.\.?($|[/\\\\])' : '(^|/)\.\.?($|/)';
|
|
|
|
sub new {
|
|
# ------------------------------------------------------------------
|
|
# Constructor
|
|
#
|
|
my ($class,%args) = @_;
|
|
my $self = bless {%args}, ref $class || $class;
|
|
|
|
$self->{cfg} = $self->load_config() if (!$self->{cfg});
|
|
$self->{cfg}->{winnt} = $^O eq 'MSWin32' ? 1 : 0;
|
|
$self->{cfg}->{upload_chmod} ||= '644';
|
|
$self->{cfg}->{template_root} or die('You must pass in your template root !');
|
|
$self->{cfg}->{root_dir} or die('You must set your root dir !');
|
|
|
|
$self->{in} = new GT::CGI;
|
|
$self->{cgi} = $self->{in}->get_hash;
|
|
|
|
my $passwd_dir = $self->{passwd_dir};
|
|
if ($passwd_dir and !$self->{in}->cookie('def_passwd_dir')) { #store the password directory to cookie
|
|
$passwd_dir = "$self->{cfg}->{root_dir}/$passwd_dir" if ($self->{cfg}->{passwd_dir_level}); # must be inside root directory
|
|
|
|
(-e $passwd_dir and -w _) or die("$passwd_dir does not exist or not writeable");
|
|
print $self->{in}->header (-cookie => [ $self->{in}->cookie ( -name => 'def_passwd_dir', -value => $passwd_dir, -expires => '+5y') ]);
|
|
}
|
|
|
|
# Set our default working directory.
|
|
$self->{work_path} = $self->{cgi}->{work_path};
|
|
if ($self->{cgi}->{def_load} and !$self->{cgi}->{work_path}) {
|
|
$self->{work_path} = ($self->{in}->cookie('def_working_dir') eq '/') ? '' : $self->{in}->cookie('def_working_dir');
|
|
(!$self->{work_path} or ($self->{work_path} =~ m,^([-\w/. ]+)$, and $self->{work_path} !~ /$UNSAFE_PATH/)) or ($self->{work_path} = '');
|
|
}
|
|
$self->{work_path} ||= '';
|
|
(!$self->{work_path} or ($self->{work_path} =~ m,^([-\w/. ]+)$, and $self->{work_path} !~ /$UNSAFE_PATH/)) or die ("work_path has invalid characters : $self->{work_path} ");
|
|
-e "$self->{cfg}->{root_dir}/$self->{work_path}" or ($self->{work_path} = '');
|
|
|
|
$self->{http_ref} = $self->{in}->url (absolute => 0, query_string => 0);
|
|
$self->{results} = '';
|
|
$self->{data} = {};
|
|
$self->{status} = '';
|
|
$self->{input} = '';
|
|
$self->{debug} and ($DEBUG = $self->{debug});
|
|
return $self;
|
|
}
|
|
|
|
sub process {
|
|
# ------------------------------------------------------------------
|
|
my $self = shift;
|
|
my $action = $self->{cgi}->{fdo} || $self->{cgi}->{cmd_do};
|
|
|
|
return $self->page("home.html") if (!$action or $action eq 'fileman');
|
|
|
|
my $command_enable = 1; # default is enable
|
|
$command_enable = $self->{commands}->{$action} if (exists $self->{commands}->{$action});
|
|
|
|
# Determine what to do:
|
|
if (exists $GT::FileMan::Commands::COMPILE{$action} and $command_enable) {
|
|
$self->$action();
|
|
}
|
|
else {
|
|
die "<font color=red>Invalid action or command is disable : $action !</font>";
|
|
}
|
|
}
|
|
|
|
sub page {
|
|
# ------------------------------------------------------------------
|
|
# Print out the requested template
|
|
#
|
|
my ($self, $file, $args) = @_;
|
|
$file ||= $self->{cgi}->{page};
|
|
print $self->{in}->header;
|
|
|
|
my $template_path = ($self->{cgi}->{t}) ? "$self->{cfg}->{template_root}/$self->{cgi}->{t}" : $self->{cfg}->{template_root};
|
|
|
|
# Check the file name requested.
|
|
"$template_path/$file" =~ /\\/ and return die "Invalid template '$file' requested (Invalid name)";
|
|
"$template_path/$file" =~ /$UNSAFE_PATH/ and return die "Invalid template '$file' requested (Invalid name)";
|
|
$file =~ m,^\s*/, and return die "Invalid template '$file' requested (Invalid name)";
|
|
-e "$template_path/$file" or return die "Invalid template '$template_path/$file' requested (File does not exist)";
|
|
-r _ or return die "Invalid template '$file' requested (Permission denied)";
|
|
|
|
# Make data available.
|
|
foreach my $key (keys % {$self->{data}}) {
|
|
exists $args->{$key} or $args->{$key} = $self->{data}->{$key};
|
|
}
|
|
|
|
# Make cgi input available.
|
|
foreach my $key (keys % {$self->{cgi}}) {
|
|
exists $args->{$key} or $args->{$key} = $self->{cgi}->{$key};
|
|
}
|
|
|
|
# Make commands available.
|
|
my $count = 0;
|
|
if ($self->{commands}) { #activate or deactivate the commands
|
|
foreach my $key (keys % {$self->{commands}}) {
|
|
exists $args->{$key} or $args->{$key} = $self->{commands}->{$key};
|
|
$count++;
|
|
}
|
|
}
|
|
|
|
$args->{show_all} = '1' if ($count == 0);
|
|
$args->{status} ||= $self->{status};
|
|
$args->{input} = $self->{input};
|
|
$args->{http_ref} = $self->{http_ref};
|
|
$args->{url_opts} = $self->{url_opts};
|
|
$args->{work_path} = $self->{work_path} || $self->{cgi}->{work_path};
|
|
$args->{template_root} = $self->{cfg}->{template_root};
|
|
|
|
$args->{root_dir} = $self->{cfg}->{root_dir};
|
|
$args->{html_url} = $self->{cfg}->{html_root_url};
|
|
$args->{root_url} = $self->{cfg}->{root_url};
|
|
$args->{root_select} = $self->{cfg}->{root_select} if ($self->{cfg}->{root_select});
|
|
$args->{session_id} = $self->{cfg}->{session_id} if ($self->{cfg}->{session_id});
|
|
$args->{user_sessions} = $self->{cfg}->{user_sessions} if ($self->{cfg}->{user_sessions});
|
|
$args->{username} = $self->{cfg}->{username} if ($self->{cfg}->{username});
|
|
$args->{multi} = $self->{cfg}->{multi} if ($self->{cfg}->{multi});
|
|
$args->{single} = $self->{cfg}->{single} if ($self->{cfg}->{single});
|
|
|
|
$args->{have_gzip} = $HAVE_GZIP;
|
|
$args->{have_azip} = $HAVE_AZIP;
|
|
$args->{srv_soft} = ($ENV{SERVER_SOFTWARE} =~ /Apache|Unix/)? 0 : 1 if ($ENV{SERVER_SOFTWARE});
|
|
$args->{position} = $self->{in}->cookie('readme_position') if ($args->{readme});
|
|
|
|
$args->{scheme} = $self->{in}->cookie('scheme') || 'fileman';
|
|
$args->{font} = $self->{in}->cookie('font') || "<font face='Verdana, Arial, Helvetica, sans-serif' size=2>";
|
|
$args->{font} =~ s/[\'\"]/\'/g;
|
|
|
|
# Used for HTML editor
|
|
my $brws = $self->get_browser();
|
|
|
|
# Export home for using in auto generate HTML.
|
|
GT::Template->parse ("$template_path/$file", { %$args, %$brws }, { print => 1 });
|
|
}
|
|
|
|
sub get_browser {
|
|
my ($self, $verify) = @_;
|
|
my ($version, %brws);
|
|
if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} =~ /MSIE (\d+(?:\.\d+)?)/i) {
|
|
$version = $1;
|
|
$brws{ie_version} = $version;
|
|
}
|
|
$brws{is_ie} = ($version and $version >= 5.5) ? 1 : 0;
|
|
|
|
if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} =~ m{Mozilla/(\d+\.\d+)\s+\([^)]*rv:(\d+\.\d+)\)}) {
|
|
if ($1 >= 5.0) {
|
|
$brws{is_mozilla} = 1;
|
|
$brws{mozilla_version} = $2;
|
|
}
|
|
}
|
|
if ( $verify ) {
|
|
($brws{ie_version} >= 5.5 or $brws{mozilla_version} >= 1.4) ? return 1 : return 0;
|
|
}
|
|
else {
|
|
return \%brws;
|
|
}
|
|
}
|
|
|
|
sub load_config {
|
|
# --------------------------------------------------------------------
|
|
# Load the config file into a hash.
|
|
#
|
|
my $self = shift;
|
|
my $file = $self->{cfg_path} || 'ConfigData.pm';
|
|
my $cfg = do $file;
|
|
if (ref $cfg ne 'HASH') {
|
|
die "Invalid config file: $file. Got: '$cfg' instead of actual data. Error: $@ $!";
|
|
}
|
|
return $cfg;
|
|
}
|
|
|
|
sub fatal {
|
|
# --------------------------------------------------------------
|
|
# Return a fatal error message to the browser.
|
|
#
|
|
die @_ if (GT::Base->in_eval()); # Don't do anything if we are in eval.
|
|
|
|
my $msg = shift;
|
|
my $in = new GT::CGI;
|
|
print $in->header;
|
|
|
|
my $work_path = $in->param('work_path') || '';
|
|
|
|
print qq!
|
|
<font face='Tahoma,Arial,Helvetica' size=2>A fatal error has occured:</font></p><blockquote><pre>$msg</pre></blockquote><p><font face='Tahoma,Arial,Helvetica' size=2>Please enable debugging in setup for more details.</font></p>\n
|
|
!;
|
|
if ($DEBUG) {
|
|
print base_env();
|
|
}
|
|
}
|
|
|
|
sub base_env {
|
|
# --------------------------------------------------------------------
|
|
# Return HTML formatted environment for error messages.
|
|
#
|
|
my $info = '<PRE>';
|
|
|
|
# Stack trace.
|
|
my $i = 0;
|
|
$info .= "<B>Stack Trace</B>\n======================================\n";
|
|
$info .= GT::Base::stack_trace('FileMan', 1, 1);
|
|
$info .= "\n\n";
|
|
|
|
$info .= "<B>System Information</B>\n======================================\n";
|
|
$info .= "Perl Version: $]\n";
|
|
$info .= "FileMan Version: $FileMan::VERSION\n" if ($FileMan::VERSION);
|
|
$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";
|
|
|
|
# Environment info.
|
|
$info .= "<B>ENVIRONMENT</B>\n======================================\n";
|
|
foreach (sort keys %ENV) { $info .= "$_ => $ENV{$_}\n"; }
|
|
$info .= "</PRE>";
|
|
return $info;
|
|
}
|
|
|
|
sub js_quote_include {
|
|
# --------------------------------------------------------------------
|
|
# This uses GT::Template to parse the passed in argument. The results are
|
|
# javascript escaped, and then returned.
|
|
#
|
|
my $file = shift;
|
|
my $tags = GT::Template->tags;
|
|
|
|
my $in = new GT::CGI;
|
|
my $css_file = $in->cookie('scheme') || 'fileman';
|
|
my $color;
|
|
CASE: {
|
|
($css_file eq 'fileman') and $color = '#D6D6D6', last CASE;
|
|
($css_file eq 'gt') and $color = '#d9e4f2', last CASE;
|
|
($css_file eq 'maple') and $color = '#F0E8CE', last CASE;
|
|
($css_file eq 'rainy') and $color = '#CFD8C2', last CASE;
|
|
($css_file eq 'rose') and $color = '#DEC9CE', last CASE;
|
|
}
|
|
my $parsed = GT::Template->parse("$tags->{template_root}/common/$file",
|
|
{
|
|
html_url => $tags->{html_url},
|
|
http_ref => $tags->{http_ref},
|
|
filename => $tags->{filename},
|
|
work_path => $tags->{work_path},
|
|
scrollbar_arrow_color => 'black',
|
|
scrollbar_base_color => $color,
|
|
editor_base_color => $color,
|
|
advanced_editor_background => 'white',
|
|
advanced_editor_font => 'arial'
|
|
});
|
|
$parsed =~ s{([\\/'"<>])}{\\$1}g;
|
|
$parsed =~ s/(?:\r\n|\r|\n)/\\n/g;
|
|
return \$parsed;
|
|
}
|
|
|
|
1;
|