/usr/share/doc/libhttp-request-ascgi-perl/examples/daemon.pl is in libhttp-request-ascgi-perl 1.2-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | #!/usr/bin/perl
use strict;
use warnings;
use CGI;
use HTTP::Daemon;
use HTTP::Request;
use HTTP::Request::AsCGI;
use HTTP::Response;
use URI;
$SIG{'PIPE'} = 'IGNORE';
my $server = HTTP::Daemon->new( LocalPort => 3000, ReuseAddr => 1 )
or die( "Can't create daemon: $!" );
print "Please contact me at: <URL:", $server->url, ">\n";
while ( my $client = $server->accept ) {
my %e = (
REMOTE_ADDR => $client->peerhost,
REMOTE_HOST => $client->peerhost,
REMOTE_PORT => $client->peerport
);
while ( my $request = $client->get_request ) {
unless ( $request->uri->host ) {
$request->uri( URI->new_abs( $request->uri, $server->url ) );
}
my $c = HTTP::Request::AsCGI->new( $request, %e )->setup;
my $q = CGI->new;
print $q->header( -charset => 'UTF-8' ),
$q->start_html(
-title => 'Hello World',
-encoding => 'UTF-8'
),
$q->h1('Hello World'),
$q->start_form,
$q->table(
$q->Tr( [
$q->td( [ 'Name', $q->textfield( -name => 'name' ) ] ),
$q->td( [ 'Email', $q->textfield( -name => 'email' ) ] ),
$q->td( [ 'Phone', $q->textfield( -name => 'phone' ) ] ),
$q->td( [ 'File', $q->filefield( -name => 'file' ) ] )
] )
),
$q->submit,
$q->end_form,
$q->h2('Parameters'),
$q->Dump,
$q->h2('Enviroment'),
$q->table(
$q->Tr( [
map{ $q->td( [ $_, $ENV{$_} ] ) } sort keys %ENV
] )
),
$q->end_html;
my $response = $c->restore->response;
# tell client to close socket to prevent blocking problems
# in this single threaded daemon.
$response->header( Connection => 'close' );
$client->send_response($response);
}
$client->close;
}
|