view release on metacpan or  search on metacpan

lib/PAGI/Middleware/ReverseProxy.pm  view on Meta::CPAN

            }
        } elsif ($real_ip) {
            if (exists $scope->{client}) {
                $new_scope{client} = [$real_ip, $scope->{client}[1]];
                $new_scope{original_client} = $scope->{client};
            } else {
                $new_scope{client} = [$real_ip, undef];
            }
        }

        # X-Forwarded-Proto
        my $forwarded_proto = $self->_get_header($scope, 'x-forwarded-proto');
        if ($forwarded_proto) {
            $forwarded_proto = lc($forwarded_proto);
            $new_scope{scheme} = $forwarded_proto if $forwarded_proto =~ /^https?$/;
        }

        # X-Forwarded-Host
        my $forwarded_host = $self->_get_header($scope, 'x-forwarded-host');
        if ($forwarded_host) {
            # Update headers with new Host
            my @new_headers;
            for my $h (@{$scope->{headers} // []}) {
                if (lc($h->[0]) eq 'host') {
                    push @new_headers, ['host', $forwarded_host];
                } else {
                    push @new_headers, $h;
                }
            }
            $new_scope{headers} = \@new_headers;
        }

        # X-Forwarded-Port
        my $forwarded_port = $self->_get_header($scope, 'x-forwarded-port');
        if ($forwarded_port && $forwarded_port =~ /^\d+$/) {
            $new_scope{server} = [$scope->{server}[0], int($forwarded_port)];
        }

        await $app->(\%new_scope, $receive, $send);
    };
}

sub _is_trusted {
    my ($self, $ip) = @_;

    for my $trusted (@{$self->{trusted_proxies}}) {
        if ($trusted =~ m{/}) {
            # CIDR notation
            return 1 if $self->_ip_in_cidr($ip, $trusted);
        } else {
            # Exact match
            return 1 if $ip eq $trusted;
        }
    }
    return 0;
}

sub _ip_in_cidr {
    my ($self, $ip, $cidr) = @_;

    my ($network, $bits) = split m{/}, $cidr;

    # Simple IPv4 check
    return 0 unless $ip =~ /^[\d.]+$/ && $network =~ /^[\d.]+$/;

    my $ip_num = $self->_ip_to_num($ip);
    my $net_num = $self->_ip_to_num($network);

    return 0 unless defined $ip_num && defined $net_num;

    my $mask = ~((1 << (32 - $bits)) - 1) & 0xFFFFFFFF;
    return ($ip_num & $mask) == ($net_num & $mask);
}

sub _ip_to_num {
    my ($self, $ip) = @_;

    my @octets = split /\./, $ip;
    return unless @octets == 4;
    return unless _all(sub { /^\d+$/ && $_ >= 0 && $_ <= 255 }, @octets);

    return ($octets[0] << 24) + ($octets[1] << 16) + ($octets[2] << 8) + $octets[3];
}

sub _all {
    my ($code, @list) = @_;
    for (@list) {
        return 0 unless $code->();
    }
    return 1;
}

sub _get_header {
    my ($self, $scope, $name) = @_;

    $name = lc($name);
    for my $h (@{$scope->{headers} // []}) {
        return $h->[1] if lc($h->[0]) eq $name;
    }
    return;
}

1;

__END__

=head1 SCOPE MODIFICATIONS

When headers are processed from a trusted proxy:

=over 4

=item * client - Updated to original client [IP, port]

=item * original_client - The proxy's [IP, port]

=item * scheme - Updated to 'https' if X-Forwarded-Proto indicates

=item * headers - Host header updated if X-Forwarded-Host present

=item * server - Port updated if X-Forwarded-Port present