Initial commit

2024-06-08 11:06:42 +03:00
commit 0c2651c4b5
10 changed files with 454 additions and 0 deletions
--- a/.gitignore
+++ b/.gitignore
@@ -0,0 +1 @@
+vendor_perl/**
--- a/.perlcriticrc
+++ 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
--- a/LICENSE.txt
+++ b/LICENSE.txt
@@ -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.
+
--- a/README.md
+++ 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
--- a/bootstrap.sh
+++ 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:
--- a/4
+++ b/4
@@ -0,0 +1,4 @@
+requires 'HTTP::Tiny';
+requires 'URI::URL';
+requires 'URI::Escape';
+requires 'Plack::Util';
--- a/joyproxy.ini
+++ 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
--- a/joyproxy.pm
+++ 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";
+<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:
--- a/joyproxy.psgi
+++ 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:
--- a/joyproxy.yaml
+++ 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