plugins/psgi - remove the need for Scalar::Util

Commit ff9bab4b fixed support for sending IO like handles or GLOBs
via sendfile by first calling fileno on them. This was checked
by calling Scalar::Util::reftype on the reference first, as per
https://metacpan.org/pod/PSGI#Body . This may be sane in pure
perl, but there are better methods in XS/C than string evalling
some Perl, which will eventually also call some XS/C.

This commit introduces more robust checking of whether we have a
"real" filehandle, and also introduces a test that chucks a bunch
of different scalars and references at uWSGI to make sure it doesn't
choke. I wasn't sure how to hook this test up to travis, or wether
that's even desireable, so just left the test in what I believe to
be the right directories.

Because this commit massively simplifies the code, it also had an
effect on object size, on my machine (x64, GCC 4.9), psgi_plugin.o
went from 63360 bytes to 62296 bytes.

The indentation level of the ->getline for loop has been left at
its original level, which is now incorrect, to make the diff
easier to read. A whitespace cleanup commit could follow.

In related news, does anyone know the purpose of the three other
use lines in psgi_loader.c, two of them were added back in 2011
by cf08972e, but I can't work out what their inclusion has to do
with memleak hunting.

Basically I would love to remove these lines as I don't believe
they're needed for uWSGI to function, and if apps running under
uWSGI need them, they should load them themselves.

Also related, would more PSGI refactorings be welcome? I get the
impression that Perl is a bit of a second class citizen in uWSGI
these days, and as both an avid user of uWSGI+PSGI and a hobby XS
developer, I'd love to clean up more of the PSGI plugin.
This commit is contained in:
James Raspass
2015-04-08 18:13:01 +01:00
parent 89ed5a26aa
commit a1e3015783
6 changed files with 156 additions and 60 deletions

View File

@@ -83,7 +83,6 @@ int psgi_response(struct wsgi_request *, AV*);
SV *uwsgi_perl_obj_call(SV *, char *);
int uwsgi_perl_obj_can(SV *, char *, size_t);
int uwsgi_perl_obj_isa(SV *, char *);
int init_psgi_app(struct wsgi_request *, char *, uint16_t, PerlInterpreter **);
PerlInterpreter *uwsgi_perl_new_interpreter(void);
int uwsgi_perl_mule(char *);

View File

@@ -442,7 +442,6 @@ int init_psgi_app(struct wsgi_request *wsgi_req, char *app, uint16_t app_len, Pe
perl_eval_pv("use IO::Handle;", 1);
perl_eval_pv("use IO::File;", 1);
perl_eval_pv("use IO::Socket;", 1);
perl_eval_pv("use Scalar::Util;", 1);
if (uperl.argv_items || uperl.argv_item) {
AV *uperl_argv = GvAV(PL_argvgv);

View File

@@ -254,34 +254,6 @@ int uwsgi_perl_obj_can(SV *obj, char *method, size_t len) {
}
int uwsgi_perl_obj_isa(SV *obj, char *class) {
int ret = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(obj);
PUTBACK;
call_pv( "Scalar::Util::reftype", G_SCALAR|G_EVAL);
SPAGAIN;
char *reftype = POPp;
if (reftype && !strcmp(reftype, class)) {
ret = 1;
}
PUTBACK;
FREETMPS;
LEAVE;
return ret;
}
SV *uwsgi_perl_obj_call(SV *obj, char *method) {
SV *ret = NULL;

View File

@@ -99,30 +99,28 @@ int psgi_response(struct wsgi_request *wsgi_req, AV *response) {
return UWSGI_OK;
}
if (!SvRV(*hitem)) { uwsgi_log("invalid PSGI response body\n") ; return UWSGI_OK; }
SV *rv = SvRV(*hitem);
if (!SvROK(*hitem)) goto unsupported;
if (SvTYPE(SvRV(*hitem)) == SVt_PVGV || SvTYPE(SvRV(*hitem)) == SVt_PVHV || SvTYPE(SvRV(*hitem)) == SVt_PVMG) {
if (!rv)
goto invalid_body;
// check for fileno() method, IO class or GvIO
if (uwsgi_perl_obj_can(*hitem, "fileno", 6) || uwsgi_perl_obj_isa(*hitem, "IO") || (uwsgi_perl_obj_isa(*hitem, "GLOB") && GvIO(SvRV(*hitem))) ) {
SV *fn = uwsgi_perl_obj_call(*hitem, "fileno");
if (fn) {
if (SvTYPE(fn) == SVt_IV && SvIV(fn) >= 0) {
wsgi_req->sendfile_fd = SvIV(fn);
SvREFCNT_dec(fn);
uwsgi_response_sendfile_do(wsgi_req, wsgi_req->sendfile_fd, 0, 0);
// no need to close here as perl GC will do the close()
uwsgi_pl_check_write_errors {
// noop
}
return UWSGI_OK;
}
SvREFCNT_dec(fn);
}
}
IO *io = GvIO(rv);
if (io) {
const int fd = PerlIO_fileno(IoIFP(io));
if (fd >= 0) {
wsgi_req->sendfile_fd = fd;
uwsgi_response_sendfile_do(wsgi_req, wsgi_req->sendfile_fd, 0, 0);
// no need to close here as perl GC will do the close()
uwsgi_pl_check_write_errors {
// noop
}
return UWSGI_OK;
}
}
if (SvOBJECT(rv)) {
// check for path method
if (uwsgi_perl_obj_can(*hitem, "path", 4)) {
SV *p = uwsgi_perl_obj_call(*hitem, "path");
@@ -135,7 +133,7 @@ int psgi_response(struct wsgi_request *wsgi_req, AV *response) {
}
return UWSGI_OK;
}
else if (uwsgi_perl_obj_can(*hitem, STR_WITH_LEN("getline"))) {
for(;;) {
wsgi_req->switches++;
@@ -173,11 +171,11 @@ int psgi_response(struct wsgi_request *wsgi_req, AV *response) {
if (closed) {
SvREFCNT_dec(closed);
}
}
}
else if (SvTYPE(SvRV(*hitem)) == SVt_PVAV) {
else if (SvTYPE(rv) == SVt_PVAV) {
body = (AV *) SvRV(*hitem);
body = (AV *) rv;
for(i=0; i<=av_len(body); i++) {
hitem = av_fetch(body,i,0);
@@ -187,13 +185,11 @@ int psgi_response(struct wsgi_request *wsgi_req, AV *response) {
break;
}
}
}
else {
unsupported:
uwsgi_log("unsupported response body type: %d\n", SvTYPE(SvRV(*hitem)));
invalid_body:
uwsgi_log("invalid PSGI response body\n");
}
return UWSGI_OK;
}

87
t/perl/all_body_types.pl Executable file
View File

@@ -0,0 +1,87 @@
#!/usr/bin/env perl
use strict;
use warnings;
use HTTP::Tiny;
use Test::More;
my $pid;
my $cpus = `nproc`;
my $http = HTTP::Tiny->new;
my $code = do { local ( @ARGV, $/ ) = 't/perl/apps/all_body_types.psgi'; <> };
# Incase we die before we're able to stop uWSGI.
END { kill 15, $pid if $pid }
for my $perl ( qw/5.20.2 5.18.4 5.16.3 5.14.4 5.12.4 5.10.1 5.8.9/ ) {
for my $thread (0, 1) {
my $name = 'uwsgi-perl-' . $perl . ( '-thread' x $thread );
system 'perlbrew', 'install', $perl,
'--as', $name, '-D', 'useshrplib', '-j', $cpus, '-n', '--noman',
('--thread') x $thread;
# Ensure all deps of t/perl/apps/all_body_types.psgi are installed.
system 'perlbrew', 'exec', '--with', $name,
'cpanm', '-n', 'IO::String' and die $!;
system 'python', 'uwsgiconfig.py', '-c' and die $!;
system 'perlbrew', 'exec', '--with', $name,
'python', 'uwsgiconfig.py', '-b', 'plonly' and die $!;
exec qw(
./uwsgi
--http-socket :5000
--perl-no-die-catch
--perl-no-plack
--psgi t/perl/apps/all_body_types.psgi
) unless $pid = fork;
# Give uWSGI a chance to start.
sleep 1;
subtest $name => sub {
for (
[ Array => 1, 'ARRAY' ],
[ Code => 0, 'CODE' ],
[ DATA => 1, 'GLOB' ],
[ DIRHANDLE => 0, 'GLOB' ],
[ FILEHANDLE => 1, 'GLOB' ],
[ FileHandle => 1, 'FileHandle' ],
[ Float => 0, '' ],
[ FloatRef => 0, 'SCALAR' ],
[ Format => 0, '' ],
[ FormatRef => 0, 'SCALAR' ],
[ Hash => 0, 'HASH' ],
[ Int => 0, '' ],
[ IntRef => 0, 'SCALAR' ],
[ 'IO::File' => 1, 'IO::File' ],
[ 'IO::String' => 1, 'IO::String' ],
[ Object => 0, 'main' ],
[ ObjectPath => 1, 'ObjectPath' ],
[ Regexp => 0, 'Regexp' ],
[ String => 0, '' ],
[ StringRef => 0, 'SCALAR' ],
[ Undef => 0, '' ],
[ UndefRef => 0, 'SCALAR' ],
) {
my ( $path, $has_content, $ref ) = @$_;
my $got = $http->get( 'http://localhost:5000/' . $path );
delete @$got{qw/protocol reason success status url/};
is_deeply $got, {
content => $code x $has_content,
headers => { 'x-ref' => $ref },
}, $path;
}
};
kill 15, $pid;
}
}
done_testing;

View File

@@ -0,0 +1,43 @@
use strict;
use warnings;
use FileHandle;
use IO::File;
use IO::String;
my $code = do { local ( @ARGV, $/ ) = __FILE__; <> };
sub ObjectPath::path { __FILE__ }
sub {
my $path = shift->{PATH_INFO};
my $body = $path eq '/Array' ? [ split //, $code ]
: $path eq '/Code' ? sub {}
: $path eq '/DATA' ? \*DATA
: $path eq '/DIRHANDLE' ? do { opendir my $fh, '.'; $fh }
: $path eq '/FILEHANDLE' ? do { open my $fh, __FILE__; $fh }
: $path eq '/FileHandle' ? FileHandle->new(__FILE__)
: $path eq '/Float' ? 3.14
: $path eq '/FloatRef' ? \3.14
: $path eq '/Format' ? *STDOUT{FORMAT}
: $path eq '/FormatRef' ? \*STDOUT{FORMAT}
: $path eq '/IO::File' ? IO::File->new(__FILE__)
: $path eq '/Hash' ? { foo => 'bar' }
: $path eq '/Int' ? 3
: $path eq '/IntRef' ? \3
: $path eq '/IO::String' ? IO::String->new($code)
: $path eq '/Object' ? bless({})
: $path eq '/ObjectPath' ? bless( {}, 'ObjectPath' )
: $path eq '/Regexp' ? qr/foo/
: $path eq '/String' ? 'foo'
: $path eq '/StringRef' ? \'bar'
: $path eq '/Undef' ? undef
: $path eq '/UndefRef' ? \undef
: return [ 404, [], [] ];
[ 200, [ 'X-ref' => ref $body ], $body ];
};
__DATA__
data data data