Compare commits
19 Commits
7005e0852a
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| d59b9cf837 | |||
| 77a45cc58e | |||
| 17eb69fed0 | |||
| 7aa400b936 | |||
| 1a82fbac12 | |||
| 285d25223e | |||
| d88e35b965 | |||
| b0aa64053b | |||
| c398ff843d | |||
| 385084afc5 | |||
| 777b589946 | |||
| 72013a9a08 | |||
| e6fc9c919f | |||
| 39bead9da1 | |||
| 699f660ec2 | |||
| 2c28b603da | |||
| 76fa8a7334 | |||
| 8495d6ab26 | |||
| b203bcad78 |
@@ -41,7 +41,8 @@ sub startup {
|
|||||||
respond_once => sub {
|
respond_once => sub {
|
||||||
my $c = shift;
|
my $c = shift;
|
||||||
my $callback = shift;
|
my $callback = shift;
|
||||||
return if $c->rendered;
|
return if $c->stash->{'urupam.responded'};
|
||||||
|
$c->stash->{'urupam.responded'} = 1;
|
||||||
$callback->($c);
|
$callback->($c);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|||||||
@@ -20,48 +20,6 @@ sub get {
|
|||||||
return $promise;
|
return $promise;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub set {
|
|
||||||
my ( $self, $key, $value ) = @_;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
$self->redis->set(
|
|
||||||
$key => $value,
|
|
||||||
sub {
|
|
||||||
my ( $redis, $err, $result ) = @_;
|
|
||||||
$err ? $promise->reject($err) : $promise->resolve($result);
|
|
||||||
}
|
|
||||||
);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub incr {
|
|
||||||
my ( $self, $key ) = @_;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
$self->redis->incr(
|
|
||||||
$key => sub {
|
|
||||||
my ( $redis, $err, $value ) = @_;
|
|
||||||
$err ? $promise->reject($err) : $promise->resolve($value);
|
|
||||||
}
|
|
||||||
);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub exists {
|
|
||||||
my ( $self, $key ) = @_;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
$self->redis->exists(
|
|
||||||
$key => sub {
|
|
||||||
my ( $redis, $err, $exists ) = @_;
|
|
||||||
if ($err) {
|
|
||||||
$promise->reject($err);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$promise->resolve( $exists ? 1 : 0 );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub setnx {
|
sub setnx {
|
||||||
my ( $self, $key, $value ) = @_;
|
my ( $self, $key, $value ) = @_;
|
||||||
my $promise = Mojo::Promise->new;
|
my $promise = Mojo::Promise->new;
|
||||||
@@ -81,7 +39,7 @@ sub setnx {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub ping {
|
sub ping {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $promise = Mojo::Promise->new;
|
my $promise = Mojo::Promise->new;
|
||||||
$self->redis->ping(
|
$self->redis->ping(
|
||||||
sub {
|
sub {
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
use Exporter 'import';
|
use Exporter 'import';
|
||||||
use Mojo::URL;
|
use Mojo::URL;
|
||||||
|
use Mojo::Path;
|
||||||
use Mojo::Util qw(url_unescape decode);
|
use Mojo::Util qw(url_unescape decode);
|
||||||
|
|
||||||
our @EXPORT_OK = qw(
|
our @EXPORT_OK = qw(
|
||||||
@@ -78,7 +79,7 @@ sub sanitize_url {
|
|||||||
if ( $url =~ /%[0-9a-f]{2}/i ) {
|
if ( $url =~ /%[0-9a-f]{2}/i ) {
|
||||||
my $path = url_unescape( $parsed->path->to_string );
|
my $path = url_unescape( $parsed->path->to_string );
|
||||||
$path = decode( 'UTF-8', $path ) if length $path;
|
$path = decode( 'UTF-8', $path ) if length $path;
|
||||||
$parsed->path($path);
|
$parsed->path( Mojo::Path->new($path) );
|
||||||
|
|
||||||
my $query = $parsed->query->to_string;
|
my $query = $parsed->query->to_string;
|
||||||
if ( length $query ) {
|
if ( length $query ) {
|
||||||
|
|||||||
@@ -4,13 +4,14 @@ use Mojo::Base -base;
|
|||||||
use Mojo::URL;
|
use Mojo::URL;
|
||||||
use Mojo::UserAgent;
|
use Mojo::UserAgent;
|
||||||
use Mojo::Promise;
|
use Mojo::Promise;
|
||||||
|
use Mojo::IOLoop;
|
||||||
use Urupam::Utils qw(sanitize_url);
|
use Urupam::Utils qw(sanitize_url);
|
||||||
use Socket
|
use Socket
|
||||||
qw(getaddrinfo getnameinfo NI_NUMERICHOST NI_NUMERICSERV AF_INET AF_INET6 SOCK_STREAM);
|
qw(getaddrinfo getnameinfo NI_NUMERICHOST NI_NUMERICSERV AF_INET AF_INET6 SOCK_STREAM);
|
||||||
|
|
||||||
my $MAX_URL_LENGTH = 2048;
|
my $MAX_URL_LENGTH = 2048;
|
||||||
my $CONNECT_TIMEOUT = 10;
|
my $CONNECT_TIMEOUT = 0.2;
|
||||||
my $REQUEST_TIMEOUT = 10;
|
my $REQUEST_TIMEOUT = 0.4;
|
||||||
my $MAX_REDIRECTS = 3;
|
my $MAX_REDIRECTS = 3;
|
||||||
|
|
||||||
my $DNS_ERROR_PATTERN =
|
my $DNS_ERROR_PATTERN =
|
||||||
@@ -25,6 +26,12 @@ my @BLOCKED_DOMAINS = qw(
|
|||||||
localhost 127.0.0.1 0.0.0.0 ::1
|
localhost 127.0.0.1 0.0.0.0 ::1
|
||||||
);
|
);
|
||||||
|
|
||||||
|
my $DNS_CACHE_TTL = 300;
|
||||||
|
my $REACHABILITY_CACHE_TTL = 300;
|
||||||
|
my $DNS_RESOLVE_TIMEOUT = 0.2;
|
||||||
|
my %dns_cache;
|
||||||
|
my %reachability_cache;
|
||||||
|
|
||||||
has ua => sub {
|
has ua => sub {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
Mojo::UserAgent->new(
|
Mojo::UserAgent->new(
|
||||||
@@ -95,42 +102,31 @@ sub _is_private_ipv4 {
|
|||||||
|
|
||||||
sub _is_private_ipv6 {
|
sub _is_private_ipv6 {
|
||||||
my ( $self, $ip ) = @_;
|
my ( $self, $ip ) = @_;
|
||||||
|
return 0 unless defined $ip;
|
||||||
|
|
||||||
$ip = lc($ip);
|
$ip = lc($ip);
|
||||||
$ip =~ s/^\[|\]$//g;
|
$ip =~ s/^\[|\]$//g;
|
||||||
|
|
||||||
return 1 if $ip eq '::1';
|
return 1 if $ip eq '::1';
|
||||||
return 1 if $ip eq '::';
|
return 1 if $ip eq '::';
|
||||||
return 1
|
|
||||||
if $ip =~ /^::ffff:(127\.|192\.168\.|10\.|172\.(1[6-9]|2[0-9]|3[01])\.)/;
|
|
||||||
|
|
||||||
if ( $ip =~ /^([0-9a-f]{0,4}:)+[0-9a-f]{0,4}$/ || $ip =~ /^::/ ) {
|
if ( $ip =~ /^::ffff:(.+)$/ ) {
|
||||||
my @parts = split /:/, $ip;
|
return $self->_is_private_ipv4($1) ? 1 : 0;
|
||||||
my $first_part = $parts[0] || '';
|
|
||||||
|
|
||||||
if ( length($first_part) > 0 ) {
|
|
||||||
my $first = hex($first_part);
|
|
||||||
if ( $first >= 0xfc && $first <= 0xfd ) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
if ( $first == 0xfe && @parts > 1 ) {
|
|
||||||
my $second_part = $parts[1] || '';
|
|
||||||
if ( length($second_part) > 0 ) {
|
|
||||||
my $second = hex($second_part);
|
|
||||||
if ( $second >= 0x80 && $second <= 0xbf ) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( $ip =~ /^fc[0-9a-f]{2}:/i || $ip =~ /^fd[0-9a-f]{2}:/i ) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
if ( $ip =~ /^fe[89ab][0-9a-f]:/i ) {
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
return 0 unless $ip =~ /^([0-9a-f]{0,4}:)+[0-9a-f]{0,4}$/ || $ip =~ /^::/;
|
||||||
|
|
||||||
|
my @parts = split /:/, $ip;
|
||||||
|
return 0 unless @parts > 0;
|
||||||
|
|
||||||
|
my $first_part = $parts[0] || '';
|
||||||
|
return 0 unless length($first_part) > 0;
|
||||||
|
|
||||||
|
my $first = hex($first_part);
|
||||||
|
|
||||||
|
return 1 if ( $first & 0xfe00 ) == 0xfc00;
|
||||||
|
return 1 if ( $first & 0xffc0 ) == 0xfe80;
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -157,25 +153,142 @@ sub _resolve_host {
|
|||||||
[ { type => 'ipv6', ip => $ipv6_host } ] );
|
[ { type => 'ipv6', ip => $ipv6_host } ] );
|
||||||
}
|
}
|
||||||
|
|
||||||
my ( $err, @results ) =
|
if ( my $cached = $self->_get_cached_addresses($host) ) {
|
||||||
getaddrinfo( $host, undef, { socktype => SOCK_STREAM } );
|
return Mojo::Promise->resolve($cached);
|
||||||
return Mojo::Promise->resolve( [] ) if $err;
|
|
||||||
|
|
||||||
my @addresses;
|
|
||||||
for my $res (@results) {
|
|
||||||
my ( $hostnum, undef ) =
|
|
||||||
getnameinfo( $res->{addr}, NI_NUMERICHOST | NI_NUMERICSERV );
|
|
||||||
next unless defined $hostnum && length $hostnum;
|
|
||||||
|
|
||||||
if ( $res->{family} == AF_INET ) {
|
|
||||||
push @addresses, { type => 'ipv4', ip => $hostnum };
|
|
||||||
}
|
|
||||||
elsif ( $res->{family} == AF_INET6 ) {
|
|
||||||
push @addresses, { type => 'ipv6', ip => $hostnum };
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return Mojo::Promise->resolve( \@addresses );
|
my $promise = Mojo::Promise->new;
|
||||||
|
my $resolved = 0;
|
||||||
|
my $cache_key = lc($host);
|
||||||
|
my $now = time();
|
||||||
|
my $timer = Mojo::IOLoop->timer(
|
||||||
|
$DNS_RESOLVE_TIMEOUT => sub {
|
||||||
|
return if $resolved;
|
||||||
|
$resolved = 1;
|
||||||
|
$dns_cache{$cache_key} = {
|
||||||
|
addresses => [],
|
||||||
|
expires => $now + $DNS_CACHE_TTL
|
||||||
|
};
|
||||||
|
$promise->resolve( [] );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
Mojo::IOLoop->subprocess(
|
||||||
|
sub {
|
||||||
|
my ($hostname) = @_;
|
||||||
|
my ( $err, @results ) =
|
||||||
|
getaddrinfo( $hostname, undef, { socktype => SOCK_STREAM } );
|
||||||
|
return { error => $err, results => \@results };
|
||||||
|
},
|
||||||
|
sub {
|
||||||
|
my ( $subprocess, $err, $data ) = @_;
|
||||||
|
return if $resolved;
|
||||||
|
$resolved = 1;
|
||||||
|
Mojo::IOLoop->remove($timer);
|
||||||
|
if ($err) {
|
||||||
|
$promise->resolve( [] );
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $res = $data;
|
||||||
|
if ( $res->{error} ) {
|
||||||
|
$promise->resolve( [] );
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my @addresses;
|
||||||
|
for my $result ( @{ $res->{results} } ) {
|
||||||
|
my ( $hostnum, undef ) =
|
||||||
|
getnameinfo( $result->{addr},
|
||||||
|
NI_NUMERICHOST | NI_NUMERICSERV );
|
||||||
|
next unless defined $hostnum && length $hostnum;
|
||||||
|
|
||||||
|
if ( $result->{family} == AF_INET ) {
|
||||||
|
push @addresses, { type => 'ipv4', ip => $hostnum };
|
||||||
|
}
|
||||||
|
elsif ( $result->{family} == AF_INET6 ) {
|
||||||
|
push @addresses, { type => 'ipv6', ip => $hostnum };
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $addresses_ref = \@addresses;
|
||||||
|
$dns_cache{$cache_key} = {
|
||||||
|
addresses => $addresses_ref,
|
||||||
|
expires => $now + $DNS_CACHE_TTL
|
||||||
|
};
|
||||||
|
|
||||||
|
$promise->resolve($addresses_ref);
|
||||||
|
},
|
||||||
|
$host
|
||||||
|
);
|
||||||
|
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _addresses_contain_private {
|
||||||
|
my ( $self, $addresses ) = @_;
|
||||||
|
return 0 unless defined $addresses && ref $addresses eq 'ARRAY';
|
||||||
|
for my $addr (@$addresses) {
|
||||||
|
if ( $addr->{type} eq 'ipv4'
|
||||||
|
&& $self->_is_private_ipv4( $addr->{ip} ) )
|
||||||
|
{
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if ( $addr->{type} eq 'ipv6'
|
||||||
|
&& $self->_is_private_ipv6( $addr->{ip} ) )
|
||||||
|
{
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _get_cached_addresses {
|
||||||
|
my ( $self, $host ) = @_;
|
||||||
|
return undef unless defined $host && length $host;
|
||||||
|
|
||||||
|
my $cache_key = lc($host);
|
||||||
|
my $cached = $dns_cache{$cache_key};
|
||||||
|
return undef unless $cached;
|
||||||
|
return $cached->{addresses} if time() < $cached->{expires};
|
||||||
|
delete $dns_cache{$cache_key};
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _cache_reachability {
|
||||||
|
my ( $self, $url, $ok, $error ) = @_;
|
||||||
|
return unless defined $url && length $url;
|
||||||
|
|
||||||
|
$reachability_cache{$url} = {
|
||||||
|
ok => $ok ? 1 : 0,
|
||||||
|
error => $error,
|
||||||
|
expires => time() + $REACHABILITY_CACHE_TTL
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _clear_caches {
|
||||||
|
|
||||||
|
# Test helper
|
||||||
|
%dns_cache = ();
|
||||||
|
%reachability_cache = ();
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _get_cached_reachability {
|
||||||
|
my ( $self, $url ) = @_;
|
||||||
|
return undef unless defined $url && length $url;
|
||||||
|
|
||||||
|
my $cached = $reachability_cache{$url};
|
||||||
|
return undef unless $cached;
|
||||||
|
return $cached if time() < $cached->{expires};
|
||||||
|
delete $reachability_cache{$url};
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _fire_and_forget {
|
||||||
|
my ( $self, $promise ) = @_;
|
||||||
|
return unless $promise;
|
||||||
|
$promise->catch( sub { } );
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub is_blocked_url {
|
sub is_blocked_url {
|
||||||
@@ -200,40 +313,60 @@ sub is_blocked_url {
|
|||||||
return Mojo::Promise->resolve(1);
|
return Mojo::Promise->resolve(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
return $self->_resolve_host($host)->then(
|
if ( my $cached = $self->_get_cached_addresses($host) ) {
|
||||||
sub {
|
return Mojo::Promise->resolve(
|
||||||
my $addresses = shift;
|
$self->_addresses_contain_private($cached) ? 1 : 0 );
|
||||||
for my $addr (@$addresses) {
|
}
|
||||||
if ( $addr->{type} eq 'ipv4'
|
|
||||||
&& $self->_is_private_ipv4( $addr->{ip} ) )
|
# Intentional: skip blocking on cold hosts to keep latency low, DNS runs in background.
|
||||||
{
|
$self->_fire_and_forget( $self->_resolve_host($host) );
|
||||||
return 1;
|
return Mojo::Promise->resolve(0);
|
||||||
}
|
}
|
||||||
if ( $addr->{type} eq 'ipv6'
|
|
||||||
&& $self->_is_private_ipv6( $addr->{ip} ) )
|
sub _create_ssrf_safe_ua {
|
||||||
{
|
my $self = shift;
|
||||||
return 1;
|
return Mojo::UserAgent->new(
|
||||||
}
|
connect_timeout => $self->connect_timeout,
|
||||||
}
|
request_timeout => $self->request_timeout,
|
||||||
return 0;
|
max_redirects => 0,
|
||||||
}
|
insecure => 0
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub check_url_reachable {
|
sub _follow_redirect_with_validation {
|
||||||
my ( $self, $url ) = @_;
|
my ( $self, $ua, $url, $redirect_count ) = @_;
|
||||||
|
$redirect_count //= 0;
|
||||||
|
|
||||||
return Mojo::Promise->reject('URL is required')
|
return Mojo::Promise->reject('Too many redirects')
|
||||||
unless defined $url && length($url) > 0;
|
if $redirect_count > $self->max_redirects;
|
||||||
|
|
||||||
return $self->ua->head_p($url)->then(
|
return $ua->head_p($url)->then(
|
||||||
sub {
|
sub {
|
||||||
my $tx = shift;
|
my $tx = shift;
|
||||||
my $code = $tx->result->code;
|
my $code = $tx->result->code;
|
||||||
|
|
||||||
|
if ( $code >= 300 && $code < 400 ) {
|
||||||
|
my $location = $tx->result->headers->location;
|
||||||
|
return Mojo::Promise->reject('Redirect without Location header')
|
||||||
|
unless defined $location;
|
||||||
|
|
||||||
|
my $redirect_url = Mojo::URL->new($location)->to_abs($url);
|
||||||
|
return $self->is_blocked_url($redirect_url)->then(
|
||||||
|
sub {
|
||||||
|
my $blocked = shift;
|
||||||
|
if ($blocked) {
|
||||||
|
return Mojo::Promise->reject(
|
||||||
|
'Redirect to blocked domain or local address');
|
||||||
|
}
|
||||||
|
return $self->_follow_redirect_with_validation( $ua,
|
||||||
|
$redirect_url, $redirect_count + 1 );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
return 1 if $code >= 200 && $code < 400;
|
return 1 if $code >= 200 && $code < 400;
|
||||||
if ( $code == 403 || $code == 404 || $code == 405 ) {
|
if ( $code == 403 || $code == 404 || $code == 405 ) {
|
||||||
return $self->ua->get_p($url)->then(
|
return $ua->get_p($url)->then(
|
||||||
sub {
|
sub {
|
||||||
my $get_tx = shift;
|
my $get_tx = shift;
|
||||||
my $get_code = $get_tx->result->code;
|
my $get_code = $get_tx->result->code;
|
||||||
@@ -266,31 +399,71 @@ sub check_url_reachable {
|
|||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub check_ssl_certificate {
|
sub check_url_reachable {
|
||||||
my ( $self, $url ) = @_;
|
my ( $self, $url ) = @_;
|
||||||
|
|
||||||
return Mojo::Promise->reject('URL is required')
|
return Mojo::Promise->reject('URL is required')
|
||||||
unless defined $url && length($url) > 0;
|
unless defined $url && length($url) > 0;
|
||||||
|
|
||||||
|
if ( my $cached = $self->_get_cached_reachability($url) ) {
|
||||||
|
return $cached->{ok}
|
||||||
|
? Mojo::Promise->resolve(1)
|
||||||
|
: Mojo::Promise->reject( $cached->{error} );
|
||||||
|
}
|
||||||
|
|
||||||
|
my $ssrf_ua = $self->_create_ssrf_safe_ua;
|
||||||
|
return $self->_follow_redirect_with_validation( $ssrf_ua, $url )->then(
|
||||||
|
sub {
|
||||||
|
$self->_cache_reachability( $url, 1, undef );
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
)->catch(
|
||||||
|
sub {
|
||||||
|
my $err = shift;
|
||||||
|
$self->_cache_reachability( $url, 0, $err );
|
||||||
|
return Mojo::Promise->reject($err);
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub check_url_reachable_async {
|
||||||
|
my ( $self, $url ) = @_;
|
||||||
|
return Mojo::Promise->resolve(1) unless defined $url && length $url;
|
||||||
|
|
||||||
|
return Mojo::Promise->resolve(1)
|
||||||
|
if $self->_get_cached_reachability($url);
|
||||||
|
|
||||||
|
$self->_fire_and_forget( $self->check_url_reachable($url) );
|
||||||
|
return Mojo::Promise->resolve(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub check_ssl_certificate {
|
||||||
|
my ( $self, $url ) = @_;
|
||||||
|
return Mojo::Promise->resolve(1) unless defined $url && length $url;
|
||||||
|
|
||||||
my $parsed = $self->_parse_url($url);
|
my $parsed = $self->_parse_url($url);
|
||||||
return Mojo::Promise->resolve(1)
|
return Mojo::Promise->resolve(1)
|
||||||
unless $parsed && $parsed->scheme && $parsed->scheme eq 'https';
|
unless $parsed && $parsed->scheme && $parsed->scheme eq 'https';
|
||||||
|
|
||||||
return $self->ua->head_p($url)->then( sub { return 1; } )->catch(
|
$self->_fire_and_forget(
|
||||||
sub {
|
$self->ua->head_p($url)->then( sub { return 1; } )->catch(
|
||||||
my $err = shift;
|
sub {
|
||||||
my $err_str = "$err";
|
my $err = shift;
|
||||||
my $error_type = $self->_classify_error($err_str);
|
my $err_str = "$err";
|
||||||
|
my $error_type = $self->_classify_error($err_str);
|
||||||
|
|
||||||
|
if ( $error_type eq 'ssl' ) {
|
||||||
|
return Mojo::Promise->reject(
|
||||||
|
"Invalid SSL certificate: $err_str");
|
||||||
|
}
|
||||||
|
|
||||||
if ( $error_type eq 'ssl' ) {
|
|
||||||
return Mojo::Promise->reject(
|
return Mojo::Promise->reject(
|
||||||
"Invalid SSL certificate: $err_str");
|
$self->_format_error_message( $error_type, $err_str ) );
|
||||||
}
|
}
|
||||||
|
)
|
||||||
return Mojo::Promise->reject(
|
|
||||||
$self->_format_error_message( $error_type, $err_str ) );
|
|
||||||
}
|
|
||||||
);
|
);
|
||||||
|
|
||||||
|
return Mojo::Promise->resolve(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub validate_short_code {
|
sub validate_short_code {
|
||||||
@@ -333,7 +506,7 @@ sub validate_url_with_checks {
|
|||||||
: Mojo::Promise->resolve(1);
|
: Mojo::Promise->resolve(1);
|
||||||
|
|
||||||
return $ssl_check->then(
|
return $ssl_check->then(
|
||||||
sub { return $self->check_url_reachable($normalized); } )
|
sub { return $self->check_url_reachable_async($normalized); } )
|
||||||
->then( sub { return $normalized; } );
|
->then( sub { return $normalized; } );
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|||||||
30
t/03_db.t
30
t/03_db.t
@@ -61,36 +61,6 @@ subtest 'get' => sub {
|
|||||||
);
|
);
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'set' => sub {
|
|
||||||
test_method(
|
|
||||||
'set',
|
|
||||||
'set',
|
|
||||||
[ 'test_key', 'test_value' ],
|
|
||||||
[ [ 'OK', undef, 'OK', 'returns success result' ] ],
|
|
||||||
[ [ 'Write error', 'error is returned' ] ]
|
|
||||||
);
|
|
||||||
};
|
|
||||||
|
|
||||||
subtest 'incr' => sub {
|
|
||||||
test_method(
|
|
||||||
'incr', 'incr', ['test_key'],
|
|
||||||
[ [ 42, undef, 42, 'returns correct value' ] ],
|
|
||||||
[ [ 'Increment error', 'error is returned' ] ]
|
|
||||||
);
|
|
||||||
};
|
|
||||||
|
|
||||||
subtest 'exists' => sub {
|
|
||||||
test_method(
|
|
||||||
'exists', 'exists',
|
|
||||||
['test_key'],
|
|
||||||
[
|
|
||||||
[ 1, undef, 1, 'returns 1 when key exists' ],
|
|
||||||
[ 0, undef, 0, 'returns 0 when key does not exist' ],
|
|
||||||
],
|
|
||||||
[ [ 'Exists error', 'error is returned' ] ]
|
|
||||||
);
|
|
||||||
};
|
|
||||||
|
|
||||||
subtest 'setnx' => sub {
|
subtest 'setnx' => sub {
|
||||||
test_method(
|
test_method(
|
||||||
'setnx', 'setnx',
|
'setnx', 'setnx',
|
||||||
|
|||||||
@@ -2,6 +2,7 @@ use Test::More;
|
|||||||
use Test::MockObject;
|
use Test::MockObject;
|
||||||
use Mojo::Promise;
|
use Mojo::Promise;
|
||||||
use Urupam::Validation;
|
use Urupam::Validation;
|
||||||
|
use Socket qw(AF_INET);
|
||||||
|
|
||||||
use_ok('Urupam::Validation');
|
use_ok('Urupam::Validation');
|
||||||
|
|
||||||
@@ -53,6 +54,12 @@ sub mock_ua_with_error {
|
|||||||
return Mojo::Promise->reject($error);
|
return Mojo::Promise->reject($error);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
$mock_ua->mock(
|
||||||
|
'get_p',
|
||||||
|
sub {
|
||||||
|
return Mojo::Promise->reject($error);
|
||||||
|
}
|
||||||
|
);
|
||||||
return $mock_ua;
|
return $mock_ua;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -65,6 +72,31 @@ sub with_resolved_addresses {
|
|||||||
return $code->();
|
return $code->();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub with_ssrf_ua {
|
||||||
|
my ( $ua, $code ) = @_;
|
||||||
|
no warnings 'redefine';
|
||||||
|
local *Urupam::Validation::_create_ssrf_safe_ua = sub {
|
||||||
|
return $ua;
|
||||||
|
};
|
||||||
|
return $code->();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub with_subprocess_stub {
|
||||||
|
my ( $result, $code, $calls_ref ) = @_;
|
||||||
|
no warnings 'redefine';
|
||||||
|
local *Mojo::IOLoop::subprocess = sub {
|
||||||
|
my ( $class, $work, $finish, $host ) = @_;
|
||||||
|
$$calls_ref++ if defined $calls_ref;
|
||||||
|
$finish->( undef, undef, $result );
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
return $code->();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub clear_validation_caches {
|
||||||
|
$validator->_clear_caches;
|
||||||
|
}
|
||||||
|
|
||||||
subtest 'is_valid_url_length' => sub {
|
subtest 'is_valid_url_length' => sub {
|
||||||
ok( $validator->is_valid_url_length('http://example.com'),
|
ok( $validator->is_valid_url_length('http://example.com'),
|
||||||
'valid URL length passes' );
|
'valid URL length passes' );
|
||||||
@@ -119,6 +151,38 @@ subtest '_format_error_message' => sub {
|
|||||||
);
|
);
|
||||||
};
|
};
|
||||||
|
|
||||||
|
subtest 'classify and format error string' => sub {
|
||||||
|
my @cases = (
|
||||||
|
[
|
||||||
|
'SSL certificate verification failed',
|
||||||
|
'SSL certificate error: SSL certificate verification failed',
|
||||||
|
'ssl error classified and formatted'
|
||||||
|
],
|
||||||
|
[
|
||||||
|
'Name or service not known',
|
||||||
|
'DNS resolution failed: Name or service not known',
|
||||||
|
'dns error classified and formatted'
|
||||||
|
],
|
||||||
|
[
|
||||||
|
'Connection refused',
|
||||||
|
'Cannot reach URL: Connection refused',
|
||||||
|
'connection error classified and formatted'
|
||||||
|
],
|
||||||
|
[
|
||||||
|
'Some unknown error',
|
||||||
|
'URL validation failed: Some unknown error',
|
||||||
|
'unknown error classified and formatted'
|
||||||
|
],
|
||||||
|
);
|
||||||
|
|
||||||
|
for my $case (@cases) {
|
||||||
|
my ( $err, $expected, $label ) = @$case;
|
||||||
|
my $type = $validator->_classify_error($err);
|
||||||
|
is( $validator->_format_error_message( $type, $err ),
|
||||||
|
$expected, $label );
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
subtest '_is_valid_ipv4' => sub {
|
subtest '_is_valid_ipv4' => sub {
|
||||||
my @valid = (
|
my @valid = (
|
||||||
[ '192.168.1.1', 'valid IPv4 passes' ],
|
[ '192.168.1.1', 'valid IPv4 passes' ],
|
||||||
@@ -170,20 +234,20 @@ subtest '_is_private_ipv4' => sub {
|
|||||||
|
|
||||||
subtest '_is_private_ipv6' => sub {
|
subtest '_is_private_ipv6' => sub {
|
||||||
my @private = (
|
my @private = (
|
||||||
[ '::1', '::1 is private' ],
|
[ '::1', '::1 is private' ],
|
||||||
[ '[::1]', '[::1] is private' ],
|
[ '[::1]', '[::1] is private' ],
|
||||||
[ '::', ':: is private' ],
|
[ '::', ':: is private' ],
|
||||||
[ '::ffff:127.0.0.1', '::ffff:127.0.0.1 is private' ],
|
[ '::ffff:127.0.0.1', '::ffff:127.0.0.1 is private' ],
|
||||||
[ '::ffff:192.168.1.1', '::ffff:192.168.1.1 is private' ],
|
[ '::ffff:192.168.1.1', '::ffff:192.168.1.1 is private' ],
|
||||||
[ '::ffff:10.0.0.1', '::ffff:10.0.0.1 is private' ],
|
[ '::ffff:10.0.0.1', '::ffff:10.0.0.1 is private' ],
|
||||||
[ '::ffff:172.16.0.1', '::ffff:172.16.0.1 is private' ],
|
[ '::ffff:172.16.0.1', '::ffff:172.16.0.1 is private' ],
|
||||||
[ 'fc00::1', 'fc00::/7 (unique local) is private' ],
|
[ 'fc00:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||||
[ 'fcff::1', 'fc00::/7 (unique local) is private' ],
|
[ 'fcff:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||||
[ 'fd00::1', 'fc00::/7 (unique local) is private' ],
|
[ 'fd00:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||||
[ 'fdff::1', 'fc00::/7 (unique local) is private' ],
|
[ 'fdff:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||||
[ 'fe80::1', 'fe80::/10 (link-local) is private' ],
|
[ 'fe80:0:0:0:0:0:0:1', 'fe80::/10 (link-local) is private' ],
|
||||||
[ 'fe80::abcd', 'fe80::/10 (link-local) is private' ],
|
[ 'fe80:0:0:0:0:0:0:abcd', 'fe80::/10 (link-local) is private' ],
|
||||||
[ 'febf::1', 'fe80::/10 (link-local) is private' ],
|
[ 'febf:0:0:0:0:0:0:1', 'fe80::/10 (link-local) is private' ],
|
||||||
);
|
);
|
||||||
my @public = (
|
my @public = (
|
||||||
[ '2001:db8::1', '2001:db8::1 is not private' ],
|
[ '2001:db8::1', '2001:db8::1 is not private' ],
|
||||||
@@ -212,10 +276,22 @@ subtest 'is_blocked_url' => sub {
|
|||||||
[ 'http://192.168.1.1/path', '192.168.1.1 is blocked' ],
|
[ 'http://192.168.1.1/path', '192.168.1.1 is blocked' ],
|
||||||
[ 'http://10.0.0.1/path', '10.0.0.1 is blocked' ],
|
[ 'http://10.0.0.1/path', '10.0.0.1 is blocked' ],
|
||||||
[ 'http://172.16.0.1/path', '172.16.0.1 is blocked' ],
|
[ 'http://172.16.0.1/path', '172.16.0.1 is blocked' ],
|
||||||
[ 'http://[fc00::1]/path', 'fc00::/7 (unique local) is blocked' ],
|
[
|
||||||
[ 'http://[fd00::1]/path', 'fc00::/7 (unique local) is blocked' ],
|
'http://[fc00:0:0:0:0:0:0:1]/path',
|
||||||
[ 'http://[fe80::1]/path', 'fe80::/10 (link-local) is blocked' ],
|
'fc00::/7 (unique local) is blocked'
|
||||||
[ 'http://[febf::1]/path', 'fe80::/10 (link-local) is blocked' ],
|
],
|
||||||
|
[
|
||||||
|
'http://[fd00:0:0:0:0:0:0:1]/path',
|
||||||
|
'fc00::/7 (unique local) is blocked'
|
||||||
|
],
|
||||||
|
[
|
||||||
|
'http://[fe80:0:0:0:0:0:0:1]/path',
|
||||||
|
'fe80::/10 (link-local) is blocked'
|
||||||
|
],
|
||||||
|
[
|
||||||
|
'http://[febf:0:0:0:0:0:0:1]/path',
|
||||||
|
'fe80::/10 (link-local) is blocked'
|
||||||
|
],
|
||||||
);
|
);
|
||||||
my @allowed = (
|
my @allowed = (
|
||||||
[ 'http://example.com/path', 'public domain is not blocked' ],
|
[ 'http://example.com/path', 'public domain is not blocked' ],
|
||||||
@@ -244,6 +320,38 @@ subtest 'is_blocked_url' => sub {
|
|||||||
);
|
);
|
||||||
};
|
};
|
||||||
|
|
||||||
|
subtest '_resolve_host - caches results' => sub {
|
||||||
|
my $calls = 0;
|
||||||
|
my $result = {
|
||||||
|
error => 0,
|
||||||
|
results => [ { addr => '127.0.0.1', family => AF_INET } ],
|
||||||
|
};
|
||||||
|
|
||||||
|
with_subprocess_stub(
|
||||||
|
$result,
|
||||||
|
sub {
|
||||||
|
my ( $value, $error ) =
|
||||||
|
wait_promise( $validator->_resolve_host('example.com') );
|
||||||
|
is( $error, undef, 'first resolve has no error' );
|
||||||
|
is( scalar @$value, 1, 'first resolve returns one address' );
|
||||||
|
},
|
||||||
|
\$calls
|
||||||
|
);
|
||||||
|
|
||||||
|
with_subprocess_stub(
|
||||||
|
$result,
|
||||||
|
sub {
|
||||||
|
my ( $value, $error ) =
|
||||||
|
wait_promise( $validator->_resolve_host('example.com') );
|
||||||
|
is( $error, undef, 'cached resolve has no error' );
|
||||||
|
is( scalar @$value, 1, 'cached resolve returns one address' );
|
||||||
|
},
|
||||||
|
\$calls
|
||||||
|
);
|
||||||
|
|
||||||
|
is( $calls, 1, 'subprocess called once due to cache' );
|
||||||
|
};
|
||||||
|
|
||||||
subtest 'validate_short_code' => sub {
|
subtest 'validate_short_code' => sub {
|
||||||
my @valid = (
|
my @valid = (
|
||||||
[ 'abc123456789', 'alphanumeric code passes' ],
|
[ 'abc123456789', 'alphanumeric code passes' ],
|
||||||
@@ -273,16 +381,22 @@ subtest 'validate_short_code' => sub {
|
|||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_url_reachable - success codes' => sub {
|
subtest 'check_url_reachable - success codes' => sub {
|
||||||
for my $code ( 200, 201, 301 ) {
|
clear_validation_caches();
|
||||||
$validator->ua( mock_ua_with_code($code) );
|
for my $code ( 200, 201 ) {
|
||||||
my ( $result, $error ) =
|
with_ssrf_ua(
|
||||||
wait_promise( $validator->check_url_reachable('http://example.com') );
|
mock_ua_with_code($code),
|
||||||
is( $result, 1, "$code status returns 1" );
|
sub {
|
||||||
is( $error, undef, "$code status has no error" );
|
my ( $result, $error ) = wait_promise(
|
||||||
|
$validator->check_url_reachable('http://example.com') );
|
||||||
|
is( $result, 1, "$code status returns 1" );
|
||||||
|
is( $error, undef, "$code status has no error" );
|
||||||
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_url_reachable - error codes' => sub {
|
subtest 'check_url_reachable - error codes' => sub {
|
||||||
|
clear_validation_caches();
|
||||||
my @cases = (
|
my @cases = (
|
||||||
[ 410, qr/URL returned 410 error/, '4xx status returns error' ],
|
[ 410, qr/URL returned 410 error/, '4xx status returns error' ],
|
||||||
[ 500, qr/URL returned 500 error/, '5xx status returns error' ],
|
[ 500, qr/URL returned 500 error/, '5xx status returns error' ],
|
||||||
@@ -290,15 +404,21 @@ subtest 'check_url_reachable - error codes' => sub {
|
|||||||
);
|
);
|
||||||
|
|
||||||
for my $case (@cases) {
|
for my $case (@cases) {
|
||||||
$validator->ua( mock_ua_with_code( $case->[0] ) );
|
my $url = "http://example.com/$case->[0]";
|
||||||
my ( $result, $error ) =
|
with_ssrf_ua(
|
||||||
wait_promise( $validator->check_url_reachable('http://example.com') );
|
mock_ua_with_code( $case->[0] ),
|
||||||
is( $result, undef, "$case->[0] status has no result" );
|
sub {
|
||||||
like( $error, $case->[1], $case->[2] );
|
my ( $result, $error ) =
|
||||||
|
wait_promise( $validator->check_url_reachable($url) );
|
||||||
|
is( $result, undef, "$case->[0] status has no result" );
|
||||||
|
like( $error, $case->[1], $case->[2] );
|
||||||
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_url_reachable - HEAD fallback to GET' => sub {
|
subtest 'check_url_reachable - HEAD fallback to GET' => sub {
|
||||||
|
clear_validation_caches();
|
||||||
my $mock_ua = Test::MockObject->new;
|
my $mock_ua = Test::MockObject->new;
|
||||||
my $head_tx = Test::MockObject->new;
|
my $head_tx = Test::MockObject->new;
|
||||||
my $head_result = Test::MockObject->new;
|
my $head_result = Test::MockObject->new;
|
||||||
@@ -324,15 +444,21 @@ subtest 'check_url_reachable - HEAD fallback to GET' => sub {
|
|||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
$validator->ua($mock_ua);
|
my ( $result, $error );
|
||||||
my ( $result, $error ) =
|
with_ssrf_ua(
|
||||||
wait_promise( $validator->check_url_reachable('http://example.com') );
|
$mock_ua,
|
||||||
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->check_url_reachable('http://example.com') );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
is( $result, 1, 'GET fallback returns success' );
|
is( $result, 1, 'GET fallback returns success' );
|
||||||
is( $error, undef, 'GET fallback has no error' );
|
is( $error, undef, 'GET fallback has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_url_reachable - HEAD fallback error' => sub {
|
subtest 'check_url_reachable - HEAD fallback error' => sub {
|
||||||
|
clear_validation_caches();
|
||||||
my $mock_ua = Test::MockObject->new;
|
my $mock_ua = Test::MockObject->new;
|
||||||
my $head_tx = Test::MockObject->new;
|
my $head_tx = Test::MockObject->new;
|
||||||
my $head_result = Test::MockObject->new;
|
my $head_result = Test::MockObject->new;
|
||||||
@@ -358,15 +484,21 @@ subtest 'check_url_reachable - HEAD fallback error' => sub {
|
|||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
$validator->ua($mock_ua);
|
my ( $result, $error );
|
||||||
my ( $result, $error ) =
|
with_ssrf_ua(
|
||||||
wait_promise( $validator->check_url_reachable('http://example.com') );
|
$mock_ua,
|
||||||
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->check_url_reachable('http://example.com') );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
is( $result, undef, 'GET fallback error has no result' );
|
is( $result, undef, 'GET fallback error has no result' );
|
||||||
like( $error, qr/URL returned 500 error/, 'GET fallback error reported' );
|
like( $error, qr/URL returned 500 error/, 'GET fallback error reported' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_url_reachable - classified errors' => sub {
|
subtest 'check_url_reachable - classified errors' => sub {
|
||||||
|
clear_validation_caches();
|
||||||
my @cases = (
|
my @cases = (
|
||||||
[
|
[
|
||||||
'Name or service not known',
|
'Name or service not known',
|
||||||
@@ -391,11 +523,16 @@ subtest 'check_url_reachable - classified errors' => sub {
|
|||||||
);
|
);
|
||||||
|
|
||||||
for my $case (@cases) {
|
for my $case (@cases) {
|
||||||
$validator->ua( mock_ua_with_error( $case->[0] ) );
|
clear_validation_caches();
|
||||||
my ( $result, $error ) =
|
with_ssrf_ua(
|
||||||
wait_promise( $validator->check_url_reachable('http://example.com') );
|
mock_ua_with_error( $case->[0] ),
|
||||||
is( $result, undef, 'no success result' );
|
sub {
|
||||||
like( $error, $case->[1], $case->[2] );
|
my ( $result, $error ) = wait_promise(
|
||||||
|
$validator->check_url_reachable('http://example.com') );
|
||||||
|
is( $result, undef, 'no success result' );
|
||||||
|
like( $error, $case->[1], $case->[2] );
|
||||||
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -437,8 +574,8 @@ subtest 'check_ssl_certificate - SSL error' => sub {
|
|||||||
my ( $result, $error ) =
|
my ( $result, $error ) =
|
||||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||||
|
|
||||||
is( $result, undef, 'SSL error has no result' );
|
is( $result, 1, 'SSL error is async' );
|
||||||
like( $error, qr/Invalid SSL certificate/, 'SSL error is detected' );
|
is( $error, undef, 'SSL error has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_ssl_certificate - non-SSL error' => sub {
|
subtest 'check_ssl_certificate - non-SSL error' => sub {
|
||||||
@@ -446,8 +583,8 @@ subtest 'check_ssl_certificate - non-SSL error' => sub {
|
|||||||
my ( $result, $error ) =
|
my ( $result, $error ) =
|
||||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||||
|
|
||||||
is( $result, undef, 'non-SSL error has no result' );
|
is( $result, 1, 'non-SSL error is async' );
|
||||||
like( $error, qr/Cannot reach URL/, 'non-SSL error is classified' );
|
is( $error, undef, 'non-SSL error has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_ssl_certificate - DNS error' => sub {
|
subtest 'check_ssl_certificate - DNS error' => sub {
|
||||||
@@ -455,8 +592,8 @@ subtest 'check_ssl_certificate - DNS error' => sub {
|
|||||||
my ( $result, $error ) =
|
my ( $result, $error ) =
|
||||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||||
|
|
||||||
is( $result, undef, 'DNS error has no result' );
|
is( $result, 1, 'DNS error is async' );
|
||||||
like( $error, qr/DNS resolution failed/, 'DNS error is classified' );
|
is( $error, undef, 'DNS error has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_ssl_certificate - unknown error' => sub {
|
subtest 'check_ssl_certificate - unknown error' => sub {
|
||||||
@@ -464,24 +601,24 @@ subtest 'check_ssl_certificate - unknown error' => sub {
|
|||||||
my ( $result, $error ) =
|
my ( $result, $error ) =
|
||||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||||
|
|
||||||
is( $result, undef, 'unknown error has no result' );
|
is( $result, 1, 'unknown error is async' );
|
||||||
like( $error, qr/URL validation failed/, 'unknown error is classified' );
|
is( $error, undef, 'unknown error has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_ssl_certificate - missing URL' => sub {
|
subtest 'check_ssl_certificate - missing URL' => sub {
|
||||||
my ( $result, $error ) =
|
my ( $result, $error ) =
|
||||||
wait_promise( $validator->check_ssl_certificate(undef) );
|
wait_promise( $validator->check_ssl_certificate(undef) );
|
||||||
|
|
||||||
is( $result, undef, 'missing URL has no result' );
|
is( $result, 1, 'missing URL passes' );
|
||||||
is( $error, 'URL is required', 'missing URL returns error' );
|
is( $error, undef, 'missing URL has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'check_ssl_certificate - empty URL' => sub {
|
subtest 'check_ssl_certificate - empty URL' => sub {
|
||||||
my ( $result, $error ) =
|
my ( $result, $error ) =
|
||||||
wait_promise( $validator->check_ssl_certificate('') );
|
wait_promise( $validator->check_ssl_certificate('') );
|
||||||
|
|
||||||
is( $result, undef, 'empty URL has no result' );
|
is( $result, 1, 'empty URL passes' );
|
||||||
is( $error, 'URL is required', 'empty URL returns error' );
|
is( $error, undef, 'empty URL has no error' );
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'validate_url_with_checks - missing URL' => sub {
|
subtest 'validate_url_with_checks - missing URL' => sub {
|
||||||
@@ -556,8 +693,14 @@ subtest 'validate_url_with_checks - HTTP success' => sub {
|
|||||||
with_resolved_addresses(
|
with_resolved_addresses(
|
||||||
[],
|
[],
|
||||||
sub {
|
sub {
|
||||||
( $result, $error ) = wait_promise(
|
with_ssrf_ua(
|
||||||
$validator->validate_url_with_checks('http://example.com/path')
|
mock_ua_with_code(200),
|
||||||
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->validate_url_with_checks(
|
||||||
|
'http://example.com/path')
|
||||||
|
);
|
||||||
|
}
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
@@ -572,9 +715,14 @@ subtest 'validate_url_with_checks - HTTPS success' => sub {
|
|||||||
with_resolved_addresses(
|
with_resolved_addresses(
|
||||||
[],
|
[],
|
||||||
sub {
|
sub {
|
||||||
( $result, $error ) = wait_promise(
|
with_ssrf_ua(
|
||||||
$validator->validate_url_with_checks(
|
mock_ua_with_code(200),
|
||||||
'https://example.com/path')
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->validate_url_with_checks(
|
||||||
|
'https://example.com/path')
|
||||||
|
);
|
||||||
|
}
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
@@ -589,8 +737,15 @@ subtest 'validate_url_with_checks - URL sanitization' => sub {
|
|||||||
with_resolved_addresses(
|
with_resolved_addresses(
|
||||||
[],
|
[],
|
||||||
sub {
|
sub {
|
||||||
( $result, $error ) = wait_promise(
|
with_ssrf_ua(
|
||||||
$validator->validate_url_with_checks('example.com/path') );
|
mock_ua_with_code(200),
|
||||||
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->validate_url_with_checks(
|
||||||
|
'example.com/path')
|
||||||
|
);
|
||||||
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
@@ -604,14 +759,20 @@ subtest 'validate_url_with_checks - SSL check failure' => sub {
|
|||||||
with_resolved_addresses(
|
with_resolved_addresses(
|
||||||
[],
|
[],
|
||||||
sub {
|
sub {
|
||||||
( $result, $error ) = wait_promise(
|
with_ssrf_ua(
|
||||||
$validator->validate_url_with_checks('https://example.com') );
|
mock_ua_with_code(200),
|
||||||
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->validate_url_with_checks(
|
||||||
|
'https://example.com')
|
||||||
|
);
|
||||||
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
is( $result, undef, 'SSL check failure has no result' );
|
is( $result, 'https://example.com', 'SSL check failure is async' );
|
||||||
like( $error, qr/Invalid SSL certificate/,
|
is( $error, undef, 'SSL check async has no error' );
|
||||||
'SSL check failure is detected' );
|
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'validate_url_with_checks - reachability check failure' => sub {
|
subtest 'validate_url_with_checks - reachability check failure' => sub {
|
||||||
@@ -638,17 +799,20 @@ subtest 'validate_url_with_checks - reachability check failure' => sub {
|
|||||||
with_resolved_addresses(
|
with_resolved_addresses(
|
||||||
[],
|
[],
|
||||||
sub {
|
sub {
|
||||||
( $result, $error ) = wait_promise(
|
with_ssrf_ua(
|
||||||
$validator->validate_url_with_checks('https://example.com') );
|
$mock_ua,
|
||||||
|
sub {
|
||||||
|
( $result, $error ) = wait_promise(
|
||||||
|
$validator->validate_url_with_checks(
|
||||||
|
'https://example.com')
|
||||||
|
);
|
||||||
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
is( $result, undef, 'reachability failure has no result' );
|
is( $result, 'https://example.com', 'reachability failure is async' );
|
||||||
like(
|
is( $error, undef, 'reachability async has no error' );
|
||||||
$error,
|
|
||||||
qr/Cannot reach URL/,
|
|
||||||
'reachability check failure is detected'
|
|
||||||
);
|
|
||||||
};
|
};
|
||||||
|
|
||||||
done_testing();
|
done_testing();
|
||||||
|
|||||||
253
t/integration.t
253
t/integration.t
@@ -2,7 +2,21 @@ use Test::More;
|
|||||||
use Test::Mojo;
|
use Test::Mojo;
|
||||||
use Urupam::App;
|
use Urupam::App;
|
||||||
|
|
||||||
my $t = Test::Mojo->new('Urupam::App');
|
my $t;
|
||||||
|
eval { $t = Test::Mojo->new('Urupam::App'); 1 }
|
||||||
|
or plan skip_all => "Test server not available: $@";
|
||||||
|
|
||||||
|
sub wait_promise {
|
||||||
|
my ($promise) = @_;
|
||||||
|
my ( $value, $error );
|
||||||
|
$promise->then( sub { $value = shift } )
|
||||||
|
->catch( sub { $error = shift } )
|
||||||
|
->wait;
|
||||||
|
return ( $value, $error );
|
||||||
|
}
|
||||||
|
|
||||||
|
my ( $pong, $ping_err ) = wait_promise( $t->app->db->ping );
|
||||||
|
plan skip_all => "Redis not available: $ping_err" if $ping_err;
|
||||||
|
|
||||||
my $CODE_PATTERN = qr/^[0-9a-zA-Z\-_]+$/;
|
my $CODE_PATTERN = qr/^[0-9a-zA-Z\-_]+$/;
|
||||||
my $CODE_LENGTH = 12;
|
my $CODE_LENGTH = 12;
|
||||||
@@ -16,12 +30,17 @@ sub validate_short_code_format {
|
|||||||
&& $code =~ $CODE_PATTERN;
|
&& $code =~ $CODE_PATTERN;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub expected_normalized_url {
|
||||||
|
my ($url) = @_;
|
||||||
|
return $url if defined $url && $url =~ m{^https?://}i;
|
||||||
|
return defined $url ? "http://$url" : undef;
|
||||||
|
}
|
||||||
|
|
||||||
sub post_shorten {
|
sub post_shorten {
|
||||||
my ($url) = @_;
|
my ($url) = @_;
|
||||||
my $tx = $t->post_ok( '/api/v1/urls' => json => { url => $url } );
|
my $tx = $t->post_ok( '/api/v1/urls' => json => { url => $url } );
|
||||||
my $json = $tx->tx->res->json;
|
my $json = $tx->tx->res->json;
|
||||||
my $error =
|
my $error = ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
||||||
ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
|
||||||
return {
|
return {
|
||||||
tx => $tx,
|
tx => $tx,
|
||||||
code => $tx->tx->res->code,
|
code => $tx->tx->res->code,
|
||||||
@@ -32,10 +51,9 @@ sub post_shorten {
|
|||||||
|
|
||||||
sub get_url {
|
sub get_url {
|
||||||
my ($code) = @_;
|
my ($code) = @_;
|
||||||
my $tx = $t->get_ok("/api/v1/urls/$code");
|
my $tx = $t->get_ok("/api/v1/urls/$code");
|
||||||
my $json = $tx->tx->res->json;
|
my $json = $tx->tx->res->json;
|
||||||
my $error =
|
my $error = ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
||||||
ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
|
||||||
return {
|
return {
|
||||||
tx => $tx,
|
tx => $tx,
|
||||||
code => $tx->tx->res->code,
|
code => $tx->tx->res->code,
|
||||||
@@ -52,6 +70,8 @@ sub validate_shorten_response {
|
|||||||
"$label: short code valid" );
|
"$label: short code valid" );
|
||||||
is( length( $json->{short_code} ),
|
is( length( $json->{short_code} ),
|
||||||
$CODE_LENGTH, "$label: short code length correct" );
|
$CODE_LENGTH, "$label: short code length correct" );
|
||||||
|
is( $json->{original_url}, $url, "$label: original URL matches" )
|
||||||
|
if defined $url;
|
||||||
like(
|
like(
|
||||||
$json->{short_url},
|
$json->{short_url},
|
||||||
qr/^https?:\/\/[^\/]+\/$json->{short_code}$/,
|
qr/^https?:\/\/[^\/]+\/$json->{short_code}$/,
|
||||||
@@ -81,39 +101,20 @@ sub validate_get_response {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub skip_if_error {
|
|
||||||
my ( $res, $context ) = @_;
|
|
||||||
if ( $res->{code} != 200 && $res->{code} != 400 && $res->{code} != 404 ) {
|
|
||||||
diag( "$context skipped: " . $res->{error} );
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real validator success cases' => sub {
|
subtest 'POST /api/v1/urls - Real validator success cases' => sub {
|
||||||
for my $url ( 'https://www.example.com', 'http://www.perl.org' ) {
|
for my $url ( 'https://www.example.com', 'http://www.perl.org' ) {
|
||||||
my $res = post_shorten($url);
|
my $res = post_shorten($url);
|
||||||
if ( $res->{code} == 200 ) {
|
is( $res->{code}, 200, "URL accepted: $url" );
|
||||||
validate_shorten_response( $res, $url, "URL: $url" );
|
validate_shorten_response( $res, $url, "URL: $url" );
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Test skipped for $url: " . $res->{error} );
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real validator URL normalization' => sub {
|
subtest 'POST /api/v1/urls - Real validator URL normalization' => sub {
|
||||||
for my $input ( 'www.example.com', 'example.com' ) {
|
for my $input ( 'www.example.com', 'example.com' ) {
|
||||||
my $res = post_shorten($input);
|
my $res = post_shorten($input);
|
||||||
if ( $res->{code} == 200 ) {
|
is( $res->{code}, 200, "URL normalized: $input" );
|
||||||
like( $res->{json}->{original_url},
|
my $expected = expected_normalized_url($input);
|
||||||
qr/^https?:\/\//, "URL normalized: $input" );
|
validate_shorten_response( $res, $expected, "URL normalized: $input" );
|
||||||
ok( validate_short_code_format( $res->{json}->{short_code} ),
|
|
||||||
"Code generated for: $input" );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Normalization test skipped for $input: " . $res->{error} );
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -134,40 +135,13 @@ subtest 'POST /api/v1/urls - Real validator blocked domains' => sub {
|
|||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real validator network errors (422)' => sub {
|
subtest 'POST /api/v1/urls - Real validator network errors (async)' => sub {
|
||||||
for my $case (
|
for
|
||||||
{
|
my $url ( 'http://nonexistent-domain-12345.invalid', 'http://192.0.2.1' )
|
||||||
url => 'http://nonexistent-domain-12345.invalid',
|
|
||||||
error => qr/Cannot reach URL|DNS resolution failed/,
|
|
||||||
},
|
|
||||||
{
|
|
||||||
url => 'http://192.0.2.1',
|
|
||||||
error => qr/Cannot reach URL|Connection refused/,
|
|
||||||
}
|
|
||||||
)
|
|
||||||
{
|
{
|
||||||
my $res = post_shorten( $case->{url} );
|
my $res = post_shorten($url);
|
||||||
if ( $res->{code} == 422 ) {
|
is( $res->{code}, 200, "Network URL accepted asynchronously: $url" );
|
||||||
like( $res->{error}, $case->{error},
|
validate_shorten_response( $res, $url, "URL: $url" );
|
||||||
"Network error: $case->{url}" );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Network error test skipped for $case->{url}: "
|
|
||||||
. $res->{error} );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
};
|
|
||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real validator SSL certificate validation' => sub {
|
|
||||||
my $res = post_shorten('https://www.example.com');
|
|
||||||
if ( $res->{code} == 200 ) {
|
|
||||||
pass('HTTPS URL with valid SSL certificate accepted');
|
|
||||||
}
|
|
||||||
elsif ( $res->{code} == 422 && $res->{error} =~ /SSL certificate/i ) {
|
|
||||||
diag( "SSL validation: " . $res->{error} );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "SSL test skipped: " . $res->{error} );
|
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -182,17 +156,17 @@ subtest 'POST /api/v1/urls - Real validator invalid URL format' => sub {
|
|||||||
is( $res->{error}, $case->{error}, "Correct error for: $case->{url}" );
|
is( $res->{error}, $case->{error}, "Correct error for: $case->{url}" );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest 'POST /api/v1/urls - Real validator bare hostname' => sub {
|
||||||
my $res = post_shorten('not-a-url');
|
my $res = post_shorten('not-a-url');
|
||||||
is( $res->{code}, 422, 'Unreachable host rejected: not-a-url' );
|
is( $res->{code}, 200, 'Bare hostname accepted: not-a-url' );
|
||||||
like(
|
validate_shorten_response( $res, 'http://not-a-url',
|
||||||
$res->{error},
|
'Bare hostname normalized' );
|
||||||
qr/Cannot reach URL|DNS resolution failed|URL validation failed/,
|
|
||||||
'Correct error for: not-a-url'
|
|
||||||
);
|
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real validator URL length validation' => sub {
|
subtest 'POST /api/v1/urls - Real validator URL length validation' => sub {
|
||||||
my $base = 'https://www.example.com/';
|
my $base = 'https://www.example.com/';
|
||||||
my $too_long_url =
|
my $too_long_url =
|
||||||
$base . ( 'a' x ( $MAX_URL_LENGTH - length($base) + 1 ) );
|
$base . ( 'a' x ( $MAX_URL_LENGTH - length($base) + 1 ) );
|
||||||
my $res = post_shorten($too_long_url);
|
my $res = post_shorten($too_long_url);
|
||||||
@@ -206,22 +180,13 @@ subtest 'POST /api/v1/urls - Real validator URL length validation' => sub {
|
|||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real validator URL edge cases' => sub {
|
subtest 'POST /api/v1/urls - Real validator URL edge cases' => sub {
|
||||||
for my $url (
|
for my $url (
|
||||||
'https://www.example.com?foo=bar',
|
'https://www.example.com?foo=bar', 'https://www.example.com#section',
|
||||||
'https://www.example.com#section',
|
'https://www.example.com:443', 'https://www.perl.org/about.html',
|
||||||
'https://www.example.com:443',
|
|
||||||
'https://www.perl.org/about.html',
|
|
||||||
)
|
)
|
||||||
{
|
{
|
||||||
my $res = post_shorten($url);
|
my $res = post_shorten($url);
|
||||||
if ( $res->{code} == 200 ) {
|
is( $res->{code}, 200, "Edge case handled: $url" );
|
||||||
ok( validate_short_code_format( $res->{json}->{short_code} ),
|
validate_shorten_response( $res, $url, "Edge case handled: $url" );
|
||||||
"Edge case handled: $url" );
|
|
||||||
like( $res->{json}->{original_url},
|
|
||||||
qr/^https?:\/\//, "URL format preserved: $url" );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Edge case test skipped for $url: " . $res->{error} );
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -229,65 +194,49 @@ subtest 'POST /api/v1/urls - Real database persistence and retrieval' => sub {
|
|||||||
my $url = 'https://www.example.com';
|
my $url = 'https://www.example.com';
|
||||||
my $res1 = post_shorten($url);
|
my $res1 = post_shorten($url);
|
||||||
|
|
||||||
if ( $res1->{code} == 200 ) {
|
is( $res1->{code}, 200, 'Database write succeeded' );
|
||||||
my $code = $res1->{json}->{short_code};
|
my $code = $res1->{json}->{short_code};
|
||||||
ok( validate_short_code_format($code), 'Code generated and stored' );
|
ok( validate_short_code_format($code), 'Code generated and stored' );
|
||||||
|
|
||||||
my $res2 = get_url($code);
|
my $res2 = get_url($code);
|
||||||
if ( $res2->{code} == 200 ) {
|
is( $res2->{code}, 200, 'Database read succeeded' );
|
||||||
validate_get_response( $res2, $url, $code, 'Database retrieval' );
|
validate_get_response( $res2, $url, $code, 'Database retrieval' );
|
||||||
pass('Database persistence verified');
|
pass('Database persistence verified');
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Database retrieval failed: " . $res2->{error} );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Database persistence test skipped: " . $res1->{error} );
|
|
||||||
}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'POST /api/v1/urls - Real database duplicate URL handling' => sub {
|
subtest 'POST /api/v1/urls - Real database duplicate URL handling' => sub {
|
||||||
my $url = 'https://www.example.com';
|
my $url = 'https://www.example.com';
|
||||||
my $res1 = post_shorten($url);
|
my $res1 = post_shorten($url);
|
||||||
|
|
||||||
if ( $res1->{code} == 200 ) {
|
is( $res1->{code}, 200, 'First create succeeded' );
|
||||||
my $code1 = $res1->{json}->{short_code};
|
my $code1 = $res1->{json}->{short_code};
|
||||||
ok( validate_short_code_format($code1), 'First code generated' );
|
ok( validate_short_code_format($code1), 'First code generated' );
|
||||||
|
|
||||||
my $res2 = post_shorten($url);
|
my $res2 = post_shorten($url);
|
||||||
if ( $res2->{code} == 200 ) {
|
is( $res2->{code}, 200, 'Second create succeeded' );
|
||||||
my $code2 = $res2->{json}->{short_code};
|
my $code2 = $res2->{json}->{short_code};
|
||||||
ok( validate_short_code_format($code2), 'Second code generated' );
|
ok( validate_short_code_format($code2), 'Second code generated' );
|
||||||
ok( $code1 ne $code2, 'Duplicate URLs generate different codes' );
|
ok( $code1 ne $code2, 'Duplicate URLs generate different codes' );
|
||||||
|
|
||||||
my $get1 = get_url($code1);
|
my $get1 = get_url($code1);
|
||||||
my $get2 = get_url($code2);
|
my $get2 = get_url($code2);
|
||||||
|
|
||||||
if ( $get1->{code} == 200 && $get2->{code} == 200 ) {
|
is( $get1->{code}, 200, 'First code retrieves' );
|
||||||
is( $get1->{json}->{original_url},
|
is( $get2->{code}, 200, 'Second code retrieves' );
|
||||||
$url, 'First code retrieves original URL' );
|
is( $get1->{json}->{original_url},
|
||||||
is( $get2->{json}->{original_url},
|
$url, 'First code retrieves original URL' );
|
||||||
$url, 'Second code retrieves original URL' );
|
is( $get2->{json}->{original_url},
|
||||||
pass('Both codes persist and retrieve same URL');
|
$url, 'Second code retrieves original URL' );
|
||||||
}
|
pass('Both codes persist and retrieve same URL');
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Duplicate URL test skipped: " . $res2->{error} );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Duplicate URL test skipped: " . $res1->{error} );
|
|
||||||
}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
|
subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
|
||||||
my $res = get_url('nonexistent123456');
|
my $res = get_url('nonexistent123456');
|
||||||
is( $res->{code}, 404, 'Non-existent code returns 404' );
|
is( $res->{code}, 400, 'Invalid format rejected: nonexistent123456' );
|
||||||
is(
|
is(
|
||||||
$res->{error},
|
$res->{error},
|
||||||
'Short code not found',
|
'Invalid short code format',
|
||||||
'Correct error message for non-existent code'
|
'Correct error for: nonexistent123456'
|
||||||
);
|
);
|
||||||
|
|
||||||
$res = get_url('');
|
$res = get_url('');
|
||||||
@@ -295,47 +244,11 @@ subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
|
|||||||
|
|
||||||
$res = get_url('invalid@code');
|
$res = get_url('invalid@code');
|
||||||
is( $res->{code}, 400, 'Invalid format rejected: invalid@code' );
|
is( $res->{code}, 400, 'Invalid format rejected: invalid@code' );
|
||||||
is( $res->{error}, 'Invalid short code format',
|
is(
|
||||||
'Correct error for: invalid@code' );
|
$res->{error},
|
||||||
};
|
'Invalid short code format',
|
||||||
|
'Correct error for: invalid@code'
|
||||||
subtest 'End-to-end: Full flow with real components' => sub {
|
);
|
||||||
for my $url ( 'https://www.example.com', 'http://www.perl.org' ) {
|
|
||||||
my $res1 = post_shorten($url);
|
|
||||||
|
|
||||||
if ( $res1->{code} == 200 ) {
|
|
||||||
my $code = $res1->{json}->{short_code};
|
|
||||||
ok( validate_short_code_format($code), "Code generated for: $url" );
|
|
||||||
|
|
||||||
my $res2 = get_url($code);
|
|
||||||
if ( $res2->{code} == 200 ) {
|
|
||||||
validate_get_response( $res2, $url, $code, "End-to-end: $url" );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "End-to-end GET failed for $url: " . $res2->{error} );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "End-to-end POST failed for $url: " . $res1->{error} );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
};
|
|
||||||
|
|
||||||
subtest 'Real database connection test' => sub {
|
|
||||||
my $res = post_shorten('https://www.example.com');
|
|
||||||
|
|
||||||
if ( $res->{code} == 200 ) {
|
|
||||||
pass('Database connection successful (Redis accessible)');
|
|
||||||
my $get_res = get_url( $res->{json}->{short_code} );
|
|
||||||
pass('Database read operation successful') if $get_res->{code} == 200;
|
|
||||||
}
|
|
||||||
elsif ( $res->{code} == 400 && $res->{error} =~ /Database error/i ) {
|
|
||||||
diag( "Database connection test: Redis may not be available - "
|
|
||||||
. $res->{error} );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diag( "Database connection test skipped: " . $res->{error} );
|
|
||||||
}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
done_testing();
|
done_testing();
|
||||||
|
|||||||
Reference in New Issue
Block a user