Начальный коммит

2021-05-18 12:32:46 +03:00
commit 0c147086c0
29 changed files with 2534 additions and 0 deletions
--- a/lib/YadProxy.pm
+++ b/lib/YadProxy.pm
@@ -0,0 +1,197 @@
+package YadProxy;
+# Выдаёт листинг каталогов в стиле nginx и редиректы для файлов
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use CHI;
+use CHI::Driver::BerkeleyDB;
+use File::Basename qw (basename dirname);
+use List::SomeUtils qw (any);
+use YadProxy::Conf qw (LoadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (DirList);
+
+my $c = LoadConf ();
+my $index_dir = $c->{index_dir};
+my $url_prefix = $c->{url_prefix};
+
+
+sub DirList {
+	my $requested_path = shift;
+
+	if ((! defined $requested_path) || $requested_path eq '') {
+		$requested_path = '/';
+	} else {
+		while (substr ($requested_path, -1) eq '/') {
+			chop $requested_path;
+		}
+
+		if ((! defined $requested_path) || $requested_path eq '') {
+			$requested_path = '/';
+		}
+	}
+
+	my @output;
+	my @found;
+	my $status = '200';
+	my $content_type = 'text/plain';
+
+	my $index_url = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $index_dir,
+		namespace => 'url'
+	);
+
+	# прежде чем строить индекс, проверим-ка мы запрос на вшивость, вдруг, с нас запрашивают файл?
+	# в этом случае нам надо отдать 302
+	if (my $url = $index_url->get ($requested_path)) {
+		return ('302', 'text/plain', $url);
+	}
+
+	my $index_size = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $index_dir,
+		namespace => 'size'
+	);
+
+	my $index_md5 = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $index_dir,
+		namespace => 'md5'
+	);
+
+	my $index_sha256 = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $index_dir,
+		namespace => 'sha256'
+	);
+
+	my $index_dirs = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $index_dir,
+		namespace => 'dirs'
+	);
+
+	my $index_mtime = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $index_dir,
+		namespace => 'mtime'
+	);
+
+	my $index_of;
+
+	if ($requested_path eq '/') {
+		$index_of = $url_prefix;
+	} else {
+		$index_of = $url_prefix . '/' . $requested_path;
+	}
+
+	if (substr ($url_prefix, 0, 1) ne '/') {
+		$index_of = '/' . $index_of;
+	}
+
+	push @output, "<html>";
+	push @output, sprintf '<head><title>Index of %s/</title></head>', $index_of;
+	push @output, "<body>";
+	push @output, sprintf '<h1>Index of %s/</h1><hr><pre><a href="../">../</a>', $index_of;
+
+	# попробуем отловить все каталоги, начинающиеся с запрошенного пути
+	foreach my $key (sort ($index_dirs->get_keys ())) {
+		if (
+			(
+				(defined $key) &&
+				(length ($key) > length ($requested_path)) &&
+				(substr ($key, 0, length ($requested_path)) eq $requested_path)
+			) ||
+			$requested_path eq '/'
+		) {
+			my @dirs;
+
+			if ($requested_path eq '/') {
+				@dirs = split /\//, $key;
+			} else {
+				@dirs = split /\//, substr ($key, 1 + length ($requested_path));
+			}
+
+			if (defined $dirs[0] && (! any {$_ eq $dirs[0]} @found)) {
+				# у каталогов нету ctime или mtime, так что поставим 01-Jan-1970 00:00
+				push @found, $dirs[0];
+				my $str = $dirs[0];
+				my $len = 50 - (1 + length ($str));
+
+				if ($len < 0) {
+					$str = substr ($str, 0, 47);
+					$str .= '...';
+					$len = 0;
+				}
+
+				# there is no way to get dir mtime from yandex.disk
+				push @output, sprintf (
+					"<a href=\"%s/\">%s/</a>% ${len}s 01-Jan-1970 00:00                   -",
+					$dirs[0],
+					$str,
+					''
+				);
+			}
+		}
+	}
+
+	# попробуем отловить все файлы, начинающиеся с запрошенного пути
+	foreach my $key (sort ($index_url->get_keys())) {
+		if (
+			(
+				(defined $key) &&
+				(length ($key) > length ($requested_path)) &&
+				(substr ($key, 0, length ($requested_path)) eq $requested_path)
+			) ||
+			$requested_path eq '/'
+		) {
+			my $str;
+			my @urls;
+
+			if ($requested_path eq '/') {
+				@urls = split /\//, $key;
+			} else {
+				@urls = split /\//, substr ($key, 1 + length ($requested_path));
+			}
+
+			if (defined $urls[0] && (! any {$_ eq $urls[0]} @found)) {
+				push @found, $urls[0];
+				$str = $urls[0];
+			}
+
+			if ($#urls < 1) {
+				my $len = 50 - length ($str);
+
+				if ($len < 0) {
+					$str = substr ($str, 0, 47);
+					$str .= '...';
+					$len = 0;
+				}
+
+				push @output, sprintf (
+					"<a href=\"%s/\">%s</a>% ${len}s %s % 19s",
+					$index_url->get ($key),
+					$str,
+					'',
+					$index_mtime->get ($key),
+					$index_size->get ($key)
+				);
+			}
+		}
+	}
+
+	push @output, "</pre><hr></body>";
+	push @output, "</html>";
+	return ('200', 'text/html', join "\n", @output);
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: