mirror of
https://github.com/clearlinux/uwsgi.git
synced 2026-05-14 02:33:51 +00:00
plugins/psgi - remove the need for Scalar::Util
Commitff9bab4bfixed 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 bycf08972e, 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:
@@ -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 *);
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
87
t/perl/all_body_types.pl
Executable 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;
|
||||
43
t/perl/apps/all_body_types.psgi
Normal file
43
t/perl/apps/all_body_types.psgi
Normal 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
|
||||
Reference in New Issue
Block a user