monk2b has asked for the wisdom of the Perl Monks concerning the following question:

When I run this tcp server script from the command line I can not exit out of the xterm that started the server. I simply don't know where to start to clear up this idiosyncrosy of this script. Any help would be greatly appreciated.

Here is the script 
#!/usr/bin/perl

use IO::Socket;
use warnings;
use strict;
my $server_port = 6002;
my ($input, $my_addr );
my $allowed = "192.168.0.53";
# Forking into a new daemon
my $pid = fork;
exit if $pid;
die "Couldn't fork: $!\n" unless defined($pid);
# make the socket
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
    or die "Can't create socket: $!\n";
# so we can restart our server quickly
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1)
    or die "Can't setsockopt $!\n";
$my_addr = sockaddr_in($server_port, INADDR_ANY);
bind(SERVER, $my_addr)
    or die "Couldn't bind to port $server_port : $!\n";
# establish a queue for incoming connections
listen(SERVER,SOMAXCONN)
    or die "Can't listen to socket: $1";

# accept and process connections
while (my $response = accept(CLIENT,SERVER)) {
  next unless(defined($input = <CLIENT>));
  my ($fpart, $spart) = sockaddr_in($response);
  my $ipaddr = inet_ntoa($spart);
  unless ( $ipaddr eq $allowed ) {
    send (CLIENT,"Sorry, ($ipaddr) is not an allowed hosts...\n",0);
  }
}

[download]

Replies are listed 'Best First'.
Re: tcp server holding xterm
by zentara (Cardinal) on Aug 10, 2007 at 18:52 UTC
    There are certain things you need to do with a daemon, to make it a real daemon. Search groups.google.com for "perl daemon" for alot of discussion and sample scripts. There is also a modules to make it easy....Proc::Daemon

    Here is the basic idea. 

    #!/usr/bin/perl
use warnings;
use strict;
use POSIX 'setsid';
use IO::Socket;

$|++;
my $server = new IO::Socket::INET (
      LocalHost => 'localhost',
      LocalPort => '7070',
      Proto => 'tcp',
      Listen => 1,
      Reuse => 1,
             );
 die "Could not create socket: $!\n" unless $server;
$server->autoflush(1);

daemonize();

open(LOG,">/tmp/7070.log") or die "$\n";

while(1){
   while ( my $client = $server->accept() ){
      sysread($client, my $buf, 100);
      syswrite(LOG, "$buf\n");
      LOG->flush;       
      }
}

#################################################################

sub daemonize {
  chdir '/' or die "Can't chdir to /: $!";
  open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null'
          or die "Can't write to /dev/null: $!";
  defined(my $pid = fork)    or die "Can't fork: $!";
  exit if $pid;
  setsid or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT'    or die "Can't dup stdout: $!";
}

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]
Re: tcp server holding xterm
by monk2b (Pilgrim) on Aug 10, 2007 at 19:12 UTC
    Thanks Zentara, Your advice is exactly what I needed.
    Bob
[reply]

Back to Seekers of Perl Wisdom