CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Advanced:
http 1.0 request - response , how to ?

 



mohamadally
New User

Jul 29, 2002, 8:59 PM

Post #1 of 3 (944 views)
http 1.0 request - response , how to ? Can't Post

dear All,

I've recently been given the task of writing a script that will recieve a request in the form of :

// Make HTTP Request Header
$in = "POST ".$postpath." HTTP/1.1\r\n";
$in .= "HOST: ".$host."\r\n";
$in .= "Authorization: Basic ".base64_encode($loginun.":".$loginpw)."\r\n";
$in .= "content-length: ".strlen($content)."\r\n\r\n";
$in .= $content;
$out = '';

$fp = fsockopen ("$host", 80, &$errnr, &$errstr) or die("$errno: $errstr");



and the script is suppose to process the request and send an http 1.0 200 ok response.

can any1 please advice me on how to do this?

Wht language shd i use?

Any useful information is welcome.



Thank you

ally



p.s sorry if i posted in the wrong forum.


davorg
Thaumaturge / Moderator

Jul 30, 2002, 1:45 AM

Post #2 of 3 (939 views)
Re: [mohamadally] http 1.0 request - response , how to ? [In reply to] Can't Post

Well, that code would be much easier to write if you used modules from the libwww bundle.

And to write the progrma that processed the request and sends a response, I'd almost certainly use Perl with the CGI module.

--
Dave Cross, Perl Hacker, Trainer and Writer
http://www.dave.org.uk/
Get more help at Perl Monks


Danni
Novice

Aug 11, 2002, 11:11 AM

Post #3 of 3 (924 views)
Re: [mohamadally] http 1.0 request - response , how to ? [In reply to] Can't Post

I think i understand what your asking, you can create a socket and had it read from it like this (this is a snippet from a project i am currently working on)

This reads a HTTP request, and will place all the headers (lowercased) into the hash $e, all the passed variables (GET only, not POST) into $form and all cookies into $cookies :)

This should work, but i just copied and pasted bits of code together here, so i may have missed something out :x

Many people have suggested i use IO::Daemon or something like that, but i have personaly had problems under heavy load with modules and prefer to do thing the hard way :) (besides its more fun)


This help you out any?


Code
use Socket; 
use Symbol;
use POSIX;
if ( fork() ) { exit; }; POSIX:setsid();

$port=8081;
$addr = "127.0.0.1";
$processes = 5;
sub SIG_HND_CHLD {$SIG{CHLD} = \&SIG_HND_CHLD; my $pid = wait; $children --; delete $children{$pid};}
sub SIG_HND_KILL {local($SIG{CHLD}) = 'IGNORE'; kill 'INT' => keys %children; exit;}


socket(S, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1);
my $my_addr = sockaddr_in($port},$addr);
bind(S, $my_addr) or die ("CRITICAL: Cant bind to main socket: $!");
listen(S, SOMAXCONN);


for (1 .. $processes) {make_new_child()}


### Install signal handlers.
$SIG{CHLD} = \&SIG_HND_CHLD;
$SIG{INT} = \&SIG_HND_KILL;


### Maintain process pool
while (1) {sleep; for ($i = $children; $i < $processes; $i++) {make_new_child()}}





sub process_connection () {
while ( <C> ) {
$headinfo .= $_;
if ( /^([A-Z]+)\s+([^\s]+)\s+([^\s\r\l\n]*)/ ) {
$method = $1;
$address = $2;
$httpver = $3;
$httpver = ( $httpver =~ m#HTTP/([0-9]\.[0-9]+)# ) ? ( $1 ) : ( 0.9 );
$address =~ s#^http://[^/]+/#/#;
if ( $httpver < 1 ) { last }
} else {
s/[\r\l\n\s]+$//;
( /^.+: (.+)/i ) && ( $e{lc($1)} = $2 );
if ( /^$/ ) { last; }
}
}
if (lc($e{'connection'}) eq "keep-alive" ) { $keepalive = 1 } else { $keepalive = 0 }


### Read URL Data
($address, $variables) = split (/[?\!]/, $address);
foreach (split(/[&|]/,$variables)) {my ($key, $value) = split(/[=;]/);$form{$key} = $value;}
foreach (split(/;\s/, $e{'cookie'})) {my ($key, $value) = split (/=/);$cookies{$key} = $value;}



#####################
## YOUR CODE HERE ##
#####################
# Cookies in %cookies
# Headers in %e
# form vars in %form
&send_basic_headers(0); # 0 = dont cache, 1 = cache

}




sub send_basic_headers () {
my ($cache) = shift @_;
my ($mtime) = scalar gmtime time;
my ( $dow, $mon, $dt, $tm, $yr ) = ( $mtime =~ m/(...) (...) (..) (..:..:..) (....)/ );$dt += 0;$yr += 0;
print C "HTTP/1.1 200 OK\n";
print C "Date: $dow, $dt $mon $yr $tm GMT\n";
print C $headers if $headers;
if ( $cache == 1 ) {
print C ( "Last-Modified: Fri, 10 May 2002 12:12:12 GMT\n" );
print C ( "Cache-Control: public\n" );
} else {
print C "Cache-Control: must-revalidate\n";
print C "Cache-Control: no-cache\n";
print C "Last-Modified: $dow, $dt $mon $yr $tm GMT\n";
}


sub make_new_child {
my $pid;
my $sigset;

# block signal for fork
$sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset)
or die "Can't block SIGINT for fork: $!\n";

die "fork: $!" unless defined ($pid = fork);

if ($pid) {
# Parent records the child's birth and returns.
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = 1;
$children++;
return;
} else {
# Child can *not* return from this subroutine.
$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before

# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";

for ($i=0; $i < $c{'maxclients'}; $i++) {
accept(C, S);
# Disable buffering on our socket
my $old_fh = select(C);
$|=1;
select($old_fh);
process_connection();
}

exit;
}
}


 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives