current status
This commit is contained in:
parent
5c8c4a9493
commit
f0fca01b4d
15 changed files with 364 additions and 96 deletions
11
cpanfile
Normal file
11
cpanfile
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
requires 'Mojolicious';
|
||||||
|
requires 'DBD::SQLite';
|
||||||
|
requires 'Rose';
|
||||||
|
requires 'URI';
|
||||||
|
requires 'Digest::Adler32';
|
||||||
|
|
||||||
|
on test => sub {
|
||||||
|
requires 'Test::More';
|
||||||
|
requires 'Test::Deep';
|
||||||
|
requires 'Test::MonkeyMock';
|
||||||
|
};
|
15
examples/etc/systemd/system/shrl_be.service
Normal file
15
examples/etc/systemd/system/shrl_be.service
Normal file
|
@ -0,0 +1,15 @@
|
||||||
|
[Unit]
|
||||||
|
Description=Shrl.be url shortener service
|
||||||
|
|
||||||
|
Wants=network.target
|
||||||
|
After=syslog.target network-online.target
|
||||||
|
|
||||||
|
[Service]
|
||||||
|
Type=simple
|
||||||
|
ExecStart=/srv/shrl.be/start.sh
|
||||||
|
Restart=on-failure
|
||||||
|
RestartSec=10
|
||||||
|
KillMode=mixed
|
||||||
|
|
||||||
|
[Install]
|
||||||
|
WantedBy=multi-user.target
|
36
examples/nginx/shrl.be
Normal file
36
examples/nginx/shrl.be
Normal file
|
@ -0,0 +1,36 @@
|
||||||
|
server {
|
||||||
|
listen 443 ssl;
|
||||||
|
|
||||||
|
ssl on;
|
||||||
|
ssl_stapling on;
|
||||||
|
|
||||||
|
server_name shrl.be;
|
||||||
|
|
||||||
|
client_max_body_size 32m;
|
||||||
|
|
||||||
|
ssl_certificate /etc/letsencrypt/live/shrl.be/fullchain.pem;
|
||||||
|
ssl_certificate_key /etc/letsencrypt/live/shrl.be/privkey.pem;
|
||||||
|
|
||||||
|
ssl_ciphers 'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-AES256-GCM-SHA384:DHE-RSA-AES128-GCM-SHA256:DHE-DSS-AES128-GCM-SHA256:kEDH+AESGCM:ECDHE-RSA-AES128-SHA256:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA:ECDHE-ECDSA-AES256-SHA:DHE-RSA-AES128-SHA256:DHE-RSA-AES128-SHA:DHE-DSS-AES128-SHA256:DHE-RSA-AES256-SHA256:DHE-DSS-AES256-SHA:DHE-RSA-AES256-SHA:AES128-GCM-SHA256:AES256-GCM-SHA384:AES128-SHA256:AES256-SHA256:AES128-SHA:AES256-SHA:AES:CAMELLIA:DES-CBC3-SHA:!aNULL:!eNULL:!EXPORT:!DES:!RC4:!MD5:!PSK:!aECDH:!EDH-DSS-DES-CBC3-SHA:!EDH-RSA-DES-CBC3-SHA:!KRB5-DES-CBC3-SHA';
|
||||||
|
ssl_prefer_server_ciphers on;
|
||||||
|
|
||||||
|
include /etc/nginx/conf.d/ssl_params.conf;
|
||||||
|
|
||||||
|
error_log /var/log/nginx/shrl.be.error.log error;
|
||||||
|
|
||||||
|
location / {
|
||||||
|
proxy_pass http://127.0.0.1:3002;
|
||||||
|
access_log /var/log/nginx/shrl.be.log combined;
|
||||||
|
proxy_http_version 1.1;
|
||||||
|
proxy_set_header Upgrade $http_upgrade;
|
||||||
|
proxy_set_header Connection "upgrade";
|
||||||
|
|
||||||
|
# Enable Convos to construct correct URLs by passing on custom
|
||||||
|
# headers. X-Request-Base is only required if "location" above
|
||||||
|
# is not "/".
|
||||||
|
proxy_set_header Host $host;
|
||||||
|
proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;
|
||||||
|
proxy_set_header X-Forwarded-Proto $scheme;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
35
lib/Shrlbe.pm
Normal file
35
lib/Shrlbe.pm
Normal file
|
@ -0,0 +1,35 @@
|
||||||
|
package Shrlbe;
|
||||||
|
use Mojo::Base 'Mojolicious', -signatures;
|
||||||
|
|
||||||
|
use Shrlbe::Utils;
|
||||||
|
|
||||||
|
my $SITE_NAME = 'shrl.be';
|
||||||
|
|
||||||
|
my $db_file = 'shrl.db';
|
||||||
|
|
||||||
|
# This method will run once at server start
|
||||||
|
sub startup ($self) {
|
||||||
|
|
||||||
|
# Load configuration from config file
|
||||||
|
my $config = $self->plugin('NotYAMLConfig');
|
||||||
|
|
||||||
|
# Configure the application
|
||||||
|
$self->secrets($config->{secrets});
|
||||||
|
|
||||||
|
my $utils = Shrlbe::Utils->new();
|
||||||
|
|
||||||
|
$self->helper(site_name => sub { return $SITE_NAME });
|
||||||
|
$self->helper(db_file => sub { return $db_file });
|
||||||
|
$self->helper(sh_utils => sub { return $utils });
|
||||||
|
|
||||||
|
# Router
|
||||||
|
my $r = $self->routes;
|
||||||
|
|
||||||
|
# Normal route to controller
|
||||||
|
$r->get('/')->to('main#index');
|
||||||
|
$r->get('/s/*url')->to('main#short_api');
|
||||||
|
$r->post('/')->to('main#short');
|
||||||
|
$r->get('/:shorten_path')->to('main#get_shorten');
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
77
lib/Shrlbe/Controller/Main.pm
Normal file
77
lib/Shrlbe/Controller/Main.pm
Normal file
|
@ -0,0 +1,77 @@
|
||||||
|
package Shrlbe::Controller::Main;
|
||||||
|
use Mojo::Base 'Mojolicious::Controller', -signatures;
|
||||||
|
|
||||||
|
use Shrlbe::Model::Url;
|
||||||
|
use Shrlbe::Model::Url::Manager;
|
||||||
|
|
||||||
|
|
||||||
|
sub index($self)
|
||||||
|
{
|
||||||
|
$self->render(template => 'index', page_data => {});
|
||||||
|
}
|
||||||
|
|
||||||
|
sub short_api ($self)
|
||||||
|
{
|
||||||
|
my $original_url = $self->param('url');
|
||||||
|
|
||||||
|
my $shorten_url = $self->_saveShortUrl($original_url);
|
||||||
|
|
||||||
|
$self->render(text => $shorten_url);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub short($self)
|
||||||
|
{
|
||||||
|
my $original_url = $self->param('url');
|
||||||
|
|
||||||
|
my $shorten_url = $self->_saveShortUrl($original_url);
|
||||||
|
|
||||||
|
$self->render(template => 'index', page_data => {url => $original_url, shorten_url => $shorten_url});
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_shorten($self)
|
||||||
|
{
|
||||||
|
my $path = $self->param('shorten_path');
|
||||||
|
|
||||||
|
my $url = Shrlbe::Model::Url->new(hash => $path);
|
||||||
|
if ($url->load(speculative => 1)) {
|
||||||
|
$self->res->code(307);
|
||||||
|
$self->redirect_to($url->original_url());
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$self->render(status => 404, text => 'Page not found :(');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _saveShortUrl($self, $original_url)
|
||||||
|
{
|
||||||
|
my $hash;
|
||||||
|
|
||||||
|
my $normalized_url = $self->sh_utils()->normalizeUrl($original_url);
|
||||||
|
|
||||||
|
my $url = $self->_loadUrl($normalized_url);
|
||||||
|
|
||||||
|
if (!$url) {
|
||||||
|
$hash = $self->sh_utils()->hashUrl($normalized_url);
|
||||||
|
|
||||||
|
$url = Shrlbe::Model::Url->new(hash => $hash, normalized_url => $normalized_url, original_url => $original_url)->save();
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$hash = $url->hash();
|
||||||
|
}
|
||||||
|
|
||||||
|
return sprintf('%s/%s', $self->site_name(), $hash);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _loadUrl($self, $normalized_url)
|
||||||
|
{
|
||||||
|
my $urls = Shrlbe::Model::Url::Manager->get_urls(
|
||||||
|
query => [
|
||||||
|
normalized_url => $normalized_url
|
||||||
|
],
|
||||||
|
limit => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
return $urls->[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
19
lib/Shrlbe/DB.pm
Normal file
19
lib/Shrlbe/DB.pm
Normal file
|
@ -0,0 +1,19 @@
|
||||||
|
package Shrlbe::DB;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use parent qw(Rose::DB);
|
||||||
|
|
||||||
|
|
||||||
|
__PACKAGE__->use_private_registry;
|
||||||
|
|
||||||
|
__PACKAGE__->register_db(
|
||||||
|
domain => 'production',
|
||||||
|
type => 'main',
|
||||||
|
driver => 'sqlite',
|
||||||
|
database => '/home/alpha6/projects/shrl.be/shrl.db',
|
||||||
|
);
|
||||||
|
|
||||||
|
Rose::DB->default_domain('production');
|
||||||
|
Rose::DB->default_type('main');
|
||||||
|
|
||||||
|
1;
|
11
lib/Shrlbe/Model/Base.pm
Normal file
11
lib/Shrlbe/Model/Base.pm
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
package Shrlbe::Model::Base;
|
||||||
|
use strict;
|
||||||
|
use warnings FATAL => 'all';
|
||||||
|
use parent qw(Rose::DB::Object);
|
||||||
|
|
||||||
|
use Shrlbe::DB;
|
||||||
|
|
||||||
|
|
||||||
|
sub init_db { Shrlbe::DB->new() }
|
||||||
|
|
||||||
|
1;
|
18
lib/Shrlbe/Model/Url.pm
Normal file
18
lib/Shrlbe/Model/Url.pm
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
package Shrlbe::Model::Url;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use parent qw(Shrlbe::Model::Base);
|
||||||
|
|
||||||
|
|
||||||
|
__PACKAGE__->meta->setup
|
||||||
|
(
|
||||||
|
table => 'url',
|
||||||
|
columns => [
|
||||||
|
id => { type => 'serial', primary_key => 1, not_null => 1 },
|
||||||
|
hash => { type => 'varchar', length => 255, not_null => 1 },
|
||||||
|
qw(shard normalized_url original_url)
|
||||||
|
],
|
||||||
|
unique_key => 'hash',
|
||||||
|
);
|
||||||
|
|
||||||
|
1;
|
11
lib/Shrlbe/Model/Url/Manager.pm
Normal file
11
lib/Shrlbe/Model/Url/Manager.pm
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
package Shrlbe::Model::Url::Manager;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use base qw(Rose::DB::Object::Manager);
|
||||||
|
|
||||||
|
|
||||||
|
sub object_class { 'Shrlbe::Model::Url' }
|
||||||
|
|
||||||
|
__PACKAGE__->make_manager_methods('urls');
|
||||||
|
|
||||||
|
1;
|
50
lib/Shrlbe/Utils.pm
Normal file
50
lib/Shrlbe/Utils.pm
Normal file
|
@ -0,0 +1,50 @@
|
||||||
|
package Shrlbe::Utils;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Digest::Adler32;
|
||||||
|
use URI;
|
||||||
|
|
||||||
|
|
||||||
|
sub new
|
||||||
|
{
|
||||||
|
my $class = shift;
|
||||||
|
my (%params) = @_;
|
||||||
|
|
||||||
|
my $self = {%params};
|
||||||
|
|
||||||
|
bless $self, $class;
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub hashUrl
|
||||||
|
{
|
||||||
|
my $self = shift;
|
||||||
|
my ($url) = @_;
|
||||||
|
|
||||||
|
my $digest = $self->_buildDigest();
|
||||||
|
|
||||||
|
$digest->add($url);
|
||||||
|
|
||||||
|
return $digest->hexdigest();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub normalizeUrl
|
||||||
|
{
|
||||||
|
my ($self) = shift;
|
||||||
|
my ($url) = @_;
|
||||||
|
|
||||||
|
my $uri = URI->new($url);
|
||||||
|
|
||||||
|
$uri = URI->new(sprintf('http://%s', $url )) unless $uri->scheme();
|
||||||
|
|
||||||
|
return $uri->as_string;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _buildDigest
|
||||||
|
{
|
||||||
|
return Digest::Adler32->new();
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
13
script/shrlbe
Executable file
13
script/shrlbe
Executable file
|
@ -0,0 +1,13 @@
|
||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use lib 'lib';
|
||||||
|
use local::lib 'local';
|
||||||
|
|
||||||
|
use Mojo::File qw(curfile);
|
||||||
|
use lib curfile->dirname->sibling('lib')->to_string;
|
||||||
|
use Mojolicious::Commands;
|
||||||
|
|
||||||
|
# Start command line interface for application
|
||||||
|
Mojolicious::Commands->start_app('Shrlbe');
|
96
shrlbe.pl
96
shrlbe.pl
|
@ -1,96 +0,0 @@
|
||||||
use strict;
|
|
||||||
use warnings FATAL => 'all';
|
|
||||||
use feature qw/say/;
|
|
||||||
|
|
||||||
use Mojolicious::Lite -signatures;
|
|
||||||
|
|
||||||
use URI;
|
|
||||||
use DBIx::Struct qw/connector hash_ref_slice/;
|
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
my $SITE_NAME = 'shrl.be/';
|
|
||||||
|
|
||||||
my $db_file = 'shrl.db';
|
|
||||||
DBIx::Struct::connect(sprintf('dbi:SQLite:dbname=%s', $db_file),"","");
|
|
||||||
|
|
||||||
# Render template "index.html.ep" from the DATA section
|
|
||||||
get '/' => sub ($c) {
|
|
||||||
$c->render(template => 'index', page_data => {});
|
|
||||||
};
|
|
||||||
|
|
||||||
get '/s/*url' => sub ($c) {
|
|
||||||
my $url = normalize_source_url($c->param('url'));
|
|
||||||
my $shorten_path = write_url($url);
|
|
||||||
my $shorten_url = $SITE_NAME.$shorten_path;
|
|
||||||
$c->render(text => $shorten_url);
|
|
||||||
};
|
|
||||||
|
|
||||||
post '/' => sub ($c) {
|
|
||||||
my $url = normalize_source_url($c->param('url'));
|
|
||||||
my $shorten_path = write_url($url);
|
|
||||||
my $shorten_url = $SITE_NAME.$shorten_path;
|
|
||||||
$c->render(template => 'index', page_data => { url => $url, shorten_url => $shorten_url});
|
|
||||||
};
|
|
||||||
|
|
||||||
get '/:shorten_path' => sub ($c) {
|
|
||||||
my $path = $c->param('shorten_path');
|
|
||||||
my $url = get_url($path);
|
|
||||||
if ($url) {
|
|
||||||
$c->res->code(307);
|
|
||||||
$c->redirect_to($url);
|
|
||||||
} else {
|
|
||||||
$c->render(status => 404, text => 'Page not found :(');
|
|
||||||
}
|
|
||||||
|
|
||||||
};
|
|
||||||
|
|
||||||
app->start;
|
|
||||||
|
|
||||||
|
|
||||||
sub rand_str() {
|
|
||||||
my @set = ('0' ..'9', 'A' .. 'z', 'a'..'z');
|
|
||||||
my $str = join '' => map $set[rand @set], 1 .. 8;
|
|
||||||
return $str;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub normalize_source_url($source_url) {
|
|
||||||
my $uri = URI->new($source_url);
|
|
||||||
$uri = URI->new('http://'.$source_url) if !$uri->scheme;
|
|
||||||
return $uri->as_string;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub write_url($source_url) {
|
|
||||||
|
|
||||||
#TODO: it's really stupid idea to create short url from random + db writing. Need better.
|
|
||||||
my $shorten_path;
|
|
||||||
eval {
|
|
||||||
my $short_row = one_row('urls',{ source_url => $source_url});
|
|
||||||
if (!$short_row) {
|
|
||||||
$shorten_path = rand_str();
|
|
||||||
new_row('urls' =>
|
|
||||||
source_url => $source_url,
|
|
||||||
shorten_path => $shorten_path,
|
|
||||||
);
|
|
||||||
|
|
||||||
} else {
|
|
||||||
$shorten_path = $short_row->shorten_path;
|
|
||||||
}
|
|
||||||
};
|
|
||||||
if ($@) { #may fall with deep recursion if no free names available
|
|
||||||
if ($@ =~ /urls.shorten_path inserting /) {
|
|
||||||
&write_url($source_url);
|
|
||||||
}
|
|
||||||
die $@;
|
|
||||||
}
|
|
||||||
return $shorten_path;
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_url($shorten_path) {
|
|
||||||
my $row = one_row('urls', { shorten_path => $shorten_path});
|
|
||||||
|
|
||||||
return $row->source_url if($row);
|
|
||||||
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
3
shrlbe.yml
Normal file
3
shrlbe.yml
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
---
|
||||||
|
secrets:
|
||||||
|
- d1133fbd47db034007e79033b2f5ace2ade2026c
|
22
t/basic.t
Normal file
22
t/basic.t
Normal file
|
@ -0,0 +1,22 @@
|
||||||
|
use Mojo::Base -strict;
|
||||||
|
|
||||||
|
use lib 'lib';
|
||||||
|
use local::lib 'local';
|
||||||
|
|
||||||
|
use Test::More;
|
||||||
|
use Test::Mojo;
|
||||||
|
|
||||||
|
|
||||||
|
my $t = Test::Mojo->new('Shrlbe');
|
||||||
|
|
||||||
|
$t->get_ok('/')->status_is(200)->content_like(qr/URL Shortener/i);
|
||||||
|
|
||||||
|
$t->get_ok('/s/ya.ru')->status_is(200)->content_like(qr/shrl.be\/1c570448/i);
|
||||||
|
|
||||||
|
$t->post_ok('/' => form => {url => 'ya.ru'})->status_is(200)->content_like(qr/shrl.be\/1c570448/i);
|
||||||
|
|
||||||
|
$t->get_ok('/1c570448')->status_is(307);
|
||||||
|
|
||||||
|
$t->get_ok('/unknown_hash')->status_is(404);
|
||||||
|
|
||||||
|
done_testing();
|
43
t/utils.t
Normal file
43
t/utils.t
Normal file
|
@ -0,0 +1,43 @@
|
||||||
|
#!/usr/bin/perl
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Test::More;
|
||||||
|
|
||||||
|
use lib 'lib';
|
||||||
|
use local::lib 'local';
|
||||||
|
|
||||||
|
use Shrlbe::Utils;
|
||||||
|
|
||||||
|
|
||||||
|
subtest 'creates correct object' => sub {
|
||||||
|
my $utils = _buildUtils();
|
||||||
|
|
||||||
|
isa_ok($utils, 'Shrlbe::Utils');
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest 'hashUrl' => sub {
|
||||||
|
my $utils = _buildUtils();
|
||||||
|
|
||||||
|
ok($utils->hashUrl('https://ya.ru/', 'Return url hash'));
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest 'normalizeUrl' => sub {
|
||||||
|
my $utils = _buildUtils();
|
||||||
|
|
||||||
|
is($utils->normalizeUrl('ya.ru'), 'http://ya.ru', 'Add http schema by default');
|
||||||
|
is($utils->normalizeUrl('https://ya.ru'), 'https://ya.ru', 'Do not change original schema');
|
||||||
|
is($utils->normalizeUrl('gopher://ya.ru'), 'gopher://ya.ru', 'Use not http schema');
|
||||||
|
is(
|
||||||
|
$utils->normalizeUrl('stratum1+ssl://0x1994aac8e2BC4281f69C487D2dea57212b475eB5.w1080@eu1.ethermine.org:5555'),
|
||||||
|
'stratum1+ssl://0x1994aac8e2BC4281f69C487D2dea57212b475eB5.w1080@eu1.ethermine.org:5555',
|
||||||
|
'Allow stratum'
|
||||||
|
);
|
||||||
|
};
|
||||||
|
|
||||||
|
sub _buildUtils
|
||||||
|
{
|
||||||
|
return Shrlbe::Utils->new();
|
||||||
|
}
|
||||||
|
|
||||||
|
done_testing();
|
||||||
|
|
Loading…
Reference in a new issue