127 lines
3 KiB
Perl
127 lines
3 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Plack::Middleware::DW::ConcatRes
|
|
#
|
|
# Handles concatenated static resource requests (CSS/JS combo handler).
|
|
# URLs like /stc/css/??a.css,b.css?v=123 get multiple files concatenated
|
|
# into a single response.
|
|
#
|
|
# Ported from Apache::LiveJournal::send_concat_res_response.
|
|
#
|
|
# Authors:
|
|
# Mark Smith <mark@dreamwidth.org>
|
|
#
|
|
# Copyright (c) 2025 by Dreamwidth Studios, LLC.
|
|
#
|
|
# This program is free software; you may redistribute it and/or modify it under
|
|
# the same terms as Perl itself. For a copy of the license, please reference
|
|
# 'perldoc perlartistic' or 'perldoc perlgpl'.
|
|
#
|
|
|
|
package Plack::Middleware::DW::ConcatRes;
|
|
|
|
use strict;
|
|
use v5.10;
|
|
|
|
use parent qw/ Plack::Middleware /;
|
|
|
|
use Fcntl ':mode';
|
|
use HTTP::Date qw/ time2str /;
|
|
|
|
sub call {
|
|
my ( $self, $env ) = @_;
|
|
|
|
my $query = $env->{QUERY_STRING} // '';
|
|
|
|
# Concat requests have a query string starting with '?' (making the URL ??...)
|
|
return $self->app->($env)
|
|
unless $query =~ /^\?/;
|
|
|
|
my $uri = $env->{PATH_INFO};
|
|
my $docroot = $LJ::STATDOCS // $LJ::HTDOCS;
|
|
my $dir = $docroot . $uri;
|
|
my $maxdir = $docroot . '/max' . $uri;
|
|
|
|
return _404()
|
|
unless -d $dir || -d $maxdir;
|
|
|
|
# Strip cache buster ?v=... suffix
|
|
$query =~ s/\?v=.*$//;
|
|
|
|
# Collect each file
|
|
my ( $body, $size, $mtime, $mime ) = ( '', 0, 0, undef );
|
|
foreach my $file ( split /,/, substr( $query, 1 ) ) {
|
|
my $res = _load_file("$dir$file") // _load_file("$maxdir$file");
|
|
return _404()
|
|
unless defined $res;
|
|
|
|
$body .= $res->[0];
|
|
$size += $res->[1];
|
|
$mtime = $res->[2]
|
|
if $res->[2] > $mtime;
|
|
$mime //= $res->[3];
|
|
|
|
# Reject mixed file types
|
|
return _404()
|
|
if $mime ne $res->[3];
|
|
}
|
|
|
|
return _404()
|
|
unless $body;
|
|
|
|
my @headers = (
|
|
'Content-Type' => $mime,
|
|
'Content-Length' => $size,
|
|
'Last-Modified' => time2str($mtime),
|
|
);
|
|
|
|
# Support HEAD requests
|
|
my $response_body = $env->{REQUEST_METHOD} eq 'HEAD' ? '' : $body;
|
|
|
|
return [ 200, \@headers, [$response_body] ];
|
|
}
|
|
|
|
sub _404 {
|
|
return [ 404, [ 'Content-Type' => 'text/plain' ], ['Not Found'] ];
|
|
}
|
|
|
|
sub _load_file {
|
|
my $fn = $_[0];
|
|
|
|
# No path traversal
|
|
return undef if $fn =~ /\.\./;
|
|
|
|
# Specific types only
|
|
my $mime;
|
|
if ( $fn =~ /\.([a-z]+)$/ ) {
|
|
$mime = {
|
|
css => 'text/css; charset=utf-8',
|
|
js => 'application/javascript; charset=utf-8',
|
|
}->{$1};
|
|
}
|
|
return undef unless $mime;
|
|
|
|
# Verify exists and is regular file
|
|
my @stat = stat($fn);
|
|
return undef
|
|
unless scalar @stat > 0
|
|
&& S_ISREG( $stat[2] );
|
|
|
|
my $contents;
|
|
open my $fh, '<', $fn
|
|
or return undef;
|
|
{ local $/ = undef; $contents = <$fh>; }
|
|
close $fh;
|
|
|
|
# Remove UTF-8 byte-order mark
|
|
$contents =~ s/\A\x{ef}\x{bb}\x{bf}//;
|
|
|
|
# Add a newline for safety
|
|
$contents .= "\n";
|
|
|
|
my $size = length($contents);
|
|
|
|
return [ $contents, $size, $stat[9], $mime ];
|
|
}
|
|
|
|
1;
|