kill off the rest of the dead code that's in tpsgi now

lib/TCMS.pm

@@ -63,6 +63,9 @@ sub build_routes {
         my $cb_wrap = sub {
             my ( $tpsgi, $query ) = @_;
 
+            # Let's open up our default route if needed before we bother thinking any harder
+            return $routes{default}{callback}->($query) unless -f "config/setup";
+
             # Set the urchin parameters if necessary.
             %$Trog::Log::DBI::urchin = map { $_ => delete $query->{$_} } qw{utm_source utm_medium utm_campaign utm_term utm_content};
 
@@ -141,302 +144,6 @@ sub generic_route ( $rname, $code, $title, $query ) {
 our @routes  = @{ build_routes() };
 our %aliases = aliases();
 
-=head2 app()
-
-Dispatches requests based on %routes built above.
-
-The dispatcher here does *not* do anything with the authn/authz data.  It sets those in the 'user' and 'acls' parameters of the query object passed to routes.
-
-If a path passed is not a defined route (or regex route), but exists as a file under www/, it will be served up immediately.
-
-=cut
-
-sub _app {
-
-    # Make sure all writes are with the proper permissions, none need know of our love
-    umask 0077;
-
-    # Start the server timing clock
-    my $start = [gettimeofday];
-
-    # Build the routing table
-    state( $conf, $data, %aliases );
-
-    # Setup logging
-    #log_init();
-
-    $conf //= Trog::Config::get();
-    $data //= Trog::Data->new($conf);
-    my %routes = %{ _routes($data) };
-    %aliases = $data->aliases() unless %aliases;
-
-    # XXX this is built progressively across the forks, leading to inconsistent behavior.
-    # This should eventually be pre-filled from DB.
-    my %etags;
-
-    my $requestid = Trog::Utils::uuid();
-    Trog::Log::uuid($requestid);
-
-    # Actually start processing the request
-    my $env = shift;
-
-    # Discard the path used in the log, it's too long and enough 4xx error code = ban
-    return _toolong( { method => $env->{REQUEST_METHOD}, fullpath => '...' } ) if length( $env->{REQUEST_URI} ) > 2048;
-
-    # Various stuff important for logging requests
-    state $domain = $conf->param('general.hostname') || $env->{HTTP_X_FORWARDED_HOST} || $env->{HTTP_HOST} || eval { Sys::Hostname::hostname() };
-    my $path   = $env->{PATH_INFO};
-    my $port   = $env->{HTTP_X_FORWARDED_PORT} // $env->{HTTP_PORT};
-    my $pport  = defined $port ? ":$port" : "";
-    my $scheme = $env->{'psgi.url_scheme'} // 'http';
-    my $method = $env->{REQUEST_METHOD};
-
-    # It's important that we log what the user ACTUALLY requested rather than the rewritten path later on.
-    my $fullpath = "$scheme://$domain$pport$path";
-
-    # sigdie can now "do the right thing"
-    $cur_query = { route => $path, fullpath => $path, method => $method };
-
-    # Set the IP of the request so we can fail2ban
-    $Trog::Log::ip = $env->{HTTP_X_FORWARDED_FOR} || $env->{REMOTE_ADDR};
-
-    # Set the referer & ua to go into DB logs, but not logs in general.
-    # The referer/ua largely has no importance beyond being a proto bug report for log messages.
-    $Trog::Log::DBI::referer = $env->{HTTP_REFERER};
-    $Trog::Log::DBI::ua      = $env->{HTTP_UA};
-
-    # Check eTags.  If we don't know about it, just assume it's good and lazily fill the cache
-    # XXX yes, this allows cache poisoning...but only for logged in users!
-    if ( $env->{HTTP_IF_NONE_MATCH} ) {
-        INFO("$env->{REQUEST_METHOD} 304 0 $fullpath");
-        return [ 304, [], [''] ] if $env->{HTTP_IF_NONE_MATCH} eq ( $etags{ $env->{REQUEST_URI} } || '' );
-        $etags{ $env->{REQUEST_URI} } = $env->{HTTP_IF_NONE_MATCH} unless exists $etags{ $env->{REQUEST_URI} };
-    }
-
-    # TODO: Actually do something with the language passed to the renderer
-    my $lang = $env->{HTTP_ACCEPT_LANGUAGE};
-
-    #TODO: Actually do something with the acceptable output formats in the renderer
-    my $accept = $env->{HTTP_ACCEPT};
-
-    # Figure out if we want compression or not
-    my $alist = $env->{HTTP_ACCEPT_ENCODING} || '';
-    $alist =~ s/\s//g;
-    my @accept_encodings;
-    @accept_encodings = split( /,/, $alist );
-    my $deflate = grep { 'gzip' eq $_ } @accept_encodings;
-
-    # NOTE These two parameters are entirely academic, as we don't use ad tracking cookies, but the UTM parameters.
-    # UTMs are actually fully sufficient to get you what you want -- e.g. keywords, audience groups, a/b testing, etc.
-    # and you need to put up cookie consent banners if you bother using tracking cookies, which are horrific UX.
-    #my $no_track = $env->{HTTP_DNT};
-    #my $no_sell_info = $env->{HTTP_SEC_GPC};
-
-    # We generally prefer this to be handled at the reverse proxy level.
-    #my $prefer_ssl = $env->{HTTP_UPGRADE_INSECURE_REQUESTS};
-
-    my $last_fetch = 0;
-    if ( $env->{HTTP_IF_MODIFIED_SINCE} ) {
-        $last_fetch = DateTime::Format::HTTP->parse_datetime( $env->{HTTP_IF_MODIFIED_SINCE} )->epoch();
-    }
-
-    #XXX Don't use statics anything that has a search query
-    # On one hand, I don't want to DOS the disk, but I'd also like some like ?rss...
-    # Should probably turn those into aliases.
-    my $has_query = !!$env->{QUERY_STRING};
-
-    my $query = {};
-    $query = URL::Encode::url_params_mixed( $env->{QUERY_STRING} ) if $env->{QUERY_STRING};
-
-    #Actually parse the POSTDATA and dump it into the QUERY object if this is a POST
-    if ( $env->{REQUEST_METHOD} eq 'POST' ) {
-
-        my $body = HTTP::Body->new( $env->{CONTENT_TYPE}, $env->{CONTENT_LENGTH} );
-        while ( $env->{'psgi.input'}->read( my $buf, $Trog::Vars::CHUNK_SIZE ) ) {
-            $body->add($buf);
-        }
-
-        @$query{ keys( %{ $body->param } ) }  = values( %{ $body->param } );
-        @$query{ keys( %{ $body->upload } ) } = values( %{ $body->upload } );
-    }
-
-    # It's mod_rewrite!
-    $path = '/index' if $path eq '/';
-
-    #XXX this is hardcoded in browsers, so just rewrite the path - neeeds to be an alias
-    $path = '/img/icon/favicon.ico' if $path eq '/favicon.ico';
-
-    # Translate alias paths into their actual path
-    $path = $aliases{$path} if exists $aliases{$path};
-
-    # Collapse multiple slashes in the path
-    $path =~ s/[\/]+/\//g;
-
-    #Handle regex/capture routes
-    if ( !exists $routes{$path} ) {
-        my @captures;
-
-        # XXX maybe this should all just go into $query?
-        # TODO can optimize by having separate hashes for capture/non-capture routes
-        foreach my $pattern ( keys(%routes) ) {
-            @captures = $path =~ m/^$pattern$/;
-            if (@captures) {
-                $path = $pattern;
-                foreach my $field ( @{ $routes{$path}{captures} } ) {
-                    $routes{$path}{data} //= {};
-                    $routes{$path}{data}{$field} = shift @captures;
-                }
-                last;
-            }
-        }
-    }
-
-    # Set the 'data' in the query that the route specifically overrides, which we are also using for the catpured data
-    # This also means you have to validate both of them via parameters if you set that up.
-    @{$query}{ keys( %{ $routes{$path}{'data'} } ) } = values( %{ $routes{$path}{'data'} } ) if ref $routes{$path}{'data'} eq 'HASH' && %{ $routes{$path}{'data'} };
-
-    # Ensure any short-circuit routes can log the request, and return the server-timing headers properly
-    $query->{method}   = $method;
-    $query->{route}    = $path;
-    $query->{fullpath} = $fullpath;
-    $query->{start}    = $start;
-
-    # Handle HTTP range/streaming requests
-    my $range = $env->{HTTP_RANGE} || "bytes=0-" if $env->{HTTP_RANGE} || $env->{HTTP_IF_RANGE};
-
-    my $streaming = $env->{'psgi.streaming'};
-    $query->{streaming} = $streaming;
-
-    my @ranges;
-    if ($range) {
-        $range =~ s/bytes=//g;
-        push(
-            @ranges,
-            map {
-                [ split( /-/, $_ ) ];
-
-                #$tuples[1] //= $tuples[0] + $Trog::Vars::CHUNK_SIZE;
-                #\@tuples
-            } split( /,/, $range )
-        );
-    }
-
-    # If it's a file, just serve it
-    return Trog::FileHandler::serve( $fullpath, "www/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "www/$path";
-
-    # Figure out if we have a logged in user, so we can serve them user-specific files
-    my $cookies = {};
-    if ( $env->{HTTP_COOKIE} ) {
-        $cookies = CGI::Cookie->parse( $env->{HTTP_COOKIE} );
-    }
-
-    my $active_user = '';
-    $Trog::Log::user = 'nobody';
-    if ( exists $cookies->{tcmslogin} ) {
-        $active_user     = Trog::Auth::session2user( $cookies->{tcmslogin}->value );
-        $Trog::Log::user = $active_user if $active_user;
-    }
-
-    return Trog::FileHandler::serve( $fullpath, "totp/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "totp/$path" && $active_user;
-
-    # Now that we have firmed up the actual routing, let's validate.
-    return _forbidden($query) if exists $routes{$path}{auth} && !$active_user;
-    return _notfound($query) unless exists $routes{$path} && ref $routes{$path} eq 'HASH' && keys( %{ $routes{$path} } );
-    return _badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ( $routes{$path}{method} || '', 'HEAD' );
-
-    # Disallow any paths that are naughty ( starman auto-removes .. up-traversal)
-    if ( index( $path, '/templates' ) == 0 || index( $path, '/statics' ) == 0 || $path =~ m/.*(\.psgi|\.pm)$/i ) {
-        return _forbidden($query);
-    }
-
-    # Set the urchin parameters if necessary.
-    %$Trog::Log::DBI::urchin = map { $_ => delete $query->{$_} } qw{utm_source utm_medium utm_campaign utm_term utm_content};
-
-    # Now that we've parsed the query and know where we want to go, we should murder everything the route does not explicitly want, and validate what it does
-    my $parameters = $routes{$path}{parameters};
-    if ($parameters) {
-        die "invalid route definition for $path: bad parameters" unless is_hashref($parameters);
-        my @known_params = keys(%$parameters);
-        for my $param (@known_params) {
-            die "Invalid route definition for $path: parameter $param must correspond to a validation CODEREF." unless is_coderef( $parameters->{$param} );
-
-            # A missing parameter is not necessarily a problem.
-            next unless $query->{$param};
-
-            # But if we have it, and it's bad, nack it, so that scanners get fail2banned.
-            DEBUG("Rejected $fullpath for bad query param $param");
-            return _badrequest($query) unless $parameters->{$param}->( $query->{$param} );
-        }
-
-        # Smack down passing of unnecessary fields
-        foreach my $field ( keys(%$query) ) {
-            next if List::Util::any { $field eq $_ } @known_params;
-            next if List::Util::any { $field eq $_ } qw{start route streaming method fullpath};
-            DEBUG("Rejected $fullpath for query param $field");
-            return _badrequest($query);
-        }
-    }
-
-    # Let's open up our default route before we bother thinking about routing any harder
-    return $routes{default}{callback}->($query) unless -f "config/setup";
-
-    $query->{user_acls} = [];
-    $query->{user_acls} = Trog::Auth::acls4user($active_user) // [] if $active_user;
-
-    # Grab the list of ACLs we want to add to a post, if any.
-    $query->{acls} = [ $query->{acls} ] if ( $query->{acls} && ref $query->{acls} ne 'ARRAY' );
-
-    # Filter out passed ACLs which are naughty
-    my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
-    @{ $query->{acls} } = grep { $_ ne 'admin' } @{ $query->{acls} } unless $is_admin;
-
-    # If we have a static render, just use it instead (These will ALWAYS be correct, data saves invalidate this)
-    # TODO: make this key on admin INSTEAD of active user when we add non-admin users.
-    if ( !$active_user && !$has_query ) {
-        return _static( $fullpath, "$path.z", $start, $streaming ) if -f "www/statics/$path.z" && $deflate;
-        return _static( $fullpath, $path,     $start, $streaming ) if -f "www/statics/$path";
-    }
-
-    $query->{deflate} = $deflate;
-    $query->{user}    = $active_user;
-
-    #Set various things we don't want overridden
-    $query->{body}         = '';
-    $query->{dnt}          = $env->{HTTP_DNT};
-    $query->{user}         = $active_user;
-    $query->{domain}       = $domain;
-    $query->{route}        = $path;
-    $query->{scheme}       = $scheme;
-    $query->{social_meta}  = 1;
-    $query->{primary_post} = {};
-    $query->{has_query}    = $has_query;
-    $query->{port}         = $port;
-    $query->{lang}         = $lang;
-    $query->{accept}       = $accept;
-
-    # Redirecting somewhere naughty not allow
-    $query->{to} = URI->new( $query->{to} // '' )->path() || $query->{to} if $query->{to};
-
-    DEBUG("DISPATCH $path to $routes{$path}{callback}");
-
-    #XXX there is a trick to now use strict refs, but I don't remember it right at the moment
-    {
-        no strict 'refs';
-        my $output = $routes{$path}{callback}->($query);
-        die "$path returned no data!" unless ref $output eq 'ARRAY' && @$output == 3;
-
-        my $pport   = defined $query->{port} ? ":$query->{port}" : "";
-        my %headers = @{ $output->[1] };
-        my $bytes   = $headers{'Content-Length'};
-        INFO("$env->{REQUEST_METHOD} $output->[0] $bytes $fullpath");
-
-        # Append server-timing headers if they aren't present
-        my $tot = tv_interval($start) * 1000;
-        push( @{ $output->[1] }, 'Server-Timing' => "app;dur=$tot" ) unless List::Util::any { $_ eq 'Server-Timing' } @{ $output->[1] };
-        return $output;
-    }
-}
-
 #XXX Return a clone of the routing table ref, because code modifies it later
 sub _routes ( $data = {} ) {
     state %routes;
@@ -493,96 +200,4 @@ sub robots ($query) {
     );
 }
 
-sub _generic ( $type, $query ) {
-    return _static( "$type.z", $query->{start}, $query->{streaming} ) if -f "www/statics/$type.z";
-    return _static( $type,     $query->{start}, $query->{streaming} ) if -f "www/statics/$type";
-    my %lookup = (
-        notfound   => \&Trog::Routes::HTML::notfound,
-        forbidden  => \&Trog::Routes::HTML::forbidden,
-        badrequest => \&Trog::Routes::HTML::badrequest,
-        toolong    => \&Trog::Routes::HTML::toolong,
-        error      => \&Trog::Routes::HTML::error,
-    );
-    return $lookup{$type}->($query);
-}
-
-# TODO: we need a better linkage between bytes and the message actually sent
-sub _notfound ($query) {
-    INFO("$query->{method} 404 33 $query->{fullpath}");
-    return _generic( 'notfound', $query );
-}
-
-sub _forbidden ($query) {
-    INFO("$query->{method} 403 23 $query->{fullpath}");
-    return _generic( 'forbidden', $query );
-}
-
-sub _badrequest ($query) {
-    INFO("$query->{method} 400 11 $query->{fullpath}");
-    return _generic( 'badrequest', $query );
-}
-
-sub _toolong ($query) {
-    INFO("$query->{method} 419 12 $query->{fullpath}");
-    return _generic( 'toolong', {} );
-}
-
-sub _error ($query) {
-    $query->{method}   //= "UNKNOWN";
-    $query->{fullpath} //= $query->{route} // '/?';
-    INFO("$query->{method} 500 21 $query->{fullpath}");
-    return _generic( 'error', $query );
-}
-
-sub _static ( $fullpath, $path, $start, $streaming, $last_fetch = 0 ) {
-
-    DEBUG("Rendering static for $path");
-
-    # XXX because of psgi I can't just vomit the file directly
-    if ( open( my $fh, '<', "www/statics/$path" ) ) {
-        my $headers = '';
-
-        # NOTE: this is relying on while advancing the file pointer
-        while (<$fh>) {
-            last if $_ eq "\n";
-            $headers .= $_;
-        }
-        my ( undef, undef, $status, undef, $headers_parsed ) = HTTP::Parser::XS::parse_http_response( "$headers\n", HEADERS_AS_HASHREF );
-
-        #XXX need to put this into the file itself
-        my $mt         = ( stat($fh) )[9];
-        my @gm         = gmtime($mt);
-        my $now_string = strftime( "%a, %d %b %Y %H:%M:%S GMT", @gm );
-        my $code       = $mt > $last_fetch ? $status : 304;
-        $headers_parsed->{"Last-Modified"} = $now_string;
-
-        # Append server-timing headers
-        my $tot = tv_interval($start) * 1000;
-        $headers_parsed->{'Server-Timing'} = "static;dur=$tot";
-
-        #XXX uwsgi just opens the file *again* when we already have a filehandle if it has a path.
-        # starman by comparison doesn't violate the principle of least astonishment here.
-        # This is probably a performance optimization, but makes the kind of micromanagement I need to do inconvenient.
-        # As such, we will just return a stream.
-        INFO("GET 200 $headers_parsed->{'Content-Length'} $fullpath");
-
-        return sub {
-            my $responder = shift;
-
-            #push(@headers, 'Content-Length' => $sz);
-            my $writer = $responder->( [ $code, [%$headers_parsed] ] );
-            while ( $fh->read( my $buf, $Trog::Vars::CHUNK_SIZE ) ) {
-                $writer->write($buf);
-            }
-            close $fh;
-            $writer->close;
-          }
-          if $streaming;
-
-        return [ $code, [%$headers_parsed], $fh ];
-    }
-    INFO("GET 403 23 $fullpath");
-    return [ 403, [ 'Content-Type' => $Trog::Vars::content_types{text} ], ["STAY OUT YOU RED MENACE"] ];
-}
-
 1;