├── .gitignore ├── .shipit ├── Changes ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README ├── bin └── fastpass ├── lib ├── Fastpass.pm ├── Fastpass │ ├── IO.pm │ ├── Server.pm │ └── Writer.pm └── Plack │ └── Handler │ └── Fastpass.pm ├── t └── 00_compile.t └── xt └── pod.t /.gitignore: -------------------------------------------------------------------------------- 1 | MYMETA.* 2 | META.yml 3 | Makefile 4 | inc/ 5 | pm_to_blib 6 | *~ 7 | -------------------------------------------------------------------------------- /.shipit: -------------------------------------------------------------------------------- 1 | steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN 2 | git.push_to = origin 3 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl extension Fastpass 2 | 3 | 0.01 Wed Apr 20 15:59:26 2011 4 | - original version 5 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | .gitignore 2 | bin/fastpass 3 | Changes 4 | inc/Module/Install.pm 5 | inc/Module/Install/Base.pm 6 | inc/Module/Install/Can.pm 7 | inc/Module/Install/Fetch.pm 8 | inc/Module/Install/Makefile.pm 9 | inc/Module/Install/Metadata.pm 10 | inc/Module/Install/ReadmeFromPod.pm 11 | inc/Module/Install/Repository.pm 12 | inc/Module/Install/Win32.pm 13 | inc/Module/Install/WriteAll.pm 14 | lib/Fastpass.pm 15 | lib/Fastpass/IO.pm 16 | lib/Fastpass/Server.pm 17 | lib/Fastpass/Writer.pm 18 | lib/Plack/Handler/Fastpass.pm 19 | Makefile.PL 20 | MANIFEST This list of files 21 | META.yml 22 | README 23 | t/00_compile.t 24 | xt/pod.t 25 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | \bRCS\b 2 | \bCVS\b 3 | \.svn/ 4 | \.git/ 5 | ^MANIFEST\. 6 | ^Makefile$ 7 | ~$ 8 | \.old$ 9 | ^blib/ 10 | ^pm_to_blib 11 | ^MakeMaker-\d 12 | \.gz$ 13 | \.cvsignore 14 | \.shipit 15 | MYMETA 16 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use inc::Module::Install; 2 | all_from 'lib/Fastpass.pm'; 3 | readme_from('lib/Fastpass.pm'); 4 | requires 'Net::FastCGI', 0.13; 5 | requires 'Net::Server'; 6 | install_script 'bin/fastpass'; 7 | build_requires 'Test::More', 0.88; 8 | test_requires 'Test::Requires'; 9 | auto_set_repository(); 10 | WriteAll; 11 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | NAME 2 | Fastpass - FastCGI daemon for PSGI apps 3 | 4 | SYNOPSIS 5 | fastpass --listen :8080 --workers 24 myapp.psgi 6 | 7 | DESCRIPTION 8 | Fastpass is a standalone FastCGI daemon that is designed to work out of 9 | the box with nginx HTTP server. The supported feature set is close to 10 | Unicorn and Starman i.e. preforking, TCP 11 | and UNIX domain socket support and PSGI compatible, but Fastpass works 12 | with the FastCGI protocol instead of HTTP. 13 | 14 | CONFIGURATIONS 15 | TBD 16 | 17 | AUTHOR 18 | Tatsuhiko Miyagawa 19 | 20 | Christian Hansen 21 | 22 | COPYRIGHT 23 | Copyright 2011- Tatsuhiko Miyagawa 24 | 25 | LICENSE 26 | This library is free software; you can redistribute it and/or modify it 27 | under the same terms as Perl itself. 28 | 29 | SEE ALSO 30 | Plack::Handler::FCGI, FCGI, Net::FastCGI 31 | 32 | -------------------------------------------------------------------------------- /bin/fastpass: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use Fastpass; 4 | 5 | my $cli = Fastpass->new; 6 | $cli->parse_options(@ARGV); 7 | $cli->run; 8 | 9 | __END__ 10 | 11 | =head1 NAME 12 | 13 | fastpass - Lightweight FastCGI daemon that works like Unicorn 14 | 15 | =head1 SYNOPSIS 16 | 17 | fastpass --listen /tmp/fcgi.sock --workers 10 myapp.psgi 18 | fastpass --listen :9000 19 | 20 | =head1 OPTIONS 21 | 22 | TBD 23 | 24 | =head1 AUTHOR 25 | 26 | Tatsuhiko Miyagawa 27 | 28 | =head1 SEE ALSO 29 | 30 | L 31 | 32 | =cut 33 | 34 | -------------------------------------------------------------------------------- /lib/Fastpass.pm: -------------------------------------------------------------------------------- 1 | package Fastpass; 2 | use strict; 3 | use warnings; 4 | 5 | use 5.008_001; 6 | our $VERSION = "0.1000"; 7 | 8 | use Fastpass::Server; 9 | use Getopt::Long (); 10 | 11 | sub new { 12 | my $class = shift; 13 | bless { 14 | options => { 15 | workers => 5, 16 | }, 17 | }, $class; 18 | } 19 | 20 | sub parse_options { 21 | my($self, @args) = @_; 22 | 23 | Getopt::Long::GetOptionsFromArray( 24 | \@args, 25 | "listen=s", \$self->{options}{listen}, 26 | "workers=i", \$self->{options}{workers}, 27 | "a|app=s", \$self->{app}, 28 | "h|help", sub { $self->show_help; exit(0) }, 29 | "v|version", sub { print "fastpass $VERSION\n"; exit(0) }, 30 | ) or exit(1); 31 | 32 | $self->{app} ||= shift(@args) || "app.psgi"; 33 | } 34 | 35 | sub show_help { 36 | my $self = shift; 37 | print <{app}; 58 | my $app = _load_app($file); 59 | 60 | unless (ref $app eq 'CODE') { 61 | $app = 'undef' unless defined $app; 62 | chomp(my $err = $@ || $!); 63 | my $msg = "The application ($app) is not a PSGI application.\n"; 64 | if ($err) { 65 | $msg .= "The error opening file '$file' was:\n$err\n"; 66 | } 67 | die $msg; 68 | } 69 | 70 | my $server = Fastpass::Server->new(%{$self->{options}}); 71 | $server->run($app); 72 | } 73 | 74 | 1; 75 | __END__ 76 | 77 | =encoding utf-8 78 | 79 | =for stopwords 80 | 81 | =head1 NAME 82 | 83 | Fastpass - FastCGI daemon for PSGI apps 84 | 85 | =head1 SYNOPSIS 86 | 87 | fastpass --listen :8080 --workers 24 myapp.psgi 88 | 89 | =head1 DESCRIPTION 90 | 91 | Fastpass is a standalone FastCGI daemon that is designed to work out of 92 | the box with nginx HTTP server. The supported feature set is close to 93 | L and L 94 | i.e. preforking, TCP and UNIX domain socket support and PSGI 95 | compatible, but Fastpass works with the FastCGI protocol instead of HTTP. 96 | 97 | =head1 CONFIGURATIONS 98 | 99 | TBD 100 | 101 | =head1 AUTHOR 102 | 103 | Tatsuhiko Miyagawa Emiyagawa@bulknews.netE 104 | 105 | Christian Hansen 106 | 107 | =head1 COPYRIGHT 108 | 109 | Copyright 2011- Tatsuhiko Miyagawa 110 | 111 | =head1 LICENSE 112 | 113 | This library is free software; you can redistribute it and/or modify 114 | it under the same terms as Perl itself. 115 | 116 | =head1 SEE ALSO 117 | 118 | L, L, L 119 | 120 | =cut 121 | -------------------------------------------------------------------------------- /lib/Fastpass/IO.pm: -------------------------------------------------------------------------------- 1 | package Fastpass::IO; 2 | use strict; 3 | use warnings; 4 | use Net::FastCGI::IO qw(write_stream); 5 | 6 | sub new { 7 | my($class, $socket, $type, $request_id, $buf_size) = @_; 8 | bless { 9 | socket => $socket, 10 | type => $type, 11 | request_id => $request_id, 12 | buf_size => $buf_size, 13 | buffer => '', 14 | }, $class; 15 | } 16 | 17 | sub print { 18 | my($self, $output) = @_; 19 | 20 | $self->{buffer} .= $output; 21 | if (length $self->{buffer} >= $self->{buf_size}) { 22 | write_stream($self->{socket}, $self->{type}, $self->{request_id}, $self->{buffer}, 0); 23 | $self->{buffer} = ''; 24 | } 25 | } 26 | 27 | sub flush { 28 | my $self = shift; 29 | write_stream($self->{socket}, $self->{type}, $self->{request_id}, $self->{buffer}, 1); 30 | } 31 | 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /lib/Fastpass/Server.pm: -------------------------------------------------------------------------------- 1 | package Fastpass::Server; 2 | use strict; 3 | use warnings; 4 | use base qw(Net::Server::PreForkSimple); 5 | use constant DEBUG => $ENV{PERL_FASTPASS_DEBUG}; 6 | 7 | use Carp (); 8 | use IO::Socket (); 9 | use Net::FastCGI 0.12; 10 | use Net::FastCGI::Constant qw[:common :type :flag :role :protocol_status]; 11 | use Net::FastCGI::IO qw[:all]; 12 | use Net::FastCGI::Protocol qw[:all]; 13 | 14 | use Fastpass::IO; 15 | use Fastpass::Writer; 16 | 17 | our $STDOUT_BUFFER_SIZE = 8192; 18 | our $STDERR_BUFFER_SIZE = 0; 19 | 20 | #use warnings FATAL => 'Net::FastCGI::IO'; 21 | 22 | sub new { 23 | my($class, %options) = @_; 24 | bless { 25 | %options, 26 | # FIXME 27 | values => { 28 | FCGI_MAX_CONNS => 1, # maximum number of concurrent transport connections this application will accept 29 | FCGI_MAX_REQS => 1, # maximum number of concurrent requests this application will accept 30 | FCGI_MPXS_CONNS => 0, # this implementation can't multiplex 31 | }, 32 | }, $class; 33 | } 34 | 35 | sub run { 36 | my($self, $app) = @_; 37 | 38 | my $listen = ref $self->{listen} eq 'ARRAY' ? $self->{listen}->[0] : $self->{listen}; 39 | 40 | $self->{app} = $app; 41 | 42 | my($host, $port, $proto); 43 | if ($listen && $listen =~ /:\d+$/) { 44 | ($host, $port) = split /:/, $listen, 2; 45 | $host ||= "*"; 46 | $proto = 'tcp'; 47 | } elsif ($listen) { 48 | $host = 'localhost'; 49 | $port = $listen; 50 | $proto = 'unix'; 51 | } else { 52 | Carp::croak("listen port or socket is not defined."); 53 | } 54 | 55 | $self->SUPER::run( 56 | port => $port, 57 | host => $host, 58 | proto => $proto, 59 | log_level => DEBUG ? 4 : 2, 60 | user => $>, 61 | group => $), 62 | listen => $self->{backlog} || 1024, 63 | leave_children_open_on_hup => 1, 64 | max_servers => $self->{workers}, 65 | min_servers => $self->{workers}, 66 | max_spare_servers => $self->{workers} - 1, 67 | min_spare_servers => $self->{workers} - 1, 68 | ); 69 | } 70 | 71 | sub post_accept_hook { 72 | my $self = shift; 73 | 74 | $self->{client} = { 75 | current_id => 0, # id of the request we're processing 76 | stdin => undef, # buffer for STDIN 77 | params => undef, # buffer for parameters 78 | done => 0, # done with connection? 79 | keep_conn => 0, # more requests on this connection? 80 | }; 81 | } 82 | 83 | sub process_request { 84 | my $self = shift; 85 | 86 | my $socket = $self->{server}{client}; 87 | my $client = $self->{client}; 88 | 89 | while (!$client->{done}) { 90 | my ($type, $request_id, $content) = read_record($socket) 91 | or last; 92 | 93 | if (DEBUG) { 94 | warn '< ', dump_record($type, $request_id, $content), "\n"; 95 | } 96 | 97 | if ($request_id == FCGI_NULL_REQUEST_ID) { 98 | if ($type == FCGI_GET_VALUES) { 99 | my $query = parse_params($content); 100 | my %reply = map { $_ => $self->{values}->{$_} } 101 | grep { exists $self->{values}->{$_} } 102 | keys %$query; 103 | write_record($socket, FCGI_GET_VALUES_RESULT, 104 | FCGI_NULL_REQUEST_ID, build_params(\%reply)); 105 | } 106 | else { 107 | write_record($socket, FCGI_UNKNOWN_TYPE, 108 | FCGI_NULL_REQUEST_ID, build_unknown_type($type)); 109 | } 110 | } 111 | elsif ($request_id != $client->{current_id} && $type != FCGI_BEGIN_REQUEST) { 112 | # ignore inactive requests (FastCGI Specification 3.3) 113 | } 114 | elsif ($type == FCGI_ABORT_REQUEST) { 115 | $client->{current_id} = 0; 116 | $client->{stdin} = undef; 117 | $client->{params} = ''; 118 | } 119 | elsif ($type == FCGI_BEGIN_REQUEST) { 120 | my ($role, $flags) = parse_begin_request_body($content); 121 | if ($client->{current_id} or $role != FCGI_RESPONDER) { 122 | my $status = $client->{current_id} ? FCGI_CANT_MPX_CONN : FCGI_UNKNOWN_ROLE; 123 | write_record($socket, FCGI_END_REQUEST, $request_id, 124 | build_end_request_body(0, $status)); 125 | } 126 | else { 127 | $client->{current_id} = $request_id; 128 | $client->{stdin} = ''; 129 | $client->{keep_conn} = ($flags & FCGI_KEEP_CONN); 130 | } 131 | } 132 | elsif ($type == FCGI_PARAMS) { 133 | $client->{params} .= $content; 134 | } 135 | elsif ($type == FCGI_STDIN) { 136 | $client->{stdin} .= $content; 137 | 138 | unless (length $content) { 139 | open my $in, "<", \$client->{stdin}; 140 | 141 | my $out = Fastpass::IO->new($socket, FCGI_STDOUT, $client->{current_id}, $STDOUT_BUFFER_SIZE); 142 | my $err = Fastpass::IO->new($socket, FCGI_STDERR, $client->{current_id}, $STDERR_BUFFER_SIZE); 143 | 144 | $self->handle_request(parse_params($client->{params}), $in, $out, $err); 145 | 146 | $out->flush; 147 | $err->flush; 148 | 149 | write_record($socket, FCGI_END_REQUEST, $client->{current_id}, 150 | build_end_request_body(0, FCGI_REQUEST_COMPLETE)); 151 | 152 | # prepare for next request 153 | $client->{current_id} = 0; 154 | $client->{stdin} = undef; 155 | $client->{params} = ''; 156 | 157 | last unless $client->{keep_conn}; 158 | } 159 | } 160 | else { 161 | warn(qq/Received an unknown record type '$type'/); 162 | } 163 | } 164 | } 165 | 166 | sub handle_request { 167 | my($self, $env, $stdin, $stdout, $stderr) = @_; 168 | 169 | $env = { 170 | %$env, 171 | 'psgi.version' => [1,1], 172 | 'psgi.url_scheme' => ($env->{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http', 173 | 'psgi.input' => $stdin, 174 | 'psgi.errors' => $stderr, 175 | 'psgi.multithread' => 0, 176 | 'psgi.multiprocess' => 1, 177 | 'psgi.run_once' => 0, 178 | 'psgi.streaming' => 1, 179 | 'psgi.nonblocking' => 0, 180 | 'psgix.input.buffered' => 1, 181 | 'psgix.harakiri' => 1, 182 | }; 183 | 184 | delete $env->{HTTP_CONTENT_TYPE}; 185 | delete $env->{HTTP_CONTENT_LENGTH}; 186 | 187 | my $res = $self->{app}->($env); 188 | 189 | if (ref $res eq 'ARRAY') { 190 | $self->_handle_response($res, $stdout); 191 | } elsif (ref $res eq 'CODE') { 192 | $res->(sub { 193 | $self->_handle_response($_[0], $stdout); 194 | }); 195 | } else { 196 | die "Bad response $res"; 197 | } 198 | 199 | if ($env->{'psgix.harakiri.commit'}) { 200 | $self->{client}{keep_conn} = 0; 201 | $self->{client}{harakiri} = 1; 202 | } 203 | } 204 | 205 | sub _handle_response { 206 | my($self, $res, $stdout) = @_; 207 | 208 | my $hdrs; 209 | $hdrs = "Status: $res->[0]\015\012"; 210 | 211 | my $headers = $res->[1]; 212 | while (my ($k, $v) = splice @$headers, 0, 2) { 213 | $hdrs .= "$k: $v\015\012"; 214 | } 215 | $hdrs .= "\015\012"; 216 | 217 | $stdout->print($hdrs); 218 | 219 | my $body = $res->[2]; 220 | if (defined $body) { 221 | if (ref $body eq 'ARRAY') { 222 | for my $line (@$body) { 223 | $stdout->print($line) if length $line; 224 | } 225 | } else { 226 | local $/ = \65536 unless ref $/; 227 | while (defined(my $line = $body->getline)) { 228 | $stdout->print($line) if length $line; 229 | } 230 | $body->close; 231 | } 232 | } else { 233 | return Fastpass::Writer->new($stdout); 234 | } 235 | } 236 | 237 | sub post_client_connection_hook { 238 | my $self = shift; 239 | 240 | if ($self->{client}{harakiri}) { 241 | warn "Committing harakiri ($$)\n" if DEBUG; 242 | exit(0); 243 | } 244 | } 245 | 246 | 247 | 1; 248 | 249 | __END__ 250 | -------------------------------------------------------------------------------- /lib/Fastpass/Writer.pm: -------------------------------------------------------------------------------- 1 | package Fastpass::Writer; 2 | use strict; 3 | 4 | sub new { 5 | my($class, $handle) = @_; 6 | bless \$handle, $class; 7 | } 8 | 9 | sub write { 10 | ${$_[0]}->print($_[1]); 11 | } 12 | 13 | sub close { } 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/Plack/Handler/Fastpass.pm: -------------------------------------------------------------------------------- 1 | package Plack::Handler::Fastpass; 2 | use strict; 3 | use Fastpass::Server; 4 | 5 | sub new { 6 | my $class = shift; 7 | bless { 8 | fastpass => Fastpass::Server->new(workers => 5, @_), 9 | }, $class; 10 | } 11 | 12 | sub run { 13 | my($self, $app) = @_; 14 | $self->{fastpass}->run($app); 15 | } 16 | 17 | 1; 18 | -------------------------------------------------------------------------------- /t/00_compile.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More tests => 1; 3 | 4 | BEGIN { use_ok 'Fastpass' } 5 | -------------------------------------------------------------------------------- /xt/pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::Pod 1.00"; 3 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 4 | all_pod_files_ok(); 5 | --------------------------------------------------------------------------------