Lstu.pm 13.7 KB
Newer Older
Luc Didry's avatar
Luc Didry committed
1
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
2 3 4
package Lstu;
use Mojo::Base 'Mojolicious';
use LstuModel;
Luc Didry's avatar
Luc Didry committed
5
use SessionModel;
Luc Didry's avatar
Luc Didry committed
6 7 8
use Data::Validate::URI qw(is_http_uri is_https_uri);
use Mojo::JSON qw(to_json decode_json);
use Mojo::URL;
9
use Net::Abuse::Utils::Spamhaus qw(check_fqdn);
Luc Didry's avatar
Luc Didry committed
10 11

$ENV{MOJO_REVERSE_PROXY} = 1;
12 13 14 15 16

# This method will run once at server start
sub startup {
    my $self = shift;

Luc Didry's avatar
Luc Didry committed
17 18 19 20 21 22 23
    my $config = $self->plugin('Config' => {
        default =>  {
            provisioning => 100,
            provis_step   => 5,
            length        => 8,
            secret        => ['hfudsifdsih'],
            page_offset   => 10,
Luc Didry's avatar
Luc Didry committed
24
            theme         => 'default'
Luc Didry's avatar
Luc Didry committed
25 26 27 28
        }
    });

    $config->{provisioning} = $config->{provisionning} if (defined($config->{provisionning}));
29

Luc Didry's avatar
Luc Didry committed
30
    die "You need to provide a contact information in lstu.conf!" unless (defined($config->{contact}));
31

Luc Didry's avatar
Luc Didry committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45
    # Themes handling
    shift @{$self->renderer->paths};
    shift @{$self->static->paths};
    if ($config->{theme} ne 'default') {
        my $theme = $self->home->rel_dir('themes/'.$config->{theme});
        push @{$self->renderer->paths}, $theme.'/templates' if -d $theme.'/templates';
        push @{$self->static->paths}, $theme.'/public' if -d $theme.'/public';
    }
    push @{$self->renderer->paths}, $self->home->rel_dir('themes/default/templates');
    push @{$self->static->paths}, $self->home->rel_dir('themes/default/public');

    # Internationalization
    my $lib = $self->home->rel_dir('themes/'.$config->{theme}.'/lib');
    eval qq(use lib "$lib");
46 47
    $self->plugin('I18N');

Luc Didry's avatar
Luc Didry committed
48 49 50
    # Debug
    $self->plugin('DebugDumperHelper');

51
    $self->secrets($config->{secret});
52 53

    $self->helper(
Luc Didry's avatar
Luc Didry committed
54
        provisioning => sub {
55 56
            my $c = shift;

Luc Didry's avatar
Luc Didry committed
57 58 59
            # Create some short patterns for provisioning
            if (LstuModel::Lstu->count('WHERE url IS NULL') < $c->config('provisioning')) {
                for (my $i = 0; $i < $c->config('provis_step'); $i++) {
60 61 62
                    if (LstuModel->begin) {
                        my $short;
                        do {
Luc Didry's avatar
Luc Didry committed
63
                            $short= $c->shortener($c->config('length'));
64 65 66 67 68 69 70
                        } while (LstuModel::Lstu->count('WHERE short = ?', $short));

                        LstuModel::Lstu->create(
                            short => $short
                        );
                        LstuModel->commit;
                    }
71 72 73 74 75
                }
            }
        }
    );

Luc Didry's avatar
Luc Didry committed
76 77 78 79 80 81 82 83
    $self->helper(
        prefix => sub {
            my $c = shift;

            my $prefix = $c->url_for('index')->to_abs;
            # Forced domain
            $prefix->host($c->config('fixed_domain')) if (defined($c->config('fixed_domain')));
            # Hack for prefix (subdir) handling
Luc Didry's avatar
Luc Didry committed
84
            $prefix .= '/' unless ($prefix =~ m#/$#);
Luc Didry's avatar
Luc Didry committed
85 86 87 88
            return $prefix;
        }
    );

89 90 91 92 93
    $self->helper(
        shortener => sub {
            my $c      = shift;
            my $length = shift;

Luc Didry's avatar
Luc Didry committed
94
            my @chars  = ('a'..'z','A'..'Z','0'..'9', '-', '_');
95 96 97 98 99 100 101 102
            my $result = '';
            foreach (1..$length) {
                $result .= $chars[rand scalar(@chars)];
            }
            return $result;
        }
    );

103 104 105 106 107 108
    $self->helper(
        is_spam => sub {
            my $c        = shift;
            my $url      = shift;
            my $nb_redir = shift;

109
            if ($nb_redir++ <= 2) {
110 111 112 113
                my $res = check_fqdn($url->host);
                if (defined $res) {
                   return {
                       is_spam => 1,
Luc Didry's avatar
Luc Didry committed
114
                       msg     => $c->l('The URL host or one of its redirection(s) (%1) is blacklisted at Spamhaus. I refuse to shorten it.', $url->host)
115 116 117 118 119 120 121 122 123 124 125 126
                   }
                } else {
                    my $res = $c->ua->get($url)->res;
                    if ($res->code >= 300 && $res->code < 400) {
                        return $c->is_spam(Mojo::URL->new($res->headers->location), $nb_redir);
                    } else {
                        return { is_spam => 0 };
                    }
                }
            } else {
               return {
                   is_spam => 1,
127
                   msg     => $c->l('The URL redirects 3 times or most. It\'s most likely a dangerous URL (spam, phishing, etc.). I refuse to shorten it.', $url->host)
128 129 130 131 132
               }
            }
        }
    );

133
    # Hooks
Luc Didry's avatar
Luc Didry committed
134 135 136 137 138 139 140 141 142 143
    $self->hook(
        after_dispatch => sub {
            shift->provisioning();
        }
    );

    $self->hook(
        before_dispatch => sub {
            my $c = shift;

Luc Didry's avatar
Luc Didry committed
144 145
            # Delete old sessions
            SessionModel::Sessions->delete_where('until < ?', time);
Luc Didry's avatar
Luc Didry committed
146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
            # API allowed domains
            if (defined($c->config('allowed_domains'))) {
                if ($c->config('allowed_domains')->[0] eq '*') {
                    $c->res->headers->header('Access-Control-Allow-Origin' => '*');
                } elsif (my $origin = $c->req->headers->origin) {
                    for my $domain (@{$c->config('allowed_domains')}) {
                        if ($domain eq $origin) {
                            $c->res->headers->header('Access-Control-Allow-Origin' => $origin);
                            last;
                        }
                    }
                }
            }
        }
    );

162
    # For the first launch (after, this isn't really useful)
Luc Didry's avatar
Luc Didry committed
163 164 165 166
    $self->provisioning();

    # Default layout
    $self->defaults(layout => 'default');
167 168 169 170 171 172

    # Router
    my $r = $self->routes;

    # Normal route to controller
    $r->get('/' => sub {
Luc Didry's avatar
Luc Didry committed
173
        shift->render(template => 'index');
174 175
    })->name('index');

Luc Didry's avatar
Luc Didry committed
176
    $r->post('/a' => sub {
177
        my $c          = shift;
Luc Didry's avatar
Luc Didry committed
178
        my $url        = Mojo::URL->new($c->param('lsturl'));
179
        my $custom_url = $c->param('lsturl-custom');
Luc Didry's avatar
Luc Didry committed
180
        my $format     = $c->param('format');
181

182
        $custom_url = undef if (defined($custom_url) && $custom_url eq '');
183

Luc Didry's avatar
Luc Didry committed
184
        my ($msg, $short);
Luc Didry's avatar
Luc Didry committed
185
        if (defined($custom_url) && ($custom_url =~ m/^a(pi)?$|^stats$/ || $custom_url =~ m/\.json$/ || $custom_url !~ m/^[-a-zA-Z0-9_]+$/)) {
Luc Didry's avatar
Luc Didry committed
186
            $msg = $c->l('The shortened text can contain only numbers, letters and the - and _ character, can\'t be "a", "api" or "stats" or end with ".json". Your URL to shorten: %1', $url);
187
        } elsif (defined($custom_url) && LstuModel::Lstu->count('WHERE short = ?', $custom_url) > 0) {
Luc Didry's avatar
Luc Didry committed
188
            $msg = $c->l('The shortened text (%1) is already used. Please choose another one.', $custom_url);
Luc Didry's avatar
Luc Didry committed
189
        } elsif (is_http_uri($url->to_string) || is_https_uri($url->to_string)) {
190 191 192
            my $res = $c->is_spam($url, 0);
            if ($res->{is_spam}) {
                $msg = $res->{msg};
193
            } else {
194 195 196 197 198 199 200 201 202 203
                my @records = LstuModel::Lstu->select('WHERE url = ?', $url);

                if (scalar(@records) && !defined($custom_url)) {
                    # Already got this URL
                    $short = $records[0]->short;
                } else {
                    if(LstuModel->begin) {
                        if (defined($custom_url)) {
                            LstuModel::Lstu->create(
                                short     => $custom_url,
204 205 206 207 208
                                url       => $url,
                                counter   => 0,
                                timestamp => time()
                            );

209
                            $short = $custom_url;
210
                        } else {
211 212 213 214 215 216 217 218 219 220 221
                            @records = LstuModel::Lstu->select('WHERE url IS NULL LIMIT 1');
                            if (scalar(@records)) {
                                $records[0]->update(
                                    url       => $url,
                                    counter   => 0,
                                    timestamp => time()
                                );

                                $short = $records[0]->short;
                            } else {
                                # Houston, we have a problem
Luc Didry's avatar
Luc Didry committed
222
                                $msg = $c->l('No shortened URL available. Please retry or contact the administrator at %1. Your URL to shorten: [_2]', $c->config('contact'), $url);
223
                            }
224
                        }
225
                        LstuModel->commit;
226
                    }
227 228 229
                }
            }
        } else {
Luc Didry's avatar
Luc Didry committed
230
            $msg = $c->l('%1 is not a valid URL.', $url);
Luc Didry's avatar
Luc Didry committed
231 232 233 234
        }
        if ($msg) {
            $c->respond_to(
                json => { json => { success => Mojo::JSON->false, msg => $msg } },
235
                any  => sub {
Luc Didry's avatar
Luc Didry committed
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
                    my $c = shift;

                    $c->flash('msg' => $msg);
                    $c->redirect_to('index');
                }
            );
        } else {
            # Get URLs from cookie
            my $u = (defined($c->cookie('url'))) ? decode_json $c->cookie('url') : [];
            # Add the new URL
            push @{$u}, $short;
            # Make the array contain only unique URLs
            my %k = map { $_, 1 } @{$u};
            @{$u} = keys %k;
            # And set the cookie
            my $cookie = to_json($u);
            $c->cookie('url' => $cookie, {expires => time + 142560000}); # expires in 10 years

            my $prefix = $c->prefix;

            $c->respond_to(
                json => { json => { success => Mojo::JSON->true, url => $url, short => $prefix.$short } },
258
                any  => sub {
Luc Didry's avatar
Luc Didry committed
259 260 261 262 263 264
                    my $c = shift;

                    $c->flash('url'   => $url);
                    $c->flash('short' => $prefix.$short);
                    $c->redirect_to('index');
                }
265 266
            );
        }
Luc Didry's avatar
Luc Didry committed
267
    })->name('add');
268

Luc Didry's avatar
Luc Didry committed
269 270 271 272 273
    $r->get('/api' => sub {
        shift->render(
            template => 'api'
        );
    })->name('api');
274

Luc Didry's avatar
Luc Didry committed
275 276 277
    $r->get('/stats' => sub {
        my $c = shift;

Luc Didry's avatar
Luc Didry committed
278
        if (defined($c->session('token')) && SessionModel::Sessions->count('WHERE token = ?', $c->session('token'))) {
Luc Didry's avatar
Luc Didry committed
279
            my $total = LstuModel::Lstu->count("WHERE url IS NOT NULL");
280 281
            my $page  = $c->param('page') || 0;
               $page  = 0 if ($page < 0);
Luc Didry's avatar
Luc Didry committed
282 283 284 285 286 287 288 289 290 291 292 293
               $page  = $page - 1 if ($page * $c->config('page_offset') > $total);

            my ($first, $last) = (!$page, ($page * $c->config('page_offset') <= $total && $total < ($page + 1) * $c->config('page_offset')));

            my @urls  = LstuModel::Lstu->select("WHERE url IS NOT NULL ORDER BY counter DESC LIMIT ? offset ?", $c->config('page_offset'), $page * $c->config('page_offset'));
            $c->render(
                template => 'stats',
                prefix   => $c->prefix,
                urls     => \@urls,
                first    => $first,
                last     => $last,
                page     => $page,
294
                admin    => 1,
Luc Didry's avatar
Luc Didry committed
295 296
                total    => $total
            )
297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336
        } else {
            my $u = (defined($c->cookie('url'))) ? decode_json $c->cookie('url') : [];

            my $p = join ",", (('?') x @{$u});
            my @urls = LstuModel::Lstu->select("WHERE short IN ($p) ORDER BY counter DESC", @{$u});

            my $prefix = $c->prefix;

            $c->respond_to(
                json => sub {
                    my @struct;
                    for my $url (@urls) {
                        push @struct, {
                            short      => $prefix.$url->{short},
                            url        => $url->{url},
                            counter    => $url->{counter},
                            created_at => $url->{timestamp}
                        };
                    }
                    $c->render( json => \@struct );
                },
                any  => sub {
                    shift->render(
                        template => 'stats',
                        prefix   => $prefix,
                        urls     => \@urls
                    )
                }
            )
        }
    })->name('stats');

    $r->post('/stats' => sub {
        my $c    = shift;
        my $pwd  = $c->param('adminpwd');
        my $act  = $c->param('action');

        if (defined($c->config('adminpwd')) && defined($pwd) && $pwd eq $c->config('adminpwd')) {
            my $token = $c->shortener(32);

Luc Didry's avatar
Luc Didry committed
337
            SessionModel::Sessions->create(token => $token, until => time + 3600);
338 339 340
            $c->session('token' => $token);
            $c->redirect_to('stats');
        } elsif (defined($act) && $act eq 'logout') {
Luc Didry's avatar
Luc Didry committed
341
            SessionModel::Sessions->delete_where('token = ?', $c->session->{token});
342 343
            delete $c->session->{token};
            $c->redirect_to('stats');
Luc Didry's avatar
Luc Didry committed
344 345 346 347 348
        } else {
            $c->flash('msg' => $c->l('Bad password'));
            $c->redirect_to('stats');
        }
    });
349 350 351 352 353 354 355

    $r->get('/:short' => sub {
        my $c = shift;
        my $short = $c->param('short');

        my @urls = LstuModel::Lstu->select('WHERE short = ?', $short);
        if (scalar(@urls)) {
Luc Didry's avatar
Luc Didry committed
356 357 358 359 360 361 362 363 364 365
            my $url = $urls[0]->url;
            $c->respond_to(
                json => { json => { success => Mojo::JSON->true, url => $url } },
                any  => sub {
                    my $c = shift;
                    $c->res->code(301);
                    $c->redirect_to($url);
                }
            );
            # Update counter
366 367 368 369 370
            $c->on(finish => sub {
                my $counter = $urls[0]->counter + 1;
                $urls[0]->update (counter => $counter);
            });
        } else {
Luc Didry's avatar
Luc Didry committed
371
            my $msg = $c->l('The shortened URL %1 doesn\'t exist.', $c->url_for('/')->to_abs.$short);
Luc Didry's avatar
Luc Didry committed
372 373 374 375 376 377 378 379
            $c->respond_to(
                json => { json => { success => Mojo::JSON->false, msg => $msg } },
                any  => sub {
                    my $c = shift;

                    $c->flash('msg' => $msg);
                    $c->redirect_to('index');
                }
380 381 382
            );
        }
    })->name('short');
383 384 385
}

1;