# ==================================================================
# File manager - enhanced web based file management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085      
#   CVS Info : 087,071,086,086,085      
#   Revision : $Id: FileMan.pm,v 1.160 2008/11/21 21:01:09 brewt 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/$MSWIN $DEBUG $HAVE_GZIP $HAVE_AZIP $LANGUAGE $LANG_TPL/;
use GT::Base qw/:persist/;
use GT::Template;
use GT::File::Tools qw/:all/;
use GT::FileMan::Session;
use GT::FileMan::Commands;
use GT::MD5;
use GT::Config;

$DEBUG = 0;

our @ISA = qw/GT::FileMan::Commands GT::FileMan::Session GT::Base/;

# Check if Compress::Zlib and Archive::Zip are available
$HAVE_GZIP = eval { local $SIG{__DIE__}; require Compress::Zlib; 1; } ? 1 : 0;
$HAVE_AZIP = eval { local $SIG{__DIE__}; require Archive::Zip; 1; } ? 1 : 0;

$MSWIN = $^O =~ /mswin/i ? 1 : 0;

sub new {
    my ($class, %args) = @_;

    my $self = bless {%args}, ref $class || $class;

# Upload progress 
    $self->{in}  = GT::CGI->new();

    unless ($self->{cfg}) {
        $self->{cfg} = $self->load_config();
    }
# This applies for GT products version 
    else {
        $self->{cfg}{template}        ||= 'luna';
        $self->{cfg}{template_path}   ||= $self->{cfg}{template_root};
        $self->{cfg}{root_path}       ||= $self->{cfg}{root_dir};
        $self->{cfg}{tmp_path}        ||= '/tmp';
        $self->{cfg}{static_url}      ||= $self->{cfg}{html_root_url} . '/static';
        $self->{cfg}{cgi_url}         ||= $self->{in}->url(absolute => 0, query_string => 0);
        $self->{cfg}{command_timeout} ||= $self->{cfg}{command_time_out};
        $self->{cfg}{path_to_perl}    ||= '/usr/bin/perl';
        $self->{cfg}{default}         ||= { allowed_space => 0, upload_mode => '644' };
        $self->{cfg}{date}              = { display => '%dd%-%mmm%-%yy% %hh%:%MM%:%ss%', input => '%yyyy%-%mm%-%dd%' };
    }

# Set tmp_path and verify to see if it's writeable
    $self->{cfg}{tmp_path} ||= '/tmp';
    die "$self->{cfg}{tmp_path} is not writeable" unless -w $self->{cfg}{tmp_path};

    my $query_string = $ENV{QUERY_STRING};
    if ($query_string =~ /^serial=/) {
        my ($read_file, $read_size) = ('', 0);
        my $uploaded_size = 0;
        my $started_time  = time;
        my $total_size    = $ENV{CONTENT_LENGTH};
        my ($serial)      = $query_string =~ /\=([^=]+)$/;
        $serial =~ m|^(\w+\d*)$|i or die "Invalid serial: $serial";
        $self->{serial}   = $serial;
        $self->{in}->upload_hook(
            sub {
                my ($filename, $buffer, $bytes) = @_;

                my $new_progress;
                if ($read_file ne $filename) {
                    $read_file = $filename;
                    $read_size = $uploaded_size;
                }
                if ($read_size) {
                    $new_progress = $read_size + $bytes;
                }
                else {
                    my $old_progress = $uploaded_size;
                    $new_progress    = $bytes >= $old_progress ? $bytes : $old_progress;
                }
                $uploaded_size = $new_progress;

                my $time = time;
                my $max_length  = 50;
                $filename = substr($filename, 0, $max_length) if length($filename) > $max_length;

                open FILE, "> $self->{cfg}{tmp_path}/$serial";
                flock FILE, 1;
                print FILE "$new_progress:|:$total_size:|:$started_time:|:$time:|:$filename:|:$self->{diskspace}{allowed}:|:$self->{diskspace}{free}\n"; # print the 
                close FILE;

                # select undef, undef, undef, 0.50;
            }
        );
    }

    $self->{cgi} = $self->{in}->get_hash();
    $DEBUG = $self->{cfg}{debug};

# Load access paths
    $self->{cfg}{template_path} or die('You must pass in your template root !');
    $self->{cfg}{root_path}     or die('You must set your root dir !');

    $self->{default} = $self->default();

# Cleanup the tmp directory
    $self->cleanup();
    return $self;
}

sub process {
    my $self = shift;

    my $action  = $self->{cgi}{cmd} || 'home';

# Avoid same name as GT::File::Tools::move/copy
    my $command = $action =~ /^(?:copy|move|print)$/ ? "cmd$action" : $action;

# Load authentication info
    if ($self->{cfg}{login}) {
        $self->auth();
        unless ($self->{session}) {
            return $self->{cgi}{ajax} ? $self->print_json({ html => $self->print('login.html', { json => 1, error => $self->language('ERR_NOAUTH') }) }, 1, undef, 'ERR_NOAUTH') : $self->login();
        }
    }

    $self->{diskspace} = $self->check_space($self->{cfg}{root_path}, $self->{cfg}{allowed_space});

# Verify action to see if it's permitted
    return $self->home(error => $self->language('ERR_POST_REQUEST', $action))   unless $self->verify_request($action);
    return $self->home(error => $self->language('ERR_INVALID_ACTION', $action)) unless exists $GT::FileMan::Commands::COMPILE{$command};
    return $self->home(error => $self->language('ERR_NO_PERM', $action))  unless $self->check_action($action);

# Checking free space
    $self->{diskspace} = $self->check_space(($self->{cfg}{root_path}), $self->{cfg}{allowed_space});
    $self->$command();
}

sub verify_request {
    my ($self, $action) = @_;

    return 1 if lc $ENV{REQUEST_METHOD} eq 'post' or $action =~ /^(?:home|print|fdownload|preview)$/;
    return 1 if $action =~ /^(?:command|upload)$/ and $self->{cgi}{serial} and -e "$self->{cfg}{tmp_path}/$self->{cgi}{serial}";
    return;
}

sub auth {
    my $self = shift;

    $self->{session} = $self->session_valid();
    return unless $self->{session};

    $self->{session}{user} = { username => $self->{cfg}{login}{username}, permission => $self->{cfg}{permission} };
}

sub print {
    my ($self, $page, $args) = @_;

    $page = 'home.html' if !$page or $page !~ /^[\w\-]+\.\w+$/;

    my $template = $self->{cgi}{t} ? $self->{cgi}{t} : $self->{cfg}{template};
    $template = 'luna' if $template !~ /^[\w-]+$/;

    my $fullpath = "$self->{cfg}{template_path}/$template/$page";

# Untaint the path
    ($fullpath) = $fullpath  =~ /^(.*)$/;

    my $globals = $self->globals();
    my %browser = $self->{in}->browser_info;

    $args->{have_gzip} = $HAVE_GZIP;
    $args->{have_azip} = $HAVE_AZIP;
    $args->{browser}   = \%browser;
    $args->{apache_server} = 1 if $ENV{SERVER_SOFTWARE} =~ /apache/i;
    $args->{mswin}         = $MSWIN;
    $args->{noauth}        = 1 unless $self->{cfg}{login} or $self->{cfg}{fversion} eq 'multiple';

    my $form = GT::Template->parse($fullpath, { %$globals, %$args }, { escape => 1 });
    return $form if $args->{json};

    print $self->{in}->header;
    print $form;
}

sub print_json_error {
# --------------------------------------------------
# shorthand to send an error message in json
#
# * If the first parameter is a hash, we assume it's a data
#   and the second parameter is the error message
#
# * If it's a scalar, we assume that it's the error message.
#
    my $self    = shift;
    my $data    = ref $_[0] eq 'HASH' ? shift : {};
    my $message = shift;
    my $status  = shift;
    return $self->print_json($data, 0, $message, $status);
}

sub print_json {
# --------------------------------------------------
# Dumps the passed data object to STDOUT
# by default, we assume that the request was a 
# success. If not, status should be set to "fail"
#
    my ($self, $data, $success, $message, $status) = @_;

    require GT::JSON;
# If success is defined, pass it through
    if (defined $success) {
        $success = $success ? $GT::JSON::true : $GT::JSON::false;
    }

# Otherwise, lets just default the success status to true
    else {
        $success = $GT::JSON::true;
    }

# If there are any special messages
    $message ||= '';

    my $json_str = GT::JSON::to_json({
        message => $message,
        success => $success,
        status  => $status,
        data    => ( $data || {} ),
    }, { utf8 => 0 });

    print $self->{in}->header({ 'no-cache' => 1 });
    print $json_str;
}

sub load_config {
# Load the config file into a hash.
#
    my $self = shift;
    my $file = $self->{cfg_path} || 'fileman.conf';

    my $header = <<END_OF_CONFIG;
# ==================================================================
# Gossamer FileMan - enhanced web based file management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/support/
#   Updated  : [localtime]
#
# Copyright (c) 2007 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

END_OF_CONFIG

# Load configuration, create $IN and $DB object
    my $cfg = GT::Config->load($file, { inheritance => 0, cache => 1, header => $header });
    $cfg->{template_path} = "$cfg->{private_path}/templates";

    $cfg->{date}     ||= { display => '%dd%-%mmm%-%yy% %hh%:%MM%:%ss%', input => '%yyyy%-%mm%-%dd%' };
    $cfg->{default}  ||= { allowed_space => 0, upload_mode => '644' };
    $cfg->{tmp_path} ||= '/tmp';
    $cfg->{filename_check} = 0 if $MSWIN;


# Create tmp directory if it doesn't exist
    rmkdir($cfg->{tmp_path}, 0755) unless -e $cfg->{tmp_path};

    return $cfg;
}

sub default {
# Load the default values from cookie
# 
    my ($self, %default) = @_;

# Loading defaults from fileman_defaults cookie
    unless (%default) {
        my $defaults = $self->{in}->cookie('fileman_defaults');
        my @defaults = split(/;/, $defaults);
        foreach my $d (@defaults) {
            if ($d =~ /^(\w+)=(.*\/?\w+)/) {
                $default{$1} = $2;
            }
        }
    }
    return \%default unless $self->{cfg}{root_path};

    if ($default{pwd_path} and $default{pwd_path} !~ /^$self->{cfg}{root_path}/) {
        $default{pwd_path} = '' ;
    }
    elsif ($default{pwd_path}) {
        $default{pwd_path} =~ s/^$self->{cfg}{root_path}//;
    }

    if ($default{path} and $default{path} !~ /^$self->{cfg}{root_path}/) {
        $default{path} = '';
    }
    elsif ($default{path}) {
        $default{path} =~ s/^$self->{cfg}{root_path}//;
    }

    $default{readme} ||= 2;
    $self->{cfg}{work_path} = $self->{cgi}{work_path} eq '/' ? '' : $self->{cgi}{work_path};

    if ($default{path} and $self->{cgi}{load_default} and !$self->{cfg}{work_path}) {
        $self->{cfg}{work_path} = $default{path};
    }

    return \%default;
}

sub cleanup {
# Clean up xx hour old files in the tmp directory
#
    my $self = shift;

    return unless -e $self->{cfg}{tmp_path};

    opendir (DIR, $self->{cfg}{tmp_path}) or return;
    my @files = readdir(DIR);
    close DIR;
    my $expiry = $self->{session}{expiry} || 5;
    foreach my $f (@files) {
        next if $f eq '.' or $f eq '..' or !-f "$self->{cfg}{tmp_file}/$f";
        my @stat = stat("$self->{cfg}{tmp_file}/$f");
        next if time - $stat[9] < 3600 * $expiry;
        del("$self->{cfg}{tmp_file}/$f", { untaint => 1 });
    }
}

sub language {
# ------------------------------------------------------------------
# Process a language request, it's only loaded once, and saved in
# $LANGUAGE.
#
    my $self = shift;
    my $code = shift;

    require GT::Config;
    my $lang = "$self->{cfg}{template_path}/$self->{cfg}{template}/language.txt";
    $LANGUAGE   = undef unless $LANG_TPL;
    $LANGUAGE ||= GT::Config->load($lang, { create_ok => 1, inheritance => 1, local => 1, header => <<HEADER });
# This file is auto generated and contains a perl hash of
# your language variables for the '$self->{cfg}{template}' template set.
# Generated on: [localtime]

HEADER
    $LANG_TPL = $self->{cfg}{template};

    if (exists $LANGUAGE->{$code}) {
        return @_ ? sprintf($LANGUAGE->{$code}, @_) : $LANGUAGE->{$code};
    }
    else {
        return $code;
    }
}

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 $in   = new GT::CGI;
    my $msg  = $in->html_escape(shift);
    my $font = "Tahoma,Arial,Helvetica";

    print $in->header;
    print qq!
        <font face="$font" size="2">A fatal error has occurred:<blockquote><pre style="font-family: $font; font-size: 12px; color: red>">$msg</pre></blockquote>Please enable debugging in setup for more details.</font>\n
    !;
    print base_env($in) if $DEBUG;
}

sub base_env {
    my ($in, $version, $commands) = @_;

    my $info = '<pre>';
    my ($oserr, $evalerr) = ($@, $!);

# Stack trace.
    $info .= "<b>Stack Trace</b>\n======================================\n";
    $info .= GT::Base::stack_trace('FileMan', 1);
    $info .= "\n";

# Print GT::SQL error if it exists.
    $info .= "<b>System Information</b>\n======================================\n";
    if (my @user = eval { getpwuid($>) }) {
        $info .= "Current user: $user[0] ($>)\n";
    }
    $info .= "Perl version: " . ($^V ? sprintf("%vd", $^V) : $]) . "\n";
    $info .= "Gossamer FileMan Version: $version\n" if $version;
    $info .= "GT::Template version: $GT::Template::VERSION\n" if $GT::Template::VERSION;
    $info .= "Running under mod_perl: " . (MOD_PERL ? "Yes (version " . MOD_PERL . ")" . (MOD_PERL >= 1.99 ? ', mod_perl 2 detected' : '') : "No") . "\n";
    $info .= "Running under SpeedyCGI: " . (SPEEDY ? "Yes (version " . SPEEDY . ")" : "No") . "\n";
    $info .= "\@INC = \n\t" . join("\n\t", @INC) . "\n";
    $info .= "\$\@: " . $in->html_escape($oserr) . "\n" if $oserr;
    $info .= "\$!: " . $in->html_escape($evalerr) . "\n" if $evalerr;
    $info .= "\n";

    if ($commands) {
        $info .= 'Commands: <table>';
        foreach (keys %$commands) {
            $info .= qq|<tr><td class="text">$_:</td><td class="text">| . ($commands->{$_} ? 'Enabled' : 'Disabled') . qq|</td></tr>|;
        }
        $info .= '</table><br />';
        $info .= "\n";
    }

# CGI Parameters and Cookies.
    if (ref $in eq 'GT::CGI') {
        if ($in->param) {
            $info .= "<b>CGI Input</b>\n======================================\n";
            foreach (sort $in->param) {
                $info .= $in->html_escape($_) . " => " . $in->html_escape($in->param($_)) . "\n";
            }
            $info .= "\n";
        }
        if ($in->cookie) {
            $info .= "<b>CGI Cookies</b>\n======================================\n";
            foreach (sort $in->cookie) {
                $info .= $in->html_escape($_) . " => " . $in->html_escape($in->cookie($_)) . "\n";
            }
            $info .= "\n";
        }
    }

# Environement info.
    $info  .= "<b>Environment</b>\n======================================\n";
    foreach (sort keys %ENV) {
        $info .= $in->html_escape($_) . " => " . $in->html_escape($ENV{$_}) . "\n";
    }

    $info .= "</pre>";
    return $info;
}

sub globals {
    my $self = shift;

# Create css and js url
    $self->{cfg}{template} = $self->{cgi}{t} if $self->{cgi}{t};
    my $date_input = $self->{cfg}{date}{input};
    $date_input    =~ s/%//g;
    $self->{cfg}{date_input} = $date_input;

    my %g = (cfg => $self->{cfg}, in => $self->{cgi}, default => $self->{default}, session => $self->{session});

    my $hiddens = $self->hiddens();
    foreach (keys %$hiddens) {
        $g{$_} = \$hiddens->{$_};
    }

# Reload user's diskspace. This applies for multiple users version only
    if ($self->{cfg}{fversion} eq 'multiple' and !$self->{session}{user}{type}) {
        my @paths = map $_->{name}, @{$self->{session}{user}{accesses_loop}};
        $self->{diskspace} = $self->check_space(\@paths, $self->{session}{user}{allowed_space}); # Load free space
        $g{space} = $self->{diskspace};
    }

    \%g;
}

sub hiddens {
    my ($self, $no_workpath) = @_;

    my @items = qw/sid t/;

    my ($query, $html) = ('', '');
    foreach (@items) {
        next unless $self->{cgi}{$_};
        $query  .= ";" . $self->{in}->escape($_) . "=" . $self->{in}->escape($self->{cgi}{$_}) if exists $self->{cgi}{$_};
        $html   .= qq|<input type="hidden" name="| . $self->{in}->html_escape($_) . qq|" value="| . $self->{in}->html_escape($self->{cgi}{$_}) . qq|" />|;
    }

    if ($self->{url_opts}) {
        my @opts = split(/;|&/, $self->{url_opts});
        foreach (@opts) {
            if ($_ =~ /^(\w+)=(.*\/?\w+)/) {
                $query .= ";$1=$2";
                $html  .= qq|<input type="hidden" name="$1" value="| . $self->{in}->html_escape($2) . qq|" />|;
            }
        }
    }

    my $subquery = $query;
    unless ($no_workpath) {
        $query .= ";work_path=" . $self->{in}->escape($self->{cfg}{work_path}) if $self->{cfg}{work_path};
        $html  .= qq|<input type="hidden" name="work_path" value="| . $self->{in}->html_escape($self->{cfg}{work_path}) . qq|" />|;
    }

    return { hidden_query => $query, hidden_subquery => $subquery, hidden_objects => $html };
}

sub check_space {
    my ($self, $path, $allowed_space) = @_;

    return undef unless $allowed_space and $path;

    my @paths = ref $path eq 'ARRAY' ? @$path : [$path];

    my ($used_space, $free_space, $usage) = (0, 0, 0);
    foreach my $p (@paths) {
        find($p, sub { $used_space += -s shift }, { untaint => 1 } );
    }

# Size in kb
    $used_space   /= 1024;
    $free_space    = $allowed_space < $used_space ? 0 : $allowed_space - $used_space;
    $usage         = $used_space / $allowed_space * 100 if $allowed_space > 0;
    return {
        free    => int($free_space * 1024),
        allowed => int($allowed_space * 1024),
        used    => int($used_space * 1024),
        usage   => int($usage)
    };
}

sub image_url {
# Takes an filename and using the current template set and theme, returns
# the url of the image.  It first checks if the file exists in the theme's
# image directory, checks the template's image directory, and then tries
# to check the template inheritance tree for more image directories.
#
    my $image = shift;

    my $tags = GT::Template->tags;

    if (-e "$tags->{cfg}{static_path}/$tags->{cfg}{template}/images/$image") {
        return "$tags->{cfg}{static_url}/$tags->{cfg}{template}/images/$image";
    }

# The image doesn't exist here, but return it anyway
    return "$tags->{cfg}{static_url}/$tags->{cfg}{template}/images/$image";
}

sub encrypt {
#--------------------------------------------------------------------
# Encrypt password
# 
    my ($clear_pass, $salt) = @_;
    $salt ||= join '', map +('a' .. 'z', 'A' .. 'Z', 0 .. 9, '.', '/')[rand 64], 1 .. 8;

    require GT::MD5::Crypt;
    return GT::MD5::Crypt::gt_md5_crypt($clear_pass, $salt);
}

sub check_action {
    my ($self, $action) = @_;

    my $perm = $self->{cfg}{fversion} eq 'multiple' ? $self->{session}{user}{permission} : $self->{cfg}{permission};
    return exists $perm->{$action} ? $perm->{$action} : 1;
}
1;