commit 0c2651c4b56278d99535f4710cacb7e437d5fa61 Author: eleksir Date: Sat Jun 8 11:06:42 2024 +0300 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..14c56ab --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +vendor_perl/** diff --git a/.perlcriticrc b/.perlcriticrc new file mode 100644 index 0000000..6aab75e --- /dev/null +++ b/.perlcriticrc @@ -0,0 +1,103 @@ +#!/usr/bin/env perlcritic +severity = 5 +verbose = 8 + +# minorify some of warnings that are not really critical +[-InputOutput::RequireCheckedClose] +# What can we handle in case of error? + +[-Modules::ProhibitExcessMainComplexity] +# Noone cares + +[-Subroutines::ProhibitExcessComplexity] +# Noone cares + +[-Subroutines::ProhibitExplicitReturnUndef] +# But it's very handy sometimes! + +[-ValuesAndExpressions::ProhibitMagicNumbers] +# this policy makes too much false positives + +[-RegularExpressions::RequireLineBoundaryMatching] +# We use /m as needed + +[-RegularExpressions::RequireExtendedFormatting] +# We do not use extended formatting of regex, they still not THAT complex + +[-RegularExpressions::RequireDotMatchAnything] +# huh? + +[-RegularExpressions::ProhibitEscapedMetacharacters] +# Looks like it pointless + +[-ControlStructures::ProhibitCascadingIfElse] +# I like long if..else chains + +[-ControlStructures::ProhibitPostfixControls] +# In short lines we can afford ourselves to use postfix controls +# but of course we should avoid such constructions in long lines. + +[-Subroutines::ProhibitSubroutinePrototypes] +# Contrary to Perl::Critic we consider prototypes as useful, even if +# the compile-time checks of Perl are not perfect, Perl may give some +# hints. + +[-CodeLayout::RequireTidyCode] +# Impossible to complete, because of on higher linting levels "## no critic..." +# require be per-case on same line where critique is, but tidy align them +# one line down. + +[-CodeLayout::ProhibitParensWithBuiltins] +# duh... + +[-ValuesAndExpressions::ProhibitEmptyQuotes] +# cause we consider following correct and useful: my $var = ''; +# the recommended use of q{} looks too complex: my $var = q{}; + +[-ValuesAndExpressions::ProhibitNoisyQuotes] +# Other people, other opinions: "," is better readable than qw(,) + +[-BuiltinFunctions::ProhibitSleepViaSelect] +# We do not wish to use too much external modules. +# select undef, undef, undef, 0.25; # actually is okay if you add comment that +# it is sleep for 0.25 seconds + +[-NamingConventions::Capitalization] +# duh... +# Noone cares, really + +[-ControlStructures::ProhibitUnlessBlocks] +# They should not be too complex - only one condition should be checked, +# that's all + +[-Miscellanea::ProhibitTies] +# Just allow it. It's very handy stuff and extremely simple and safe enough to use. + +[-ValuesAndExpressions::RequireNumberSeparators] +# Not really + +[-InputOutput::RequireBracedFileHandleWithPrint] +# We prefer not to use braced file handles + +[-Documentation::PodSpelling] +# It doesn't help, but emits annoying errors + +[Documentation::RequirePodSections] +# Considering this as "soft" requirement. For modules that is (or will be) +# stand-alone libs well formed documentation is highly desired. +lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT + +[-ErrorHandling::RequireCheckingReturnValueOfEval] +# In this app eval is not critical to error, so there is no need to check for it + +[-InputOutput::RequireBriefOpen] +# Yes, i do! + +[-InputOutput::RequireCheckedSyscalls] +# What can go wrong in "say"? what and how should i handle in this case? + +[-ControlStructures::ProhibitDeepNests] +# Oh, really? Maybe you know better solution? + +[-Variables::ProhibitPunctuationVars] +# I don't want use English here \ No newline at end of file diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..70466f0 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,21 @@ +Copyright (c) 2022 Sergei Fedosoff + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + diff --git a/README.md b/README.md new file mode 100644 index 0000000..401f41f --- /dev/null +++ b/README.md @@ -0,0 +1,50 @@ +# Joyproxy + +Эта версия приложения устаревшая, она не поддерживается и размещена +исключительно в ознакомительных целях. + +## Что это? + +Своего рода API, делающий запросы в img#.reactor.cc + +## Зачем это нужно? + +Сайт reactor.cc не даёт возможности постить на внешние ресурсы ссылки без +указания правильного referer-а. + +Эта прокся призвана частично решить эту проблему через создание линков вида +`https://сайт/joyproxy/img1.reactor.cc/pics/post/mp4/видосик.mp4` + +Сгенерировать ссылку можно запостив урл с видосиком в форму на страничке +`https://сайт/joyurl` + +## Как это работает? + +При обращении к сгенерённому урлу, апи вначале идёт на сайт, выкачивает +видосик во временный каталог, отдаёт видосик клиенту. Есть встроенное +ограничение на размер файла в 10Мб. + +N.B. Файлы из временного каталога автоматически не вычищаются. Получается +своего рода "перманентный" кэш. + +## Как это запустить? + +Я это запускаю как [PSGI][1]-приложение, через [UWSGI][2]. + +Для запуска понадобятся: + +* uwsgi версии 2.0.15 или новее +* perl-5.18 или новее (вплоть до 5.32.x) +* модули perl-HTTP-Tiny, perl-URI-URL, perl-URL-Escape, perl-local-lib. + +Можно использовать модули из системы, а можно подтянуть их из CPAN-а с помощью +[cpanm][3] (но, правда, perl-local-lib всё же придётся поставить, так как без +него ничего не заработает). + +## Кому сказать спасибо? + +Авторам, редакторам и тем, кто поддерживает `reactor.cc` + +[1]: https://uwsgi-docs.readthedocs.io/en/latest/Perl.html +[2]: https://github.com/unbit/uwsgi +[3]: https://github.com/miyagawa/cpanminus diff --git a/bootstrap.sh b/bootstrap.sh new file mode 100644 index 0000000..697f373 --- /dev/null +++ b/bootstrap.sh @@ -0,0 +1,5 @@ +#!/bin/bash + +cpanm -l vendor_perl --self-contained --force --update --installdeps . + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..a040f62 --- /dev/null +++ b/cpanfile @@ -0,0 +1,4 @@ +requires 'HTTP::Tiny'; +requires 'URI::URL'; +requires 'URI::Escape'; +requires 'Plack::Util'; diff --git a/joyproxy.ini b/joyproxy.ini new file mode 100644 index 0000000..4b7c453 --- /dev/null +++ b/joyproxy.ini @@ -0,0 +1,12 @@ +[settings] +; This server can be behind reverse-proxy, set here http or https proto, correct for incomming connecions +proto = http + +; we listen on *:this_port +port = 9980 + +; timeout for upstream connection +timeout = 30 + +; loglevel - info or debug, info is what you want +loglevel = debug \ No newline at end of file diff --git a/joyproxy.pm b/joyproxy.pm new file mode 100644 index 0000000..f354abe --- /dev/null +++ b/joyproxy.pm @@ -0,0 +1,193 @@ +package joyproxy; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); + +use Carp qw (carp); +use Fcntl; +use HTTP::Tiny; +use URI::URL; +use URI::Escape qw (uri_unescape); + +use Exporter qw (import); +use version; our $VERSION = qw (1.1.1); +our @EXPORT_OK = qw (joyproxy joyurl); + +sub joyproxy ($) { + my $str = shift; + chomp $str; + + # 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"); + + if (defined $file) { + my $buf = ''; + + if (open my $VID, '<', $file) { + binmode $VID; + my $readlen = read ($VID, $buf, $filesize); + close $VID; + + if (defined $readlen) { + if ($readlen != $filesize) { + carp "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 { + carp "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$/xmsgi) { + return ('200', 'video/webm', $buf); + } else { + return ('200', 'video/mpeg', $buf); + } + } else { + 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"); + } +} + +sub joyurl (@) { + my $str = shift; + my $host = shift; + + # TODO: handle error here + $str = uri_unescape $str; + + if (length ($str) < 60) { + $str = ''; + } + + if ($str =~ /^joyurl=https?\:\/\/(img\d+\.reactor\.cc.+)/xmsg) { + my $string = $1; + # img1.reactor.cc/pics/post/webm/видосик.webm + my @url = split /\//msx, $string; + + 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, -5) if (substr ($url[4], -5, 6) eq '.webm'); + $fname = substr ($url[4], 0, -4) if (substr ($url[4], -4, 4) eq '.mp4'); + + $string = sprintf ( + 'https://%s/joyproxy/%s/%s/%s/mp4/%s.mp4', + $host, + $url[0], + $url[1], + $url[2], + $fname + ); + + $str = __urlencode ($string); + } else { + $str = ''; + } + } else { + $str = ''; + } + + my $msg = << "EOL"; + + +
+
+ +
$str + +\n +EOL + + return ('200', 'text/html', $msg); +} + +sub __urlencode($) { + my $str = shift; + my $urlobj = url $str; + $str = $urlobj->as_string; + $urlobj = ''; + return $str; +} + +sub __dlfunc($) { + my $url = shift; + + unless (-d '/tmp/joyproxy') { + carp 'no /tmp/joyproxy'; + + unless (mkdir '/tmp/joyproxy') { + return (undef, undef); + } + } + + my @explodedurl = split /\//msx, $url; + my $file = $explodedurl[$#explodedurl]; ## no critic (Variables::RequireNegativeIndices) + $#explodedurl = -1; undef @explodedurl; + $file = '/tmp/joyproxy/' . $file; + $url = __urlencode ($url); + + my $http = HTTP::Tiny->new (max_size => 10485760); + + # use ->get because of ->mirror does not respect max_size + my $response = $http->get ( + $url, + { + headers => { + 'Accept' => '*/*', + 'Accept-Encoding' => 'identity;q=1, *;q=0', + 'Accept-Language' => 'ru-RU,ru;q=0.9,en-US;q=0.8,en;q=0.7', + 'Range' => 'bytes=0-', + 'Referer' => 'http://old.reactor.cc/all', + 'User-Agent' => 'Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/80.0.3987.116 Safari/537.36' + } + } + ); + + $http = ''; + + if ($response->{success}) { + my $filesize = 0; + + sysopen (my $FILE, $file, O_CREAT|O_TRUNC|O_WRONLY) or do { + $response = ''; + return (undef, undef); + }; + + binmode $FILE; + + syswrite ($FILE, $response->{content}) or do { + close $FILE; + $response = ''; + return (undef, undef); + }; + + close $FILE; + $response = ''; + $filesize = (stat $file )[7]; + return ($file, $filesize); + } else { + $response = ''; + return (undef, undef); + } +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/joyproxy.psgi b/joyproxy.psgi new file mode 100644 index 0000000..b6224fb --- /dev/null +++ b/joyproxy.psgi @@ -0,0 +1,48 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use version; our $VERSION = qw (1.1.0); + +use lib qw (. ./vendor_perl/lib/perl5); +use joyproxy qw (joyurl joyproxy); + +my $app = sub { + my $env = shift; + + my $msg = "Your Opinion is very important for us, please stand by.\n"; + my $status = '404'; + my $content = 'text/plain'; + + if ($env->{PATH_INFO} =~ /^\/joyproxy\/(.+)/xmsg) { + my $joyproxyurl = $1; + ($status, $msg) = ('400', "Bad Request?\n"); + + if (($joyproxyurl =~ /\.mp4$/xmsgi) or ($joyproxyurl =~ /\.webm$/xmsgi)) { + ($status, $content, $msg) = joyproxy $joyproxyurl ; + } + } + + if ($env->{PATH_INFO} =~ /^\/joyurl/xmsg) { + my $querystring = $env->{QUERY_STRING} // ''; + + ($status, $content, $msg) = joyurl ($querystring, $env->{HTTP_HOST}); + } + + use bytes; + my $length = length $msg; + no bytes; + + return [ + $status, + [ 'Content-Type' => $content, 'Content-Length' => $length ], + [ $msg ], + ]; +}; + + +__END__ +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/joyproxy.yaml b/joyproxy.yaml new file mode 100644 index 0000000..249980e --- /dev/null +++ b/joyproxy.yaml @@ -0,0 +1,17 @@ +uwsgi: + http-socket: 127.0.0.1:3081 + socket-protocol: http + so-keepalive: 0 + logformat: %(var.REMOTE_ADDR) %(var.REQUEST_METHOD) %(var.REQUEST_URI) %(status) + processes: 1 + need-app: true + log-reopen: yes + reload-mercy: 5 + buffer-size: 32768 + die-on-term: true + pidfile: /run/joyproxy/joyproxy.pid + logto: /var/log/joyproxy/joyproxy.log + plugins: psgi + chdir: /var/lib/joyproxy + psgi: /var/lib/joyproxy/joyproxy.psgi + perl-local-lib: /var/lib/joyproxy/vendor_perl \ No newline at end of file