url.pm 6.2 KB
Newer Older
1 2 3 4
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lstu::Command::url;
use Mojo::Base 'Mojolicious::Command';
use Mojo::Util qw(getopt);
5
use Mojo::Collection 'c';
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
use Lstu::DB::URL;
use FindBin qw($Bin);
use File::Spec qw(catfile);

has description => 'Manage stored URL';
has usage => sub { shift->extract_usage };

sub run {
    my $c = shift;
    my @args = @_;

    my $cfile = Mojo::File->new($Bin, '..' , 'lstu.conf');
    if (defined $ENV{MOJO_CONFIG}) {
        $cfile = Mojo::File->new($ENV{MOJO_CONFIG});
        unless (-e $cfile->to_abs) {
            $cfile = Mojo::File->new($Bin, '..', $ENV{MOJO_CONFIG});
        }
    }
    my $config = $c->app->plugin('Config', {
        file    => $cfile,
        default =>  {
27 28 29 30 31 32 33 34 35
            prefix                 => '/',
            provisioning           => 100,
            provis_step            => 5,
            length                 => 8,
            secret                 => ['hfudsifdsih'],
            page_offset            => 10,
            theme                  => 'default',
            ban_min_strike         => 3,
            ban_whitelist          => [],
36
            ban_blacklist          => [],
37
            minion                 => {
38 39 40
                enabled => 0,
                db_path => 'minion.db'
            },
41 42 43 44 45 46 47 48 49
            session_duration       => 3600,
            dbtype                 => 'sqlite',
            db_path                => 'lstu.db',
            max_redir              => 2,
            skip_spamhaus          => 0,
            memcached_servers      => [],
            x_frame_options        => 'DENY',
            x_content_type_options => 'nosniff',
            x_xss_protection       => '1; mode=block',
50
            log_creator_ip         => 0,
51 52 53
        }
    });

54 55 56 57 58 59 60 61 62 63
    if (scalar(@{$config->{memcached_servers}})) {
        $c->app->plugin(CHI => {
            lstu_urls_cache => {
                driver             => 'Memcached',
                servers            => $config->{memcached_servers},
                expires_in         => '1 day',
                expires_on_backend => 1,
            }
        });
    }
64 65

    getopt \@args,
66
      'info=s{1,}'   => \my @info,
67 68 69 70 71 72 73 74 75 76 77
      'r|remove=s{1,}' => \my @remove,
      's|search=s'     => \my $search,
      'ip=s'           => \my $ip,
      'y|yes'          => \my $yes;

    if (scalar @info) {
        c(@info)->each(
            sub {
                my ($e, $num) = @_;
                my $u = get_short($c, $e);
                print_infos($u->to_hash) if $u;
78
            }
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
        );
    }
    if (scalar @remove) {
        c(@remove)->each(
            sub {
                my ($e, $num) = @_;
                my $u = get_short($c, $e);
                if ($u) {
                    print_infos($u->to_hash);
                    my $confirm = ($yes) ? 'yes' : undef;
                    unless (defined $confirm) {
                        printf('Are you sure you want to remove this URL (%s)? [N/y] ', $e);
                        $confirm = <STDIN>;
                        chomp $confirm;
                    }
                    if ($confirm =~ m/^y(es)?$/i) {
                        if ($u->delete) {
                            if (scalar(@{$config->{memcached_servers}})) {
                                $c->app->chi('lstu_urls_cache')->remove($e);
                            }
                            say sprintf('Success: %s URL has been removed', $e);
                        } else {
                            say sprintf('Failure: %s URL has not been removed', $e);
                        }
                    } else {
                        say 'Answer was not "y" or "yes". Aborting deletion.';
105
                    }
106 107
                }
            }
108
        );
109 110 111
    }
    if ($search) {
        my $u = Lstu::DB::URL->new(app => $c->app)->search_url($search);
112
        my @shorts;
113 114
        $u->each(sub {
            my ($e, $num) = @_;
115
            push @shorts, $e->{short};
116 117
            print_infos($e);
        });
118
        say sprintf('%d matching URLs', $u->size);
119
        say sprintf("If you want to delete those URLs, please do:\n  carton exec script/lstu url --remove %s", join(' ', @shorts)) if @shorts;
120
    }
121 122
    if ($ip) {
        my $u = Lstu::DB::URL->new(app => $c->app)->search_creator($ip);
123
        my @shorts;
124 125
        $u->each(sub {
            my ($e, $num) = @_;
126
            push @shorts, $e->{short};
127 128 129
            print_infos($e);
        });
        say sprintf('%d matching URLs', $u->size);
130
        say sprintf("If you want to delete those URLs, please do:\n  carton exec script/lstu url --remove %s", join(' ', @shorts)) if @shorts;
131
    }
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
}

sub get_short {
    my $c     = shift;
    my $short = shift;

    my $u = Lstu::DB::URL->new(app => $c->app, short => $short);
    if ($u->url) {
        return $u;
    } else {
        say sprintf('Sorry, unable to find an URL with short = %s', $short);
        return undef;
    }
}

sub print_infos {
    my $u = shift;

    if ($u) {
        my $msg = <<EOF;
%s
    url        : %s
    counter    : %d
    created at : %s
    timestamp  : %d
EOF
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($u->{timestamp});
        my $timestamp = sprintf('%d-%d-%d %d:%d:%d GMT', $year + 1900, ++$mon, $mday, $hour, $min, $sec);
160 161 162 163 164 165
        if ($u->{created_by}) {
            $msg .= '    created_by : %s';
            say sprintf($msg, $u->{short}, $u->{url}, $u->{counter}, $timestamp, $u->{timestamp}, $u->{created_by});
        } else {
            say sprintf($msg, $u->{short}, $u->{url}, $u->{counter}, $timestamp, $u->{timestamp});
        }
166 167 168 169 170 171 172 173 174 175 176 177
    }
}

=encoding utf8

=head1 NAME

Lstu::Command::url - Manage URL in Lstu's database

=head1 SYNOPSIS

  Usage:
Luc Didry's avatar
Luc Didry committed
178 179 180 181 182
      carton exec script/lstu url --info <short> <short>           Print infos about the space-separated URLs
      carton exec script/lstu url --remove <short> <short> [--yes] Remove the space-separated URLs (ask for confirmation unless --yes is given)
                                                                   Will print infos about URL before confirmation
      carton exec script/lstu url --search <url>                   Search URLs by its true URL (LIKE match)
      carton exec script/lstu url --ip <ip address>                Search URLs by the IP address of its creator (exact match)
183 184 185 186

=cut

1;