コピペでお持ち帰りください。2バイト文字入れてないので文字コードは関係ないです。
#!/usr/bin/perl use Socket; # parameters $accept_ip = 'xxx.xxx.xxx.xxx'; $cgi_pass = 'hogehoge'; # get parameters ( $sv, $port, $wait_port, $pass ) = split( /:/, $ENV{'QUERY_STRING'} ); err( 'Bad password !' ) if $pass ne $cgi_pass; err( 'Any ports other than 6660-6669 are not permitted.' ) if ( $port < 6660 or $port > 6669 ); err( "The connection from $ENV{'REMOTE_ADDR'} is not permitted." ) if $accept_ip ne $ENV{'REMOTE_ADDR'}; # create output socket $iaddr = inet_aton( $sv ); $paddr = sockaddr_in( $port, $iaddr ); socket( SV, PF_INET, SOCK_STREAM, 0 ) or err( 'Cannot create server socket.' ); connect( SV, $paddr ) or err( 'Cannot connect server.' ); select( (select(SV), $| = 1)[0] ); # create input socket socket( WAITING, PF_INET, SOCK_STREAM, 0 ) or err( 'Cannot create input socket.' ); setsockopt( WAITING, SOL_SOCKET, SO_REUSEADDR, 1 ) or err( "Cannot setsockopt." ); bind( WAITING, sockaddr_in( $wait_port, INADDR_ANY ) ) or err( 'Cannot bind.' ); listen( WAITING, SOMAXCONN ) or err( 'Cannot listen.' ); ( $cport,$tmp ) = unpack_sockaddr_in(getsockname(WAITING)); #? # wating client $user = accept( CL, WAITING ); select( (select(CL), $| = 1)[0] ); # client come now ! ( $client_port, $client_iaddr ) = unpack_sockaddr_in( $user ); $client_ip = inet_ntoa( $client_iaddr ); err( 'The connection from $client_ip is not permitted.' ) if $accept_ip ne $client_ip; $| = 1; if( fork ) { print "Content-type: text/html\n\n"; print "The connection from $client_ip connected. $wait_port --> $sv:$port"; exit; } close(STDOUT); # fork $rin = $win = $ein = ''; $sv_no = fileno(SV); $cl_no = fileno(CL); vec( $rin, $sv_no,1 ) = 1; vec( $rin, $cl_no,1 ) = 1; while(1) { $nfound = select( $rout = $rin, $wout = $win, $eout = $ein, undef ); if( vec( $rout, $sv_no, 1 ) ) { if( sysread( SV, $mes, 4096 ) ) { print CL $mes; } else { exit; } } if( vec( $rout, $cl_no, 1 ) ) { if( sysread( CL, $mes, 4096 ) ) { print SV $mes; } else { exit; } } } # output error messages sub err { print "Content-Type: text/html\n\n"; print @_[0] . "\n"; exit; }
中継します。たったそれだけです。個人的にはircに使っています。但し、
仕様になっています。なぜかというと、一般に使わせる串ではなくて自分だけでこっそり安全に使う串だからです。
ちょっと改造すれば、複数のクライアントを受け付けるようにも出来ますけど、そんなおっかないこと出来ません。
これを満たすところはなかなか無いと思います。
CGIの名前は変えたほうが良いと思います。
呼び出すとブラウザが読み込み中になります。その間に、クライアントで設定した受付ipに接続して下さい。成功したならブラウザにその旨のメッセージが出ます。
このスクリプトについては著作を放棄します。様々なところを参考にしてつぎはぎして作ったものだからです。ほとんどオリジナリティのある部分がありません。元ネタの出典も失念しまいました。
改造、流用、勝手にやってください。但し自己責任で。複数クライアントを受け付けるようにするのも数行書き換えるだけだと思います。