Compare commits
70 Commits
4d48f90ceb
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| d59b9cf837 | |||
| 77a45cc58e | |||
| 17eb69fed0 | |||
| 7aa400b936 | |||
| 1a82fbac12 | |||
| 285d25223e | |||
| d88e35b965 | |||
| b0aa64053b | |||
| c398ff843d | |||
| 385084afc5 | |||
| 777b589946 | |||
| 72013a9a08 | |||
| e6fc9c919f | |||
| 39bead9da1 | |||
| 699f660ec2 | |||
| 2c28b603da | |||
| 76fa8a7334 | |||
| 8495d6ab26 | |||
| b203bcad78 | |||
| 7005e0852a | |||
| af5a924ae3 | |||
| 4730c577fa | |||
| 940f60e471 | |||
| 407289cd2a | |||
| b5ab00ef93 | |||
| 0b277a3e65 | |||
| e9c298110d | |||
| ae1dab8116 | |||
| eb4c4e4c4c | |||
| e2c4916565 | |||
| 15f082fcdc | |||
| 8e6665971e | |||
| 09a0fe017a | |||
| 9fc620130c | |||
| 2903aa51ff | |||
| bf9579ab14 | |||
| 48f2b8448a | |||
| 10fd579d0b | |||
| 4810966b1c | |||
| 8c62bff80b | |||
| 17857a6b56 | |||
| 4053b89cf4 | |||
| 331dba9211 | |||
| bd4c6c9a1d | |||
| 6f40a4569a | |||
| 9f8570eea2 | |||
| 611a25c88d | |||
| 801b09ac83 | |||
| 39fd9d5c20 | |||
| b15b473033 | |||
| e9969841b1 | |||
| edc1c8cd66 | |||
| fcbb8f8e5e | |||
| d8c43cd29b | |||
| 2ae22a271b | |||
| 6912495a04 | |||
| aa9f557aa0 | |||
| fb500c7799 | |||
| d9b05bab33 | |||
| 6ce43f4608 | |||
| 09abbd84dc | |||
| 43253e6fc6 | |||
| 64a9db7324 | |||
| 40b848eeee | |||
| 7d46eb3922 | |||
| 71c5d4b628 | |||
| 4e4820c165 | |||
| 7ffa61846f | |||
| 1826f7e847 | |||
| 86007a74d8 |
63
README.md
63
README.md
@@ -2,21 +2,44 @@
|
||||
|
||||
`urupam` is a lightweight URL shortener built with Perl and Mojolicious, and backed by Redis.
|
||||
|
||||
## Warning
|
||||
|
||||
It's a work in progress. API looks good but all the front part remains to do.
|
||||
|
||||
## Basic requirements
|
||||
|
||||
- Perl 5.42.0
|
||||
- Carton (handles perl deps)
|
||||
- Redis
|
||||
|
||||
## How to run
|
||||
## Installation
|
||||
|
||||
To run the application in development, you'll first need a Redis server.
|
||||
### Classic
|
||||
|
||||
The easiest way is to start a local Redis instance using Docker:
|
||||
Run the installation script:
|
||||
|
||||
```sh
|
||||
scripts/install.sh
|
||||
```
|
||||
|
||||
It will create a `urupam` user and group, deploy the application in `/opt/urupam` and create/enable a `systemd` service. Documentation will be installed in `/usr/share/doc/urupam`.
|
||||
|
||||
The application will listen on `:8080`.
|
||||
|
||||
### Using docker
|
||||
|
||||
Build the image and use the `docker-compose` file:
|
||||
|
||||
```sh
|
||||
docker build -t urupam .
|
||||
docker compose up -d
|
||||
```
|
||||
|
||||
Alternatively, if you already have a running `redis` instance, you can skip `compose` and start a standalone container:
|
||||
|
||||
```sh
|
||||
docker run --name urupam -p 8080:8080 -d urupam:latest
|
||||
```
|
||||
|
||||
## Hacking
|
||||
|
||||
To run the application in development, you'll first need a Redis server. The easiest way is to start one is using Docker:
|
||||
|
||||
```sh
|
||||
docker run --name mojo-redis -p 6379:6379 -d redis
|
||||
@@ -28,36 +51,28 @@ Install Perl dependencies with [Carton](https://github.com/perl-carton/carton):
|
||||
carton install
|
||||
```
|
||||
|
||||
Start the application with `morbo`:
|
||||
Add your changes and your tests, then start the application with `morbo`:
|
||||
|
||||
```sh
|
||||
carton exec morbo bin/urupam
|
||||
```
|
||||
|
||||
Application will listen on port `3000`.
|
||||
The application will listen on port `3000` by default.
|
||||
|
||||
## Installation
|
||||
## Running tests
|
||||
|
||||
Run the installation script:
|
||||
As every perl project, tests are located in the `t` directory.
|
||||
|
||||
To run tests, use the `carton` command:
|
||||
|
||||
```sh
|
||||
scripts/install.sh
|
||||
carton exec prove -lr t/
|
||||
```
|
||||
|
||||
Enable and start the systemd service:
|
||||
To run specific tests (like integration tests), use:
|
||||
|
||||
```sh
|
||||
sudo systemctl enable --now urupam
|
||||
```
|
||||
|
||||
### Using docker
|
||||
|
||||
Build the image and use the `docker-compose` file:
|
||||
|
||||
```sh
|
||||
cd docker
|
||||
docker build -t urupam .
|
||||
docker compose up -d
|
||||
carton exec prove -lr t/integration.t
|
||||
```
|
||||
|
||||
## License
|
||||
|
||||
1
cpanfile
1
cpanfile
@@ -5,6 +5,7 @@ requires 'Mojo::URL';
|
||||
requires 'Mojo::UserAgent';
|
||||
requires 'Mojo::Util';
|
||||
requires 'Mojolicious';
|
||||
requires 'Bytes::Random::Secure';
|
||||
|
||||
on test => sub {
|
||||
requires 'Test::Mojo';
|
||||
|
||||
@@ -1,5 +1,19 @@
|
||||
# carton snapshot format: version 1.0
|
||||
DISTRIBUTIONS
|
||||
Bytes-Random-Secure-0.29
|
||||
pathname: D/DA/DAVIDO/Bytes-Random-Secure-0.29.tar.gz
|
||||
provides:
|
||||
Bytes::Random::Secure 0.29
|
||||
requirements:
|
||||
Carp 0
|
||||
Crypt::Random::Seed 0
|
||||
ExtUtils::MakeMaker 6.56
|
||||
MIME::Base64 0
|
||||
MIME::QuotedPrint 3.03
|
||||
Math::Random::ISAAC 0
|
||||
Scalar::Util 1.21
|
||||
Test::More 0.98
|
||||
perl 5.006000
|
||||
Class-Load-0.25
|
||||
pathname: E/ET/ETHER/Class-Load-0.25.tar.gz
|
||||
provides:
|
||||
@@ -30,6 +44,34 @@ DISTRIBUTIONS
|
||||
perl 5.006
|
||||
strict 0
|
||||
warnings 0
|
||||
Crypt-Random-Seed-0.03
|
||||
pathname: D/DA/DANAJ/Crypt-Random-Seed-0.03.tar.gz
|
||||
provides:
|
||||
Crypt::Random::Seed 0.03
|
||||
requirements:
|
||||
Carp 0
|
||||
Crypt::Random::TESHA2 0
|
||||
Exporter 5.562
|
||||
ExtUtils::MakeMaker 0
|
||||
Fcntl 0
|
||||
Test::More 0.45
|
||||
base 0
|
||||
constant 0
|
||||
perl 5.006002
|
||||
Crypt-Random-TESHA2-0.01
|
||||
pathname: D/DA/DANAJ/Crypt-Random-TESHA2-0.01.tar.gz
|
||||
provides:
|
||||
Crypt::Random::TESHA2 0.01
|
||||
Crypt::Random::TESHA2::Config 0.01
|
||||
requirements:
|
||||
Carp 0
|
||||
Digest::SHA 5.22
|
||||
Exporter 5.562
|
||||
ExtUtils::MakeMaker 0
|
||||
Test::More 0.45
|
||||
Time::HiRes 1.9711
|
||||
base 0
|
||||
perl 5.006002
|
||||
Data-OptList-0.114
|
||||
pathname: R/RJ/RJBS/Data-OptList-0.114.tar.gz
|
||||
provides:
|
||||
@@ -112,6 +154,15 @@ DISTRIBUTIONS
|
||||
requirements:
|
||||
ExtUtils::MakeMaker 0
|
||||
perl 5.006
|
||||
Math-Random-ISAAC-1.004
|
||||
pathname: J/JA/JAWNSY/Math-Random-ISAAC-1.004.tar.gz
|
||||
provides:
|
||||
Math::Random::ISAAC 1.004
|
||||
Math::Random::ISAAC::PP 1.004
|
||||
requirements:
|
||||
ExtUtils::MakeMaker 6.31
|
||||
Test::More 0.62
|
||||
Test::NoWarnings 0.084
|
||||
Module-Implementation-0.09
|
||||
pathname: D/DR/DROLSKY/Module-Implementation-0.09.tar.gz
|
||||
provides:
|
||||
@@ -860,6 +911,15 @@ DISTRIBUTIONS
|
||||
perl 5.008
|
||||
strict 0
|
||||
warnings 0
|
||||
Test-NoWarnings-1.06
|
||||
pathname: H/HA/HAARG/Test-NoWarnings-1.06.tar.gz
|
||||
provides:
|
||||
Test::NoWarnings 1.06
|
||||
Test::NoWarnings::Warning 1.06
|
||||
requirements:
|
||||
ExtUtils::MakeMaker 0
|
||||
Test::Builder 0.86
|
||||
perl 5.006
|
||||
Try-Tiny-0.32
|
||||
pathname: E/ET/ETHER/Try-Tiny-0.32.tar.gz
|
||||
provides:
|
||||
|
||||
@@ -11,9 +11,13 @@ sub shorten {
|
||||
|
||||
my $json = $c->req->json;
|
||||
unless ( defined $json && ref $json eq 'HASH' ) {
|
||||
$c->render(
|
||||
json => { error => 'Invalid JSON format' },
|
||||
status => 400
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->render(
|
||||
json => { error => 'Invalid JSON format' },
|
||||
status => 400
|
||||
);
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
@@ -21,15 +25,19 @@ sub shorten {
|
||||
my $original_url = sanitize_input( $json->{url} || '' );
|
||||
|
||||
unless ($original_url) {
|
||||
$c->render(
|
||||
json => { error => 'URL is required' },
|
||||
status => 400
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->render(
|
||||
json => { error => 'URL is required' },
|
||||
status => 400
|
||||
);
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
my $normalized_url;
|
||||
$validator->validate_url_with_checks($original_url)->then(
|
||||
return $validator->validate_url_with_checks($original_url)->then(
|
||||
sub {
|
||||
my $sanitized_url = shift;
|
||||
$normalized_url = $sanitized_url;
|
||||
@@ -38,25 +46,34 @@ sub shorten {
|
||||
)->then(
|
||||
sub {
|
||||
my $short_code = shift;
|
||||
my $short_url = $c->url_for("/$short_code")->to_abs;
|
||||
$c->render(
|
||||
json => {
|
||||
success => 1,
|
||||
short_url => $short_url,
|
||||
short_code => $short_code,
|
||||
original_url => $normalized_url
|
||||
$c->respond_once(
|
||||
sub {
|
||||
my $short_url = $c->url_for("/$short_code")->to_abs;
|
||||
$c->render(
|
||||
json => {
|
||||
success => 1,
|
||||
short_url => $short_url,
|
||||
short_code => $short_code,
|
||||
original_url => $normalized_url
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
)->catch(
|
||||
sub {
|
||||
my $err = shift;
|
||||
$c->app->log->error("API URL validation/creation error: $err");
|
||||
my $status = get_error_status($err);
|
||||
my $sanitized_error = sanitize_error_message($err);
|
||||
$c->render(
|
||||
json => { error => $sanitized_error },
|
||||
status => $status
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->app->log->error(
|
||||
"API URL validation/creation error: $err");
|
||||
my $status = get_error_status($err);
|
||||
my $sanitized_error = sanitize_error_message($err);
|
||||
$c->render(
|
||||
json => { error => $sanitized_error },
|
||||
status => $status
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
@@ -70,43 +87,55 @@ sub get_url {
|
||||
my $validator = $c->validator;
|
||||
|
||||
unless ( $short_code && $validator->validate_short_code($short_code) ) {
|
||||
$c->render(
|
||||
json => { error => 'Invalid short code format' },
|
||||
status => 400
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->render(
|
||||
json => { error => 'Invalid short code format' },
|
||||
status => 400
|
||||
);
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
$url_service->get_original_url($short_code)->then(
|
||||
return $url_service->get_original_url($short_code)->then(
|
||||
sub {
|
||||
my $original_url = shift;
|
||||
if ($original_url) {
|
||||
my $short_url = $c->url_for("/$short_code")->to_abs;
|
||||
$c->render(
|
||||
json => {
|
||||
success => 1,
|
||||
short_code => $short_code,
|
||||
original_url => $original_url,
|
||||
short_url => $short_url
|
||||
$c->respond_once(
|
||||
sub {
|
||||
if ($original_url) {
|
||||
my $short_url = $c->url_for("/$short_code")->to_abs;
|
||||
$c->render(
|
||||
json => {
|
||||
success => 1,
|
||||
short_code => $short_code,
|
||||
original_url => $original_url,
|
||||
short_url => $short_url
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
else {
|
||||
$c->render(
|
||||
json => { error => 'Short code not found' },
|
||||
status => 404
|
||||
);
|
||||
}
|
||||
else {
|
||||
$c->render(
|
||||
json => { error => 'Short code not found' },
|
||||
status => 404
|
||||
);
|
||||
}
|
||||
}
|
||||
);
|
||||
}
|
||||
)->catch(
|
||||
sub {
|
||||
my $err = shift;
|
||||
$c->app->log->error("API URL retrieval error: $err");
|
||||
my $status = get_error_status($err);
|
||||
my $sanitized_error = sanitize_error_message($err);
|
||||
$c->render(
|
||||
json => { error => $sanitized_error },
|
||||
status => $status
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->app->log->error("API URL retrieval error: $err");
|
||||
my $status = get_error_status($err);
|
||||
my $sanitized_error = sanitize_error_message($err);
|
||||
$c->render(
|
||||
json => { error => $sanitized_error },
|
||||
status => $status
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
@@ -5,6 +5,7 @@ use Urupam::DB;
|
||||
use Urupam::URL;
|
||||
use Urupam::Validation;
|
||||
use Urupam::API;
|
||||
use Urupam::Version;
|
||||
|
||||
sub startup {
|
||||
my $self = shift;
|
||||
@@ -29,6 +30,22 @@ sub startup {
|
||||
$c->stash->{validator} ||= Urupam::Validation->new;
|
||||
}
|
||||
);
|
||||
$self->helper(
|
||||
version => sub {
|
||||
my $c = shift;
|
||||
$c->stash->{version} ||= Urupam::Version->new->get_version;
|
||||
}
|
||||
);
|
||||
|
||||
$self->helper(
|
||||
respond_once => sub {
|
||||
my $c = shift;
|
||||
my $callback = shift;
|
||||
return if $c->stash->{'urupam.responded'};
|
||||
$c->stash->{'urupam.responded'} = 1;
|
||||
$callback->($c);
|
||||
}
|
||||
);
|
||||
|
||||
my $r = $self->routes;
|
||||
|
||||
@@ -38,18 +55,31 @@ sub startup {
|
||||
$c->render_later;
|
||||
$c->db->ping->then(
|
||||
sub {
|
||||
$c->render( json => { status => 'ok' } );
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->render(
|
||||
json => {
|
||||
status => 'ok',
|
||||
version => $c->version
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
)->catch(
|
||||
sub {
|
||||
my $err = shift;
|
||||
$c->app->log->error("Health check DB error: $err");
|
||||
$c->render(
|
||||
json => {
|
||||
status => 'error',
|
||||
error => 'Database connection failed'
|
||||
},
|
||||
status => 503
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->app->log->error("Health check DB error: $err");
|
||||
$c->render(
|
||||
json => {
|
||||
status => 'error',
|
||||
error => 'Database connection failed'
|
||||
},
|
||||
status => 503
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
@@ -58,9 +88,7 @@ sub startup {
|
||||
$r->get('/')->to(
|
||||
cb => sub {
|
||||
my $c = shift;
|
||||
$c->render(
|
||||
json => { status => 'hello from urupam', service => 'urupam' }
|
||||
);
|
||||
$c->render( template => 'index' );
|
||||
}
|
||||
);
|
||||
|
||||
@@ -91,33 +119,45 @@ sub startup {
|
||||
unless ( $short_code
|
||||
&& $validator->validate_short_code($short_code) )
|
||||
{
|
||||
$c->render(
|
||||
json => { error => 'Invalid short code format' },
|
||||
status => 400
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->render(
|
||||
template => '404',
|
||||
status => 404
|
||||
);
|
||||
}
|
||||
);
|
||||
return;
|
||||
}
|
||||
|
||||
$url_service->get_original_url($short_code)->then(
|
||||
return $url_service->get_original_url($short_code)->then(
|
||||
sub {
|
||||
my $original_url = shift;
|
||||
if ($original_url) {
|
||||
$c->redirect_to($original_url);
|
||||
}
|
||||
else {
|
||||
$c->render(
|
||||
json => { error => 'Short code not found' },
|
||||
status => 404
|
||||
);
|
||||
}
|
||||
$c->respond_once(
|
||||
sub {
|
||||
if ($original_url) {
|
||||
$c->redirect_to($original_url);
|
||||
}
|
||||
else {
|
||||
$c->render(
|
||||
template => '404',
|
||||
status => 404
|
||||
);
|
||||
}
|
||||
}
|
||||
);
|
||||
}
|
||||
)->catch(
|
||||
sub {
|
||||
my $err = shift;
|
||||
$c->app->log->error("Redirect lookup error: $err");
|
||||
$c->render(
|
||||
json => { error => 'Internal server error' },
|
||||
status => 500
|
||||
$c->respond_once(
|
||||
sub {
|
||||
$c->app->log->error("Redirect lookup error: $err");
|
||||
$c->render(
|
||||
template => '500',
|
||||
status => 500
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
@@ -20,48 +20,6 @@ sub get {
|
||||
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 {
|
||||
my ( $self, $key, $value ) = @_;
|
||||
my $promise = Mojo::Promise->new;
|
||||
@@ -81,7 +39,7 @@ sub setnx {
|
||||
}
|
||||
|
||||
sub ping {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $promise = Mojo::Promise->new;
|
||||
$self->redis->ping(
|
||||
sub {
|
||||
|
||||
@@ -2,7 +2,8 @@ package Urupam::URL;
|
||||
|
||||
use Mojo::Base -base;
|
||||
use Mojo::Promise;
|
||||
use Mojo::Util qw(b64_encode);
|
||||
use Mojo::Util qw(b64_encode);
|
||||
use Bytes::Random::Secure qw(random_string_from random_bytes);
|
||||
|
||||
has db => sub { die 'db attribute required' };
|
||||
|
||||
@@ -32,11 +33,7 @@ sub _validate_url {
|
||||
|
||||
sub _generate_random_code {
|
||||
my ($self) = @_;
|
||||
my $code = '';
|
||||
for ( 1 .. $CODE_LENGTH ) {
|
||||
$code .= substr( $CHARSET, int( rand( length($CHARSET) ) ), 1 );
|
||||
}
|
||||
return $code;
|
||||
return random_string_from( $CHARSET, $CODE_LENGTH );
|
||||
}
|
||||
|
||||
sub _generate_code_from_url {
|
||||
@@ -55,11 +52,25 @@ sub _generate_code_from_url {
|
||||
}
|
||||
|
||||
my $max_start = length($encoded) - $CODE_LENGTH;
|
||||
my $start_pos = int( rand( ( $max_start > 0 ? $max_start : 0 ) + 1 ) );
|
||||
my $range = ( $max_start > 0 ? $max_start : 0 ) + 1;
|
||||
my $start_pos = $self->_secure_int($range);
|
||||
|
||||
return substr( $encoded, $start_pos, $CODE_LENGTH );
|
||||
}
|
||||
|
||||
sub _secure_int {
|
||||
my ( $self, $max ) = @_;
|
||||
return 0 unless defined $max && $max > 1;
|
||||
|
||||
my $limit = int( 0xFFFFFFFF / $max ) * $max;
|
||||
my $value;
|
||||
do {
|
||||
$value = unpack( 'N', random_bytes(4) );
|
||||
} while ( $value >= $limit );
|
||||
|
||||
return $value % $max;
|
||||
}
|
||||
|
||||
sub generate_short_code {
|
||||
my ( $self, $original_url, $use_pure_random ) = @_;
|
||||
|
||||
@@ -172,4 +183,3 @@ sub get_original_url {
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -4,7 +4,8 @@ use strict;
|
||||
use warnings;
|
||||
use Exporter 'import';
|
||||
use Mojo::URL;
|
||||
use Mojo::Util qw(url_unescape);
|
||||
use Mojo::Path;
|
||||
use Mojo::Util qw(url_unescape decode);
|
||||
|
||||
our @EXPORT_OK = qw(
|
||||
sanitize_input
|
||||
@@ -34,8 +35,7 @@ sub sanitize_error_message {
|
||||
$sanitized =~ s/[^\p{L}\p{N}_\s\.\-\:\/]//gu;
|
||||
$sanitized =~ s/\s+/ /g;
|
||||
$sanitized =~ s/^\s+|\s+$//g;
|
||||
return
|
||||
length($sanitized) > 200
|
||||
return length($sanitized) > 200
|
||||
? substr( $sanitized, 0, 200 ) . '...'
|
||||
: $sanitized;
|
||||
}
|
||||
@@ -58,6 +58,7 @@ sub sanitize_url {
|
||||
return undef if $authority =~ /[\s\x00-\x1F\x7F]/;
|
||||
|
||||
my $hostport = ( split /\@/, $authority )[-1];
|
||||
return undef unless defined $hostport && length $hostport;
|
||||
my $host_raw;
|
||||
if ( $hostport =~ /^\[(.+)\](?::\d+)?$/ ) {
|
||||
$host_raw = $1;
|
||||
@@ -77,13 +78,24 @@ sub sanitize_url {
|
||||
|
||||
if ( $url =~ /%[0-9a-f]{2}/i ) {
|
||||
my $path = url_unescape( $parsed->path->to_string );
|
||||
$parsed->path($path);
|
||||
$path = decode( 'UTF-8', $path ) if length $path;
|
||||
$parsed->path( Mojo::Path->new($path) );
|
||||
|
||||
my $query = $parsed->query->to_string;
|
||||
$parsed->query( url_unescape($query) ) if length $query;
|
||||
if ( length $query ) {
|
||||
my $decoded_query = url_unescape($query);
|
||||
$decoded_query = decode( 'UTF-8', $decoded_query )
|
||||
if length $decoded_query;
|
||||
$parsed->query($decoded_query);
|
||||
}
|
||||
|
||||
my $fragment = $parsed->fragment;
|
||||
$parsed->fragment( url_unescape($fragment) ) if defined $fragment;
|
||||
if ( defined $fragment ) {
|
||||
my $decoded_fragment = url_unescape($fragment);
|
||||
$decoded_fragment = decode( 'UTF-8', $decoded_fragment )
|
||||
if length $decoded_fragment;
|
||||
$parsed->fragment($decoded_fragment);
|
||||
}
|
||||
|
||||
$url = $parsed->to_string;
|
||||
}
|
||||
|
||||
@@ -4,11 +4,14 @@ use Mojo::Base -base;
|
||||
use Mojo::URL;
|
||||
use Mojo::UserAgent;
|
||||
use Mojo::Promise;
|
||||
use Mojo::IOLoop;
|
||||
use Urupam::Utils qw(sanitize_url);
|
||||
use Socket
|
||||
qw(getaddrinfo getnameinfo NI_NUMERICHOST NI_NUMERICSERV AF_INET AF_INET6 SOCK_STREAM);
|
||||
|
||||
my $MAX_URL_LENGTH = 2048;
|
||||
my $CONNECT_TIMEOUT = 10;
|
||||
my $REQUEST_TIMEOUT = 10;
|
||||
my $CONNECT_TIMEOUT = 0.2;
|
||||
my $REQUEST_TIMEOUT = 0.4;
|
||||
my $MAX_REDIRECTS = 3;
|
||||
|
||||
my $DNS_ERROR_PATTERN =
|
||||
@@ -23,6 +26,12 @@ my @BLOCKED_DOMAINS = qw(
|
||||
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 {
|
||||
my $self = shift;
|
||||
Mojo::UserAgent->new(
|
||||
@@ -71,6 +80,7 @@ sub is_valid_url_length {
|
||||
|
||||
sub _is_valid_ipv4 {
|
||||
my ( $self, $ip ) = @_;
|
||||
return 0 unless defined $ip;
|
||||
return 0 unless $ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
|
||||
my ( $a, $b, $c, $d ) = ( $1, $2, $3, $4 );
|
||||
return
|
||||
@@ -92,50 +102,287 @@ sub _is_private_ipv4 {
|
||||
|
||||
sub _is_private_ipv6 {
|
||||
my ( $self, $ip ) = @_;
|
||||
return 0 unless defined $ip;
|
||||
|
||||
$ip = lc($ip);
|
||||
$ip =~ s/^\[|\]$//g;
|
||||
return
|
||||
$ip eq '::1'
|
||||
|| $ip eq '::'
|
||||
|| $ip =~ /^::ffff:(127\.|192\.168\.|10\.|172\.(1[6-9]|2[0-9]|3[01])\.)/;
|
||||
}
|
||||
|
||||
sub is_blocked_url {
|
||||
my ( $self, $url ) = @_;
|
||||
return 0 unless defined $url;
|
||||
return 1 if $ip eq '::1';
|
||||
return 1 if $ip eq '::';
|
||||
|
||||
my $parsed = $self->_parse_url($url);
|
||||
return 0 unless $parsed;
|
||||
|
||||
my $host = lc( $parsed->host // '' );
|
||||
|
||||
for my $blocked (@BLOCKED_DOMAINS) {
|
||||
return 1 if $host eq $blocked;
|
||||
if ( $ip =~ /^::ffff:(.+)$/ ) {
|
||||
return $self->_is_private_ipv4($1) ? 1 : 0;
|
||||
}
|
||||
|
||||
if ( $self->_is_private_ipv4($host) ) {
|
||||
return 1;
|
||||
}
|
||||
return 0 unless $ip =~ /^([0-9a-f]{0,4}:)+[0-9a-f]{0,4}$/ || $ip =~ /^::/;
|
||||
|
||||
if ( $self->_is_private_ipv6($host) ) {
|
||||
return 1;
|
||||
}
|
||||
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;
|
||||
}
|
||||
|
||||
sub check_url_reachable {
|
||||
sub _resolve_host {
|
||||
my ( $self, $host ) = @_;
|
||||
return Mojo::Promise->resolve( [] )
|
||||
unless defined $host && length($host) > 0;
|
||||
|
||||
if ( $self->_is_valid_ipv4($host) ) {
|
||||
return Mojo::Promise->resolve( [ { type => 'ipv4', ip => $host } ] );
|
||||
}
|
||||
|
||||
my $ipv6_host = $host;
|
||||
$ipv6_host =~ s/^\[|\]$//g;
|
||||
if ( $self->_is_private_ipv6($ipv6_host) ) {
|
||||
return Mojo::Promise->resolve(
|
||||
[ { type => 'ipv6', ip => $ipv6_host } ] );
|
||||
}
|
||||
|
||||
if ( $ipv6_host =~ /^([0-9a-f]{0,4}:){2,}[0-9a-f]{0,4}$/i
|
||||
|| $ipv6_host =~ /^::/ )
|
||||
{
|
||||
return Mojo::Promise->resolve(
|
||||
[ { type => 'ipv6', ip => $ipv6_host } ] );
|
||||
}
|
||||
|
||||
if ( my $cached = $self->_get_cached_addresses($host) ) {
|
||||
return Mojo::Promise->resolve($cached);
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
return Mojo::Promise->reject('URL is required')
|
||||
unless defined $url && length($url) > 0;
|
||||
my $cached = $reachability_cache{$url};
|
||||
return undef unless $cached;
|
||||
return $cached if time() < $cached->{expires};
|
||||
delete $reachability_cache{$url};
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $self->ua->head_p($url)->then(
|
||||
sub _fire_and_forget {
|
||||
my ( $self, $promise ) = @_;
|
||||
return unless $promise;
|
||||
$promise->catch( sub { } );
|
||||
return;
|
||||
}
|
||||
|
||||
sub is_blocked_url {
|
||||
my ( $self, $url ) = @_;
|
||||
return Mojo::Promise->resolve(0) unless defined $url;
|
||||
|
||||
my $parsed = $self->_parse_url($url);
|
||||
return Mojo::Promise->resolve(0) unless $parsed;
|
||||
|
||||
my $host = lc( $parsed->host // '' );
|
||||
return Mojo::Promise->resolve(0) unless length($host) > 0;
|
||||
|
||||
for my $blocked (@BLOCKED_DOMAINS) {
|
||||
return Mojo::Promise->resolve(1) if $host eq $blocked;
|
||||
}
|
||||
|
||||
if ( $self->_is_private_ipv4($host) ) {
|
||||
return Mojo::Promise->resolve(1);
|
||||
}
|
||||
|
||||
if ( $self->_is_private_ipv6($host) ) {
|
||||
return Mojo::Promise->resolve(1);
|
||||
}
|
||||
|
||||
if ( my $cached = $self->_get_cached_addresses($host) ) {
|
||||
return Mojo::Promise->resolve(
|
||||
$self->_addresses_contain_private($cached) ? 1 : 0 );
|
||||
}
|
||||
|
||||
# Intentional: skip blocking on cold hosts to keep latency low, DNS runs in background.
|
||||
$self->_fire_and_forget( $self->_resolve_host($host) );
|
||||
return Mojo::Promise->resolve(0);
|
||||
}
|
||||
|
||||
sub _create_ssrf_safe_ua {
|
||||
my $self = shift;
|
||||
return Mojo::UserAgent->new(
|
||||
connect_timeout => $self->connect_timeout,
|
||||
request_timeout => $self->request_timeout,
|
||||
max_redirects => 0,
|
||||
insecure => 0
|
||||
);
|
||||
}
|
||||
|
||||
sub _follow_redirect_with_validation {
|
||||
my ( $self, $ua, $url, $redirect_count ) = @_;
|
||||
$redirect_count //= 0;
|
||||
|
||||
return Mojo::Promise->reject('Too many redirects')
|
||||
if $redirect_count > $self->max_redirects;
|
||||
|
||||
return $ua->head_p($url)->then(
|
||||
sub {
|
||||
my $tx = shift;
|
||||
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;
|
||||
if ( $code == 403 || $code == 404 || $code == 405 ) {
|
||||
return $ua->get_p($url)->then(
|
||||
sub {
|
||||
my $get_tx = shift;
|
||||
my $get_code = $get_tx->result->code;
|
||||
return 1 if $get_code >= 200 && $get_code < 400;
|
||||
return 1
|
||||
if $get_code == 403
|
||||
|| $get_code == 404
|
||||
|| $get_code == 405;
|
||||
return Mojo::Promise->reject(
|
||||
"URL returned $get_code error")
|
||||
if $get_code >= 400;
|
||||
return Mojo::Promise->reject(
|
||||
"URL returned unexpected status: $get_code");
|
||||
}
|
||||
);
|
||||
}
|
||||
return Mojo::Promise->reject("URL returned $code error")
|
||||
if $code >= 400;
|
||||
return Mojo::Promise->reject(
|
||||
@@ -152,36 +399,76 @@ sub check_url_reachable {
|
||||
);
|
||||
}
|
||||
|
||||
sub check_ssl_certificate {
|
||||
sub check_url_reachable {
|
||||
my ( $self, $url ) = @_;
|
||||
|
||||
return Mojo::Promise->reject('URL is required')
|
||||
unless defined $url && length($url) > 0;
|
||||
|
||||
my $parsed = $self->_parse_url($url);
|
||||
return Mojo::Promise->resolve(1)
|
||||
unless $parsed && $parsed->scheme && $parsed->scheme eq 'https';
|
||||
if ( my $cached = $self->_get_cached_reachability($url) ) {
|
||||
return $cached->{ok}
|
||||
? Mojo::Promise->resolve(1)
|
||||
: Mojo::Promise->reject( $cached->{error} );
|
||||
}
|
||||
|
||||
return $self->ua->head_p($url)->then( sub { return 1; } )->catch(
|
||||
my $ssrf_ua = $self->_create_ssrf_safe_ua;
|
||||
return $self->_follow_redirect_with_validation( $ssrf_ua, $url )->then(
|
||||
sub {
|
||||
my $err = shift;
|
||||
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");
|
||||
}
|
||||
|
||||
return Mojo::Promise->reject(
|
||||
$self->_format_error_message( $error_type, $err_str ) );
|
||||
$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);
|
||||
return Mojo::Promise->resolve(1)
|
||||
unless $parsed && $parsed->scheme && $parsed->scheme eq 'https';
|
||||
|
||||
$self->_fire_and_forget(
|
||||
$self->ua->head_p($url)->then( sub { return 1; } )->catch(
|
||||
sub {
|
||||
my $err = shift;
|
||||
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");
|
||||
}
|
||||
|
||||
return Mojo::Promise->reject(
|
||||
$self->_format_error_message( $error_type, $err_str ) );
|
||||
}
|
||||
)
|
||||
);
|
||||
|
||||
return Mojo::Promise->resolve(1);
|
||||
}
|
||||
|
||||
sub validate_short_code {
|
||||
my ( $self, $code ) = @_;
|
||||
return defined $code && length($code) > 0 && $code =~ /^[0-9a-zA-Z\-_]+$/;
|
||||
return defined $code && length($code) == 12 && $code =~ /^[0-9a-zA-Z\-_]+$/;
|
||||
}
|
||||
|
||||
sub validate_url_with_checks {
|
||||
@@ -200,21 +487,29 @@ sub validate_url_with_checks {
|
||||
unless $parsed->scheme && $parsed->scheme =~ /^https?$/i;
|
||||
return Mojo::Promise->reject('Invalid URL format') unless $parsed->host;
|
||||
|
||||
my $normalized = $parsed->to_string;
|
||||
|
||||
return Mojo::Promise->reject(
|
||||
"URL exceeds maximum length of $MAX_URL_LENGTH characters")
|
||||
unless $self->is_valid_url_length($sanitized);
|
||||
return Mojo::Promise->reject(
|
||||
'This URL cannot be shortened (blocked domain or local address)')
|
||||
if $self->is_blocked_url($sanitized);
|
||||
unless $self->is_valid_url_length($normalized);
|
||||
|
||||
my $ssl_check =
|
||||
$parsed->scheme eq 'https'
|
||||
? $self->check_ssl_certificate($sanitized)
|
||||
: Mojo::Promise->resolve(1);
|
||||
return $self->is_blocked_url($normalized)->then(
|
||||
sub {
|
||||
my $blocked = shift;
|
||||
return Mojo::Promise->reject(
|
||||
'This URL cannot be shortened (blocked domain or local address)'
|
||||
) if $blocked;
|
||||
|
||||
return $ssl_check->then(
|
||||
sub { return $self->check_url_reachable($sanitized); } )
|
||||
->then( sub { return $sanitized; } );
|
||||
my $ssl_check =
|
||||
$parsed->scheme eq 'https'
|
||||
? $self->check_ssl_certificate($normalized)
|
||||
: Mojo::Promise->resolve(1);
|
||||
|
||||
return $ssl_check->then(
|
||||
sub { return $self->check_url_reachable_async($normalized); } )
|
||||
->then( sub { return $normalized; } );
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
12
lib/Urupam/Version.pm
Normal file
12
lib/Urupam/Version.pm
Normal file
@@ -0,0 +1,12 @@
|
||||
package Urupam::Version;
|
||||
|
||||
use Mojo::Base -base;
|
||||
|
||||
has version => sub { '0.1.0' };
|
||||
|
||||
sub get_version {
|
||||
my $self = shift;
|
||||
return $self->version;
|
||||
}
|
||||
|
||||
1;
|
||||
166
public/css/app.css
Normal file
166
public/css/app.css
Normal file
@@ -0,0 +1,166 @@
|
||||
* {
|
||||
box-sizing: border-box;
|
||||
}
|
||||
|
||||
body {
|
||||
font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, "Helvetica Neue", Arial, sans-serif;
|
||||
line-height: 1.6;
|
||||
color: #222;
|
||||
background: #fafafa;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
}
|
||||
|
||||
.page {
|
||||
max-width: 600px;
|
||||
margin: 0 auto;
|
||||
padding: 2rem;
|
||||
min-height: 100vh;
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
justify-content: center;
|
||||
}
|
||||
|
||||
.page-center {
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
h1 {
|
||||
font-size: 2.5rem;
|
||||
margin-bottom: 1rem;
|
||||
color: #444;
|
||||
}
|
||||
|
||||
.brand-mark {
|
||||
position: fixed;
|
||||
left: 1rem;
|
||||
top: 1rem;
|
||||
font-size: 0.85rem;
|
||||
letter-spacing: 0.2em;
|
||||
text-transform: uppercase;
|
||||
color: #777;
|
||||
}
|
||||
|
||||
.brand-version {
|
||||
position: fixed;
|
||||
right: 1rem;
|
||||
bottom: 1rem;
|
||||
font-size: 0.85rem;
|
||||
letter-spacing: 0.2em;
|
||||
text-transform: uppercase;
|
||||
color: #777;
|
||||
}
|
||||
|
||||
.page-center h1 {
|
||||
margin-bottom: 0.5rem;
|
||||
}
|
||||
|
||||
p {
|
||||
font-size: 1.1rem;
|
||||
color: #666;
|
||||
}
|
||||
|
||||
.form-group {
|
||||
margin-bottom: 1.5rem;
|
||||
}
|
||||
|
||||
#shorten-form {
|
||||
max-width: 420px;
|
||||
margin: 0 auto;
|
||||
}
|
||||
|
||||
label {
|
||||
display: block;
|
||||
margin-bottom: 0.5rem;
|
||||
color: #444;
|
||||
font-weight: 500;
|
||||
}
|
||||
|
||||
input[type="url"] {
|
||||
width: 100%;
|
||||
padding: 0.75rem;
|
||||
font-size: 1rem;
|
||||
border: 1px solid #ddd;
|
||||
border-radius: 4px;
|
||||
}
|
||||
|
||||
input[type="url"]:focus {
|
||||
outline: none;
|
||||
border-color: #444;
|
||||
}
|
||||
|
||||
button {
|
||||
width: 100%;
|
||||
padding: 0.75rem;
|
||||
font-size: 1rem;
|
||||
background-color: #444;
|
||||
color: white;
|
||||
border: none;
|
||||
border-radius: 4px;
|
||||
cursor: pointer;
|
||||
font-weight: 500;
|
||||
}
|
||||
|
||||
button:hover {
|
||||
background-color: #333;
|
||||
}
|
||||
|
||||
button:disabled {
|
||||
background-color: #999;
|
||||
cursor: not-allowed;
|
||||
}
|
||||
|
||||
.result {
|
||||
margin-top: 2rem;
|
||||
padding: 1rem;
|
||||
border-radius: 4px;
|
||||
display: none;
|
||||
}
|
||||
|
||||
.result.success {
|
||||
background-color: #e8f5e9;
|
||||
border: 1px solid #4caf50;
|
||||
color: #2e7d32;
|
||||
}
|
||||
|
||||
.result.error {
|
||||
background-color: #ffebee;
|
||||
border: 1px solid #f44336;
|
||||
color: #c62828;
|
||||
}
|
||||
|
||||
.result.show {
|
||||
display: block;
|
||||
}
|
||||
|
||||
.short-url {
|
||||
word-break: break-all;
|
||||
font-weight: 500;
|
||||
margin-top: 0.5rem;
|
||||
}
|
||||
|
||||
.short-url a {
|
||||
color: #2e7d32;
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
.short-url a:hover {
|
||||
text-decoration: underline;
|
||||
}
|
||||
|
||||
.error-message {
|
||||
margin-top: 0.5rem;
|
||||
}
|
||||
|
||||
.link-home {
|
||||
display: inline-block;
|
||||
margin-top: 1.5rem;
|
||||
color: #444;
|
||||
text-decoration: none;
|
||||
border-bottom: 1px solid #444;
|
||||
}
|
||||
|
||||
.link-home:hover {
|
||||
color: #333;
|
||||
border-color: #333;
|
||||
}
|
||||
BIN
public/favicon.ico
Normal file
BIN
public/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 173 B |
@@ -26,7 +26,7 @@ groupadd urupam
|
||||
useradd -s /bin/bash -g urupam -d /opt/urupam urupam
|
||||
|
||||
# deploy code
|
||||
cp -r bin lib cpan* /opt/urupam
|
||||
cp -r bin lib cpanfile* public templates /opt/urupam
|
||||
chown -R urupam:urupam /opt/urupam
|
||||
|
||||
# install dependencies
|
||||
|
||||
104
t/02_app.t
Normal file
104
t/02_app.t
Normal file
@@ -0,0 +1,104 @@
|
||||
use Test::More;
|
||||
use Test::Mojo;
|
||||
use Mojo::Promise;
|
||||
use Urupam::App;
|
||||
|
||||
use_ok('Urupam::App');
|
||||
|
||||
package Mock::DB;
|
||||
use Mojo::Base -base;
|
||||
use Mojo::Promise;
|
||||
|
||||
has ping_cb => sub {
|
||||
sub { Mojo::Promise->resolve(1) }
|
||||
};
|
||||
|
||||
sub ping {
|
||||
my ( $self, @args ) = @_;
|
||||
return $self->ping_cb->( $self, @args );
|
||||
}
|
||||
|
||||
package Mock::Validator;
|
||||
use Mojo::Base -base;
|
||||
|
||||
has validate_short_code_cb => sub {
|
||||
sub { 1 }
|
||||
};
|
||||
|
||||
sub validate_short_code {
|
||||
my ( $self, $code ) = @_;
|
||||
return $self->validate_short_code_cb->( $self, $code );
|
||||
}
|
||||
|
||||
package Mock::URLService;
|
||||
use Mojo::Base -base;
|
||||
use Mojo::Promise;
|
||||
|
||||
has get_original_url_cb => sub {
|
||||
sub { Mojo::Promise->resolve('https://example.com') }
|
||||
};
|
||||
|
||||
sub get_original_url {
|
||||
my ( $self, $code ) = @_;
|
||||
return $self->get_original_url_cb->( $self, $code );
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
my $t = Test::Mojo->new('Urupam::App');
|
||||
my $db = Mock::DB->new;
|
||||
my $validator = Mock::Validator->new;
|
||||
my $url_service = Mock::URLService->new;
|
||||
|
||||
$t->app->helper( db => sub { $db } );
|
||||
$t->app->helper( validator => sub { $validator } );
|
||||
$t->app->helper( url_service => sub { $url_service } );
|
||||
|
||||
sub reset_mocks {
|
||||
$db->ping_cb( sub { Mojo::Promise->resolve(1) } );
|
||||
$validator->validate_short_code_cb( sub { 1 } );
|
||||
$url_service->get_original_url_cb(
|
||||
sub { Mojo::Promise->resolve('https://example.com') } );
|
||||
}
|
||||
|
||||
subtest 'GET /health' => sub {
|
||||
reset_mocks();
|
||||
$t->get_ok('/health')->status_is(200)->json_is( '/status' => 'ok' );
|
||||
|
||||
reset_mocks();
|
||||
$db->ping_cb( sub { Mojo::Promise->reject('boom') } );
|
||||
$t->get_ok('/health')
|
||||
->status_is(503)
|
||||
->json_is( '/status' => 'error' )
|
||||
->json_is( '/error' => 'Database connection failed' );
|
||||
};
|
||||
|
||||
subtest 'GET / - index template' => sub {
|
||||
reset_mocks();
|
||||
$t->get_ok('/')->status_is(200)->content_like(qr/urupam/i);
|
||||
};
|
||||
|
||||
subtest 'GET /:short_code' => sub {
|
||||
reset_mocks();
|
||||
$validator->validate_short_code_cb( sub { 0 } );
|
||||
$t->get_ok('/bad@code')->status_is(404)->content_like(qr/404 Not Found/);
|
||||
|
||||
reset_mocks();
|
||||
$url_service->get_original_url_cb( sub { Mojo::Promise->resolve(undef) } );
|
||||
$t->get_ok('/AbCdEf123456')
|
||||
->status_is(404)
|
||||
->content_like(qr/404 Not Found/);
|
||||
|
||||
reset_mocks();
|
||||
$t->get_ok('/AbCdEf123456')
|
||||
->status_is(302)
|
||||
->header_is( Location => 'https://example.com' );
|
||||
|
||||
reset_mocks();
|
||||
$url_service->get_original_url_cb( sub { Mojo::Promise->reject('boom') } );
|
||||
$t->get_ok('/AbCdEf123456')
|
||||
->status_is(500)
|
||||
->content_like(qr/500 Internal Server Error/);
|
||||
};
|
||||
|
||||
done_testing();
|
||||
95
t/03_db.t
Normal file
95
t/03_db.t
Normal file
@@ -0,0 +1,95 @@
|
||||
use Test::More;
|
||||
use Test::MockObject;
|
||||
use Mojo::Promise;
|
||||
use Urupam::DB;
|
||||
|
||||
use_ok('Urupam::DB');
|
||||
|
||||
sub wait_promise {
|
||||
my ($promise) = @_;
|
||||
my ( $value, $error );
|
||||
$promise->then( sub { $value = shift } )
|
||||
->catch( sub { $error = shift } )
|
||||
->wait;
|
||||
return ( $value, $error );
|
||||
}
|
||||
|
||||
sub mock_redis_method {
|
||||
my ( $method, $err, $result ) = @_;
|
||||
my $mock_redis = Test::MockObject->new;
|
||||
$mock_redis->mock(
|
||||
$method,
|
||||
sub {
|
||||
my ( $self, @args ) = @_;
|
||||
my $cb = pop @args;
|
||||
$cb->( $self, $err, $result );
|
||||
}
|
||||
);
|
||||
return $mock_redis;
|
||||
}
|
||||
|
||||
sub test_method {
|
||||
my ( $name, $method, $args, $success_cases, $error_cases ) = @_;
|
||||
my $db = Urupam::DB->new;
|
||||
|
||||
for my $case (@$success_cases) {
|
||||
my ( $expected, $err, $result, $desc ) = @$case;
|
||||
my $mock_redis = mock_redis_method( $method, $err, $result );
|
||||
$db->redis($mock_redis);
|
||||
my ( $value, $error ) = wait_promise( $db->$method(@$args) );
|
||||
is( $value, $expected, "$name success: $desc" );
|
||||
is( $error, undef, "$name success: no error" );
|
||||
}
|
||||
|
||||
for my $case (@$error_cases) {
|
||||
my ( $err, $desc ) = @$case;
|
||||
my $mock_redis = mock_redis_method( $method, $err, undef );
|
||||
$db->redis($mock_redis);
|
||||
my ( $value, $error ) = wait_promise( $db->$method(@$args) );
|
||||
is( $value, undef, "$name error: $desc" );
|
||||
is( $error, $err, "$name error: error returned" );
|
||||
}
|
||||
}
|
||||
|
||||
subtest 'get' => sub {
|
||||
test_method(
|
||||
'get',
|
||||
'get',
|
||||
['test_key'],
|
||||
[ [ 'test_value', undef, 'test_value', 'returns correct value' ] ],
|
||||
[ [ 'Connection error', 'error is returned' ] ]
|
||||
);
|
||||
};
|
||||
|
||||
subtest 'setnx' => sub {
|
||||
test_method(
|
||||
'setnx', 'setnx',
|
||||
[ 'test_key', 'test_value' ],
|
||||
[
|
||||
[ 1, undef, 1, 'returns 1 when key is set' ],
|
||||
[ 0, undef, 0, 'returns 0 when key already exists' ],
|
||||
],
|
||||
[ [ 'Setnx error', 'error is returned' ] ]
|
||||
);
|
||||
};
|
||||
|
||||
subtest 'ping' => sub {
|
||||
test_method(
|
||||
'ping', 'ping', [],
|
||||
[ [ 'PONG', undef, 'PONG', 'returns PONG' ] ],
|
||||
[ [ 'Connection lost', 'error is returned' ] ]
|
||||
);
|
||||
};
|
||||
|
||||
subtest 'redis attribute' => sub {
|
||||
my $new_db = Urupam::DB->new;
|
||||
ok( $new_db->redis, 'redis attribute is initialized' );
|
||||
isa_ok( $new_db->redis, 'Mojo::Redis2',
|
||||
'redis is a Mojo::Redis2 instance' );
|
||||
|
||||
my $custom_redis = Test::MockObject->new;
|
||||
my $custom_db = Urupam::DB->new( redis => $custom_redis );
|
||||
is( $custom_db->redis, $custom_redis, 'custom redis instance is set' );
|
||||
};
|
||||
|
||||
done_testing();
|
||||
183
t/04_url.t
Normal file
183
t/04_url.t
Normal file
@@ -0,0 +1,183 @@
|
||||
use Test::More;
|
||||
use Mojo::Promise;
|
||||
use Urupam::URL;
|
||||
|
||||
use_ok('Urupam::URL');
|
||||
|
||||
package Mock::DB;
|
||||
use Mojo::Base -base;
|
||||
use Mojo::Promise;
|
||||
|
||||
has setnx_cb => sub {
|
||||
sub { Mojo::Promise->resolve(1) }
|
||||
};
|
||||
|
||||
has get_cb => sub {
|
||||
sub { Mojo::Promise->resolve('https://example.com') }
|
||||
};
|
||||
|
||||
sub setnx {
|
||||
my ( $self, $key, $value ) = @_;
|
||||
return $self->setnx_cb->( $self, $key, $value );
|
||||
}
|
||||
|
||||
sub get {
|
||||
my ( $self, $key ) = @_;
|
||||
return $self->get_cb->( $self, $key );
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
my $db = Mock::DB->new;
|
||||
my $url = Urupam::URL->new( db => $db );
|
||||
|
||||
sub wait_promise {
|
||||
my ($promise) = @_;
|
||||
my ( $value, $error );
|
||||
$promise->then( sub { $value = shift } )
|
||||
->catch( sub { $error = shift } )
|
||||
->wait;
|
||||
return ( $value, $error );
|
||||
}
|
||||
|
||||
sub reset_db {
|
||||
$db->setnx_cb( sub { Mojo::Promise->resolve(1) } );
|
||||
$db->get_cb( sub { Mojo::Promise->resolve('https://example.com') } );
|
||||
}
|
||||
|
||||
subtest '_validate_short_code' => sub {
|
||||
my @valid = ( [ 'AbCdEf123456', 'valid short code passes' ], );
|
||||
my @invalid = (
|
||||
[ 'short', 'short code length fails' ],
|
||||
[ 'AbCdEf1234567', 'long code length fails' ],
|
||||
[ 'AbCdEf12@456', 'invalid chars fail' ],
|
||||
[ undef, 'undef fails' ],
|
||||
);
|
||||
|
||||
for my $case (@valid) {
|
||||
ok( $url->_validate_short_code( $case->[0] ), $case->[1] );
|
||||
}
|
||||
|
||||
for my $case (@invalid) {
|
||||
ok( !$url->_validate_short_code( $case->[0] ), $case->[1] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'generate_short_code - invalid URL' => sub {
|
||||
my $long_url = 'http://example.com/' . ( 'a' x 2049 );
|
||||
my @cases = (
|
||||
[ '', qr/^Original URL is required$/, 'empty URL rejected' ],
|
||||
[ $long_url, qr/exceeds maximum length/, 'long URL rejected' ],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
my ( $value, $error ) =
|
||||
wait_promise( $url->generate_short_code( $case->[0] ) );
|
||||
is( $value, undef, 'invalid URL has no result' );
|
||||
like( $error, $case->[1], $case->[2] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'generate_short_code - success' => sub {
|
||||
my ( $value, $error ) =
|
||||
wait_promise( $url->generate_short_code('https://example.com') );
|
||||
is( $error, undef, 'no error for valid URL' );
|
||||
ok( defined $value, 'short code generated' );
|
||||
is( length($value), 12, 'short code length is 12' );
|
||||
like( $value, qr/^[0-9a-zA-Z\-_]+$/, 'short code matches pattern' );
|
||||
};
|
||||
|
||||
subtest 'create_short_url - custom code' => sub {
|
||||
reset_db();
|
||||
my ( $value, $error ) =
|
||||
wait_promise(
|
||||
$url->create_short_url( 'https://example.com', 'AbCdEf123456' ) );
|
||||
is( $error, undef, 'no error for custom code' );
|
||||
is( $value, 'AbCdEf123456', 'custom code is returned' );
|
||||
|
||||
my @cases = (
|
||||
[
|
||||
sub { reset_db(); },
|
||||
'bad',
|
||||
qr/^Invalid short code format$/,
|
||||
'invalid custom code rejected'
|
||||
],
|
||||
[
|
||||
sub {
|
||||
reset_db();
|
||||
$db->setnx_cb( sub { Mojo::Promise->resolve(0) } );
|
||||
},
|
||||
'AbCdEf123456',
|
||||
qr/^Database error: Short code already exists$/,
|
||||
'custom code collision rejected'
|
||||
],
|
||||
[
|
||||
sub {
|
||||
reset_db();
|
||||
$db->setnx_cb(
|
||||
sub { Mojo::Promise->reject('connection failed') } );
|
||||
},
|
||||
'AbCdEf123456',
|
||||
qr/^Database error: connection failed$/,
|
||||
'db error message is wrapped'
|
||||
],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
$case->[0]->();
|
||||
( $value, $error ) =
|
||||
wait_promise(
|
||||
$url->create_short_url( 'https://example.com', $case->[1] ) );
|
||||
is( $value, undef, 'custom code failure has no result' );
|
||||
like( $error, $case->[2], $case->[3] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'create_short_url - retry behavior' => sub {
|
||||
reset_db();
|
||||
$db->setnx_cb( sub { Mojo::Promise->resolve(0) } );
|
||||
{
|
||||
no warnings 'redefine';
|
||||
local *Urupam::URL::generate_short_code = sub {
|
||||
return Mojo::Promise->resolve('AbCdEf123456');
|
||||
};
|
||||
|
||||
my ( $value, $error ) =
|
||||
wait_promise( $url->create_short_url('https://example.com') );
|
||||
is( $value, undef, 'retry exhaustion has no result' );
|
||||
like(
|
||||
$error,
|
||||
qr/Failed to generate unique short code after retry/,
|
||||
'retry exhaustion returns error'
|
||||
);
|
||||
}
|
||||
|
||||
reset_db();
|
||||
$db->setnx_cb( sub { Mojo::Promise->resolve(1) } );
|
||||
my $calls = 0;
|
||||
{
|
||||
no warnings 'redefine';
|
||||
local *Urupam::URL::generate_short_code = sub {
|
||||
$calls++;
|
||||
return $calls == 1
|
||||
? Mojo::Promise->reject('Database error: connection failed')
|
||||
: Mojo::Promise->resolve('AbCdEf123456');
|
||||
};
|
||||
|
||||
my ( $value, $error ) =
|
||||
wait_promise( $url->create_short_url('https://example.com') );
|
||||
is( $error, undef, 'retry succeeds without error' );
|
||||
is( $value, 'AbCdEf123456', 'code returned after retry' );
|
||||
is( $calls, 2, 'retry invoked after database error' );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'get_original_url' => sub {
|
||||
reset_db();
|
||||
my ( $value, $error ) =
|
||||
wait_promise( $url->get_original_url('AbCdEf123456') );
|
||||
is( $error, undef, 'get_original_url has no error' );
|
||||
is( $value, 'https://example.com', 'returns stored URL' );
|
||||
};
|
||||
|
||||
done_testing();
|
||||
214
t/05_utils.t
214
t/05_utils.t
@@ -4,61 +4,68 @@ use Urupam::Utils ();
|
||||
use_ok('Urupam::Utils');
|
||||
|
||||
subtest 'sanitize_input' => sub {
|
||||
is( Urupam::Utils::sanitize_input(undef), '', 'undef becomes empty' );
|
||||
is( Urupam::Utils::sanitize_input(" spaced out\t\n"),
|
||||
'spaced out', 'trims leading and trailing whitespace' );
|
||||
is( Urupam::Utils::sanitize_input('a b'),
|
||||
'a b', 'preserves internal whitespace' );
|
||||
is( Urupam::Utils::sanitize_input(0), '0', 'handles numeric zero' );
|
||||
is( Urupam::Utils::sanitize_input('0'), '0', 'handles string zero' );
|
||||
my @cases = (
|
||||
[ undef, '', 'undef becomes empty' ],
|
||||
[ " spaced out\t\n", 'spaced out', 'trims leading/trailing' ],
|
||||
[ 'a b', 'a b', 'preserves internal whitespace' ],
|
||||
[ 0, '0', 'handles numeric zero' ],
|
||||
[ '0', '0', 'handles string zero' ],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
is( Urupam::Utils::sanitize_input( $case->[0] ),
|
||||
$case->[1], $case->[2] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'get_error_status' => sub {
|
||||
is( Urupam::Utils::get_error_status('SSL certificate error'),
|
||||
422, 'SSL error maps to 422' );
|
||||
is( Urupam::Utils::get_error_status('Cannot reach URL: timeout'),
|
||||
422, 'connection error maps to 422' );
|
||||
is( Urupam::Utils::get_error_status('DNS resolution failed'),
|
||||
422, 'DNS error maps to 422' );
|
||||
is( Urupam::Utils::get_error_status('server error: 500'),
|
||||
422, 'server error maps to 422' );
|
||||
is( Urupam::Utils::get_error_status('SeRvEr ErRoR'),
|
||||
422, 'mixed case matches' );
|
||||
is( Urupam::Utils::get_error_status('Database error: connection failed'),
|
||||
400, 'default maps to 400' );
|
||||
is( Urupam::Utils::get_error_status('unrelated error'),
|
||||
400, 'non-matching message maps to 400' );
|
||||
my @cases = (
|
||||
[ 'SSL certificate error', 422, 'SSL error maps to 422' ],
|
||||
[ 'Cannot reach URL: timeout', 422, 'connection error maps to 422' ],
|
||||
[ 'DNS resolution failed', 422, 'DNS error maps to 422' ],
|
||||
[ 'server error: 500', 422, 'server error maps to 422' ],
|
||||
[ 'SeRvEr ErRoR', 422, 'mixed case matches' ],
|
||||
[ 'Database error: connection failed', 400, 'default maps to 400' ],
|
||||
[ 'unrelated error', 400, 'non-matching message maps to 400' ],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
is( Urupam::Utils::get_error_status( $case->[0] ),
|
||||
$case->[1], $case->[2] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'sanitize_error_message' => sub {
|
||||
is(
|
||||
Urupam::Utils::sanitize_error_message(undef),
|
||||
'An error occurred',
|
||||
'undef gets default message'
|
||||
);
|
||||
is(
|
||||
Urupam::Utils::sanitize_error_message("Database error: <bad>\n\t!!"),
|
||||
'Database error: bad',
|
||||
'strips unsafe chars and collapses whitespace'
|
||||
);
|
||||
is(
|
||||
Urupam::Utils::sanitize_error_message('Allowed: ./-_: ok'),
|
||||
'Allowed: ./-_: ok',
|
||||
'preserves allowed punctuation'
|
||||
);
|
||||
is(
|
||||
Urupam::Utils::sanitize_error_message("Error with spaces"),
|
||||
'Error with spaces',
|
||||
'collapses multiple spaces'
|
||||
);
|
||||
is( Urupam::Utils::sanitize_error_message("Bad\x01\x02Chars"),
|
||||
'BadChars', 'strips control characters' );
|
||||
is(
|
||||
Urupam::Utils::sanitize_error_message("Cafe\x{00E9} error"),
|
||||
"Cafe\x{00E9} error",
|
||||
'preserves Unicode characters'
|
||||
my @cases = (
|
||||
[ undef, 'An error occurred', 'undef gets default message' ],
|
||||
[
|
||||
"Database error: <bad>\n\t!!",
|
||||
'Database error: bad',
|
||||
'strips unsafe chars and collapses whitespace'
|
||||
],
|
||||
[
|
||||
'Allowed: ./-_: ok',
|
||||
'Allowed: ./-_: ok',
|
||||
'preserves allowed punctuation'
|
||||
],
|
||||
[
|
||||
"Error with spaces",
|
||||
'Error with spaces',
|
||||
'collapses multiple spaces'
|
||||
],
|
||||
[ "Bad\x01\x02Chars", 'BadChars', 'strips control characters' ],
|
||||
[
|
||||
"Cafe\x{00E9} error",
|
||||
"Cafe\x{00E9} error",
|
||||
'preserves Unicode characters'
|
||||
],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
is( Urupam::Utils::sanitize_error_message( $case->[0] ),
|
||||
$case->[1], $case->[2] );
|
||||
}
|
||||
|
||||
my $long_error = 'Error: ' . ( 'a' x 210 );
|
||||
my $expected = substr( $long_error, 0, 200 ) . '...';
|
||||
is( Urupam::Utils::sanitize_error_message($long_error),
|
||||
@@ -66,51 +73,76 @@ subtest 'sanitize_error_message' => sub {
|
||||
};
|
||||
|
||||
subtest 'sanitize_url' => sub {
|
||||
is( Urupam::Utils::sanitize_url(undef), undef, 'undef stays undef' );
|
||||
is( Urupam::Utils::sanitize_url(' '), undef, 'blank is undef' );
|
||||
is( Urupam::Utils::sanitize_url('example.com/path'),
|
||||
'http://example.com/path', 'adds scheme when missing' );
|
||||
is( Urupam::Utils::sanitize_url(' example.com/path '),
|
||||
'http://example.com/path', 'trims before processing' );
|
||||
is( Urupam::Utils::sanitize_url('https://example.com/path'),
|
||||
'https://example.com/path', 'preserves http(s) scheme' );
|
||||
is( Urupam::Utils::sanitize_url('http://example.com'),
|
||||
'http://example.com', 'does not double-add scheme' );
|
||||
is( Urupam::Utils::sanitize_url('HTTP://Example.com/Path'),
|
||||
'HTTP://Example.com/Path', 'accepts mixed-case scheme' );
|
||||
is( Urupam::Utils::sanitize_url('https://example.com/%7Euser'),
|
||||
'https://example.com/~user', 'unescapes percent-encoded path' );
|
||||
is(
|
||||
Urupam::Utils::sanitize_url('https://example.com/%7Euser%2Fdocs'),
|
||||
'https://example.com/~user/docs',
|
||||
'unescapes multiple percent-encoded segments'
|
||||
my @cases = (
|
||||
[ undef, undef, 'undef stays undef' ],
|
||||
[ ' ', undef, 'blank is undef' ],
|
||||
[
|
||||
'example.com/path', 'http://example.com/path',
|
||||
'adds scheme when missing'
|
||||
],
|
||||
[
|
||||
' example.com/path ',
|
||||
'http://example.com/path',
|
||||
'trims before processing'
|
||||
],
|
||||
[
|
||||
'https://example.com/path', 'https://example.com/path',
|
||||
'preserves http(s) scheme'
|
||||
],
|
||||
[
|
||||
'http://example.com', 'http://example.com',
|
||||
'does not double-add scheme'
|
||||
],
|
||||
[
|
||||
'HTTP://Example.com/Path', 'HTTP://Example.com/Path',
|
||||
'accepts mixed-case scheme'
|
||||
],
|
||||
[
|
||||
'https://example.com/%7Euser', 'https://example.com/~user',
|
||||
'unescapes percent-encoded path'
|
||||
],
|
||||
[
|
||||
'https://example.com/%7Euser%2Fdocs',
|
||||
'https://example.com/~user/docs',
|
||||
'unescapes multiple percent-encoded segments'
|
||||
],
|
||||
[
|
||||
'https://fr.wikipedia.org/wiki/Pic_L%C3%A9nine',
|
||||
'https://fr.wikipedia.org/wiki/Pic_L%C3%A9nine',
|
||||
'preserves UTF-8 percent-encoded path'
|
||||
],
|
||||
[
|
||||
'https://example.com?q=hello%20world',
|
||||
'https://example.com?q=hello%20world',
|
||||
'preserves percent-encoded query'
|
||||
],
|
||||
[
|
||||
'https://example.com#frag%20ment',
|
||||
'https://example.com#frag%20ment',
|
||||
'preserves percent-encoded fragment'
|
||||
],
|
||||
[
|
||||
'https://example.com/%257Euser', 'https://example.com/%7Euser',
|
||||
'unescapes only once'
|
||||
],
|
||||
[
|
||||
'https://ex%61mple.com/path', undef,
|
||||
'rejects percent-encoded hostname'
|
||||
],
|
||||
[ 'example.com:8080/path', undef, 'rejects missing scheme with colon' ],
|
||||
[ 'user@example.com', undef, 'rejects missing scheme with at-sign' ],
|
||||
[
|
||||
'http://user@example.com/path', undef,
|
||||
'rejects userinfo with scheme'
|
||||
],
|
||||
[ 'http://[::1]/path', 'http://[::1]/path', 'accepts IPv6 host' ],
|
||||
[ 'http://[::1/path', undef, 'rejects malformed IPv6 host' ],
|
||||
[ 'http://exa mple.com/path', undef, 'rejects whitespace in host' ],
|
||||
);
|
||||
is(
|
||||
Urupam::Utils::sanitize_url('https://example.com?q=hello%20world'),
|
||||
'https://example.com?q=hello%20world',
|
||||
'preserves percent-encoded query'
|
||||
);
|
||||
is(
|
||||
Urupam::Utils::sanitize_url('https://example.com#frag%20ment'),
|
||||
'https://example.com#frag%20ment',
|
||||
'preserves percent-encoded fragment'
|
||||
);
|
||||
is( Urupam::Utils::sanitize_url('https://example.com/%257Euser'),
|
||||
'https://example.com/%7Euser', 'unescapes only once' );
|
||||
is( Urupam::Utils::sanitize_url('https://ex%61mple.com/path'),
|
||||
undef, 'rejects percent-encoded hostname' );
|
||||
is( Urupam::Utils::sanitize_url('example.com:8080/path'),
|
||||
undef, 'rejects missing scheme with colon' );
|
||||
is( Urupam::Utils::sanitize_url('user@example.com'),
|
||||
undef, 'rejects missing scheme with at-sign' );
|
||||
is( Urupam::Utils::sanitize_url('http://user@example.com/path'),
|
||||
undef, 'rejects userinfo with scheme' );
|
||||
is( Urupam::Utils::sanitize_url('http://[::1]/path'),
|
||||
'http://[::1]/path', 'accepts IPv6 host' );
|
||||
is( Urupam::Utils::sanitize_url('http://[::1/path'),
|
||||
undef, 'rejects malformed IPv6 host' );
|
||||
is( Urupam::Utils::sanitize_url('http://exa mple.com/path'),
|
||||
undef, 'rejects whitespace in host' );
|
||||
|
||||
for my $case (@cases) {
|
||||
is( Urupam::Utils::sanitize_url( $case->[0] ), $case->[1], $case->[2] );
|
||||
}
|
||||
};
|
||||
|
||||
done_testing();
|
||||
|
||||
818
t/06_validation.t
Normal file
818
t/06_validation.t
Normal file
@@ -0,0 +1,818 @@
|
||||
use Test::More;
|
||||
use Test::MockObject;
|
||||
use Mojo::Promise;
|
||||
use Urupam::Validation;
|
||||
use Socket qw(AF_INET);
|
||||
|
||||
use_ok('Urupam::Validation');
|
||||
|
||||
my $validator = Urupam::Validation->new;
|
||||
|
||||
sub wait_promise {
|
||||
my ($promise) = @_;
|
||||
my ( $value, $error );
|
||||
$promise->then( sub { $value = shift } )
|
||||
->catch( sub { $error = shift } )
|
||||
->wait;
|
||||
return ( $value, $error );
|
||||
}
|
||||
|
||||
sub mock_ua_with_code {
|
||||
my ($code) = @_;
|
||||
my $mock_ua = Test::MockObject->new;
|
||||
my $mock_tx = Test::MockObject->new;
|
||||
my $mock_result = Test::MockObject->new;
|
||||
my $mock_get_tx = Test::MockObject->new;
|
||||
my $mock_get_result = Test::MockObject->new;
|
||||
|
||||
$mock_result->mock( 'code', sub { $code } );
|
||||
$mock_tx->mock( 'result', sub { $mock_result } );
|
||||
$mock_get_result->mock( 'code', sub { $code } );
|
||||
$mock_get_tx->mock( 'result', sub { $mock_get_result } );
|
||||
$mock_ua->mock(
|
||||
'head_p',
|
||||
sub {
|
||||
return Mojo::Promise->resolve($mock_tx);
|
||||
}
|
||||
);
|
||||
$mock_ua->mock(
|
||||
'get_p',
|
||||
sub {
|
||||
return Mojo::Promise->resolve($mock_get_tx);
|
||||
}
|
||||
);
|
||||
|
||||
return $mock_ua;
|
||||
}
|
||||
|
||||
sub mock_ua_with_error {
|
||||
my ($error) = @_;
|
||||
my $mock_ua = Test::MockObject->new;
|
||||
$mock_ua->mock(
|
||||
'head_p',
|
||||
sub {
|
||||
return Mojo::Promise->reject($error);
|
||||
}
|
||||
);
|
||||
$mock_ua->mock(
|
||||
'get_p',
|
||||
sub {
|
||||
return Mojo::Promise->reject($error);
|
||||
}
|
||||
);
|
||||
return $mock_ua;
|
||||
}
|
||||
|
||||
sub with_resolved_addresses {
|
||||
my ( $addresses, $code ) = @_;
|
||||
no warnings 'redefine';
|
||||
local *Urupam::Validation::_resolve_host = sub {
|
||||
return Mojo::Promise->resolve($addresses);
|
||||
};
|
||||
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 {
|
||||
ok( $validator->is_valid_url_length('http://example.com'),
|
||||
'valid URL length passes' );
|
||||
ok( !$validator->is_valid_url_length(undef), 'undef fails length check' );
|
||||
ok(
|
||||
!$validator->is_valid_url_length(''),
|
||||
'empty string fails length check'
|
||||
);
|
||||
ok( $validator->is_valid_url_length( 'a' x 2048 ),
|
||||
'exactly 2048 characters passes' );
|
||||
ok( !$validator->is_valid_url_length( 'a' x 2049 ),
|
||||
'2049 characters fails' );
|
||||
ok(
|
||||
$validator->is_valid_url_length(
|
||||
'http://example.com/' . ( 'a' x 2000 )
|
||||
),
|
||||
'long URL within limit passes'
|
||||
);
|
||||
};
|
||||
|
||||
subtest '_classify_error' => sub {
|
||||
is( $validator->_classify_error('SSL certificate verification failed'),
|
||||
'ssl', 'classifies SSL errors' );
|
||||
is( $validator->_classify_error('Name or service not known'),
|
||||
'dns', 'classifies DNS errors' );
|
||||
is( $validator->_classify_error('Connection refused'),
|
||||
'connection', 'classifies connection errors' );
|
||||
is( $validator->_classify_error('unexpected failure'),
|
||||
'unknown', 'classifies unknown errors' );
|
||||
};
|
||||
|
||||
subtest '_format_error_message' => sub {
|
||||
is(
|
||||
$validator->_format_error_message( 'ssl', 'bad cert' ),
|
||||
'SSL certificate error: bad cert',
|
||||
'formats SSL errors'
|
||||
);
|
||||
is(
|
||||
$validator->_format_error_message( 'dns', 'timeout' ),
|
||||
'DNS resolution failed: timeout',
|
||||
'formats DNS errors'
|
||||
);
|
||||
is(
|
||||
$validator->_format_error_message( 'connection', 'refused' ),
|
||||
'Cannot reach URL: refused',
|
||||
'formats connection errors'
|
||||
);
|
||||
is(
|
||||
$validator->_format_error_message( 'unknown', 'oops' ),
|
||||
'URL validation failed: oops',
|
||||
'formats unknown errors'
|
||||
);
|
||||
};
|
||||
|
||||
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 {
|
||||
my @valid = (
|
||||
[ '192.168.1.1', 'valid IPv4 passes' ],
|
||||
[ '0.0.0.0', '0.0.0.0 is valid' ],
|
||||
[ '255.255.255.255', '255.255.255.255 is valid' ],
|
||||
);
|
||||
my @invalid = (
|
||||
[ '256.1.1.1', 'octet > 255 fails' ],
|
||||
[ '192.168.1', 'missing octet fails' ],
|
||||
[ '192.168.1.1.1', 'extra octet fails' ],
|
||||
[ 'not.an.ip.address', 'non-numeric fails' ],
|
||||
[ '192.168.-1.1', 'negative octet fails' ],
|
||||
);
|
||||
|
||||
for my $case (@valid) {
|
||||
ok( $validator->_is_valid_ipv4( $case->[0] ), $case->[1] );
|
||||
}
|
||||
|
||||
for my $case (@invalid) {
|
||||
ok( !$validator->_is_valid_ipv4( $case->[0] ), $case->[1] );
|
||||
}
|
||||
|
||||
ok( !$validator->_is_valid_ipv4(undef), 'undef fails' );
|
||||
};
|
||||
|
||||
subtest '_is_private_ipv4' => sub {
|
||||
my @private = (
|
||||
[ '127.0.0.1', '127.0.0.1 is private' ],
|
||||
[ '192.168.1.1', '192.168.x.x is private' ],
|
||||
[ '10.0.0.1', '10.x.x.x is private' ],
|
||||
[ '172.16.0.1', '172.16.x.x is private' ],
|
||||
[ '172.31.255.255', '172.31.x.x is private' ],
|
||||
);
|
||||
my @public = (
|
||||
[ '172.15.0.1', '172.15.x.x is not private' ],
|
||||
[ '172.32.0.1', '172.32.x.x is not private' ],
|
||||
[ '8.8.8.8', '8.8.8.8 is not private' ],
|
||||
[ 'invalid', 'invalid IP is not private' ],
|
||||
);
|
||||
|
||||
for my $case (@private) {
|
||||
ok( $validator->_is_private_ipv4( $case->[0] ), $case->[1] );
|
||||
}
|
||||
|
||||
for my $case (@public) {
|
||||
ok( !$validator->_is_private_ipv4( $case->[0] ), $case->[1] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest '_is_private_ipv6' => sub {
|
||||
my @private = (
|
||||
[ '::1', '::1 is private' ],
|
||||
[ '[::1]', '[::1] is private' ],
|
||||
[ '::', ':: 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:10.0.0.1', '::ffff:10.0.0.1 is private' ],
|
||||
[ '::ffff:172.16.0.1', '::ffff:172.16.0.1 is private' ],
|
||||
[ 'fc00:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||
[ 'fcff:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||
[ 'fd00:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||
[ 'fdff:0:0:0:0:0:0:1', 'fc00::/7 (unique local) is private' ],
|
||||
[ 'fe80:0:0:0:0:0:0:1', 'fe80::/10 (link-local) is private' ],
|
||||
[ 'fe80:0:0:0:0:0:0:abcd', 'fe80::/10 (link-local) is private' ],
|
||||
[ 'febf:0:0:0:0:0:0:1', 'fe80::/10 (link-local) is private' ],
|
||||
);
|
||||
my @public = (
|
||||
[ '2001:db8::1', '2001:db8::1 is not private' ],
|
||||
[ '::ffff:8.8.8.8', '::ffff:8.8.8.8 is not private' ],
|
||||
[ 'fec0::1', 'fec0:: is not private (deprecated, but not blocked)' ],
|
||||
[ 'fec1::1', 'fec1:: is not private' ],
|
||||
[ 'invalid', 'invalid IPv6 is not private' ],
|
||||
);
|
||||
|
||||
for my $case (@private) {
|
||||
ok( $validator->_is_private_ipv6( $case->[0] ), $case->[1] );
|
||||
}
|
||||
|
||||
for my $case (@public) {
|
||||
ok( !$validator->_is_private_ipv6( $case->[0] ), $case->[1] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'is_blocked_url' => sub {
|
||||
my @blocked = (
|
||||
[ 'http://localhost/path', 'localhost is blocked' ],
|
||||
[ 'http://127.0.0.1/path', '127.0.0.1 is blocked' ],
|
||||
[ 'http://0.0.0.0/path', '0.0.0.0 is blocked' ],
|
||||
[ 'http://[::1]/path', '::1 is blocked' ],
|
||||
[ 'http://[::]/path', ':: 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://172.16.0.1/path', '172.16.0.1 is blocked' ],
|
||||
[
|
||||
'http://[fc00:0:0:0:0:0:0:1]/path',
|
||||
'fc00::/7 (unique 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 = (
|
||||
[ 'http://example.com/path', 'public domain is not blocked' ],
|
||||
[ 'http://8.8.8.8/path', 'public IP is not blocked' ],
|
||||
[ 'invalid url', 'invalid URL is not blocked' ],
|
||||
[ undef, 'undef is not blocked' ],
|
||||
);
|
||||
|
||||
with_resolved_addresses(
|
||||
[],
|
||||
sub {
|
||||
for my $case (@blocked) {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->is_blocked_url( $case->[0] ) );
|
||||
ok( $result, $case->[1] );
|
||||
is( $error, undef, "no error for $case->[1]" );
|
||||
}
|
||||
|
||||
for my $case (@allowed) {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->is_blocked_url( $case->[0] ) );
|
||||
ok( !$result, $case->[1] );
|
||||
is( $error, undef, "no error for $case->[1]" );
|
||||
}
|
||||
}
|
||||
);
|
||||
};
|
||||
|
||||
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 {
|
||||
my @valid = (
|
||||
[ 'abc123456789', 'alphanumeric code passes' ],
|
||||
[ 'ABC123456789', 'uppercase code passes' ],
|
||||
[ 'ab-123456789', 'code with dash passes' ],
|
||||
[ 'ab_123456789', 'code with underscore passes' ],
|
||||
[ '0123456789ab', '12 character code passes' ],
|
||||
);
|
||||
my @invalid = (
|
||||
[ 'abc@12345678', 'code with @ fails' ],
|
||||
[ 'abc.12345678', 'code with dot fails' ],
|
||||
[ 'abc 12345678', 'code with space fails' ],
|
||||
[ 'abc123', 'code too short fails' ],
|
||||
[ 'a', 'single character fails' ],
|
||||
[ 'abc123456789012345', 'code too long fails' ],
|
||||
[ '', 'empty code fails' ],
|
||||
[ undef, 'undef code fails' ],
|
||||
);
|
||||
|
||||
for my $case (@valid) {
|
||||
ok( $validator->validate_short_code( $case->[0] ), $case->[1] );
|
||||
}
|
||||
|
||||
for my $case (@invalid) {
|
||||
ok( !$validator->validate_short_code( $case->[0] ), $case->[1] );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'check_url_reachable - success codes' => sub {
|
||||
clear_validation_caches();
|
||||
for my $code ( 200, 201 ) {
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_code($code),
|
||||
sub {
|
||||
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 {
|
||||
clear_validation_caches();
|
||||
my @cases = (
|
||||
[ 410, qr/URL returned 410 error/, '4xx status returns error' ],
|
||||
[ 500, qr/URL returned 500 error/, '5xx status returns error' ],
|
||||
[ 100, qr/unexpected status/, 'unexpected status returns error' ],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
my $url = "http://example.com/$case->[0]";
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_code( $case->[0] ),
|
||||
sub {
|
||||
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 {
|
||||
clear_validation_caches();
|
||||
my $mock_ua = Test::MockObject->new;
|
||||
my $head_tx = Test::MockObject->new;
|
||||
my $head_result = Test::MockObject->new;
|
||||
my $get_tx = Test::MockObject->new;
|
||||
my $get_result = Test::MockObject->new;
|
||||
|
||||
$head_result->mock( 'code', sub { 404 } );
|
||||
$head_tx->mock( 'result', sub { $head_result } );
|
||||
|
||||
$get_result->mock( 'code', sub { 200 } );
|
||||
$get_tx->mock( 'result', sub { $get_result } );
|
||||
|
||||
$mock_ua->mock(
|
||||
'head_p',
|
||||
sub {
|
||||
return Mojo::Promise->resolve($head_tx);
|
||||
}
|
||||
);
|
||||
$mock_ua->mock(
|
||||
'get_p',
|
||||
sub {
|
||||
return Mojo::Promise->resolve($get_tx);
|
||||
}
|
||||
);
|
||||
|
||||
my ( $result, $error );
|
||||
with_ssrf_ua(
|
||||
$mock_ua,
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->check_url_reachable('http://example.com') );
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, 1, 'GET fallback returns success' );
|
||||
is( $error, undef, 'GET fallback has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_url_reachable - HEAD fallback error' => sub {
|
||||
clear_validation_caches();
|
||||
my $mock_ua = Test::MockObject->new;
|
||||
my $head_tx = Test::MockObject->new;
|
||||
my $head_result = Test::MockObject->new;
|
||||
my $get_tx = Test::MockObject->new;
|
||||
my $get_result = Test::MockObject->new;
|
||||
|
||||
$head_result->mock( 'code', sub { 405 } );
|
||||
$head_tx->mock( 'result', sub { $head_result } );
|
||||
|
||||
$get_result->mock( 'code', sub { 500 } );
|
||||
$get_tx->mock( 'result', sub { $get_result } );
|
||||
|
||||
$mock_ua->mock(
|
||||
'head_p',
|
||||
sub {
|
||||
return Mojo::Promise->resolve($head_tx);
|
||||
}
|
||||
);
|
||||
$mock_ua->mock(
|
||||
'get_p',
|
||||
sub {
|
||||
return Mojo::Promise->resolve($get_tx);
|
||||
}
|
||||
);
|
||||
|
||||
my ( $result, $error );
|
||||
with_ssrf_ua(
|
||||
$mock_ua,
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->check_url_reachable('http://example.com') );
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, undef, 'GET fallback error has no result' );
|
||||
like( $error, qr/URL returned 500 error/, 'GET fallback error reported' );
|
||||
};
|
||||
|
||||
subtest 'check_url_reachable - classified errors' => sub {
|
||||
clear_validation_caches();
|
||||
my @cases = (
|
||||
[
|
||||
'Name or service not known',
|
||||
qr/DNS resolution failed/,
|
||||
'DNS error is classified'
|
||||
],
|
||||
[
|
||||
'SSL certificate verification failed',
|
||||
qr/SSL certificate error/,
|
||||
'SSL error is classified'
|
||||
],
|
||||
[
|
||||
'Connection refused',
|
||||
qr/Cannot reach URL/,
|
||||
'connection error is classified'
|
||||
],
|
||||
[
|
||||
'Some unknown error',
|
||||
qr/URL validation failed/,
|
||||
'unknown error is classified'
|
||||
],
|
||||
);
|
||||
|
||||
for my $case (@cases) {
|
||||
clear_validation_caches();
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_error( $case->[0] ),
|
||||
sub {
|
||||
my ( $result, $error ) = wait_promise(
|
||||
$validator->check_url_reachable('http://example.com') );
|
||||
is( $result, undef, 'no success result' );
|
||||
like( $error, $case->[1], $case->[2] );
|
||||
}
|
||||
);
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'check_url_reachable - missing URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_url_reachable(undef) );
|
||||
|
||||
is( $result, undef, 'missing URL has no result' );
|
||||
is( $error, 'URL is required', 'missing URL returns error' );
|
||||
};
|
||||
|
||||
subtest 'check_url_reachable - empty URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_url_reachable('') );
|
||||
|
||||
is( $result, undef, 'empty URL has no result' );
|
||||
is( $error, 'URL is required', 'empty URL returns error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - non-HTTPS URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('http://example.com') );
|
||||
|
||||
is( $result, 1, 'non-HTTPS URL passes without check' );
|
||||
is( $error, undef, 'non-HTTPS URL has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - HTTPS success' => sub {
|
||||
$validator->ua( mock_ua_with_code(200) );
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||
|
||||
is( $result, 1, 'valid SSL certificate passes' );
|
||||
is( $error, undef, 'valid SSL certificate has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - SSL error' => sub {
|
||||
$validator->ua( mock_ua_with_error('SSL certificate verification failed') );
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||
|
||||
is( $result, 1, 'SSL error is async' );
|
||||
is( $error, undef, 'SSL error has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - non-SSL error' => sub {
|
||||
$validator->ua( mock_ua_with_error('Connection refused') );
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||
|
||||
is( $result, 1, 'non-SSL error is async' );
|
||||
is( $error, undef, 'non-SSL error has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - DNS error' => sub {
|
||||
$validator->ua( mock_ua_with_error('Name or service not known') );
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||
|
||||
is( $result, 1, 'DNS error is async' );
|
||||
is( $error, undef, 'DNS error has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - unknown error' => sub {
|
||||
$validator->ua( mock_ua_with_error('Some unknown error') );
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('https://example.com') );
|
||||
|
||||
is( $result, 1, 'unknown error is async' );
|
||||
is( $error, undef, 'unknown error has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - missing URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate(undef) );
|
||||
|
||||
is( $result, 1, 'missing URL passes' );
|
||||
is( $error, undef, 'missing URL has no error' );
|
||||
};
|
||||
|
||||
subtest 'check_ssl_certificate - empty URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->check_ssl_certificate('') );
|
||||
|
||||
is( $result, 1, 'empty URL passes' );
|
||||
is( $error, undef, 'empty URL has no error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - missing URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks(undef) );
|
||||
|
||||
is( $result, undef, 'missing URL has no result' );
|
||||
is( $error, 'URL is required', 'missing URL returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - empty URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks('') );
|
||||
|
||||
is( $result, undef, 'empty URL has no result' );
|
||||
is( $error, 'URL is required', 'empty URL returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - invalid URL format' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks('not a url') );
|
||||
|
||||
is( $result, undef, 'invalid format has no result' );
|
||||
is( $error, 'Invalid URL format', 'invalid URL format returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - invalid scheme' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks('ftp://example.com') );
|
||||
|
||||
is( $result, undef, 'invalid scheme has no result' );
|
||||
is( $error, 'Invalid URL format', 'invalid scheme returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - missing host' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks('http://') );
|
||||
|
||||
is( $result, undef, 'missing host has no result' );
|
||||
is( $error, 'Invalid URL format', 'missing host returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - URL too long' => sub {
|
||||
my $long_url = 'http://example.com/' . ( 'a' x 2049 );
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks($long_url) );
|
||||
|
||||
is( $result, undef, 'URL too long has no result' );
|
||||
like( $error, qr/exceeds maximum length/, 'URL too long returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - blocked URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise(
|
||||
$validator->validate_url_with_checks('http://localhost/path') );
|
||||
|
||||
is( $result, undef, 'blocked URL has no result' );
|
||||
like( $error, qr/cannot be shortened/, 'blocked URL returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - blocked IPv6 URL' => sub {
|
||||
my ( $result, $error ) =
|
||||
wait_promise( $validator->validate_url_with_checks('http://[::1]/path') );
|
||||
|
||||
is( $result, undef, 'blocked IPv6 URL has no result' );
|
||||
like( $error, qr/cannot be shortened/, 'blocked IPv6 URL returns error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - HTTP success' => sub {
|
||||
$validator->ua( mock_ua_with_code(200) );
|
||||
my ( $result, $error );
|
||||
with_resolved_addresses(
|
||||
[],
|
||||
sub {
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_code(200),
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->validate_url_with_checks(
|
||||
'http://example.com/path')
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, 'http://example.com/path', 'valid HTTP URL passes' );
|
||||
is( $error, undef, 'valid HTTP URL has no error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - HTTPS success' => sub {
|
||||
$validator->ua( mock_ua_with_code(200) );
|
||||
my ( $result, $error );
|
||||
with_resolved_addresses(
|
||||
[],
|
||||
sub {
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_code(200),
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->validate_url_with_checks(
|
||||
'https://example.com/path')
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, 'https://example.com/path', 'valid HTTPS URL passes' );
|
||||
is( $error, undef, 'valid HTTPS URL has no error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - URL sanitization' => sub {
|
||||
$validator->ua( mock_ua_with_code(200) );
|
||||
my ( $result, $error );
|
||||
with_resolved_addresses(
|
||||
[],
|
||||
sub {
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_code(200),
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->validate_url_with_checks(
|
||||
'example.com/path')
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, 'http://example.com/path', 'URL is sanitized' );
|
||||
is( $error, undef, 'URL sanitization has no error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - SSL check failure' => sub {
|
||||
$validator->ua( mock_ua_with_error('SSL certificate verification failed') );
|
||||
my ( $result, $error );
|
||||
with_resolved_addresses(
|
||||
[],
|
||||
sub {
|
||||
with_ssrf_ua(
|
||||
mock_ua_with_code(200),
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->validate_url_with_checks(
|
||||
'https://example.com')
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, 'https://example.com', 'SSL check failure is async' );
|
||||
is( $error, undef, 'SSL check async has no error' );
|
||||
};
|
||||
|
||||
subtest 'validate_url_with_checks - reachability check failure' => sub {
|
||||
my $mock_ua = Test::MockObject->new;
|
||||
my $mock_tx = Test::MockObject->new;
|
||||
my $mock_result = Test::MockObject->new;
|
||||
my $call_count = 0;
|
||||
|
||||
$mock_result->mock( 'code', sub { 200 } );
|
||||
$mock_tx->mock( 'result', sub { $mock_result } );
|
||||
$mock_ua->mock(
|
||||
'head_p',
|
||||
sub {
|
||||
$call_count++;
|
||||
return $call_count == 1
|
||||
? Mojo::Promise->resolve($mock_tx)
|
||||
: Mojo::Promise->reject('Connection refused');
|
||||
}
|
||||
);
|
||||
|
||||
$validator->ua($mock_ua);
|
||||
|
||||
my ( $result, $error );
|
||||
with_resolved_addresses(
|
||||
[],
|
||||
sub {
|
||||
with_ssrf_ua(
|
||||
$mock_ua,
|
||||
sub {
|
||||
( $result, $error ) = wait_promise(
|
||||
$validator->validate_url_with_checks(
|
||||
'https://example.com')
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
is( $result, 'https://example.com', 'reachability failure is async' );
|
||||
is( $error, undef, 'reachability async has no error' );
|
||||
};
|
||||
|
||||
done_testing();
|
||||
253
t/integration.t
253
t/integration.t
@@ -2,7 +2,21 @@ use Test::More;
|
||||
use Test::Mojo;
|
||||
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_LENGTH = 12;
|
||||
@@ -16,12 +30,17 @@ sub validate_short_code_format {
|
||||
&& $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 {
|
||||
my ($url) = @_;
|
||||
my $tx = $t->post_ok( '/api/v1/urls' => json => { url => $url } );
|
||||
my $json = $tx->tx->res->json;
|
||||
my $error =
|
||||
ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
||||
my $tx = $t->post_ok( '/api/v1/urls' => json => { url => $url } );
|
||||
my $json = $tx->tx->res->json;
|
||||
my $error = ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
||||
return {
|
||||
tx => $tx,
|
||||
code => $tx->tx->res->code,
|
||||
@@ -32,10 +51,9 @@ sub post_shorten {
|
||||
|
||||
sub get_url {
|
||||
my ($code) = @_;
|
||||
my $tx = $t->get_ok("/api/v1/urls/$code");
|
||||
my $json = $tx->tx->res->json;
|
||||
my $error =
|
||||
ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
||||
my $tx = $t->get_ok("/api/v1/urls/$code");
|
||||
my $json = $tx->tx->res->json;
|
||||
my $error = ref $json eq 'HASH' ? ( $json->{error} // '' ) : '';
|
||||
return {
|
||||
tx => $tx,
|
||||
code => $tx->tx->res->code,
|
||||
@@ -52,6 +70,8 @@ sub validate_shorten_response {
|
||||
"$label: short code valid" );
|
||||
is( length( $json->{short_code} ),
|
||||
$CODE_LENGTH, "$label: short code length correct" );
|
||||
is( $json->{original_url}, $url, "$label: original URL matches" )
|
||||
if defined $url;
|
||||
like(
|
||||
$json->{short_url},
|
||||
qr/^https?:\/\/[^\/]+\/$json->{short_code}$/,
|
||||
@@ -81,39 +101,20 @@ sub validate_get_response {
|
||||
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 {
|
||||
for my $url ( 'https://www.example.com', 'http://www.perl.org' ) {
|
||||
my $res = post_shorten($url);
|
||||
if ( $res->{code} == 200 ) {
|
||||
validate_shorten_response( $res, $url, "URL: $url" );
|
||||
}
|
||||
else {
|
||||
diag( "Test skipped for $url: " . $res->{error} );
|
||||
}
|
||||
is( $res->{code}, 200, "URL accepted: $url" );
|
||||
validate_shorten_response( $res, $url, "URL: $url" );
|
||||
}
|
||||
};
|
||||
|
||||
subtest 'POST /api/v1/urls - Real validator URL normalization' => sub {
|
||||
for my $input ( 'www.example.com', 'example.com' ) {
|
||||
my $res = post_shorten($input);
|
||||
if ( $res->{code} == 200 ) {
|
||||
like( $res->{json}->{original_url},
|
||||
qr/^https?:\/\//, "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} );
|
||||
}
|
||||
is( $res->{code}, 200, "URL normalized: $input" );
|
||||
my $expected = expected_normalized_url($input);
|
||||
validate_shorten_response( $res, $expected, "URL normalized: $input" );
|
||||
}
|
||||
};
|
||||
|
||||
@@ -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 {
|
||||
for my $case (
|
||||
{
|
||||
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/,
|
||||
}
|
||||
)
|
||||
subtest 'POST /api/v1/urls - Real validator network errors (async)' => sub {
|
||||
for
|
||||
my $url ( 'http://nonexistent-domain-12345.invalid', 'http://192.0.2.1' )
|
||||
{
|
||||
my $res = post_shorten( $case->{url} );
|
||||
if ( $res->{code} == 422 ) {
|
||||
like( $res->{error}, $case->{error},
|
||||
"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} );
|
||||
my $res = post_shorten($url);
|
||||
is( $res->{code}, 200, "Network URL accepted asynchronously: $url" );
|
||||
validate_shorten_response( $res, $url, "URL: $url" );
|
||||
}
|
||||
};
|
||||
|
||||
@@ -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}" );
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
subtest 'POST /api/v1/urls - Real validator bare hostname' => sub {
|
||||
my $res = post_shorten('not-a-url');
|
||||
is( $res->{code}, 422, 'Unreachable host rejected: not-a-url' );
|
||||
like(
|
||||
$res->{error},
|
||||
qr/Cannot reach URL|DNS resolution failed|URL validation failed/,
|
||||
'Correct error for: not-a-url'
|
||||
);
|
||||
is( $res->{code}, 200, 'Bare hostname accepted: not-a-url' );
|
||||
validate_shorten_response( $res, 'http://not-a-url',
|
||||
'Bare hostname normalized' );
|
||||
};
|
||||
|
||||
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 =
|
||||
$base . ( 'a' x ( $MAX_URL_LENGTH - length($base) + 1 ) );
|
||||
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 {
|
||||
for my $url (
|
||||
'https://www.example.com?foo=bar',
|
||||
'https://www.example.com#section',
|
||||
'https://www.example.com:443',
|
||||
'https://www.example.com/path/to/resource',
|
||||
'https://www.example.com?foo=bar', 'https://www.example.com#section',
|
||||
'https://www.example.com:443', 'https://www.perl.org/about.html',
|
||||
)
|
||||
{
|
||||
my $res = post_shorten($url);
|
||||
if ( $res->{code} == 200 ) {
|
||||
ok( validate_short_code_format( $res->{json}->{short_code} ),
|
||||
"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} );
|
||||
}
|
||||
is( $res->{code}, 200, "Edge case handled: $url" );
|
||||
validate_shorten_response( $res, $url, "Edge case handled: $url" );
|
||||
}
|
||||
};
|
||||
|
||||
@@ -229,65 +194,49 @@ subtest 'POST /api/v1/urls - Real database persistence and retrieval' => sub {
|
||||
my $url = 'https://www.example.com';
|
||||
my $res1 = post_shorten($url);
|
||||
|
||||
if ( $res1->{code} == 200 ) {
|
||||
my $code = $res1->{json}->{short_code};
|
||||
ok( validate_short_code_format($code), 'Code generated and stored' );
|
||||
is( $res1->{code}, 200, 'Database write succeeded' );
|
||||
my $code = $res1->{json}->{short_code};
|
||||
ok( validate_short_code_format($code), 'Code generated and stored' );
|
||||
|
||||
my $res2 = get_url($code);
|
||||
if ( $res2->{code} == 200 ) {
|
||||
validate_get_response( $res2, $url, $code, 'Database retrieval' );
|
||||
pass('Database persistence verified');
|
||||
}
|
||||
else {
|
||||
diag( "Database retrieval failed: " . $res2->{error} );
|
||||
}
|
||||
}
|
||||
else {
|
||||
diag( "Database persistence test skipped: " . $res1->{error} );
|
||||
}
|
||||
my $res2 = get_url($code);
|
||||
is( $res2->{code}, 200, 'Database read succeeded' );
|
||||
validate_get_response( $res2, $url, $code, 'Database retrieval' );
|
||||
pass('Database persistence verified');
|
||||
};
|
||||
|
||||
subtest 'POST /api/v1/urls - Real database duplicate URL handling' => sub {
|
||||
my $url = 'https://www.example.com';
|
||||
my $res1 = post_shorten($url);
|
||||
|
||||
if ( $res1->{code} == 200 ) {
|
||||
my $code1 = $res1->{json}->{short_code};
|
||||
ok( validate_short_code_format($code1), 'First code generated' );
|
||||
is( $res1->{code}, 200, 'First create succeeded' );
|
||||
my $code1 = $res1->{json}->{short_code};
|
||||
ok( validate_short_code_format($code1), 'First code generated' );
|
||||
|
||||
my $res2 = post_shorten($url);
|
||||
if ( $res2->{code} == 200 ) {
|
||||
my $code2 = $res2->{json}->{short_code};
|
||||
ok( validate_short_code_format($code2), 'Second code generated' );
|
||||
ok( $code1 ne $code2, 'Duplicate URLs generate different codes' );
|
||||
my $res2 = post_shorten($url);
|
||||
is( $res2->{code}, 200, 'Second create succeeded' );
|
||||
my $code2 = $res2->{json}->{short_code};
|
||||
ok( validate_short_code_format($code2), 'Second code generated' );
|
||||
ok( $code1 ne $code2, 'Duplicate URLs generate different codes' );
|
||||
|
||||
my $get1 = get_url($code1);
|
||||
my $get2 = get_url($code2);
|
||||
my $get1 = get_url($code1);
|
||||
my $get2 = get_url($code2);
|
||||
|
||||
if ( $get1->{code} == 200 && $get2->{code} == 200 ) {
|
||||
is( $get1->{json}->{original_url},
|
||||
$url, 'First code retrieves original URL' );
|
||||
is( $get2->{json}->{original_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} );
|
||||
}
|
||||
is( $get1->{code}, 200, 'First code retrieves' );
|
||||
is( $get2->{code}, 200, 'Second code retrieves' );
|
||||
is( $get1->{json}->{original_url},
|
||||
$url, 'First code retrieves original URL' );
|
||||
is( $get2->{json}->{original_url},
|
||||
$url, 'Second code retrieves original URL' );
|
||||
pass('Both codes persist and retrieve same URL');
|
||||
};
|
||||
|
||||
subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
|
||||
my $res = get_url('nonexistent123456');
|
||||
is( $res->{code}, 404, 'Non-existent code returns 404' );
|
||||
is( $res->{code}, 400, 'Invalid format rejected: nonexistent123456' );
|
||||
is(
|
||||
$res->{error},
|
||||
'Short code not found',
|
||||
'Correct error message for non-existent code'
|
||||
'Invalid short code format',
|
||||
'Correct error for: nonexistent123456'
|
||||
);
|
||||
|
||||
$res = get_url('');
|
||||
@@ -295,47 +244,11 @@ subtest 'GET /api/v1/urls/:short_code - Real database error cases' => sub {
|
||||
|
||||
$res = get_url('invalid@code');
|
||||
is( $res->{code}, 400, 'Invalid format rejected: invalid@code' );
|
||||
is( $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} );
|
||||
}
|
||||
is(
|
||||
$res->{error},
|
||||
'Invalid short code format',
|
||||
'Correct error for: invalid@code'
|
||||
);
|
||||
};
|
||||
|
||||
done_testing();
|
||||
|
||||
7
templates/404.html.ep
Normal file
7
templates/404.html.ep
Normal file
@@ -0,0 +1,7 @@
|
||||
% layout 'default';
|
||||
% stash title => '404 Not Found';
|
||||
<main class="page page-center">
|
||||
<h1>404 Not Found</h1>
|
||||
<p>The requested short link was not found.</p>
|
||||
<a href="/" class="link-home">Back to home</a>
|
||||
</main>
|
||||
7
templates/500.html.ep
Normal file
7
templates/500.html.ep
Normal file
@@ -0,0 +1,7 @@
|
||||
% layout 'default';
|
||||
% stash title => '500 Internal Server Error';
|
||||
<main class="page page-center">
|
||||
<h1>500 Internal Server Error</h1>
|
||||
<p>An error occurred while processing your request.</p>
|
||||
<a href="/" class="link-home">Back to home</a>
|
||||
</main>
|
||||
91
templates/index.html.ep
Normal file
91
templates/index.html.ep
Normal file
@@ -0,0 +1,91 @@
|
||||
% layout 'default';
|
||||
% stash title => 'Urupam';
|
||||
<main class="page">
|
||||
<form id="shorten-form">
|
||||
<div class="form-group">
|
||||
<input type="url" id="url" name="url" placeholder="https://example.com" required aria-label="URL to shorten">
|
||||
</div>
|
||||
<button type="submit" id="submit-btn">Shorten URL</button>
|
||||
</form>
|
||||
<div id="result" class="result"></div>
|
||||
<script>
|
||||
const form = document.getElementById('shorten-form');
|
||||
const urlInput = document.getElementById('url');
|
||||
const submitBtn = document.getElementById('submit-btn');
|
||||
const resultDiv = document.getElementById('result');
|
||||
|
||||
form.addEventListener('submit', async (e) => {
|
||||
e.preventDefault();
|
||||
|
||||
const url = urlInput.value.trim();
|
||||
if (!url) {
|
||||
showError('Please enter a URL');
|
||||
return;
|
||||
}
|
||||
|
||||
submitBtn.disabled = true;
|
||||
submitBtn.textContent = 'Shortening...';
|
||||
hideResult();
|
||||
|
||||
try {
|
||||
const response = await fetch('/api/v1/urls', {
|
||||
method: 'POST',
|
||||
headers: {
|
||||
'Content-Type': 'application/json',
|
||||
},
|
||||
body: JSON.stringify({ url: url })
|
||||
});
|
||||
|
||||
const contentType = response.headers.get('content-type') || '';
|
||||
let data = {};
|
||||
if (contentType.includes('application/json')) {
|
||||
data = await response.json();
|
||||
} else {
|
||||
const text = await response.text();
|
||||
data = { error: text || 'Unexpected response' };
|
||||
}
|
||||
|
||||
if (response.ok && data.success) {
|
||||
showSuccess(data.short_url, data.original_url);
|
||||
urlInput.value = '';
|
||||
} else {
|
||||
const message = data.error || `Request failed (${response.status})`;
|
||||
showError(message);
|
||||
}
|
||||
} catch (error) {
|
||||
showError('Network error: ' + error.message);
|
||||
} finally {
|
||||
submitBtn.disabled = false;
|
||||
submitBtn.textContent = 'Shorten URL';
|
||||
}
|
||||
});
|
||||
|
||||
function showSuccess(shortUrl, originalUrl) {
|
||||
resultDiv.className = 'result success show';
|
||||
resultDiv.innerHTML = `
|
||||
<strong>Short URL created:</strong>
|
||||
<div class="short-url">
|
||||
<a href="${shortUrl}" target="_blank">${shortUrl}</a>
|
||||
</div>
|
||||
`;
|
||||
}
|
||||
|
||||
function showError(message) {
|
||||
resultDiv.className = 'result error show';
|
||||
resultDiv.innerHTML = `
|
||||
<strong>Error:</strong>
|
||||
<div class="error-message">${escapeHtml(message)}</div>
|
||||
`;
|
||||
}
|
||||
|
||||
function hideResult() {
|
||||
resultDiv.className = 'result';
|
||||
}
|
||||
|
||||
function escapeHtml(text) {
|
||||
const div = document.createElement('div');
|
||||
div.textContent = text;
|
||||
return div.innerHTML;
|
||||
}
|
||||
</script>
|
||||
</main>
|
||||
15
templates/layouts/default.html.ep
Normal file
15
templates/layouts/default.html.ep
Normal file
@@ -0,0 +1,15 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<title><%= stash('title') || 'Urupam' %></title>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<link rel="icon" type="image/x-icon" href="/favicon.ico">
|
||||
<%= stylesheet '/css/app.css' %>
|
||||
</head>
|
||||
<body>
|
||||
<%= content %>
|
||||
<div class="brand-mark">urupam</div>
|
||||
<div class="brand-version">v<%= $c->version %></div>
|
||||
</body>
|
||||
</html>
|
||||
Reference in New Issue
Block a user