#!/usr/local/bin/perl5
#
# telnet.cgi
#
# 1997/08/18 Ver.0.00
# 1997/08/19 Ver.0.01
# 1997/09/05 Ver.0.02
# 1997/09/17 Ver.0.03 アンダーラインの処理を追加
# 1997/11/11 Ver.0.04 PATH の設定
# 1998/01/23 Ver.0.05 $ownname の自動化
# 1998/01/30 Ver.0.06 PATH の見直しなど
# 1998/03/03 Ver.0.07 多重打ち、リストマークの処理など
# 感謝! yav さん(http://www2s.biglobe.ne.jp/~yav/ )
# 1998/04/06 Ver.0.08 pwd から cwd へ, cd の入力の解釈をちょっと改良
# Hi-HO, RIMNET での動作を確認
#
# (c) 1997,1998 がま
# e-mail addr : gama@mvg.biglobe.ne.jp
#
# usage:
# ex.
# telnet.cgi?date
#
# cgi 自身の名前 -------------------------------------------------------
$ownname="http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";
# PATH を設定する ------------------------------------------------------
$ENV{'PATH'} = '/bin'
. ':/usr/bin'
. ':/usr/ucb'
. ':/etc'
. ':/usr/etc'
. ':/usr/lib'
. ':/usr/local/bin'
. ':/usr/local/X11R6/bin'
. ':/usr/local/bin/mh'
. ':/usr/local/lib'
. ':/usr/local/lib/mh'
. ':/usr/local/sbin'
. ':/usr/local/libexec'
. ':/usr/local/canna/bin'
;
# ----------------------------------------------------------------------
($dir,$cmd)=split('&',$ENV{'QUERY_STRING'}); # & で分離 dir=????&cmd=
$dir =~ s/dir=//;
$dir =~ s/%(..)/pack('c',hex($1))/ge;
$cmd =~ s/cmd=//;
$cmd =~ s/\+/ /g;
$cmd =~ s/%(..)/pack('c',hex($1))/ge;
# ----------------------------------------------------------------------
$|=1;
print "Content-type: text/html\n\n";
print '<HTML><BODY>';
print "<PRE>\n";
# ----------------------------------------------------------------------
chdir("$dir");
$wd=&pwd;
print "Curr Dir:$wd\n";
# ----------------------------------------------------------------------
$cmdpr = $cmd;
$cmdpr =~ s/&/&/g;
$cmdpr =~ s/</</g;
$cmdpr =~ s/>/>/g;
print "\n<B>>$cmdpr</B>\n";
# ----------------------------------------------------------------------
if ($cmd =~ /^cd(\s)*/ ) { # cd は、内部で処理する。
unless (chdir($')) {
print "cd $':not success.\n";
}
$dir=&pwd;
print "Curr Dir:$dir\n";
} else {
open(PROC,"$cmd 2>&1 |"); # 実行
while (<PROC>) { # 結果を読み出す
s/</\001/g; #
s/>/\002/g; #
s/(.)(\x08\1)+/<B>$1<\/B>/g; # 多重打ち : . 08h(BS) .
s/_\x08(.)/<U>$1<\/U>/g; # アンダーライン : 5fh(_) 08h(BS)
s/o\x08\+/<S>X<\/S>/g; # リストマーク : 35h(o) 08h(BS) 2bh(+)
s/<\/(.)><\1>//g; # </TAG><TAG> を削除
s/&/&/g; #
s/\001/</g; #
s/\002/>/g; #
print $_;
}
close(PROC);
}
# ----------------------------------------------------------------------
print "</PRE>\n";
print '<HR>';
print '<FORM ACTION="' . $ownname . '" METHOD="GET">';
print '<INPUT TYPE="hidden" NAME="dir" VALUE="' . $dir . '">';
print '<INPUT TYPE="text" NAME="cmd" SIZE=80 VALUE="' . $cmd . '">';
print '<INPUT TYPE="submit" VALUE="Send">';
print '</FORM>';
print '</BODY></HTML>';
exit;
# ----------------------------------------------------------------------
sub pwd {
use Cwd;
$wd = Cwd::getcwd();
unless ($wd) {
$wd='/';
}
return $wd;
}