565 lines
19 KiB
Perl
565 lines
19 KiB
Perl
# ==================================================================
|
|
# 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;
|