Skip to content
Browse files

Major updates, resolves issue #1, thanks to bbkr++

  • Loading branch information...
1 parent 545cfd5 commit 7e7f1d41dbeb53f6e5ff195c4448e03db2d81045 Timothy Totten committed Oct 12, 2012
Showing with 203 additions and 140 deletions.
  1. +0 −52 README
  2. +60 −0 README.md
  3. +0 −2 TODO
  4. +123 −75 lib/HTTP/Easy.pm6
  5. +17 −10 lib/HTTP/Easy/PSGI.pm6
  6. +3 −1 {examples → test}/test.p6
View
52 README
@@ -1,52 +0,0 @@
-HTTP::Easy
------------
-
-Perl 6 libraries to make HTTP servers easily.
-
-This was inspired by HTTP::Server::Simple, but has a very different internal
-API, and extended functionality. It's been designed to work well with my
-own WWW::App and SCGI libraries. Also see my HTTP::Client library if you
-are looking for an HTTP client rather than an HTTP server.
-
-= HTTP::Easy =
-
-A role to build custom HTTP servers.
-Provides the framework for parsing HTTP connections.
-The classes implementing this must provide the rest, and send the appropriate
-output (in HTTP compliant ways.)
-
-= HTTP::Easy::PSGI =
-
-A class implementing HTTP::Easy. This builds a PSGI environment, and passes
-it onto a handler. The handler must return a PSGI response
-(e.g.: [ $status, @headers, @body ] )
-
-This can be used as an engine in the WWW::App library.
-
-= HTTP::Easy::SCGI =
-
- ** Not implemented yet, see TODO **
-
-A class implementing HTTP::Easy. This connects to an SCGI daemon.
-It will receive the reply from the SCGI daemon, and parse it accordingly
-(it automatically detects if NPH output was returned.)
-
-= Examples =
-
-See the examples in the 'examples/' folder.
-
-= Requirements =
-
- * Rakudo Perl 6
- * HTTP::Status
-
-= Author =
-
-Timothy Totten
-http://huri.net/
-http://github.com/supernovus/
-
-= License =
-
-Artistic License 2.0
-
View
60 README.md
@@ -0,0 +1,60 @@
+# HTTP::Easy
+
+## Introduction
+
+Perl 6 libraries to make HTTP servers easily.
+
+This was inspired by HTTP::Server::Simple, but has a very different internal
+API, and extended functionality. It's been designed to work well with my
+own WWW::App and SCGI libraries. Also see my HTTP::Client library if you
+are looking for an HTTP client rather than an HTTP server.
+
+## HTTP::Easy
+
+A role to build HTTP daemon classes with.
+This provides the framework for parsing HTTP connections.
+
+## HTTP::Easy::PSGI
+
+A class implementing HTTP::Easy. This builds a PSGI environment, and passes
+it onto a handler. The handler must return a PSGI response:
+
+```perl
+ [ $status, @headers, @body ]
+```
+
+This can be used as an engine in the WWW::App library.
+
+## Example
+
+```perl
+
+ use HTTP::Easy::PSGI;
+ my $http = HTTP::Easy::PSGI.new(:port(8080));
+
+ my $app = sub (%env)
+ {
+ my $name = %env<QUERY_STRING> || "World";
+ return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $name" ] ];
+ }
+
+ $http.handle($app);
+
+```
+
+## Requirements
+
+ * HTTP::Status
+
+## TODO
+
+ * Implement HTTP/1.1 features such as Transfer-Encoding, etc.
+
+## Author
+
+Timothy Totten, supernovus on #perl6, https://github.com/supernovus/
+
+## License
+
+Artistic License 2.0
+
View
2 TODO
@@ -1,2 +0,0 @@
-* Add HTTP::Easy::SCGI
-* Add examples other than test.p6
View
198 lib/HTTP/Easy.pm6
@@ -1,87 +1,135 @@
## A simple HTTP Daemon role. Inspired by HTTP::Server::Simple
-## This doesn't do anything by itself, and must be extended.
-## See HTTP::Easy::PSGI and HTTP::Easy::SCGI for implementations
-## using this role.
+## See HTTP::Easy::PSGI as the default daemon class implementation.
-class HTTP::Easy {
- has Int $.port = 8080;
- has Str $.host = 'localhost';
- has Bool $.debug = False;
- has $!listener = IO::Socket::INET.new(:localhost($!host), :localport($!port), :listen(1));
- has $.connection is rw; ## To be populated by accept().
- has %.env; ## The environment, generated by run().
- has $.body is rw; ## Any request body, populated by run().
+role HTTP::Easy;
- ## We're using DateTime.new(time) instead of DateTime.now()
- ## Because the current DateTime messes up the user's local timezone
- ## if they are in a negative offset, which totally screws up the reported
- ## time, so we are forcing UTC instead.
- sub message ($message) {
- my $timestamp = DateTime.new(time).Str;
- $*ERR.say: "$timestamp -- $message";
- }
+use HTTP::Status;
- method run {
- message('Started HTTP server.');
- self.pre-connection;
- while $.connection = $!listener.accept {
- self.on-connection;
- if ($.debug) { message("Client connection opened."); }
- my $received = $!connection.recv();
- if ($.debug) { message("Got HTTP request:\n$received"); }
- my @request = split("\x0D\x0A", $received);
- my $request = shift @request;
- if (! $.debug) { ## This is shown when not debugging.
- message($request);
- }
- my ($method, $uri, $protocol) = $request.split(/\s/);
- if (!$protocol) { $protocol = 'HTTP/1.1'; }
- unless $method eq any(<GET POST HEAD PUT DELETE>) { die "unknown HTTP method"; }
- my ($path, $query) = $uri.split('?', 2);
- $query //= '';
- ## First, let's add our "known" headers.
- %.env<SERVER_PROTOCOL> = $protocol;
- %.env<REQUEST_METHOD> = $method;
- %.env<QUERY_STRING> = $query;
- %.env<PATH_INFO> = $path;
- %.env<REQUEST_URI> = $uri;
- %.env<SERVER_NAME> = $.host;
- %.env<SERVER_PORT> = $.port;
- ## Next, let's add HTTP request headers.
- while my $header = shift @request { ## Will end at the first empty line.
- my ($key, $value) = $header.split(': ');
- if defined $key and defined $value {
- $key ~~ s:g/\-/_/;
- $key .= uc;
- $key = 'HTTP_' ~ $key unless $key eq any(<CONTENT_LENGTH CONTENT_TYPE>);
- if %!env.exists($key) {
- %!env{$key} ~= ", $value";
- }
- else {
- %!env{$key} = $value;
- }
+has Int $.port = 8080;
+has Str $.host = 'localhost';
+has Bool $.debug = False;
+has $!listener;
+has $.connection; ## To be populated by accept().
+has %.env; ## The environment, generated by run().
+has $.http-protocol; ## The HTTP version being used.
+has $.body; ## Any request body, populated by run().
+
+constant CRLF = "\x0D\x0A";
+constant DEFAULT_PROTOCOL = 'HTTP/1.0';
+
+## We're using DateTime.new(time) instead of DateTime.now()
+## Because the current DateTime messes up the user's local timezone
+## if they are in a negative offset, which totally screws up the reported
+## time, so we are forcing UTC instead.
+sub message ($message)
+{
+ my $timestamp = DateTime.new(time).Str;
+ $*ERR.say: "[$timestamp] $message";
+}
+
+method connect (:$port=$.port, :$host=$.host)
+{
+ $!listener = IO::Socket::INET.new(
+ :localhost($host),
+ :localport($port),
+ :listen(1)
+ );
+}
+
+method run
+{
+ if ! $!listener { self.connect; }
+ message('Started HTTP server.');
+ self.pre-connection;
+ while $!connection = $!listener.accept
+ {
+ if $.debug { message("Client connection received."); }
+ self.on-connection;
+ my $request = $!connection.get;
+ message($request);
+ my @headers;
+ my $in-headers = True;
+ while $in-headers
+ {
+ my $line = $!connection.get.chomp;
+ if ! $line { $in-headers = False; }
+ if $.debug { $*ERR.say: " $line"; }
+ @headers.push($line);
+ }
+ if $.debug { message("Finished parsing headers."); }
+ my ($method, $uri, $protocol) = $request.split(/\s/);
+ if (!$protocol) { $protocol = DEFAULT_PROTOCOL; }
+ unless $method eq any(<GET POST HEAD PUT DELETE>)
+ {
+ $!connection.send(self.unhandled-method);
+ $!connection.close;
+ next;
+ }
+ $!http-protocol = $protocol;
+ %!env = {}; ## Delete the previous hash.
+ my ($path, $query) = $uri.split('?', 2);
+ $query //= '';
+ ## First, let's add our "known" headers.
+ %.env<SERVER_PROTOCOL> = $protocol;
+ %.env<REQUEST_METHOD> = $method;
+ %.env<QUERY_STRING> = $query;
+ %.env<PATH_INFO> = $path;
+ %.env<REQUEST_URI> = $uri;
+ %.env<SERVER_NAME> = $.host;
+ %.env<SERVER_PORT> = $.port;
+ ## Next, let's add HTTP request headers.
+ for @headers -> $header
+ {
+ my ($key, $value) = $header.split(': ');
+ if defined $key and defined $value {
+ $key ~~ s:g/\-/_/;
+ $key .= uc;
+ $key = 'HTTP_' ~ $key unless $key eq any(<CONTENT_LENGTH CONTENT_TYPE>);
+ if %!env.exists($key) {
+ %!env{$key} ~= ", $value";
+ }
+ else {
+ %!env{$key} = $value;
}
}
- ## Anything left in @request is now the body.
- $.body = @request.join("\x0D\x0A"); ## Put it back together with CRLF.
- my $res = self.handler; ## Call our handler. It can return an HTTP response, or handle it itself, in which case it should return Nil.
- if defined $res {
- $!connection.send($res);
- }
- $!connection.close;
- self.closed-connection;
}
- self.finish-connection;
- }
- ## Stub methods. Replace with your own.
- method pre-connection {}; ## Runs prior to waiting for connection.
- method on-connection {}; ## Runs at the beginning of each connection.
- method closed-connection {}; ## Runs after closing each connection.
- method finished-connection {}; ## Runs when the wait loop is ended.
- method handler {}; ## The HTTP request handler (MANDATORY).
+ ## Now, if there is a CONTENT_LENGTH header, let's read the content.
+ if %.env<CONTENT_LENGTH>
+ {
+ my $len = +%.env<CONTENT_LENGTH>;
+ $!body = $!connection.read($len);
+# if $.debug { message("Got body: "~$!body.decode); }
+ }
+ ## Call the handler. If it returns a string, it is assumed to be a valid
+ ## HTTP response. If it returns an undefined value, we assume the handler
+ ## sent the response to the client directly, and end the session.
+ my $res = self.handler;
+ if defined $res
+ {
+ $!connection.send($res);
+ }
+ $!connection.close;
+ self.closed-connection;
+ }
+ self.finish-connection;
}
-## End of role.
+## Stub methods. Replace with your own.
+method pre-connection {}; ## Runs prior to waiting for connection.
+method on-connection {}; ## Runs at the beginning of each connection.
+method closed-connection {}; ## Runs after closing each connection.
+method finished-connection {}; ## Runs when the wait loop is ended.
+
+## The handler method, this MUST be defined in your class.
+method handler {...};
+
+## Feel free to override this in your class.
+method unhandled-method
+{
+ my $status = 501;
+ my $message = get_http_status_msg($status);
+ return "$.http-protocol $status $message";
+}
View
27 lib/HTTP/Easy/PSGI.pm6
@@ -3,19 +3,21 @@
use HTTP::Easy;
-class HTTP::Easy::PSGI is HTTP::Easy;
+class HTTP::Easy::PSGI does HTTP::Easy;
use HTTP::Status;
constant $CRLF = "\x0D\x0A";
-has $!app is rw;
+has $!app;
-method app ($app) {
+method app ($app)
+{
$!app = $app;
}
-method handler {
+method handler
+{
## First, let's add any necessary PSGI variables.
%.env<psgi.version> = [1,0];
%.env<psgi.url_scheme> = 'http'; ## TODO: detect this.
@@ -27,26 +29,31 @@ method handler {
%.env<psgi.nonblocking> = False; ## Allow when NBIO.
%.env<psgi.streaming> = False; ## Eventually?
my $result;
- if $!app ~~ Callable {
+ if $!app ~~ Callable
+ {
$result = $!app(%.env);
}
- elsif $!app.can('handle') {
+ elsif $!app.can('handle')
+ {
$result = $!app.handle(%.env);
}
- else {
+ else
+ {
die "Invalid {self.WHAT} application.";
}
my $message = get_http_status_msg($result[0]);
- my $output = %.env<SERVER_PROTOCOL>~' '~$result[0]~" $message$CRLF";
- for @($result[1]) -> $header {
+ my $output = $.http-protocol ~ ' ' ~ $result[0] ~ " $message$CRLF";
+ for @($result[1]) -> $header
+ {
$output ~= $header.key ~ ': ' ~ $header.value ~ $CRLF;
}
my $body = $result[2].join;
$output ~= $CRLF ~ $body;
return $output;
}
-method handle ($app) {
+method handle ($app)
+{
self.app($app);
return self.run;
}
View
4 examples/test.p6 → test/test.p6
@@ -5,10 +5,12 @@ BEGIN { @*INC.unshift: './lib'; }
use HTTP::Easy::PSGI;
my $app = sub (%env) {
- return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello World" ] ];
+ my $name = %env<QUERY_STRING> || "World";
+ return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $name" ] ];
}
## We are using :debug for more detailed output to STDERR.
my $server = HTTP::Easy::PSGI.new(:debug);
$server.app($app);
$server.run;
+

2 comments on commit 7e7f1d4

@bbkr
bbkr commented on 7e7f1d4 Oct 12, 2012

Works flawlessly with JSON::RPC::Server (including Buf psgi.input and custom debug / host / port params).

Will it be bumped in Star 2012.10 release - https://github.com/rakudo/star/tree/master/modules ?

@supernovus
Owner

That's something you'll have to ask the Rakudo Star maintainers.

Please sign in to comment.
Something went wrong with that request. Please try again.