eleksir/joyproxy
0
Fork 0
Code Activity

Initial commit

Browse Source
This commit is contained in:
eleksir
2024-06-08 11:06:42 +03:00
commit 0c2651c4b5
10 changed files with 454 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
vendor_perl/**

103
.perlcriticrc Normal file
View File

@@ -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

21
LICENSE.txt Normal file
View File

@@ -0,0 +1,21 @@
Copyright (c) 2022 Sergei Fedosoff <eleksir@gmail.com>
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.

50
README.md Normal file
View File

@@ -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

5
bootstrap.sh Normal file
View File

@@ -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:

4
cpanfile Normal file
View File

@@ -0,0 +1,4 @@
requires 'HTTP::Tiny';
requires 'URI::URL';
requires 'URI::Escape';
requires 'Plack::Util';

12
joyproxy.ini Normal file
View File

@@ -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

193
joyproxy.pm Normal file
View File

@@ -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";
<html>
<body>
<form method='get' action='joyurl'>
<input type='text' name='joyurl' size=100 autofocus><br />
<input type='submit' value='Post it!' style='font-size:115%;' />
<br>$str
</body>
</html>\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:

48
joyproxy.psgi Normal file
View File

@@ -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:

17
joyproxy.yaml Normal file
View File

@@ -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