Commit | Line | Data |
628f1440 |
1 | package Catalyst::Engine::SCGI; |
2 | |
3 | use strict; |
74b7d482 |
4 | use warnings; |
5 | |
628f1440 |
6 | use base 'Catalyst::Engine::CGI'; |
7 | eval "use SCGI"; |
8 | die "Please install SCGI\n" if $@; |
9 | use IO::Socket; |
628f1440 |
10 | |
5ca78ffd |
11 | our $VERSION = '0.03'; |
628f1440 |
12 | |
13 | =head1 NAME |
14 | |
15 | Catalyst::Engine::SCGI - SCGI Engine |
16 | |
17 | =head1 DESCRIPTION |
18 | |
19 | This is the SCGI engine. |
20 | |
21 | =head1 OVERLOADED METHODS |
22 | |
23 | This class overloads some methods from C<Catalyst::Engine::CGI>. |
24 | |
25 | =head2 $self->run($c, $port, $detach) |
26 | |
27 | Start the SCGI server. If $port is not set default to port 9000. If $detach is set, server will go into the background. |
28 | |
29 | =cut |
30 | |
31 | sub run { |
32 | my ( $self, $class, $port, $detach ) = @_; |
33 | |
34 | my $sock = 0; |
35 | $port = 9000 unless defined $port; |
36 | my $socket = IO::Socket::INET->new( |
37 | Listen => 5, |
38 | ReuseAddr => 1, |
39 | LocalPort => $port, |
40 | ) or die "cannot bind to port $port: $!"; |
41 | $sock = SCGI->new( $socket, blocking => 1 ) |
42 | or die "Failed to open SCGI socket; $!"; |
43 | |
44 | $self->daemon_fork() if defined $detach; |
45 | $self->daemon_detach() if defined $detach; |
46 | while ( my $request = $sock->accept ) { |
47 | eval { $request->read_env }; |
48 | if ($@) { |
49 | |
50 | # some error |
51 | } |
52 | else { |
53 | $self->{_request} = $request; |
54 | $class->handle_request( env => $request->env ); |
55 | # make sure to close once we are done. |
56 | $request->close(); |
57 | } |
58 | } |
59 | } |
60 | |
61 | =head2 $self->finalize_headers ( $c ) |
62 | |
63 | Write finalized headers to socket |
64 | |
65 | =cut |
66 | sub finalize_headers { |
67 | my ( $self, $c ) = @_; |
68 | $c->response->header( Status => $c->response->status ); |
69 | $self->{_request}->connection->print( |
70 | $c->response->headers->as_string("\015\012") . "\015\012" ); |
71 | } |
72 | |
73 | =head2 $self->write ( $c, $buffer ) |
74 | |
75 | Write directly to socket |
76 | |
77 | =cut |
78 | sub write { |
79 | my ( $self, $c, $buffer ) = @_; |
80 | |
81 | unless ( $self->{_prepared_write} ) { |
82 | $self->prepare_write($c); |
83 | $self->{_prepared_write} = 1; |
84 | } |
85 | |
86 | $self->{_request}->connection->print($buffer); |
87 | } |
88 | |
628f1440 |
89 | =head2 $self->read_chunk ( $c, $buffer, $readlen ) |
90 | |
91 | Read Body content to $_[3]'s set length and direct output to $_[2]. |
92 | |
93 | =cut |
94 | sub read_chunk { |
95 | my ( $self, $c ) = @_; |
96 | my $rc = read( $self->{_request}->connection, $_[2], $_[3] ); |
97 | return $rc; |
98 | } |
99 | |
100 | =head2 $self->daemon_fork() |
101 | |
102 | Performs the first part of daemon initialisation. Specifically, |
103 | forking. STDERR, etc are still connected to a terminal. |
104 | |
105 | =cut |
106 | |
107 | sub daemon_fork { |
108 | require POSIX; |
109 | fork && exit; |
110 | } |
111 | |
112 | =head2 $self->daemon_detach( ) |
113 | |
114 | Performs the second part of daemon initialisation. Specifically, |
115 | disassociates from the terminal. |
116 | |
117 | However, this does B<not> change the current working directory to "/", |
118 | as normal daemons do. It also does not close all open file |
119 | descriptors (except STDIN, STDOUT and STDERR, which are re-opened from |
120 | F</dev/null>). |
121 | |
122 | =cut |
123 | |
124 | sub daemon_detach { |
125 | my $self = shift; |
126 | print "SCGI daemon started (pid $$)\n"; |
127 | open STDIN, "+</dev/null" or die $!; |
128 | open STDOUT, ">&STDIN" or die $!; |
129 | open STDERR, ">&STDIN" or die $!; |
130 | POSIX::setsid(); |
131 | } |
132 | |
133 | 1; |