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

2021-05-18 12:32:46 +03:00
commit 0c147086c0
29 changed files with 2534 additions and 0 deletions
--- a/bin/yad_get_token.pl
+++ b/bin/yad_get_token.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (1.0);
+
+my $workdir;
+
+# Надо сменить рабочий каталог до запуска основной логики
+BEGIN {
+	use Cwd qw (chdir abs_path);
+	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
+	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+
+use CHI;
+use CHI::Driver::BerkeleyDB;
+use Yandex::OAuth;
+use YadProxy::Conf qw (LoadConf);
+
+my $c = LoadConf ();
+
+my $oauth = Yandex::OAuth->new (
+	client_id     => $c->{ID},
+	client_secret => $c->{'Пароль'},
+);
+
+unless (defined $c->{'Код подтверждения'}) {
+	# Первый шаг - получение проверочного кода
+
+	say "Шаг 1.\nСсылка для открывания в браузере: \n" . $oauth->get_code();
+	say '';
+	say 'Код подтверждения надо записать в config.json в параметр "Код подтверждения"';
+	say 'Понадобится запустить этот скрипт ещё раз, чтобы занести refresh_token и access_token в локальную базу для работы yadproxy.';
+} else {
+	# Второй шаг - получение access-токена
+
+	my $token = $oauth->get_token ( code => $c->{'Код подтверждения'} );
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $c->{oauth_dir},
+		namespace => 'yad_auth'
+	);
+
+	# yad обычно выдаёт токен на год, скинем с этого 1 минуту :) чтобы уж точно
+	$cache->set ('refresh_token', $token->{refresh_token}, 'never');
+	$cache->set ('access_token', $token->{access_token}, $token->{expires_in} - 60);
+
+	printf "Шаг 2.\nrefresh_token (%s) и access_token (%s) сохранены в базе.\n\n", $token->{refresh_token}, $token->{access_token};
+	say 'Можно пользоваться yadproxy.';
+}
+
+exit 0;
+
+__END__
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/bin/yad_index_repo.pl
+++ b/bin/yad_index_repo.pl
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (1.0);
+
+my $workdir;
+
+# сменим рабочий каталог
+BEGIN {
+	use Cwd qw (chdir abs_path);
+	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
+	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+use File::Basename qw (basename dirname);
+use File::Find qw (find);
+use YadProxy::Conf qw (LoadConf);
+use YadProxy::Lib qw (GetAccessToken);
+use Yandex::Disk;
+
+my $c = LoadConf ();
+my $remote_dir = $c->{remote_dir};
+my $index_dir = $c->{index_dir};
+
+my $index_url = CHI->new (
+        driver => 'BerkeleyDB',
+        root_dir => $index_dir,
+        namespace => '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 $disk = Yandex::Disk->new ( -token => GetAccessToken );
+
+
+if (substr ($remote_dir, -1) eq '/') {
+	chop $remote_dir;
+}
+
+if (substr ($remote_dir, 0, 1) eq '/') {
+	$remote_dir = substr $remote_dir, 1;
+}
+
+unless (substr ($remote_dir, 0, 6) eq 'disk:/') {
+	$remote_dir = sprintf 'disk:/%s/', $remote_dir;
+}
+
+my $list = $disk->listAllFiles ( -path => 'REPO' ); # Note that this will give us first 999999 files
+my $pattern = qr /$remote_dir/;
+
+my %month = (
+	'01' => 'Jan',
+	'02' => 'Feb',
+	'03' => 'Mar',
+	'04' => 'Apr',
+	'05' => 'May',
+	'06' => 'Jun',
+	'07' => 'Jul',
+	'08' => 'Aug',
+	'09' => 'Sep',
+	'10' => 'Oct',
+	'11' => 'Nov',
+	'12' => 'Dec'
+);
+
+foreach (@{$list}) {
+	my $filename = $_->{path};
+
+	if ($filename =~ m/$pattern(.+)/) {
+		$filename = $1;
+
+		if (defined $filename) {
+			if (defined $_->{file} && defined $_->{size} && defined $_->{md5} && defined $_->{sha256} && defined $_->{modified}) {
+				$index_url->set    ($filename, $_->{file},     'never');
+				$index_size->set   ($filename, $_->{size},     'never');
+				$index_md5->set    ($filename, $_->{md5},      'never');
+				$index_sha256->set ($filename, $_->{sha256},   'never');
+
+				my $time = sprintf (
+					'%s-%s-%s %s:%s',
+					substr ($_->{modified}, 8, 2),
+					$month{substr ($_->{modified}, 5, 2)},
+					substr ($_->{modified}, 0, 4),
+					substr ($_->{modified}, 11, 2),
+					substr ($_->{modified}, 14, 2)
+				);
+
+				$index_mtime->set  ($filename, $time,          'never');
+				my $dir = dirname $filename;
+
+				if (defined $dir && $dir ne '' && $dir ne '.') {
+					my @dirs = split (/\//, $dir);
+
+					do {
+						unless (defined $index_dirs->get (join '/', @dirs)) {
+							$index_dirs->set (join ('/', @dirs), 1, 'never');
+						}
+					} while (pop @dirs);
+				}
+
+			} else {
+				warn "Yandex.Диск API вернуло неполные данные для $filename";
+			}
+		}
+	}
+}
--- a/bin/yad_refresh_token.pl
+++ b/bin/yad_refresh_token.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (1.0);
+
+my $workdir;
+
+# Надо сменить рабочий каталог до запуска основной логики
+BEGIN {
+	use Cwd qw (chdir abs_path);
+	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
+	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+
+use CHI;
+use CHI::Driver::BerkeleyDB;
+use Yandex::OAuth;
+use YadProxy::Conf qw (LoadConf);
+
+my $c = LoadConf ();
+
+my $oauth = Yandex::OAuth->new (
+	client_id     => $c->{ID},
+	client_secret => $c->{'Пароль'},
+);
+
+my $cache = CHI->new (
+	driver => 'BerkeleyDB',
+	root_dir => $c->{oauth_dir},
+	namespace => 'yad_auth'
+);
+
+my $refresh_token = $cache->get ('refresh_token');
+
+if (defined $refresh_token) {
+	my $token = $oauth->refresh_token ( refresh_token => $refresh_token );
+	# yad обычно выдаёт токен на год, скинем с этого 1 минуту :) чтобы уж точно
+	$cache->set ('refresh_token', $token->{refresh_token}, 'never');
+	$cache->set ('access_token', $token->{access_token}, $token->{expires_in} - 60);
+} else {
+	die "В локальной базе нет refresh token, возможно, для начала следует запустить yad_get_token.pl";
+}
+
+exit 0;
+
+__END__
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/bin/yad_show_token.pl
+++ b/bin/yad_show_token.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (1.0);
+
+my $workdir;
+
+# Надо сменить рабочий каталог до запуска основной логики
+BEGIN {
+	use Cwd qw (chdir abs_path);
+	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
+	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+
+use CHI;
+use CHI::Driver::BerkeleyDB;
+use YadProxy::Conf qw (LoadConf);
+
+my $c = LoadConf ();
+
+my $cache = CHI->new (
+	driver => 'BerkeleyDB',
+	root_dir => $c->{oauth_dir},
+	namespace => 'yad_auth'
+);
+
+my $refresh_token = $cache->get ('refresh_token');
+my $access_token = $cache->get ('access_token');
+
+if (defined $refresh_token && defined $access_token) {
+	printf "access_token:\n%s\n\nrefresh_token:\n%s\n", $access_token, $refresh_token;
+} else {
+	say "Что-то пошло не так, токены не нашлись, попробуйте их пере-получить через скрипт yad_get_token.pl";
+	exit 1;
+}
+
+exit 0;
+
+__END__
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/bin/yad_upload_dir.pl
+++ b/bin/yad_upload_dir.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (1.0);
+
+my $workdir;
+
+# сменим рабочий каталог
+BEGIN {
+	use Cwd qw (chdir abs_path);
+	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
+	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+use File::Basename qw (basename dirname);
+use File::Find qw (find);
+use YadProxy::Conf qw (LoadConf);
+use YadProxy::Lib qw (GetAccessToken);
+use Yandex::Disk;
+
+my $c = LoadConf ();
+
+my $disk = Yandex::Disk->new ( -token => GetAccessToken );
+my $remote_dir = $c->{remote_dir};
+my $local_dir = $c->{local_dir};
+
+if (substr ($remote_dir, -1) eq '/') {
+	chop $remote_dir;
+}
+
+if (substr ($remote_dir, 0, 1) eq '/') {
+	$remote_dir = substr $remote_dir, 1;
+}
+
+if (substr ($local_dir, -1) eq '/') {
+	chop $local_dir;
+}
+
+# рекурсивненько зааплодим найденные файлы
+find (
+	{
+		wanted => \&wanted,
+		no_chdir => 1
+	},
+	$local_dir
+);
+
+sub wanted {
+	my $file = $_;
+	my %targets;
+
+	if (-f $file) {
+		print "Uploading file: $file ... ";
+		my $target = substr $file, length ($local_dir) + 1;
+		$target = dirname $target;
+
+		if (defined $target && $target ne '' && $target ne '/') {
+			$target = sprintf '%s/%s', $remote_dir, $target;
+		} else {
+			$target = $remote_dir;
+		}
+
+		unless (defined $targets{$target}) {
+			unless ($disk->createFolder (-path => $target, -recursive => 1)) {
+				die "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске";
+			}
+
+			$targets{$target} = 1;
+		}
+
+		$disk->uploadFile (
+			-file => $file,
+			-remote_path => $target,
+			-overwrite => 1
+		) or warn "Не могу за-аплодить файл в каталог $remote_dir на Yandex.Диске\n";
+
+		print "done.\n";
+	}
+
+	sleep 3;
+}