lutim/lib/Lutim/Plugin/Helpers.pm

# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lutim::Plugin::Helpers;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::Util qw(quote);
use Mojo::File;
use Crypt::CBC;
use Data::Entropy qw(entropy_source);
use DateTime;
use Mojo::Util qw(decode);
use ISO::639_1;
use Digest::MD5 'md5';

sub register {
    my ($self, $app) = @_;


    if ($app->config('dbtype') eq 'postgresql') {
        require Mojo::Pg;
        $app->plugin('PgURLHelper');
        $app->helper(pg => \&_pg);

        # Database migration
        my $migrations = Mojo::Pg::Migrations->new(pg => $app->pg);
        if ($app->mode eq 'development' && $ENV{LUTIM_DEBUG}) {
            $migrations->from_file('utilities/migrations/postgresql.sql')->migrate(0)->migrate(3);
        } else {
            $migrations->from_file('utilities/migrations/postgresql.sql')->migrate(3);
        }
    } elsif ($app->config('dbtype') eq 'sqlite') {
        # SQLite database migration if needed
        require Mojo::SQLite;
        $app->helper(sqlite => \&_sqlite);

        my $sql = Mojo::SQLite->new('sqlite:'.$app->config('db_path'));
        my $migrations = $sql->migrations;
        if ($app->mode eq 'development' && $ENV{LUTIM_DEBUG}) {
            $migrations->from_file('utilities/migrations/sqlite.sql')->migrate(0)->migrate(2);
        } else {
            $migrations->from_file('utilities/migrations/sqlite.sql')->migrate(2);
        }
    }

    $app->helper(render_file        => \&_render_file);
    $app->helper(ip                 => \&_ip);
    $app->helper(provisioning       => \&_provisioning);
    $app->helper(shortener          => \&_shortener);
    $app->helper(stop_upload        => \&_stop_upload);
    $app->helper(max_delay          => \&_max_delay);
    $app->helper(default_delay      => \&_default_delay);
    $app->helper(is_selected        => \&_is_selected);
    $app->helper(is_wm_selected     => \&_is_wm_selected);
    $app->helper(crypt              => \&_crypt);
    $app->helper(decrypt            => \&_decrypt);
    $app->helper(delete_image       => \&_delete_image);
    $app->helper(iso639_native_name => \&_iso639_native_name);
    $app->helper(prefix             => \&_prefix);
}

sub _pg {
    my $c     = shift;

    state $pg = Mojo::Pg->new($c->app->pg_url($c->app->config('pgdb')));
    return $pg;
}

sub _sqlite {
    my $c     = shift;

    state $sqlite = Mojo::SQLite->new('sqlite:'.$c->app->config('db_path'));
    return $sqlite;
}

sub _render_file {
    my $c = shift;
    my ($im_loaded, $img, $dl, $key, $thumb) = @_;

    my ($filename, $path, $iv, $mediatype, $no_cache) = ($img->filename, $img->path, $img->iv, $img->mediatype, $img->delete_at_first_view);

    my $expires = ($img->delete_at_day) ? $img->delete_at_day : 360;
    my $dt = DateTime->from_epoch( epoch => $expires * 86400 + $img->created_at);
    $dt->set_time_zone('GMT');
    $expires = $dt->strftime("%a, %d %b %Y %H:%M:%S GMT");

    $dl       = 'attachment' if ($mediatype =~ m/svg/);
    $filename = quote($filename);

    unless (-f $path && -r $path) {
        $c->app->log->error("Cannot read file [$path]. error [$!]");
        $c->flash(
            msg => $c->l('Unable to find the image: it has been deleted.')
        );
        return 500;
    }

    $mediatype =~ s/x-//;

    my $headers = Mojo::Headers->new();
    if ($no_cache || defined($thumb)) {
        $headers->add('Cache-Control'   => 'no-cache, no-store, max-age=0, must-revalidate');
    } else {
        $headers->add('Expires'         => $expires);
    }
    $headers->add('Content-Type'        => $mediatype.';name='.$filename);
    $headers->add('Content-Disposition' => $dl.';filename='.$filename);
    $c->res->content->headers($headers);

    my $cache;
    if ($c->config('cache_max_size') != 0 || scalar(@{$c->config('memcached_servers')})) {
        $cache = $c->chi('lutim_images_cache')->compute($img->short, undef, sub {
            if ($key) {
                return {
                    asset => $c->decrypt($key, $path, $iv),
                    key   => $key
                };
            } else {
                return {
                    asset => Mojo::File->new($path)->slurp,
                };
            }
        });
        if ($key && $key ne $cache->{key}) {
            my $tmp = $c->decrypt($key, $path, $iv);
            $cache->{asset} = $tmp;
            $c->chi('lutim_images_cache')->replace(
                $img->short,
                {
                    asset => $tmp,
                    key   => $key
                },
            );
        }
    } else {
        if ($key) {
            $cache = {
                asset => $c->decrypt($key, $path, $iv),
            };
        } else {
            $cache = {
                asset => Mojo::File->new($path)->slurp,
            };
        }
    }
    # Extend expiration time
    my $asset = Mojo::Asset::Memory->new;
    $asset->add_chunk($cache->{asset});

    if (defined $thumb && $im_loaded && $mediatype ne 'image/svg+xml' && $mediatype !~ m#image/(x-)?xcf# && $mediatype ne 'image/avif') { # ImageMagick don't work in Debian with svg (for now?)
        my $im  = Image::Magick->new;
        $im->BlobToImage($asset->slurp);

        # Create the thumbnail
        if ($thumb eq '') {
            $im->Resize(geometry => 'x'.$c->config('thumbnail_size'));
        } else {
            $im->Resize(geometry => $thumb);
        }

        # Replace the asset with the thumbnail
        $asset = Mojo::Asset::Memory->new->add_chunk($im->ImageToBlob());
    }

    $c->res->content->asset($asset);
    $headers->add('Content-Length' => $asset->size);

    return $c->rendered(200);
}

sub _ip {
    my $c  = shift;
    my $ip_only = shift || 0;

    my $proxy = $c->req->headers->header('X-Forwarded-For');

    my $ip = ($proxy) ? $proxy : $c->tx->remote_address;

    my $remote_port = (defined($c->req->headers->header('X-Remote-Port'))) ? $c->req->headers->header('X-Remote-Port') : $c->tx->remote_port;

    return ($ip_only) ? $ip : "$ip remote port:$remote_port";
}

sub _provisioning {
    my $c = shift;

    # Create some short patterns for provisioning
    my $img = Lutim::DB::Image->new(app => $c->app);
    if ($img->count_empty < $c->app->config('provisioning')) {
        for (my $i = 0; $i < $c->app->config('provis_step'); $i++) {
            my $short;
            do {
                $short = $c->shortener($c->app->config('length'));
            } while ($img->count_short($short) || $short eq 'about' || $short eq 'stats' || $short eq 'd' || $short eq 'm' || $short eq 'gallery' || $short eq 'zip' || $short eq 'infos');

            $img->short($short)
                ->counter(0)
                ->enabled(1)
                ->delete_at_first_view(0)
                ->delete_at_day(0)
                ->mod_token($c->shortener($c->app->config('token_length')))
                ->write('provisioning');

            $img = Lutim::DB::Image->new(app => $c->app);
        }
    }
}

sub _shortener {
    my $c      = shift;
    my $length = shift;

    my @chars  = ('a'..'z','A'..'Z','0'..'9');
    my $result = '';
    foreach (1..$length) {
        $result .= $chars[entropy_source->get_int(scalar(@chars))];
    }
    return $result;
}

sub _stop_upload {
    my $c = shift;

    if (-f 'stop-upload' || -f 'stop-upload.manual') {
        $c->stash(
            stop_upload => $c->l('Uploading is currently disabled, please try later or contact the administrator (%1).', $c->app->config('contact'))
        );
        return 1;
    }
    return 0;
}

sub _max_delay {
    my $c = shift;

    return $c->app->config('max_delay') if ($c->app->config('max_delay') >= 0);

    warn "max_delay set to a negative value. Default to 0.";
    return 0;
}

sub _default_delay {
    my $c = shift;

    return $c->app->config('default_delay') if ($c->app->config('default_delay') >= 0);

    warn "default_delay set to a negative value. Default to 0.";
    return 0;
}

sub _is_selected {
    my $c   = shift;
    my $num = shift;

    return ($num == $c->default_delay) ? 'selected="selected"' : '';
}

sub _is_wm_selected {
    my $c  = shift;
    my $wm = shift;

    return ($wm eq $c->config('watermark_default')) ? 'selected="selected"' : '';
}

sub _key_from_key {
    my $key = shift;

    # Key size for Blowfish is 56
    my $ks = 56;
    my $material = md5($key);
    while (length($material) < $ks) {
        $material .= md5($material);
    }
    return substr($material,0,$ks);
}

sub _crypt {
    my $c        = shift;
    my $upload   = shift;
    my $filename = shift;

    my $key   = $c->shortener($c->config('crypto_key_length'));
    my $iv    = $c->shortener(8);

    my $cipher = Crypt::CBC->new(
        -key         => _key_from_key($key),
        -cipher      => 'Blowfish',
        -header      => 'none',
        -literal_key => 1,
        -pbkdf       => 'pbkdf2',
        -iv          => $iv
    );

    $cipher->start('encrypting');

    my $crypt_asset = Mojo::Asset::File->new;

    $crypt_asset->add_chunk($cipher->crypt($upload->slurp));
    $crypt_asset->add_chunk($cipher->finish);

    my $crypt_upload = Mojo::Upload->new;
    $crypt_upload->filename($filename);
    $crypt_upload->asset($crypt_asset);

    return ($crypt_upload, $key, $iv);
}

sub _decrypt {
    my $c    = shift;
    my $key  = _key_from_key(shift);
    my $file = shift;
    my $iv   = shift;
    $iv = 'dupajasi' unless $iv;

    my $cipher = Crypt::CBC->new(
        -key         => $key,
        -cipher      => 'Blowfish',
        -header      => 'none',
        -literal_key => 1,
        -pbkdf       => 'pbkdf2',
        -iv          => $iv
    );

    $cipher->start('decrypting');

    my $decrypt_asset = Mojo::Asset::File->new;

    open(my $f, "<",$file) or die "Unable to read encrypted file: $!";
    binmode $f;
    while (read($f, my $buffer, 1024)) {
          $decrypt_asset->add_chunk($cipher->crypt($buffer));
    }
    $decrypt_asset->add_chunk($cipher->finish) ;

    return $decrypt_asset->slurp;
}

sub _delete_image {
    my $c   = shift;
    my $img = shift;
    if ($c->config('cache_max_size') != 0 || scalar(@{$c->config('memcached_servers')})) {
        $c->chi('lutim_images_cache')->remove($img->short);
    }
    unlink $img->path or warn "Could not unlink ".$img->path.": $!";
    $img->disable();
}

sub _iso639_native_name {
    my $c = shift;
    return ucfirst(decode 'UTF-8', get_iso639_1(shift)->{nativeName});
}

sub _prefix {
    my $c = shift;

    my $prefix = $c->url_for('/')->to_abs;
    # Forced domain
    $prefix->host($c->config('fixed_domain')) if (defined($c->config('fixed_domain')) && $c->config('fixed_domain') ne '');
    # Hack for prefix (subdir) handling
    $prefix .= '/' unless ($prefix =~ m#/$#);
    return $prefix;
}

1;