# ==================================================================
# 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;