1package Plack::Middleware::Deflater; 2use strict; 3use 5.008001; 4our $VERSION = '0.12'; 5use parent qw(Plack::Middleware); 6use Plack::Util::Accessor qw( content_type vary_user_agent); 7use Plack::Util; 8 9sub prepare_app { 10 my $self = shift; 11 if ( my $match_cts = $self->content_type ) { 12 $match_cts = [$match_cts] if ! ref $match_cts; 13 $self->content_type($match_cts); 14 } 15} 16 17sub call { 18 my($self, $env) = @_; 19 20 my $res = $self->app->($env); 21 22 $self->response_cb($res, sub { 23 my $res = shift; 24 25 # can't operate on Content-Ranges 26 return if $env->{HTTP_CONTENT_RANGE}; 27 28 return if $env->{"plack.skip-deflater"}; 29 30 my $h = Plack::Util::headers($res->[1]); 31 my $content_type = $h->get('Content-Type') || ''; 32 $content_type =~ s/(;.*)$//; 33 if ( my $match_cts = $self->content_type ) { 34 my $match=0; 35 for my $match_ct ( @{$match_cts} ) { 36 if ( $content_type eq $match_ct ) { 37 $match++; 38 last; 39 } 40 } 41 return unless $match; 42 } 43 44 if (Plack::Util::status_with_no_entity_body($res->[0]) or 45 $h->exists('Cache-Control') && $h->get('Cache-Control') =~ /\bno-transform\b/) { 46 return; 47 } 48 49 my @vary = split /\s*,\s*/, ($h->get('Vary') || ''); 50 push @vary, 'Accept-Encoding'; 51 push @vary, 'User-Agent' if $self->vary_user_agent; 52 $h->set('Vary' => join(",", @vary)); 53 54 # some browsers might have problems, so set no-compress 55 return if $env->{"psgix.no-compress"}; 56 57 # Some browsers might have problems with content types 58 # other than text/html, so set compress-only-text/html 59 if ( $env->{"psgix.compress-only-text/html"} ) { 60 return if $content_type ne 'text/html'; 61 } 62 63 # TODO check quality 64 my $encoding = 'identity'; 65 if ( defined $env->{HTTP_ACCEPT_ENCODING} ) { 66 for my $enc (qw(gzip deflate identity)) { 67 if ( $env->{HTTP_ACCEPT_ENCODING} =~ /\b$enc\b/ ) { 68 $encoding = $enc; 69 last; 70 } 71 } 72 } 73 74 my $encoder; 75 if ($encoding eq 'gzip' || $encoding eq 'deflate') { 76 $encoder = Plack::Middleware::Deflater::Encoder->new($encoding); 77 } elsif ($encoding ne 'identity') { 78 my $msg = "An acceptable encoding for the requested resource is not found."; 79 @$res = (406, ['Content-Type' => 'text/plain'], [ $msg ]); 80 return; 81 } 82 83 if ($encoder) { 84 $h->set('Content-Encoding' => $encoding); 85 $h->remove('Content-Length'); 86 87 # normal response 88 if ( $res->[2] && ref($res->[2]) && ref($res->[2]) eq 'ARRAY' ) { 89 my $buf = ''; 90 foreach (@{$res->[2]}) { 91 $buf .= $encoder->print($_) if defined $_; 92 } 93 $buf .= $encoder->close(); 94 $res->[2] = [$buf]; 95 return; 96 } 97 98 # delayed or stream 99 return sub { 100 $encoder->print(shift); 101 }; 102 } 103 }); 104} 105 1061; 107 108package Plack::Middleware::Deflater::Encoder; 109 110use strict; 111use warnings; 112use Compress::Zlib; 113 114use constant GZIP_MAGIC => 0x1f8b; 115 116sub new { 117 my $class = shift; 118 my $encoding = shift; 119 my ($encoder,$status) = $encoding eq 'gzip' 120 ? deflateInit(-WindowBits => -MAX_WBITS()) 121 : deflateInit(-WindowBits => MAX_WBITS()); 122 die 'Cannot create a deflation stream' if $status != Z_OK; 123 124 bless { 125 header => 0, 126 closed => 0, 127 encoding => $encoding, 128 encoder => $encoder, 129 crc => crc32(undef), 130 length => 0, 131 }, $class; 132} 133 134sub print : method { 135 my $self = shift; 136 return if $self->{closed}; 137 my $chunk = shift; 138 if ( ! defined $chunk ) { 139 my ($buf,$status) = $self->{encoder}->flush(); 140 die "deflate failed: $status" if ( $status != Z_OK ); 141 if ( !$self->{header} && $self->{encoding} eq 'gzip' ) { 142 $buf = pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,$Compress::Raw::Zlib::gzip_os_code) . $buf 143 } 144 $buf .= pack("LL", $self->{crc},$self->{length}) if $self->{encoding} eq 'gzip'; 145 $self->{closed} = 1; 146 return $buf; 147 } 148 149 my ($buf,$status) = $self->{encoder}->deflate($chunk); 150 die "deflate failed: $status" if ( $status != Z_OK ); 151 $self->{length} += length $chunk; 152 $self->{crc} = crc32($chunk,$self->{crc}); 153 if ( length $buf ) { 154 if ( !$self->{header} && $self->{encoding} eq 'gzip' ) { 155 $buf = pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,$Compress::Raw::Zlib::gzip_os_code) . $buf 156 } 157 $self->{header} = 1; 158 return $buf; 159 } 160 return ''; 161} 162 163sub close : method { 164 $_[0]->print(undef); 165} 166 167sub closed { 168 $_[0]->{closed}; 169} 170 1711; 172 173 174__END__ 175 176=head1 NAME 177 178Plack::Middleware::Deflater - Compress response body with Gzip or Deflate 179 180=head1 SYNOPSIS 181 182 use Plack::Builder; 183 184 builder { 185 enable sub { 186 my $app = shift; 187 sub { 188 my $env = shift; 189 my $ua = $env->{HTTP_USER_AGENT} || ''; 190 # Netscape has some problem 191 $env->{"psgix.compress-only-text/html"} = 1 if $ua =~ m!^Mozilla/4!; 192 # Netscape 4.06-4.08 have some more problems 193 $env->{"psgix.no-compress"} = 1 if $ua =~ m!^Mozilla/4\.0[678]!; 194 # MSIE (7|8) masquerades as Netscape, but it is fine 195 if ( $ua =~ m!\bMSIE (?:7|8)! ) { 196 $env->{"psgix.no-compress"} = 0; 197 $env->{"psgix.compress-only-text/html"} = 0; 198 } 199 $app->($env); 200 } 201 }; 202 enable "Deflater", 203 content_type => ['text/css','text/html','text/javascript','application/javascript'], 204 vary_user_agent => 1; 205 sub { [200,['Content-Type','text/html'],["OK"]] } 206 }; 207 208=head1 DESCRIPTION 209 210Plack::Middleware::Deflater is a middleware to encode your response 211body in gzip or deflate, based on C<Accept-Encoding> HTTP request 212header. It would save the bandwidth a little bit but should increase 213the Plack server load, so ideally you should handle this on the 214frontend reverse proxy servers. 215 216This middleware removes C<Content-Length> and streams encoded content, 217which means the server should support HTTP/1.1 chunked response or 218downgrade to HTTP/1.0 and closes the connection. 219 220=head1 CONFIGURATIONS 221 222=over 4 223 224=item content_type 225 226 content_type => 'text/html', 227 content_type => [ 'text/html', 'text/css', 'text/javascript', 'application/javascript', 'application/x-javascript' ] 228 229Content-Type header to apply deflater. if content-type is not defined, Deflater will try to deflate all contents. 230 231=item vary_user_agent 232 233 vary_user_agent => 1 234 235Add "User-Agent" to Vary header. 236 237=back 238 239=head1 ENVIRONMENT VALUE 240 241=over 4 242 243=item psgix.no-compress 244 245Do not apply deflater 246 247=item psgix.compress-only-text/html 248 249Apply deflater only if content_type is "text/html" 250 251=item plack.skip-deflater 252 253Skip all Deflater features 254 255=back 256 257=head2 Compare psgix.no-compress with plack.skip-deflater 258 259If no-compress is true, PM::Deflater skips gzip or deflate. But adds Vary: Accept-Encoding and Vary: User-Agent header. skip-deflater forces to skip all PM::Deflater feature, doesn't allow to add Vary header. 260 261=head1 LICENSE 262 263This software is licensed under the same terms as Perl itself. 264 265=head1 AUTHOR 266 267Tatsuhiko Miyagawa 268 269=head1 SEE ALSO 270 271L<Plack>, L<http://httpd.apache.org/docs/2.2/en/mod/mod_deflate.html> 272 273=cut 274