/ws-main.pl

#!/usr/bin/perl

### Standart modules
use strict;
use warnings;
use IO::Socket;
use Getopt::Long; ### This module handles command line argiments reading

### 3rd party modules


### Project specific modules
use logger;

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

initialize_logging("/tmp/my-perl-webservice/");

my $host = '0.0.0.0';
my $port = 8080;

my $help = 0;
GetOptions(
	'h|help' => \$help,
	'port|p:i' => \$port,
	'loglvl|log:s' => \$LOG_LVL );

if( $help == 1 )
{
	print_usage_notes();
	exit 0;
}

### Start Working

my $sock = new_listener($host, $port) or die "Can't create server: $!";
my $c; #connection

$SIG{CHLD} = 'IGNORE';  # Don't reap zombies

msg("Entering accept loop (port $port)");
while (1) 
{
	#parent = listener
	dbg("Waiting for connections");
	$c = $sock->accept;
	dbg("Accepted connection");
	if (!defined $c) 
	{
		dbg("Accept timeout. Retrying");
		next;
	}

	msg("Forking off child to handle connection");
	my $pid = fork;
	if( $pid == 0 )
	{
		last;  # last will happen to child, parent stays in loop
	}
	dbg("New connection handler forked. Pid=$pid");
}

### Child handles a connection

undef $sock;  # close listening socket

#Hello message
#send_data( $c, "Hello message\n" );

my $cmdrecv = "";
while (1) 
{
	#child handles all commands
	$cmdrecv = "";
	msg("Start listening for command");
	$c->recv( $cmdrecv, 65536 );
	msg("Command received.");
	dbg("---------------");
	dbg($cmdrecv);
	dbg("Size: ".length($cmdrecv));
	dbg("hex: ".unpack('H*', "$cmdrecv"));
	dbg("---------------");

	if( $cmdrecv eq '' || $cmdrecv eq "\r\n" || $cmdrecv eq "\n\r" || $cmdrecv eq "\n" )
	{
		msg("Client Closed!");

		msg("Shutting down connection");
		shutdown( $c, 2 );
		$c->close;
		msg("Done");

		exit;
	}
	else
	{
		###This is a real request.

		###Form response chunks
		my $response_text = form_http_response("This is a simple response");

		msg("Sending response data");
		send_data( $c, $response_text );
	}
}

sub form_http_response
{
	my ($data) = @_;

	return
	"HTTP/1.1 200 OK\r\n".
	"Connection: close\r\n".
	"Content-Length: ".length($data).
	"\r\n\r\n".
	$data;
}

sub send_data
{
	my ($c, $data) = @_;

	dbg( "Sending ".length($data)." bytes: ".$data );
	$c->print($data);
	$c->flush;
}

sub new_listener
{
	my ($host, $port) = @_;
	my $s = IO::Socket::INET->new(
		LocalAddr => $host,
		LocalPort => $port,
		Proto    => 'tcp',
		ReuseAddr => 'true',
		Listen   => 5,
		Timeout  => 10)
	or return undef;

	$s->sockopt(SO_REUSEADDR => 1);
	$s->autoflush(1);
	return $s;
}

sub print_usage_notes
{
	print( "Usage:
    $0 [--port|-p <LISTENING PORT>] [--loglvl|-log <LOGGING LEVEL>] [--help|-h]\n

Parameters notes:
    --port, -p          [Default=9000] The listening port.

    --loglvl, -log      [Default=4] The logging level.
                        0            - Suppress all logging.
                        1            - Errors only,
                        2            - Messages and errors only,
                        3            - Debugging messages, messages and errors,
                        4(and above) - Add log dump to stdout.

    --help, -h          print this usage and exit.\n" );
}

#EOF