metagen.pm: correctly buffer munch, use vars for file and dir hanles

* Добавлена форма для превращения урлов реактора в урлы прокси
* Добавлен пример использования в .psgi-файл

lib/buildinfo.pm

@@ -5,7 +5,6 @@ use warnings "all";
 use vars qw/$VERSION/;
 use conf;
 use JSON::XS;
-use Data::Dumper;
 
 use Exporter qw(import);
 our @EXPORT = qw(buildinfo);

lib/joyproxy.pm

@@ -6,18 +6,21 @@ use lib qw(./lib ./vendor_perl);
 use Fcntl qw(O_RDONLY O_WRONLY O_CREAT O_TRUNC);
 use HTTP::Tiny;
 use URI::URL;
+use URI::Escape;
+use conf;
 
 use Exporter qw(import);
 use vars qw/$VERSION/;
 $VERSION = "1.0";
-our @EXPORT = qw(joyproxy);
+our @EXPORT = qw(joyproxy joyurl);
 
+my $CONF = loadConf();
 
 sub joyproxy ($) {
 	my $str = shift;
 	chomp($str);
 
-	return ('500', 'text/plain', 'This is not reactor video') if ($str !~ /^img[0|1]\.reactor\.cc/);
+	return ('500', 'text/plain', 'This is not reactor video') if ($str !~ /^img[0-9]+\.reactor\.cc/);
 
 	my ($file, $filesize) = __dlfunc("http://$str");
 
@@ -44,6 +47,57 @@ sub joyproxy ($) {
 	}
 }
 
+sub joyurl ($) {
+	my $str = shift;
+	$str = uri_unescape($str);
+
+	if (length($str) < 60) {
+		$str = '';
+	} else {
+		$str = substr($str, 14);
+	}
+
+	if ($str =~ /^img\d+\.reactor\.cc/) {
+# img1.reactor.cc/pics/post/webm/видосик.webm
+		my @url = split(/\//, $str);
+
+		if (($url[3] eq 'webm' || $url[3] eq 'mp4') and
+		    ($url[4] =~ /\.webm$/ || $url[4] =~ /\.mp4$/)) {
+# 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');
+
+			$str = sprintf(
+				"https://exs-elm.ru%s/joyproxy/%s/%s/%s/mp4/%s.mp4",
+				$CONF->{api}->{prefix},
+				$url[0],
+				$url[1],
+				$url[2],
+				$fname
+			);
+
+			$str = __urlencode($str);
+		} else {
+			$str = '';
+		}
+	} else {
+		$str = '';
+	}
+
+	my $msg = "<html>
+<body>
+<form method='get' action='$CONF->{api}->{prefix}/joyurl'>
+<input type='text' name='joyurl' size=100 autofocus><br />
+<input type='submit' value='Post it!'' style='font-size:115%;'' />
+<br>$str
+</body>
+</html>
+";
+
+	return ('200', 'text/html', $msg);
+}
+
 sub __urlencode($) {
 	my $str = shift;
 	my $urlobj = url $str;
@@ -53,7 +107,6 @@ sub __urlencode($) {
 	return $str;
 }
 
-
 sub __dlfunc($) {
 	my $url = shift;
 
@@ -64,7 +117,7 @@ sub __dlfunc($) {
 
 	my @tmparray = split(/\//, $url);
 	my $file = $tmparray[@tmparray - 1];
-	@tmparray = -1; undef @tmparray;
+	$#tmparray = -1; undef @tmparray;
 	$file = "/tmp/joyproxy/" . $file;
 	$url = __urlencode($url);
 

lib/metagen.pm

@@ -18,9 +18,11 @@
 
 package metagen;
 
-use warnings "all";
+use warnings;
 use strict;
 
+use utf8;
+use open qw(:std :utf8);
 use Fcntl;
 use Compress::Raw::Bzip2 qw(BZ_RUN_OK BZ_STREAM_END);
 use Compress::Raw::Zlib;
@@ -42,7 +44,7 @@ sub metagen($) {
 	$dir = $c->{metagen}->{$dir};
 
 	unless (defined($dir)) {
-		return ('400', 'text/plain', "No such repository\n");
+		return ('400', 'text/plain',  "No such repository\n");
 	}
 
 	opendir(my $dh, $dir) or do {
@@ -75,13 +77,13 @@ sub metagen($) {
 
 	foreach my $str (@list) {
 		if ($str =~ /\.lst/) {
-			open (F, '<', "$dir/$str") or do {
+			open (my $LSTHANDLE, '<', "$dir/$str") or do {
 				warn "[FATA] Unable to open file $dir/$str: $!";
 				return  ('500', 'text/plain',  "Unable to open file $dir/$str: $!\n");
 			};
 
 			my $len = (stat("$dir/$str"))[7];
-			my $readlen = read(F, $buf, $len);
+			my $readlen = read($LSTHANDLE, $buf, $len);
 
 			unless (defined($readlen)) {
 				warn "[FATA] Unable to read $dir/$str: $!";
@@ -93,15 +95,16 @@ sub metagen($) {
 				return ('500', 'text/plain', "Unable to read $dir/$str\n");
 			}
 
-# we need exactly 1 \n at the end of the buffer
+# we need exactly 3 \n at the end of the buffer
-			while (substr($buf, -2, -1) eq "\n") {
+			while (substr($buf, -1) eq "\n") {
 				chop($buf);
 			}
+
 			$buf .= "\n\n\n";
 
 # also $buffer must not begin with \n
 			while (substr($buf, 0, 1) eq "\n") {
-				$buf = substr($buf, 1, -1);
+				$buf = substr($buf, 1);
 			}
 
 			if ($bz->bzdeflate($buf, $output) != BZ_RUN_OK) {
@@ -114,7 +117,7 @@ sub metagen($) {
 				return  ('500', 'text/plain',  "Unable to flush bz buffer\n");
 			}
 
-			close F;
+			close $LSTHANDLE;
 		}
 	}
 
@@ -125,15 +128,14 @@ sub metagen($) {
 
 	$bz = '';
 
-	sysopen(BZ, "$dir/MANIFEST.bz2", O_WRONLY|O_TRUNC|O_CREAT) or do {
+	sysopen(my $MANIFESTHANDLE, "$dir/MANIFEST.bz2", O_WRONLY|O_TRUNC|O_CREAT) or do {
 		warn "[FATA] Unable to open $dir/MANIFEST.bz2: $!";
 		return ('500', 'text/plain', "Unable to open $dir/MANIFEST.bz2: $!\n");
 	};
 
-	binmode(BZ);
+	binmode ($MANIFESTHANDLE);
 	my $len = length($output);
-	my $written = syswrite(BZ, $output, $len);
+	my $written = syswrite($MANIFESTHANDLE, $output, $len);
-	close BZ;
 
 	unless (defined($written)) {
 		warn "[FATA] Unable to write $dir/MANIFEST.bz2: $!";
@@ -145,6 +147,8 @@ sub metagen($) {
 		return ('500', 'text/plain', "Unable to write $dir/MANIFEST.bz2: written bytes does not match with buffer size\n");
 	}
 
+	close $MANIFESTHANDLE;
+
 	$output = '';
 	$buf = '';
 # checksums
@@ -167,17 +171,17 @@ MD5 message digest                Filename
 		next if ($str =~ /CHECKSUMS.md5.gz$/);
 
 		if ($str =~ /\.md5/) {
-			sysopen (F, "$dir/$str", O_RDONLY) or do {
+			sysopen (my $MD5HANDLE, "$dir/$str", O_RDONLY) or do {
 				warn "[FATA] Unable to open file $dir/$str: $!";
 				return  ('500', 'text/plain',  "Unable to open file $dir/$str: $!\n");
 			};
 
-			$buffer .= <F>;
+			$buffer .= <$MD5HANDLE>;
-			close F;
+			close $MD5HANDLE;
 		}
 	}
 
-	sysopen (CS, "$dir/CHECKSUMS.md5", O_WRONLY|O_TRUNC|O_CREAT) or do {
+	sysopen (my $CHECKSUMSHANDLE, "$dir/CHECKSUMS.md5", O_WRONLY|O_TRUNC|O_CREAT) or do {
 		warn "[FATA] Unable to open file $dir/CHECKSUMS.md5: $!";
 		return ('500', 'text/plain', "Unable to open file $dir/CHECKSUMS.md5: $!\n");
 	};
@@ -185,8 +189,8 @@ MD5 message digest                Filename
 	use bytes;
 	$len = length($buffer);
 	no bytes;
-	$written = syswrite(CS, $buffer, $len);
+	$written = syswrite($CHECKSUMSHANDLE, $buffer, $len);
-	close CS;
+	close $CHECKSUMSHANDLE;
 
 	unless (defined($written)) {
 		warn "[FATA] Unable to write $dir/CHECKSUMS.md5: $!";
@@ -223,15 +227,15 @@ MD5 message digest                Filename
 	$gz = '';
 	$buffer = '';
 
-	sysopen (F, "$dir/CHECKSUMS.md5.gz", O_WRONLY|O_TRUNC|O_CREAT) or do {
+	sysopen (my $CHECKSUMSGZHANDLE, "$dir/CHECKSUMS.md5.gz", O_WRONLY|O_TRUNC|O_CREAT) or do {
 		warn "[FATA] Unable to open file $dir/CHECKSUMS.md5.gz: $!";
 		return  ('500', 'text/plain',  "Unable to open file $dir/CHECKSUMS.md5.gz: $!\n");
 	};
 
-	binmode F;
+	binmode ($CHECKSUMSGZHANDLE);
 	$len = length($output);
-	$written = syswrite(F, $output, $len);
+	$written = syswrite($CHECKSUMSGZHANDLE, $output, $len);
-	close F;
+	close $CHECKSUMSGZHANDLE;
 
 	unless (defined($written)) {
 		warn "[FATA] Unable to write $dir/CHECKSUMS.md5.gz: $!";
@@ -247,18 +251,18 @@ MD5 message digest                Filename
 
 # packages
 	my $date = __pdate;
-	$buffer = "PACKAGES.TXT;  $date\n\n";
+	$buffer = "PACKAGES.TXT;  $date\n\n\n";
 
 	foreach my $str (@list) {
 		if ($str =~ /\.meta/) {
-			open (F, '<', "$dir/$str") or do {
+			open (my $METAHANDLE, '<', "$dir/$str") or do {
 				warn "[FATA] Unable to open file $dir/$str: $!";
 				return  ('500', 'text/plain',  "Unable to open file $dir/$str: $!\n");
 			};
 
 			my $buf;
 			my $len = (stat("$dir/$str"))[7];
-			my $readlen = read(F, $buf, $len);
+			my $readlen = read($METAHANDLE, $buf, $len);
 
 			unless (defined($readlen)) {
 				warn "[FATA] Unable to read $dir/$str: $!";
@@ -270,11 +274,11 @@ MD5 message digest                Filename
 				return ('500', 'text/plain', "Unable to read $dir/$str\n");
 			}
 
-			close F;
+			close $METAHANDLE;
 			$buffer .= $buf;
 
-# we need exactly 1 \n at the end of the buffer
+# we need exactly 2 \n at the end of the buffer
-			while (substr($buffer, -2, -1) eq "\n") {
+			while (substr($buffer, -1) eq "\n") {
 				chop($buffer);
 			}
 
@@ -282,21 +286,20 @@ MD5 message digest                Filename
 
 # also $buffer must not begin with \n
 			while (substr($buffer, 0, 1) eq "\n") {
-				$buffer = substr($buffer, 1, -1);
+				$buffer = substr($buffer, 1);
 			}
 		}
 	}
 
-	sysopen (F, "$dir/PACKAGES.TXT", O_WRONLY|O_TRUNC|O_CREAT) or do {
+	sysopen (my $PACKAGESHANDLE, "$dir/PACKAGES.TXT", O_WRONLY|O_TRUNC|O_CREAT) or do {
 		warn "[FATA] Unable to open file $dir/PACKAGES.TXT: $!";
 		return  ('500', 'text/plain',  "Unable to open file $dir/PACKAGES.TXT: $!\n");
 	};
 
-	binmode F;
 	use bytes;
 	$len = length($buffer);
-	$written = syswrite(F, $buffer, $len);
+	$written = syswrite($PACKAGESHANDLE, $buffer, $len);
-	close F;
+	close $PACKAGESHANDLE;
 
 	unless (defined($written)) {
 		warn "[FATA] Unable to write $dir/PACKAGES.TXT: $!";
@@ -308,8 +311,6 @@ MD5 message digest                Filename
 		return ('500', 'text/plain', "Unable to write $dir/PACKAGES.TXT: written bytes does not match with buffer size\n");
 	}
 
-	close F;
-
 	$gz = new Compress::Raw::Zlib::Deflate (
 		-Level => Z_BEST_COMPRESSION,
 		-CRC32 => 1,
@@ -335,14 +336,14 @@ MD5 message digest                Filename
 	$gz = '';
 	$buffer = '';
 
-	sysopen (F, "$dir/PACKAGES.TXT.gz", O_WRONLY|O_TRUNC|O_CREAT) or do {
+	sysopen (my $PACKAGESGZHANDLE, "$dir/PACKAGES.TXT.gz", O_WRONLY|O_TRUNC|O_CREAT) or do {
 		warn "[FATA] Unable to open file $dir/PACKAGES.TXT.gz: $!";
 		return  ('500', 'text/plain',  "Unable to open file $dir/PACKAGES.TXT.gz: $!\n");
 	};
 
-	binmode F;
+	binmode ($PACKAGESGZHANDLE);
 	$len = length($output);
-	$written = syswrite(F, $output, $len);
+	$written = syswrite($PACKAGESGZHANDLE, $output, $len);
 
 	unless (defined($written)) {
 		warn "[FATA] Unable to write $dir/PACKAGES.TXT.gz: $!";
@@ -354,46 +355,58 @@ MD5 message digest                Filename
 		return ('500', 'text/plain', "Unable to write $dir/PACKAGES.TXT.gz: written bytes does not match with buffer size\n");
 	}
 
-	close F;
+	close $PACKAGESGZHANDLE;
 	$output = '';
 
-	@list = -1;
+	$#list = -1;
-	@list = split(/\n/, `ls -lAn --time-style=long-iso "$dir"`);
+	my $date = __pdate;
+	$buffer = "$date
 
-	@list = map {
+Here is the file list for this directory,
-		my $str = $_;
+maintained by eleksir <eleksir\@gmail.com> .
-
-		if (length($str) > 45) {
-			substr($str, 44, 0, './');
-			$str = $str . "\n";
-		} else {
-			my $date = __pdate;
-			$str = "$date
-
-Here is the file list for this directory ,
-maintained by Eric Hameleers <alien\@slackware.com> .
 If you are using a mirror site and find missing or extra files
 in the subdirectories, please have the archive administrator
 refresh the mirror.
 
 ";
-		}
 
-		$str;
+	opendir (my $DIR, $dir) or do {
-	} @list;
+		warn "[FATA] Unable to open $dir: $!";
+		return  ('500', 'text/plain', "Unable to open $dir: $!\n");
+	};
 
-	sysopen(F, "$dir/FILELIST.TXT", O_WRONLY|O_TRUNC|O_CREAT) or do {
+	my @files = sort (readdir ($DIR));
+	closedir $DIR;
+
+	while (my $file = shift (@files)) {
+		my $filename = sprintf ("%s/%s", $dir, $file);
+		next unless (-f $filename);
+
+		my @stat = stat $filename;
+		my @date = localtime ($stat[10]);
+
+		$buffer .= sprintf (
+			"-rw-r--r-- %d root root % 8d %04d-%02d-%02d %02d:%02d ./%s\n",
+			$stat[3],
+			$stat[7],
+			$date[5] + 1900,
+			$date[4],
+			$date[3],
+			$date[2],
+			$date[1],
+			$file
+		);
+	}
+
+	sysopen(my $FILELISTHANDLE, "$dir/FILELIST.TXT", O_WRONLY|O_TRUNC|O_CREAT) or do {
 		warn "[FATA] Unable to open $dir/FILELIST.TXT: $!";
 		return  ('500', 'text/plain', "Unable to open $dir/FILELIST.TXT: $!\n");
 	};
 
-	binmode F;
-	$buffer = join('', @list);
-	@list = -1; undef @list;
 	use bytes;
 	$len = length($buffer);
 	no bytes;
-	$written = syswrite F, $buffer, $len;
+	$written = syswrite $FILELISTHANDLE, $buffer, $len;
 
 	unless (defined($written)) {
 		warn "[FATA] Unable to write $dir/FILELIST.TXT: $!";
@@ -405,7 +418,7 @@ refresh the mirror.
 		return ('500', 'text/plain', "Unable to write $dir/FILELIST.TXT: written bytes does not match with buffer size\n");
 	}
 
-	close F;
+	close $FILELISTHANDLE;
 	$buffer = '';
 	return  ('200', 'text/plain', "Done\n");
 }

myapi-joyproxy.psgi

@@ -27,7 +27,13 @@ my $app = sub {
 		}
 	}
 
-
+	if ($env->{PATH_INFO} =~ /$prefix\/joyurl/) {
+		if (defined($env->{QUERY_STRING})) {
+			($status, $content, $msg) = joyurl($env->{QUERY_STRING});
+		} else {
+			($status, $content, $msg) = joyurl('');
+		}
+	}
 
 	return [
 		$status,