DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets has posted 5883 posts at DZone. View Full User Profile

Webserver In Perl

12.09.2009
| 3454 views |
  • submit to reddit
        
#!/usr/bin/perl -w
#
# Simple server using IO::Socket
# John Harrison - 16 Nov 2009
#
use strict;
use IO::Socket;
use CGI;

my $port = 6463;
my $host = 'HOSTNAME';

my $sock = new IO::Socket::INET(
    LocalHost => $host,
    LocalPort => $port,
    Proto     => 'tcp',
    Listen    => SOMAXCONN,
    Reuse     => 1
);
(my $my_name = $0) =~ s{.*/}{}g;

$sock or die "$my_name: Failed to create socket :$!\n";

my($new_sock, $c_addr); # , $buf);

my @ignore = (
    'Host',
    'User-Agent', 'Accept', 'Accept-Language',
    'Accept-Encoding', 'Accept-Charset',
    'Keep-Alive', 'Connection', 'Cache-Control'
);

print "Starting Server...\n";
SOCK: while (($new_sock, $c_addr) = $sock->accept()) {

    my ($client_port, $c_ip) = sockaddr_in($c_addr);
    my $client_ip = inet_ntoa($c_ip);
    # my $client_host = gethostbyaddr($c_ip, AF_INET);

    print "$my_name: Connect from: [$client_ip]\n";

    LINE: while (defined (my $buf = <$new_sock>)) {

        chomp $buf;
        $buf =~ s/\r$//;

        if ( $buf =~ m{^GET /host/([^/\s]+)/dc HTTP/1.1} ) {

            my $q = CGI->new;

            # print $new_sock $q->header( -type => 'text/plain' );

            print $new_sock "QUERY HOST: $1\n";

        }
        elsif ( $buf =~ m{help}i ) {

            print $new_sock "\nUsage: /host/<HOSTNAME>/dc\n";

        }
        elsif ( $buf =~ /QUIT/ ) {

            print $new_sock "bye...\n";
            close($new_sock);
            next SOCK;

        }
        elsif ( $buf eq "" ) {

            close($new_sock);
            next SOCK;

        }
        else {

            for my $header ( @ignore ) {
                next LINE if $buf =~ /^${header}:/;
            }
            print "[$buf]\n";

        }

    }

}