Implement listing of repositories in registry

cpanfile

@@ -16,6 +16,7 @@ requires "Encode",                  "==3.17";
 requires "English",                 "0";
 requires "File::Basename",          "==2.85";
 requires "File::Path",              "==2.18";
+requires "HTTP::Tiny",              "==0.088";
 requires "IO::Socket::SSL",         "==2.074";
 requires "JSON::XS",                "==4.03";
 requires "JSON::PP",                "==4.09";

data/config-sample.json

@@ -13,7 +13,7 @@
 	# Список каналов, к которым необходимо заджойниться
 	"channels": {
 		"assist": "#a",
-		"notify": "#registry"
+		"registry": "#registry"
 	},
 
 	# datadir, куда складываются данные - databases, datafiles, etc
@@ -24,6 +24,15 @@
 		"todo": "db/todo"
 	},
 
+	# Настройки модуля rgistry
+	"registry": {
+		# Урл, где находится регистри
+		"url": "https://registry.lan",
+		# Basic-авторизация
+		"user": "docker",
+		"password": "secret"
+	},
+
 	# Настройки логов
 	"log" : "meow.log",
 	"loglevel" : "info",

lib/BotLib.pm

@@ -11,8 +11,8 @@ use JSON::XS                   ();
 use Log::Any                qw ($log);
 
 use BotLib::Conf            qw (LoadConf);
-use BotLib::Chan::Assist    qw (Help Todo Md5Str Sha1Str Sha224Str Sha256Str Sha384Str Sha512Str Crc32Str MurmurhashStr
+use BotLib::Chan::Assist       ();
-                                B64Str UrlencodeStr IrandNum);
+use BotLib::Chan::Registry     ();
 use BotLib::Util            qw (runcmd);
 
 use version; our $VERSION = qw (1.0);
@@ -94,7 +94,7 @@ sub Command {
 
 	if ($chatid eq $c->{channels}->{assist}) {
 		if ($cmd eq 'help' || $cmd eq 'помощь') {
-			$reply = Help ();
+			$reply = BotLib::Chan::Assist::Help ();
 		} elsif ($cmd eq 'version'  ||  $cmd eq 'ver') {
 			$reply = 'Версия нуль.чего-то_там.чего-то_там';
 		} elsif ($text eq '=(' || $text eq ':(' || $text eq '):') {
@@ -124,32 +124,38 @@ sub Command {
 		} elsif ($cmd eq 'quit' || $cmd eq 'exit') {
 			SigHandler ('exit');
 		} elsif ($cmd =~ /^(todo\s*|todo\s+.+)$/) {
-			$reply = Todo ($cmd);
+			$reply = BotLib::Chan::Assist::Todo ($cmd);
 		} elsif ($cmd =~ /^b64\s(.*)/) {
-			$reply = B64Str ($1);
+			$reply = BotLib::Chan::Assist::B64Str ($1);
 		} elsif ($cmd =~ /^md5\s(.*)/) {
-			$reply = Md5Str ($1);
+			$reply = BotLib::Chan::Assist::Md5Str ($1);
 		} elsif ($cmd =~ /^sha1\s(.*)/) {
-			$reply = Sha1Str ($1);
+			$reply = BotLib::Chan::Assist::Sha1Str ($1);
 		} elsif ($cmd =~ /^sha224\s(.*)/) {
-			$reply = Sha224Str ($1);
+			$reply = BotLib::Chan::Assist::Sha224Str ($1);
 		} elsif ($cmd =~ /^sha256\s(.*)/) {
-			$reply = Sha256Str ($1);
+			$reply = BotLib::Chan::Assist::Sha256Str ($1);
 		} elsif ($cmd =~ /^sha384\s(.*)/) {
-			$reply = Sha384Str ($1);
+			$reply = BotLib::Chan::Assist::Sha384Str ($1);
 		} elsif ($cmd =~ /^sha512\s(.*)/) {
-			$reply = Sha512Str ($1);
+			$reply = BotLib::Chan::Assist::Sha512Str ($1);
 		} elsif ($cmd =~ /^crc32\s(.*)/) {
-			$reply = Crc32Str ($1);
+			$reply = BotLib::Chan::Assist::Crc32Str ($1);
 		} elsif ($cmd =~ /^murmurhash\s(.*)/) {
-			$reply = MurmurhashStr ($1);
+			$reply = BotLib::Chan::Assist::MurmurhashStr ($1);
 		} elsif ($cmd =~ /^urlencode\s(.*)/) {
-			$reply = UrlencodeStr ($1);
+			$reply = BotLib::Chan::Assist::UrlencodeStr ($1);
 		} elsif ($cmd =~ /^rand\s+(.*)\s*/) {
-			$reply = IrandNum ($1);
+			$reply = BotLib::Chan::Assist::IrandNum ($1);
 		} elsif ($cmd eq 'unixtime') {
 			$reply = time ();
 		}
+	} elsif ($chatid eq $c->{channels}->{registry}) {
+		if ($cmd eq 'help' || $cmd eq 'помощь') {
+			$reply = BotLib::Chan::Registry::Help ();
+		} elsif ($cmd eq 'ls') {
+			$reply = BotLib::Chan::Registry::ListProjects ();
+		}
 	}
 
 	return $reply;

lib/BotLib/Chan/Assist.pm

@@ -35,8 +35,6 @@ sub Help {
 	$text .= "${csign}cal                        - календарик\n";
 	$text .= "${csign}exit                       - завершить работу бота\n";
 	$text .= "${csign}quit                       - завершить работу бота\n";
-	$text .= "${csign}notify me after N [s|m|h]  - одноразовая напоминалка через desktop notification\n";
-	$text .= "${csign}n N[s|m|h] message         - одноразовая напоминалка через desktop notification\n";
 	$text .= "${csign}todo                       - выводит списк запланированных дел\n";
 	$text .= "${csign}todo -d N                  - удаляет из списка запланированных дел дело N\n";
 	$text .= "${csign}todo ДЕЛО                  - добавляет в списк запланированных дел ДЕЛО\n";

lib/BotLib/Chan/Registry.pm

@@ -0,0 +1,121 @@
+package BotLib::Chan::Registry;
+# Парсит команды
+
+use 5.030; ## no critic (ProhibitImplicitImport)
+use strict;
+use warnings;
+use utf8;
+use open         qw (:std :utf8);
+use English      qw ( -no_match_vars );
+
+use HTTP::Tiny      ();
+use JSON::XS     qw (decode_json);
+use Log::Any     qw ($log);
+
+use BotLib::Conf qw (LoadConf);
+use BotLib::Util qw (utf2b64);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT = qw (Help ListProjects);
+
+local $OUTPUT_AUTOFLUSH = 1;
+
+my $c = LoadConf ();
+
+# Возвращает список возможных команд
+# $text Help()
+sub Help {
+	my $text  = '';
+	my $csign = $c->{csign};
+
+	$text .= "${csign}help                       - это сообщение\n";
+	$text .= "${csign}ls                         - список репозиториев образов\n";
+
+	return $text;
+}
+
+sub ListProjects {
+	my $str = '';
+	my $url = sprintf '%s/v2/_catalog', $c->{registry}->{url};
+
+	my $s = getJson ($url, $c->{registry}->{user}, $c->{registry}->{password});
+
+	if ($s->{success}) {
+		foreach (@{$s->{struct}->{repositories}}) {
+			$str .= $_ . "\n";
+		}
+	} else {
+		$str = "Unable to list repositories"
+	}
+
+	return $str;
+}
+
+# Делает http GET-запрос и возвращает ответ ref-объектиком, ошибку записывает в лог.
+# {success, error, status, text} get (url, user, pass)
+sub get {
+	my $url    = shift;
+	my $user   = shift;
+	my $pass   = shift;
+
+	my $auth = 'Basic ' . utf2b64 ( sprintf('%s:%s', $user, $pass) );
+
+	my $ret->{success} = 0;
+
+	my $http = HTTP::Tiny->new(
+		agent => "meow-irc-bot",
+		timeout => 10,
+		# Просто, отъебитесь с этой хуйнёй
+		verify_SSL => 0,
+		default_headers => { Authorization => $auth },
+	);
+
+	my $r = $http->get ($url);
+
+	if ($r->{success}) {
+		$ret->{success} = $r->{success};
+		$ret->{text}    = $r->{content};
+		$ret->{status}  = $r->{status};
+	} else {
+		$ret->{error}  = $r->{reason};
+		$ret->{status} = $r->{status};
+
+		$log->error( sprintf ("[ERRO] Unable to GET $url: %s %s", $r->{status}, $r->{reason}) );
+	}
+
+	return $ret;
+}
+
+# Раскодирует JSON, полученный из get-запроса в данный url и возвращает ref-структурку, ошибку декодирования записывает
+# в лог.
+# {success, error, status, struct{...}} getJson (url, user, pass)
+sub getJson {
+	my $url    = shift;
+	my $user   = shift;
+	my $pass   = shift;
+
+	my $r = get ($url, $user, $pass);
+	my $ret->{status} = $r->{status};
+	$ret->{success}   = $r->{success};
+
+	if ($r->{success}) {
+		my $j = eval { decode_json($r->{text}) };
+
+		unless (defined $j) {
+			$ret->{success} = 0;
+			$ret->{status}  = 500;
+			$ret->{error}   = $EVAL_ERROR;
+
+			$log->error( sprintf ("[ERRO] Unable to decode json GET-ed from $url: %s", $EVAL_ERROR) );
+
+			return $ret;
+		}
+
+		$ret->{struct} = $j;
+	} else {
+		$ret->{error} = $r->{error};
+	}
+
+	return $ret;
+}

lib/BotLib/Conf.pm

@@ -18,6 +18,8 @@ our @EXPORT_OK = qw (LoadConf);
 
 local $OUTPUT_AUTOFLUSH = 1;
 
+# TODO: Валидировать конфиг
+
 # Загружает конфиг в hashref
 # $hashref LoadConf()
 sub LoadConf {

lib/BotLib/Util.pm

@@ -93,7 +93,10 @@ sub utf2b64 {
 	}
 
 	my $bytes = encode_utf8 $string;
-	return encode_base64 $bytes;
+	my $str   = encode_base64 $bytes;
+	chomp ($str);
+
+	return $str;
 }
 
 # Берёт от даденной строки sha1 и кодирует "по base64"