Re: using http::Daemon and cgi

[drieux]

On Tuesday, Feb 11, 2003, at 14:59 US/Pacific, Joe Echavarria wrote:

Hi there,

   I want to write a simple cgi application using
http::daemon.   I want to write a cgi application
without installing a web server.  Can i do that ?, can
anyone send me a simple code ?.  Everything works fine
when i don't use a cgi script, i mean when i only use
html files, not perl scripts.

I think what you are asking is

how do I make a 'mini-web server' that will
front end one or more cgi piece of code?

It's not really that hard, and you're aiming in the
right direction-ish with the http::daemon approach,
the trick then becomes how to managing setting up
the appropriate environment for the cgi scripts,
and then resolving if you want to manage running
more than one cgi script at a time.... hence if
you are going to fork() yourself...

The code itself is not really simple. I would
highly recommend peeking at the webadmin tool set
at:

http://www.webmin.com/


ciao
drieux

---

an illustration - this code may not work, as i opted
to do some major re-write about hot to get it to do
what I wanted, but I think It will help you towards the idea.

#!/usr/bin/perl -w
use strict;

#
# the plot here is to generate a basic test Frame webServer
#
use HTTP::Daemon;
use HTTP::Status;

my $local_host = 'libex';
my $local_port = 12347;

my $d = new HTTP::Daemon (
LocalAddr => $local_host ,
LocalPort => $local_port ,
Reuse => 1 );

die "unable to new daemon\n"
unless($d);

my $main_fileno = $d->fileno ;
print "Please contact me at: <URL: ", $d->url, " > we are on $main_fileno\n";

open(STDIN, "</dev/null");
open(STDOUT, ">/dev/null");

#
# here we go into our main processing loop
#

our $c; # for our $c the socket

$SIG{'TERM'} = sub { if ($c) {
$c->shutdown(2);
$c->close; }};

$SIG{'__DIE__'} = sub {
if ($c) {
$c->shutdown(2);
$c->close;
}
};

my ( @childpids, $rmask, @passin, @passout );

while ($c = $d->accept) {
while (my $r = $c->get_request) {
my $path = $r->url->path ;
my $url = $r->uri ;
my $method = $r->method ;
my $qstring = $r->uri->query ;
my $content = ${$r->content_ref};
my $iaddr = $c->peeraddr ;
my $peer = gethostbyaddr($iaddr, AF_INET);

print STDERR "handed request: $path and $url \n";
print STDERR " we got content <$content>\n"
if($content);
print STDERR " we got qstring <$qstring>\n"
if($qstring);
if ($method eq 'GET' && $path =~ /^\/$/ ) {
$c->send_file_response("../docs/hello.html");
} elsif ( -f "../docs${path}" ) {
$c->send_file_response("../docs${path}");
} elsif ( -f "../cgi_bin${path}" ) {
#
# we know it is something we can invoke
# let us just cope with the game now
#
handle_request($r, $c);

} else {
$c->send_error(RC_NOT_FOUND)
}
undef($r);
}

$c->shutdown(2);
$c->close;
undef($c);
}

#------------------------
#
sub handle_request {
my ($req, $caller) = @_;

my $cgipid = -1;
my $posted_data;
my $queryargs;
my $scriptname;

my $meth = $req->method ;
my $path = $req->url->path ;
($scriptname = $path ) =~ s/\/// ;
my $uri = $req->url ;
my $full = "./$scriptname";
if ( $meth eq 'POST' ) {
#
# we need to pull this out for the fun filled folks.
#
$ENV{'CONTENT_LENGTH'} = $req->content_length;
$posted_data = $req->content();
#$posted_data =~ s/&/ /g ;
}

if ( $meth eq 'GET' ) {
#$queryargs = $req->url
$queryargs = $req->uri->query ;
$queryargs ||= ' ';
#$queryargs =~ s/&/ /g ;
}
$queryargs ||= $posted_data;

$ENV{'QUERY_STRING'} = $queryargs ;
$ENV{'CONTENT_TYPE'} = $req->content_type;
$ENV{"PWD"} = "../cgi_bin";
$ENV{"REQUEST_METHOD"} = $meth;
$ENV{"SCRIPT_NAME"} = $scriptname;
$ENV{"REQUEST_URI"} = $uri;

#
# borrowing the webMin fork cgi model
#
pipe(CGIINr, CGIINw);
pipe(CGIOUTr, CGIOUTw);
#pipe(CGIERRr, CGIERRw);
if (!($cgipid = fork())) {
chdir($ENV{"PWD"});
open(STDIN, "<&CGIINr");
open(STDOUT, ">&CGIOUTw");
#open(STDERR, ">&CGIERRw");
close(CGIINw); close(CGIOUTr); #close(CGIERRr);
exec($full, split(/\s+/, $queryargs));
exit;
}
print STDERR "calling $full \n";
close(CGIINr); close(CGIOUTw); #close(CGIERRw);

#
# send in the posted data
if ( $posted_data ) {
print CGIINw $posted_data;
}
close(CGIINw);
$caller->shutdown(0);
select(CGIOUTr); $|=1; select(STDOUT);
#
# we read their phoo and woof it through
#
my $line;
while($line = <CGIOUTr>) {
$caller->print( $line );
}
#print STDERR "make it out OK\n";

close(CGIOUTr); #close(CGIERRr);

} # end of handle_request

if nothing else it will give you a feel for what needs to be done.




--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]