/ws-main.pl
Perl | 163 lines | 116 code | 33 blank | 14 comment | 13 complexity | 4c2fd00865911d7c3c3bcd68288f7a60 MD5 | raw file
- #!/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