Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Rewrote the Request parsing. Refactored the rest.

  • Loading branch information...
commit b73aebe42e0bd6bc58890870f8d143cd604fdc4c 1 parent ddd8612
@supernovus authored
Showing with 49 additions and 74 deletions.
  1. +5 −3 README
  2. +1 −1  SCGI-test.p6
  3. +41 −65 SCGI.pm
  4. +2 −5 TODO
View
8 README
@@ -10,9 +10,9 @@ It offers a bit of candy coating compared to the Perl 5 version.
The environment contains three special keys:
- Request.SCGI is a reference to the SCGI object itself.
+ Request.Body is the request body (usually from an HTTP POST.)
Request.Object is a reference to the individual request object.
- Request.Body is the actual request body (usually from an HTTP POST.)
+ Request.SCGI is a reference to the SCGI object itself.
Also, you don't need to create your own IO::Socket::INET object.
Just pass an 'addr' and 'port' attribute to the new() declaration and it'll
@@ -39,8 +39,10 @@ the heavy lifting for you:
-Yeah, that's it. A simple SCGI script.
+The output of the handler will be sent as the SCGI response,
+so make it a valid CGI response.
Author: Timothy Totten (supernovus) <2010@huri.net> http://huri.net/
Released under the Artisitc License 2.0
+
View
2  SCGI-test.p6
@@ -4,7 +4,7 @@
use SCGI;
-my $scgi = SCGI.new();
+my $scgi = SCGI.new( :port(8118), :strict );
my $handler = sub (%env) {
my $name = %env<QUERY_STRING> // 'World';
View
106 SCGI.pm
@@ -1,54 +1,43 @@
class SCGI::Request {
+ has $!strict = True;
has $.connection;
- has $!env_read is rw;
- has $!env_buffer is rw = '';
- has $!env_length_buffer is rw = '';
- has $!env_length_read is rw;
has %.env is rw;
+ has $.body is rw;
+ has $.request is rw;
has $!closed is rw = 0;
- #has Bool $.blocking is rw = False;
- method read_env {
- unless $!env_length_read {
- say "read_env entered";
- my $buffer = $.connection.recv(14);
- say "initial receiving done";
- my $bytes_read = ~$buffer.chars;
- die "read error $!" unless defined $bytes_read;
- return unless $bytes_read;
- if $buffer ~~ / ^ (\d+) \: (.*) $ / {
- $!env_length_buffer ~= +$0;
- $!env_buffer ~= ~$1;
- $!env_length_read = 1;
- }
- elsif $!env_length_buffer ne '' && $buffer ~~ / ^ \: (.*) $ / {
- $!env_buffer ~= ~$0;
- $!env_length_read = 1;
- }
- elsif $buffer ~~ / ^ \d+ $ / {
- $!env_length_buffer = +$buffer;
- return;
- }
- else {
- die "malformed env length";
- }
- }
- my $left_to_read = $!env_length_buffer - $!env_buffer.chars;
- my $buffer = $.connection.recv($left_to_read + 1);
- my $read = ~$buffer.chars;
- die "read error: $!" unless defined $read;
- return unless $read;
- if $read == $left_to_read + 1 {
- if (my $comma = $buffer.substr($left_to_read) ne ',') {
- die "malformed netstring, expecting terminating comma, found \"$comma\"";
+ method err ($message) {
+ my $crlf = "\x0D\x0A" x 2;
+ $*ERR.say: "[{time}] $message";
+ $.connection.send("Status: 500 SCGI Protocol Error$crlf");
+ self.close;
+ return 0;
+ }
+
+ method parse {
+ $.request = $.connection.recv();
+ if $.request ~~ / ^ (\d+) \: / {
+ my $length = +$0;
+ my $offset = ~$0.chars + 1;
+ my $env_string = $.request.substr($offset, $length);
+ my $comma = $.request.substr($offset+$length, 1);
+ return self.err("malformed netstring, expecting terminating comma, found \"$comma\"") if $comma ne ',';
+ $.body = $.request.substr($offset+$length+1);
+ %.env = $env_string.split("\0");
+ if $!strict {
+ return self.err("malformed or missing CONTENT_LENGTH header")\
+ unless %.env<CONTENT_LENGTH> \
+ && %.env<CONTENT_LENGTH> ~~ / ^ \d+ $ /;
+ return self.err("missing SCGI header")\
+ unless %.env<SCGI> && %.env<SCGI> eq '1';
}
- self!decode_env($!env_buffer ~ $buffer.substr(0, $left_to_read));
return 1;
}
else {
- $!env_buffer ~= $buffer;
- return;
+ return self.err(
+ "invalid request, expected a netstring, got: $.request"
+ );
}
}
@@ -57,21 +46,6 @@ class SCGI::Request {
$!closed = 1;
}
- method !decode_env ($env_string) {
- my %env = $env_string.split("\0");
- die "malformed or missing CONTENT_LENGTH header" unless %env<CONTENT_LENGTH> && %env<CONTENT_LENGTH> ~~ / ^ \d+ $ /;
- die "missing SCGI header" unless %env<SCGI> && %env<SCGI> eq '1';
- %.env = %env;
- }
-
- method read_body {
- my $body;
- if %.env<CONTENT_LENGTH> {
- $body = $.connection.recv(%.env<CONTENT_LENGTH>);
- }
- return $body;
- }
-
submethod DESTROY {
self.close unless $.closed;
}
@@ -80,7 +54,6 @@ class SCGI::Request {
class SCGI {
- #has Bool $.blocking = False;
has Int $!port = 8080;
has Str $!addr = 'localhost';
has IO::Socket $.socket = IO::Socket::INET.socket(2, 1, 6)\
@@ -89,21 +62,24 @@ class SCGI {
has $!bodykey = 'Request.Body';
has $!requestkey = 'Request.Object';
has $!scgikey = 'Request.SCGI';
+
+ has $!strict = True;
method accept () {
my $connection = self.socket.accept() or return;
- #$connecton.blocking(0) unless $.blocking;
- SCGI::Request.new( :connection($connection) );
+ SCGI::Request.new( :connection($connection), :strict($!strict) );
}
method handle (&closure) {
while (my $request = self.accept) {
- $request.read_env;
- my %env = $request.env;
- %env($!requestkey) = $request;
- %env($!scgikey) = self;
- %env($!bodykey) = $request.read_body;
- $request.connection.send($.closure(%env));
+ if $request.parse {
+ my %env = $request.env;
+ %env{$!requestkey} = $request;
+ %env{$!scgikey} = self;
+ %env{$!bodykey} = $request.body;
+ $request.connection.send(closure(%env));
+ $request.close;
+ }
}
}
View
7 TODO
@@ -1,6 +1,3 @@
-- Fix the library. In the January release of Rakudo, it bails out
- when you try to open a connection to the port.
- - I may end up changing how SCGI::Request reads from the socket.
- Reading the entire request, then parsing the components may be
- a simpler method. We'll see.
+- Include some more examples, like a wrapper that logs the STDOUT and STDERR
+ to log files, as it is not passed through the socket.
Please sign in to comment.
Something went wrong with that request. Please try again.