#!/usr/bin/perl # # PerlWebShell 0.1 # # PerlWebShell is an interactive CGI-script that will execute any # command entered. See the files README and INSTALL or # http://yola.in-berlin.de/perlwebshell/ for further information. # # Copyright (C) 2004 Florian Rossol # Copyright (C) 2000-2003 Martin Geisler # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You can get a copy of the GNU General Public License from this # address: http://www.gnu.org/copyleft/gpl.html#SEC1 # You can also write to the Free Software Foundation, Inc., 59 Temple # Place - Suite 330, Boston, MA 02111-1307, USA. # use CGI qw(:standard); use Cwd; use strict; my $q = new CGI; my $command; my $cwd; my $fname; my $parent_dir; if (param()) { $cwd = param('cwd'); $command = param('command'); } $cwd = getcwd() unless $cwd; chdir $cwd or die "can't chdir"; $command = "ls -l" unless $command; open ("COMH", "$command |") or die "can't open: $!\n"; print "Content-type: text/html\n\n"; print <<'EOHTML'; EOHTML print "shell.cgi ($ENV{'SERVER_NAME'})"; print <<'EOHTML'; EOHTML my $abs_url = $q->url(-absolute=>1); print h1("shell.cgi ($ENV{'SERVER_NAME'})"); print $q->start_form(-method=>"get", -action=>$abs_url); print "
Input", "

Current working directory: "; $cwd = $cwd . "/" unless $cwd =~ /\/$/; if ($cwd =~ /(.*)\/(.*)\//) { $parent_dir = $1 . "/"; } my @path = split('/', $cwd); shift(@path); my $tmp_path; print "root/"; foreach (@path) { $tmp_path .= $_ . "/"; print "$_/"; } print "

\n"; print "

Choose new working directory: \n", "

\n"; print q(

Command:

); #

Enable stderr-trapping? print q(

); print "
"; print "
Output ($command)"; print q(
"; print $q->end_form(); # print <<'EOHTML';
Copyright © 2004, Florian Rossol. Get the latest version at http://yola.in-berlin.de/perlwebshell/.

Valid XHTML 1.0 Strict! Valid CSS!

EOHTML print $q->end_html();