Initial commit
This commit is contained in:
eleksir
193
joyproxy.pm
Normal file
193
joyproxy.pm
Normal 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:
|
||||
Reference in New Issue
Block a user