Revision: 124
Author: jwalt
Date: 2006-08-24 19:22:32 +0000 (Thu, 24 Aug 2006)
Log Message:
-----------
- change uri_to_file to be more portable using File::Spec exclusively
- chance uri_to_file to behave like apache regarding path_info and nonexistant
files
- add plugin typeless_uri to manage URIs without file extension
- extend AxKit2::Test to provide a comfortable testing toolkit
- add exhaustive tests for uri_to_file and typeless_uri
Modified Paths:
--------------
trunk/lib/AxKit2/Client.pm
trunk/lib/AxKit2/Connection.pm
trunk/lib/AxKit2/Test.pm
trunk/plugins/uri_to_file
Added Paths:
-----------
trunk/plugins/typeless_uri
trunk/t/
trunk/t/10uri_to_file.t
trunk/t/11typeless_uri.t
trunk/t/server1/
trunk/t/server1/foo/
trunk/t/server1/foo/index.html
trunk/t/server1/index.html
trunk/t/server1/multi/
trunk/t/server1/multi/index.html
trunk/t/server1/multi.html
Modified: trunk/lib/AxKit2/Client.pm
===================================================================
--- trunk/lib/AxKit2/Client.pm 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/lib/AxKit2/Client.pm 2006-08-24 19:22:32 UTC (rev 124)
@@ -419,6 +419,7 @@
# stolen shamelessly from httpd-2.2.2/modules/http/http_protocol.c
sub default_error_out {
my ($self, $code, $extras) = @_;
+ $extras = '' unless defined $extras;
$self->headers_out->code($code);
Modified: trunk/lib/AxKit2/Connection.pm
===================================================================
--- trunk/lib/AxKit2/Connection.pm 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/lib/AxKit2/Connection.pm 2006-08-24 19:22:32 UTC (rev 124)
@@ -140,7 +140,6 @@
# extra \r\n and if we clean it now (throw it away), then we
# can avoid a regexp later on.
if ($self->{ditch_leading_rn} && $self->{headers_string} eq "\r\n") {
- print " throwing away leading \\r\\n\n" if $::DEBUG >= 3;
$self->{ditch_leading_rn} = 0;
$self->{headers_string} = "";
return;
@@ -152,12 +151,10 @@
}
my $hstr = substr($self->{headers_string}, 0, $idx);
- print " pre-parsed headers: [$hstr]\n" if $::DEBUG >= 3;
my $extra = substr($self->{headers_string}, $idx+4);
if (my $len = length($extra)) {
- print " pushing back $len bytes after header\n" if $::DEBUG >= 3;
$self->push_back_read(\$extra);
}
Modified: trunk/lib/AxKit2/Test.pm
===================================================================
--- trunk/lib/AxKit2/Test.pm 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/lib/AxKit2/Test.pm 2006-08-24 19:22:32 UTC (rev 124)
@@ -19,12 +19,18 @@
use warnings;
use IO::Socket;
-use base 'Exporter';
+use LWP::UserAgent;
+use File::Spec;
+use base 'Test::Builder::Module';
-our @EXPORT = qw(start_server);
+our @EXPORT = qw(start_server stop_server content_is status_is is_redirect
no_redirect);
+our $VERSION = 0.01;
# Module to assist with testing
+my $ua = LWP::UserAgent->new;
+$ua->agent(__PACKAGE__."/".$VERSION);
+
my $server_port = 54000;
sub get_free_port {
@@ -41,15 +47,99 @@
return $server_port;
}
+my $server;
+
+=head2 start_server <config> | <docroot> <plugins> directives
+
+This takes either a configuration file excerpt as a string (anything that goes
inside a <Server></Server> block),
+or the document root, a list of plugins to load and a list of other
configuration directives.
+
+=cut
+
sub start_server {
- my $config = shift;
+ my ($docroot, $plugins, $directives) = @_;
my $port = get_free_port();
- return AxKit2::Test::Server->new($port, $config);
+ if (defined $plugins) {
+ $directives ||= [];
+ $docroot = File::Spec->rel2abs($docroot);
+ $server = AxKit2::Test::Server->new($port,"DocumentRoot
$docroot\n" .
+ join("\n",map { "Plugin $_" } @$plugins) . "\n" .
+ join("\n",@$directives) . "\n");
+ } else {
+ $server = AxKit2::Test::Server->new($port, $docroot);
+ }
+
+ return $server;
}
+sub stop_server {
+ $server->shutdown();
+ undef $server;
+}
+sub http_get {
+ my ($url) = @_;
+ $url = "http://localhost:$server_port$url"; if $url !~
m/^[a-z0-9]{1,6}:/i;
+ my $req = new HTTP::Request(GET => $url);
+ return ($req, $ua->request($req));
+}
+
+sub content_is {
+ my ($url, $content, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ my $res = http_get($url);
+ if (!$res->is_success) {
+ $builder->ok(0,$name);
+ $builder->diag("Request for '${url}' failed with error code
".$res->status_line);
+ return 0;
+ }
+ my $got = $res->content;
+ $got =~ s/[\r\n]*$//;
+ $content =~ s/[\r\n]*$//;
+ $builder->ok($res->content eq $content, $name) or
$builder->diag("Request for '${url}' failed:
+ got: $got
+expected: $content");
+}
+
+sub is_redirect {
+ my ($url, $dest, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ $ua->max_redirect(0);
+ $dest = "http://localhost:$server_port$dest";;
+ my $res = http_get($url);
+ $ua->max_redirect(7);
+ my $got = $res->code;
+ my $gotdest = $res->header('Location');
+ $builder->ok($res->is_redirect && $dest eq $gotdest, $name) or
$builder->diag("Request for '${url}' failed:" .
+ ($res->is_redirect? "" : "\n got status: $got, expected a
redirect") .
+ ($dest eq $gotdest? "" : "\n got destination:
$gotdest\nexpected destination: $dest"));
+}
+
+sub no_redirect {
+ my ($url, $dest, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ $ua->max_redirect(0);
+ $dest = "http://localhost:$server_port$dest";;
+ my $res = http_get($url);
+ $ua->max_redirect(7);
+ my $got = $res->code;
+ my $gotdest = $res->header('Location');
+ $builder->ok(!$res->is_redirect) or $builder->diag("Request for
'${url}' failed:
+ got status: $got -> $gotdest, expected non-redirect status");
+}
+
+sub status_is {
+ my ($url, $status, $name) = @_;
+ my $builder = __PACKAGE__->builder;
+ my $res = http_get($url);
+ my $got = $res->code;
+ $builder->ok($got == $status, $name) or $builder->diag("Request for
'${url}' failed:
+ got status: $got
+expected status: $status");
+}
+
package AxKit2::Test::Server;
use File::Temp qw(tempfile);
Added: trunk/plugins/typeless_uri
===================================================================
--- trunk/plugins/typeless_uri 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/plugins/typeless_uri 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -w
+
+# Copyright 2001-2006 The Apache Software Foundation
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+
+=head1 NAME
+
+typeless_uri - convert typeless URIs (URIs without extension) to working file
references
+
+=head1 SYNOPSIS
+
+ # uri_to_file must go first.
+ Plugin uri_to_file
+ Plugin typeless_uri
+
+ # required
+ DirectoryIndex index
+ # optionally
+ URIExtensions html xhtml xsp
+
+=head1 DESCRIPTION
+
+This plugin provides the filename for a given URI. It supplements uri_to_file
and
+provides typeless URIs, i.e. URIs that do not contain a file extension.
+
+See L<http://www.w3.org/Provider/Style/URI> for a discussion, why this is a
Good Thing (TM).
+
+It works by trying several extensions on the given URI until the resulting
file exists.
+
+=head1 CONFIG
+
+=head2 URIExtensions STRINGLIST
+
+A list of file extensions to try in sequence not including the leading dot.
+
+=head1 TODO
+
+Content Negotiation should be investigated for another level of flexibility.
+
+=cut
+
+use File::Spec::Functions qw(canonpath catfile);
+use constant EXTENSIONS => [
+ 'xhtml',
+ 'html',
+ 'xsp',
+ 'pl',
+ 'cgi',
+];
+
+sub init {
+ my $self = shift;
+ $self->register_config('URIExtensions', sub { $self->set_uriextensions(@_)
});
+}
+
+sub set_uriextensions {
+ my ($self, $config, $value) = @_;
+ $config->notes($self->plugin_name.'::extensions', [ split(/\s+/,$value) ]);
+}
+
+sub try_extensions {
+}
+
+sub hook_uri_translation {
+ my ($self, $hd, $uri) = @_;
+
+ my $file = $hd->filename;
+ return DECLINED if -f $file;
+
+ do {
+ $file =
canonpath(catfile($file,$self->config->notes('uri_to_file::dirindex')))
+ if -d _ && !$self->client->notes('need_redirect');
+ $self->log(LOGINFO, "typeless: $uri -> $file.*");
+
+ my $extensions = $self->config('extensions') || EXTENSIONS;
+ for my $extension (@$extensions) {
+ if (-f $file.'.'.$extension) {
+ $hd->filename($file.'.'.$extension);
+ $self->log(LOGDEBUG, "Translated $uri to ".
$hd->filename);
+ $self->client->notes('need_redirect', 0);
+ return DECLINED;
+ }
+ }
+
+ return DECLINED if ! -d $file ||
$self->client->notes('need_redirect');
+ $file =
canonpath(catfile($file,$self->config->notes('uri_to_file::dirindex')));
+ } while (1);
+
+ return DECLINED;
+}
Modified: trunk/plugins/uri_to_file
===================================================================
--- trunk/plugins/uri_to_file 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/plugins/uri_to_file 2006-08-24 19:22:32 UTC (rev 124)
@@ -44,7 +44,7 @@
=cut
-use File::Spec::Functions qw(canonpath catfile);
+use File::Spec::Functions qw(canonpath catfile splitdir catdir splitpath
catpath);
use AxKit2::Utils qw(uri_decode);
sub init {
@@ -54,8 +54,7 @@
sub set_dirindex {
my ($self, $config, $value) = @_;
- my $key = $self->plugin_name . '::dirindex';
- $config->notes($key, $value);
+ $config->notes($self->plugin_name.'::dirindex',$value);
}
sub hook_uri_translation {
@@ -63,9 +62,7 @@
$self->log(LOGINFO, "translate: $uri");
- $uri =~ s/(\?.*)//;
- my $removed = $1 || '';
-
+ $uri =~ s/\?.*//;
my $original_uri = $uri;
$uri = uri_decode($uri);
@@ -78,39 +75,32 @@
$uri =~ s/^\Q$root// || die "$uri did not match config path $root";
- my $path = canonpath(catfile($self->config->docroot, $uri));
- $path .= '/' if $uri =~ /\/$/; # canonpath will strip a trailing slash
+ my ($volume, $dir, $file) = splitpath($self->config->docroot, 1);
+ my @path = (splitdir($dir),split(/\//,$uri));
+
+ my $i = -1;
+ if (-d catpath($volume,catdir(@path),'')) {
+ $i = @path-1;
+ if ($original_uri =~ m/\/$/) {
+ push @path, $self->config('dirindex')
+ if (defined $self->config('dirindex') && -f
catpath($volume,catdir(@path),$self->config('dirindex')));
+ } else {
+ $self->client->notes('need_redirect',1);
+ }
+ } else {
+ my $path = '';
+ foreach my $dir (@path) {
+ $path = catdir($path,$dir);
+ last unless -d catpath($volume, $path, '');
+ $i++;
+ }
+ }
+ $hd->filename(canonpath(catpath($volume, catdir(@path[0..$i]),
($i+1<@path?$path[$i+1]:''))));
+ $hd->path_info(join("/",'',@path[($i+2)..$#path]));
+ $hd->request_uri(substr($original_uri,0,- length($hd->path_info))) if
length($hd->path_info);
+ $self->log(LOGDEBUG, "Translated $uri to " . $hd->filename .
+ " (request uri: " . $hd->request_uri . ", path info: " .
$hd->path_info . ")");
- my $path_info = '';
-
- if (-d $path) {
- $self->client->notes('is_dir', 1);
- if (my $dirindex = $self->config->notes($self->plugin_name .
'::dirindex')) {
- my $filepath = catfile($path, $dirindex);
- $path = $filepath if -f $filepath;
- }
- }
- else {
- while ($path =~ /\// && !-f $path) {
- $path =~ s/(\/[^\/]*)$//;
- $path_info = $1 . $path_info;
- }
- if ($path_info && -f _) {
- $hd->path_info($path_info);
- substr($original_uri, 0 - length($path_info)) = '';
- $hd->request_uri($original_uri);
- }
- else {
- $path .= $path_info;
- $hd->path_info('');
- }
- }
-
- $self->log(LOGDEBUG, "Translated $uri to $path" .
- ($path_info ? " (path info: $path_info)" : ""));
-
- $hd->filename($path);
-
return DECLINED;
}
@@ -118,7 +108,7 @@
sub hook_fixup {
my $self = shift;
- return DECLINED unless $self->client->notes('is_dir');
+ return DECLINED unless $self->client->notes('need_redirect');
my $uri = $self->client->headers_in->request_uri;
@@ -127,9 +117,9 @@
if ($uri =~ s/^([^\?]*)(?<!\/)(\?.*)?$/$1\/$2/) {
# send redirect
$self->log(LOGINFO, "redirect to $uri");
- $self->client->headers_out->header('Location', "$uri");
+ $self->client->headers_out->header('Location',
"http://".$self->client->headers_in->header('Host').$uri);
return REDIRECT;
}
-
- return DECLINED;
+ # the above string replace should always succeed
+ return SERVER_ERROR;
}
Added: trunk/t/10uri_to_file.t
===================================================================
--- trunk/t/10uri_to_file.t 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/t/10uri_to_file.t 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use AxKit2::Test tests => 8;
+
+start_server("t/server1",[qw(uri_to_file serve_file)],['DirectoryIndex
index.html']);
+
+content_is('/index.html','This is index.html', 'Basic path
translation');
+content_is('/','This is index.html', 'DirectoryIndex');
+content_is('/index.html/foobar','This is index.html', 'path_info');
+is_redirect('/foo','/foo/', 'directory redirect');
+
+status_is('/index',404, 'nonexistant file');
+status_is('/..',400, 'invalid URL');
+status_is('/i..ndex',400, 'better-safe-than-sorry
invalid URL');
+status_is('/i.%2Endex',400, 'hidden invalid URL');
Added: trunk/t/11typeless_uri.t
===================================================================
--- trunk/t/11typeless_uri.t 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/t/11typeless_uri.t 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+
+use AxKit2::Test tests => 11;
+
+start_server("t/server1",[qw(uri_to_file typeless_uri
serve_file)],['DirectoryIndex index']);
+
+content_is('/index.html','This is index.html', 'Basic path
translation');
+content_is('/index','This is index.html', 'Basic typeless
operation');
+content_is('/','This is index.html', 'typeless
DirectoryIndex');
+content_is('/index/foo','This is index.html', 'typeless path_info');
+
+is_redirect('/foo','/foo/', 'directory redirect');
+content_is('/foo','This is foo/index.html', 'directory redirect plus
DirectoryIndex');
+
+no_redirect('/multi', 'no typeless directory
redirect');
+content_is('/multi','This is multi.html', 'typeless plus
directory');
+content_is('/multi/','This is multi/index.html', 'typeless plus
DirectoryIndex');
+
+status_is('/index.foo',404, 'nonexistant file');
+status_is('/bar',404, 'nonexistant file');
Added: trunk/t/server1/foo/index.html
===================================================================
--- trunk/t/server1/foo/index.html 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/t/server1/foo/index.html 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1 @@
+This is foo/index.html
\ No newline at end of file
Added: trunk/t/server1/index.html
===================================================================
--- trunk/t/server1/index.html 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/t/server1/index.html 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1 @@
+This is index.html
\ No newline at end of file
Added: trunk/t/server1/multi/index.html
===================================================================
--- trunk/t/server1/multi/index.html 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/t/server1/multi/index.html 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1 @@
+This is multi/index.html
\ No newline at end of file
Added: trunk/t/server1/multi.html
===================================================================
--- trunk/t/server1/multi.html 2006-08-24 18:11:37 UTC (rev 123)
+++ trunk/t/server1/multi.html 2006-08-24 19:22:32 UTC (rev 124)
@@ -0,0 +1 @@
+This is multi.html
\ No newline at end of file
