Dr. Dobb's is part of the Informa Tech Division of Informa PLC

This site is operated by a business or businesses owned by Informa PLC and all copyright resides with them. Informa PLC's registered office is 5 Howick Place, London SW1P 1WG. Registered in England and Wales. Number 8860726.


Welcome Guest | Log In | Register | Benefits
Channels ▼
RSS

Webbook: An Address Book for the World Wide Web (Web Techniques, Apr 1996)


#!/usr/local/bin/perl
#
# cgi-server: 
#   A stand-alone CGI server designed to be used with cgi-lib.pl.
#   Sets $standalone and calls &main for each received connection
#
# Usage: cgi-server {port} {script}
#
# 
use Socket;

$port = $ARGV[0];
$script = $ARGV[1];

($port && $script) || die "usage: $0 port script\n"; 

$standalone = 1;
require $script;

# This is from perl5 manual:

$sockaddr = 'S n a4 x8';
($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $port) = getservbyname($port, 'tcp')
    unless $port =~ /^\d+$/;
$this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
select(NS); $| = 1; select(STDOUT);
socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
bind(S, $this) || die "bind: $!";
listen(S, 5)   || die "connect: $!";
select(S); $| = 1; select(STDOUT);

# Set up static variables
$ENV{'SERVER_PORT'}  = $port;
chop ($hostname = `hostname`);
$ENV{'SERVER_NAME'}  = $hostname;
$ENV{'SCRIPT_NAME'}  = "/"; # One script per port

# Accept connections

for (;;) {
    ($addr = accept(NS,S)) || die $!;

    if($pid=fork){
    # parent;
    close(NS);
    } elsif (defined $pid){
    &httpd;
    } else {
    die "Can't fork: $!\n";
    }
}
    
# Handle an incoming httpd connection
sub httpd {
    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
    @inetaddr = unpack('C4',$inetaddr);

    open(STDIN,">&NS");
    open(STDOUT,">&NS");
    
    close(NS);
    select(STDIN);$| = 1;
    select(STDOUT);$| = 1;
    
    # Get command
    $_ = <STDIN>;
    chop $_;
    chop $_;
    ($command,$arg,$protocol) = split(' ',$_);

    # Print log
    print STDERR "cgi_server: $_\n";

    do {
    $_ = <STDIN>;
    chop;
    chop;
    if(m/Content-length: ([0-9]*)/){
        $ENV{'CONTENT_LENGTH'} = $1;
    }
    } until($_ eq "");
    

    # Set up environment

    $arg =~ s/.*\?//;
    $ENV{'REQUEST_METHOD'} = $command;
    $ENV{'QUERY_STRING'} = $arg;
    
    # Run the script

    print "HTTP/1.0 200 Document follows\r\n";
    print "Content-type: text/html\r\n\r\n";
    &main;
    exit(0);
}

Related Reading


More Insights