diff --git a/README.md b/README.md index 8488a14..2b59a8e 100644 --- a/README.md +++ b/README.md @@ -18,8 +18,10 @@ ## Как это работает? При обращении к сгенерённому урлу, апи вначале идёт на сайт, выкачивает -видосик во временный каталог, отдаёт видосик клиенту и удаляет его из -временного каталога. Есть встроенное ограничение на размер файла в 10Мб. +видосик во временный каталог, отдаёт видосик клиенту. Есть встроенное +ограничение на размер файла в 10Мб. + +N.B. Файлы из временного каталога автоматически не вычищаются. ## Как это запустить? diff --git a/joyproxy.pm b/joyproxy.pm index 6e202e9..4cd4973 100644 --- a/joyproxy.pm +++ b/joyproxy.pm @@ -2,47 +2,61 @@ package joyproxy; use 5.018; use strict; -use warnings "all"; +use warnings; use utf8; -use open qw(:std :utf8); +use open qw (:std :utf8); +use Fcntl; use HTTP::Tiny; use URI::URL; -use URI::Escape qw(uri_unescape); +use URI::Escape qw (uri_unescape); -use Exporter qw(import); -use vars qw/$VERSION/; - -$VERSION = "1.0"; -our @EXPORT = qw(joyproxy joyurl); - -$| = 1; +use Exporter qw (import); +use version; our $VERSION = qw (1.1.0); +our @EXPORT_OK = qw (joyproxy joyurl); sub joyproxy ($) { my $str = shift; - chomp($str); + chomp $str; - return ('500', 'text/plain', 'This is not reactor video') if ($str !~ /^img[0-9]+\.reactor\.cc/); + # formal url check + if ($str !~ /^img\d+\.reactor\.cc/xmsg) { + return ('500', 'text/plain', 'This is not reactor video'); + } - my ($file, $filesize) = __dlfunc("http://$str"); + my ($file, $filesize) = __dlfunc ("http://$str"); - if (defined($file)) { + if (defined $file) { my $buf = ''; - if (open(VID, '<', $file)) { - read(VID, $buf, $filesize); - close VID; + if (open my $VID, '<', $file) { + binmode $VID; + my $readlen = read ($VID, $buf, $filesize); + close $VID; - if ($file =~ /\.mp4/i) { + if (defined $readlen) { + if ($readlen != $filesize) { + warn "Unable to read $file readlen does not match filesize: $readlen vs $filesize"; + return ('500', 'text/plain', "Unable to read file in temporary location\n"); + } + } else { + warn "Unable to read $file: $!"; + return ('500', 'text/plain', "Unable to read file in temporary location: $!\n"); + } + + if ($file =~ /\.mp4$/xmsgi) { return ('200', 'video/mp4', $buf); - } elsif ($file =~ /\.webm/i) { + } elsif ($file =~ /\.webm$/xmsgi) { return ('200', 'video/webm', $buf); } else { return ('200', 'video/mpeg', $buf); } } else { - unlink $file if (-f $file); - return ('500', 'text/plain', "Unable to open file in temporary loaction: $!\n"); + if (-f $file) { + unlink $file; + } + + return ('500', 'text/plain', "Unable to open file in temporary location: $!\n"); } } else { return ('500', 'text/plain', "Unable to get file from remote source!\n"); @@ -52,27 +66,29 @@ sub joyproxy ($) { sub joyurl (@) { my $str = shift; my $host = shift; - $str = uri_unescape($str); - if (length($str) < 60) { + # TODO: handle error here + $str = uri_unescape $str; + + if (length ($str) < 60) { $str = ''; } else { - $str = substr($str, 14); + $str = substr $str, 14; } - if ($str =~ /^img\d+\.reactor\.cc/) { + if ($str =~ /^img\d+\.reactor\.cc/xmsg) { # img1.reactor.cc/pics/post/webm/видосик.webm - my @url = split(/\//, $str); + my @url = split /\//msx, $str; - if (($url[3] eq 'webm' || $url[3] eq 'mp4') and - ($url[4] =~ /\.webm$/ || $url[4] =~ /\.mp4$/)) { + if (($url[3] eq 'webm' || $url[3] eq 'mp4') && + ($url[4] =~ /\.webm$/xmsg || $url[4] =~ /\.mp4$/xmsg)) { # we prefer mp4, right?, so my $fname; - $fname = substr($url[4], 0, -4) if (substr($url[4], -4, 4) eq '.mp4'); - $fname = substr($url[4], 0, -5) if (substr($url[4], -5, 6) eq '.webm'); + $fname = substr ($url[4], 0, -5) if (substr ($url[4], -5, 6) eq '.webm'); + $fname = substr ($url[4], 0, -4) if (substr ($url[4], -4, 4) eq '.mp4'); - $str = sprintf( - "https://%s/joyproxy/%s/%s/%s/mp4/%s.mp4", + $str = sprintf ( + 'https://%s/joyproxy/%s/%s/%s/mp4/%s.mp4', $host, $url[0], $url[1], @@ -80,7 +96,7 @@ sub joyurl (@) { $fname ); - $str = __urlencode($str); + $str = __urlencode ($str); } else { $str = ''; } @@ -88,7 +104,16 @@ sub joyurl (@) { $str = ''; } - my $msg = "\n
\n