Combining HTTP:Daemon and CGI

[Yuri Shtil]

Hi all,

I am working on a script for a simple Browser based GUI.

The idea is to create an HTTP:daemon object on a random local port, spawn a
browser on the local machine pointing to the daemon's URL , send a form to
the browser via CGI and process the user response.

The code works fine up to processing of the form (a POST request). I can see
the form in the browser, and see the request coming back, once the SUBMIT
button is pressed.

I ran into a problem trying to make CGI to process the request within the
daemon process.
My understanding is that CGI relies on the Web Server to set up a bunch of
environment variables, invoke the CGI script and feed the POST request to
the script via STDIN.

In order to imitate this setup I populated the environment variables from
the HTTP::Request object, wrote the content field (supposetely containing
the POST data) into a file, redirected STDIN from the file and started CGI
(see below). However, the CGI module does not parse the content correctly.

Has anyone tried to make CGI work in t a similar environment?

--------------------------------------------------------


Here is the code:

use strict;

use CGI ':all';
use HTTP:aemon;
use Win32:rocess;
use Win32;
use File::Temp qw/tempfile/;
use File::Slurp;

my %template = ('title' => Title',
'fields' => [
{
'name' => 'LABEL',
'type' => '=s',
'default' => 'V100_005',
},
{
'name' => 'PLATFORM',
'type' => '=c',
'default' => ['one', 'two'],
},
{
'name' => 'PRODUCT',
'type' => '=c',
'default' => ['one', 'two'],
},
{
'name' => 'Whatever',
'type' => '=s',
'default' => 'however',
},
],
);

my %cgi_env = (
'CONTENT'=> sub {$_[0]->content},
'CONTENT_LENGTH' => \&content_length,
'CONTENT_TYPE' => sub {$_[0]->headers->{'content-type'}
if exists $_[0]->headers->{'content-type'}},
'QUERY_STRING' => sub {$_[0]->uri =~ /\?(.+$)/; $1},
'REQUEST_METHOD' => sub {$_[0]->method},
'REQUEST_URI' => sub {$_[0]->uri;},
);

$| = 1;
my $d = HTTP:aemon->new || die;

# Spawn the browser with out URL
my $proc;
unless (Win32:rocess::Create($proc,'c:\\WINDOWS\\system32\\cmd.exe',
sprintf('cmd /C start %s', $d->url )
,0,NORMAL_PRIORITY_CLASS,'.'))
{
die Win32::FormatMessage( Win32::GetLastError() );
}

my ($fh, $tmpfile) = tempfile("cgiXXXXXX", UNLINK => 1, DIR =>
File::Spec->tmpdir());
close $fh;

while (my $c = $d->accept) {

my $r = $c->get_request;
if ($r->method eq 'GET') {
# Push table out
generate_form($c, \%template);
} elsif ($r->method eq 'POST') {
# Cheat CGI to a temp file
write_file($tmpfile, $r->content);

local *STDIN;
unless (open STDIN, '<', $tmpfile)
{
die "cannot redirect stdIN:$!";
}

CGI::initialize_globals();
set_env($r);
my $cgi = new CGI;
# can't make it to read content
1;

} {
# Process response
1;
last;
}

close $c;
}

sub set_env
{
my $r = shift;
while (my ($k, $v) = each %cgi_env) {
$ENV{$k} = $v->($r);
}

# Also set the HTTP_ from headers
while (my ($k, $v) = each %{$r->headers}) {
my $n = $k;
$n =~ s/-/_/g;
$n = 'HTTP_' . uc $n;
$ENV{$n} = $v;
}
}

sub content_length
{
my $r = shift;
my $b = $r->headers->{'content-type'};
$b =~ s!^multipart/form-data; boundary=!!;
my $bl = length $b;
my @num = $r->content =~ /$b/g;
length($r->content) - $#num * $bl;
}

sub content
{
my $r = shift;
$r->content;
}

sub content_type {
my $r = shift;
$r->headers->{'content-type'} if exists $r->headers->{'content-type'};
}

sub query_string {
my $r = shift;
$r->uri =~ /\?(.+$)/;
$1;
}
sub request_method {
my $r = shift;
$r->method;
}
sub request_uri {
my $r = shift;
$r->uri;
}

sub generate_form
{
my ($c, $desc) = @_;

# This will make our life easier
local *STDOUT;
unless (open STDOUT, '>&', $c)
{
die "cannot redirect stdout:$!";
}

# Create table data
my @tds;
foreach (@{$desc->{'fields'}}) {
my $type = substr($_->{'type'}, 1, 1);
my $td;
if ($type eq 's') { # String
$td = textfield('-name' => $_->{'name'},
'-size' => 50,
'maxlength' => 256,
'-value' => $_->{'default'},
);
} elsif ($type eq 'm') { # Menu
$td = popup_menu(-name=> $_->{'name'},
-values => $_->{'default'});
} elsif ($type eq 'c') { # Checkbox
$td = checkbox_group('-name' => $_->{'name'}, '-values' =>
$_->{'default'});
}
else {
die sprintf('Invalid type %s for element %s', $type, $_->{'name'});
}
push(@tds, td([$_->{'name'} . ': ', $td]));
}

print start_html($desc->{'title'}), h1(sprintf('Enviroment for Project
%s', $desc->{'title'}));
print start_form('-align' => 'center');
print table({-border=>2},
Tr({-align=>'LEFT', -valign=>'TOP'},
[
th(['Name', 'Value']),
@tds,
]
)
);

print submit(-name=> 'Submit');
print endform;

print end_html;
close STDOUT;
}

 

[xhoster]

Hi all,

I am working on a script for a simple Browser based GUI.

The idea is to create an HTTP:daemon object on a random local port, spawn
a browser on the local machine pointing to the daemon's URL , send a form
to the browser via CGI and process the user response.

The code works fine up to processing of the form (a POST request). I can
see the form in the browser, and see the request coming back, once the
SUBMIT button is pressed.

I ran into a problem trying to make CGI to process the request within the
daemon process.
My understanding is that CGI relies on the Web Server to set up a bunch
of environment variables, invoke the CGI script and feed the POST request
to the script via STDIN.

In order to imitate this setup I populated the environment variables from
the HTTP::Request object, wrote the content field (supposetely containing
the POST data) into a file, redirected STDIN from the file and started
CGI (see below). However, the CGI module does not parse the content
correctly.

Has anyone tried to make CGI work in t a similar environment?

Yep. Other than multi-part forms, it just worked. I don't know how (or
if) the environment variables get set up--it happens somewhere behind the
scenes.

The wrinkles I encountered were:
need -nph
no multipart forms => no file uploads
start_form needs to give an explicit action, or else you get the wrong
url. Some mysterious deaths, probably interupted system calls I haven't
tracked
down yet.

I didn't try to do a forking server, so I don't know the implications
of it.

If I had it to do over, I'd have changed the whiles to explicit infinite
loops, but I'm too lazy at this point.

use strict;
use warnings;
use HTTP:aemon;
use HTTP::Status;
use CGI qw( -nph -no_xhtml); # no_xhtml prevents the automatic
# use of multipart forms on newer CGI.pm
my $port=9871;
my %h= (
'/foo.cgi' => \&process ,
'/test.cgi' => \&test2 ,
);
my $d = HTTP:aemon->new(LocalPort => $port, ReuseAddr => 1) or die $!;
#warn $d;
while (my $c = $d->accept or warn "$!,$@:") {
redo unless $c;
my $r = $c->get_request or warn "$!, $@, ". ($c->reason()).":";
redo unless $r;
#print scalar localtime, "\n";
#print Dumper($r);
if (exists $h{$r->url->path}) {
my $q = $r->method eq 'GET' ?
new CGI($r->url->query) :
new CGI($r->content);
my $old = select $c; # Save real STDOUT (for logging)
$h{$r->url->path}->($q);
#warn "Done";
select $old;
#warn "Done2";
} else {
$c->send_error(RC_FORBIDDEN);
}
} continue {
$c->close;
}

sub process {
my $q=shift;
print $q->header();
print $q->start_html();
print "<H1>Hi!</H1>There<hr>";
print $q->Dump();
print $q->start_form(-action => "/foo.cgi");
print $q->textfield('sdfsdf');
print $q->submit();
print $q->end_form();
print $q->end_html();
};



Xho

 

[Randal L. Schwartz]

xhoster> Yep. Other than multi-part forms, it just worked. I don't know how (or
xhoster> if) the environment variables get set up--it happens somewhere behind the
xhoster> scenes.

I have code in CGI:rototype::Mecha to build a full CGI object
from what WWW::Mechanize would have sent... you might want to look
at that as a model.

print "Just another Perl hacker,"; # the original

--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[email protected]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

*** ***

 

[usenet]

I finally figured iit out.

Thanks for posting your resolution. It would be nice if everybody did
this...