Reactor code. Some assorted bits of fixes.

* Check read() results where possible * Use unbuffered writes for temp files * Use vars instead of bare words as file handles * Use $VERSION * Coding style fixes * Update of Readme.md
2021-02-11 01:05:03 +03:00
3 changed files with 110 additions and 85 deletions
--- a/README.md
+++ b/README.md
@@ -18,8 +18,10 @@
 ## Как это работает?

 При обращении к сгенерённому урлу, апи вначале идёт на сайт, выкачивает
-видосик во временный каталог, отдаёт видосик клиенту и удаляет его из
-временного каталога. Есть встроенное ограничение на размер файла в 10Мб.
+видосик во временный каталог, отдаёт видосик клиенту. Есть встроенное
+ограничение на размер файла в 10Мб.
+
+N.B. Файлы из временного каталога автоматически не вычищаются.

 ## Как это запустить?

--- 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 = "<html>\n<body>\n<form method='get' action='joyurl'>\n<input type='text' name='joyurl' size=100 autofocus><br />\n<input type='submit' value='Post it!'' style='font-size:115%;'' />\n<br>$str\n</body>\n</html>\n";
+	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);
 }
@@ -97,71 +122,72 @@ sub __urlencode($) {
 	my $str = shift;
 	my $urlobj = url $str;
 	$str = $urlobj->as_string;
-	$urlobj = undef;
-	undef $urlobj;
+	$urlobj = '';
 	return $str;
 }

 sub __dlfunc($) {
 	my $url = shift;

-	if (! -d "/tmp/joyproxy") {
-		warn "no /tmp/joyproxy";
-		return (undef, undef) unless (mkdir("/tmp/joyproxy"));
+	unless (-d '/tmp/joyproxy') {
+		warn 'no /tmp/joyproxy';
+
+		unless (mkdir '/tmp/joyproxy') {
+			return (undef, undef);
+		}
 	}

-	my @tmparray = split(/\//, $url);
-	my $file = $tmparray[@tmparray - 1];
-	$#tmparray = -1; undef @tmparray;
-	$file = "/tmp/joyproxy/" . $file;
-	$url = __urlencode($url);
+	my @explodedurl = split /\//msx, $url;
+	my $file = $explodedurl[$#explodedurl];
+	$#explodedurl = -1; undef @explodedurl;
+	$file = '/tmp/joyproxy/' . $file;
+	$url = __urlencode ($url);

-	my $http = HTTP::Tiny->new(max_size => 10485760);
+	my $http = HTTP::Tiny->new (max_size => 10485760);

-	my $response = $http->get(
+	# 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"
+				'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;

-		open (FILE, '>', $file) or do {
-			$http = undef;
-			$response = undef;
+		sysopen (my $FILE, $file, O_CREAT|O_TRUNC|O_WRONLY) or do {
+			$response = '';
 			return (undef, undef);
 		};

-		binmode FILE;
+		binmode $FILE;

-		print (FILE $response->{content}) or do {
-			$http = undef;
-			$response = undef;
+		syswrite ($FILE, $response->{content}) or do {
+			close $FILE;
+			$response = '';
 			return (undef, undef);
 		};

-		close FILE;
-		$http = undef;
-		$response = undef;
-		$filesize = (stat($file))[7];
+		close $FILE;
+		$response = '';
+		$filesize = (stat $file )[7];
 		return ($file, $filesize);
 	} else {
-		$http = undef;
-		$response = undef;
+		$response = '';
 		return (undef, undef);
 	}
 }

-
 1;

 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/joyproxy.psgi
+++ b/joyproxy.psgi
@@ -1,13 +1,12 @@
 use 5.018;
 use strict;
-use warnings "all";
+use warnings;
 use utf8;
-use open qw(:std :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);
-
-$| = 1;
+use lib qw (. ./vendor_perl/lib/perl5);
+use joyproxy qw (joyurl joyproxy);

 my $app = sub {
 	my $env = shift;
@@ -16,25 +15,23 @@ my $app = sub {
 	my $status = '404';
 	my $content = 'text/plain';

-	if ($env->{PATH_INFO} =~ /^\/joyproxy\/(.+)/) {
+	if ($env->{PATH_INFO} =~ /^\/joyproxy\/(.+)/xmsg) {
 		my $joyproxyurl = $1;
-		($status, $content, $msg) = ('400', $content, "Bad Request?\n");
+		($status, $msg) = ('400', "Bad Request?\n");

-		if (($joyproxyurl =~ /\.mp4/i) or ($joyproxyurl =~ /\.webm/i)) {
-			($status, $content, $msg) = joyproxy($joyproxyurl);
+		if (($joyproxyurl =~ /\.mp4$/xmsgi) or ($joyproxyurl =~ /\.webm$/xmsgi)) {
+			($status, $content, $msg) = joyproxy $joyproxyurl ;
 		}
 	}

-	if ($env->{PATH_INFO} =~ /^\/joyurl/) {
-		if (defined($env->{QUERY_STRING})) {
-			($status, $content, $msg) = joyurl($env->{QUERY_STRING}, $env->{HTTP_HOST});
-		} else {
-			($status, $content, $msg) = joyurl('', $env->{HTTP_HOST});
-		}
+	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);
+	my $length = length $msg;
 	no bytes;

 	return [