Implement tag deletion

lib/BotLib.pm

@@ -157,6 +157,8 @@ sub Command {
 			$reply = BotLib::Chan::Registry::ListProjects ();
 		} elsif ($cmd =~ /^ls\s+(\S+)/) {
 			$reply = BotLib::Chan::Registry::ListTags($1);
+		} elsif ($cmd =~ /^(del|delete|rm|remove)\s+(\S+:\S+)/) {
+			$reply = BotLib::Chan::Registry::DeleteTag($2);
 		}
 	}
 

lib/BotLib/Chan/Registry.pm

@@ -17,8 +17,8 @@ use BotLib::Conf qw (LoadConf);
 use BotLib::Util qw (utf2b64 urlencode);
 
 use version; our $VERSION = qw (1.0);
-use Exporter qw (import);
+use Exporter  qw (import);
-our @EXPORT = qw (Help ListProjects);
+our @EXPORT = qw (Help ListProjects ListTags DeleteTag);
 
 local $OUTPUT_AUTOFLUSH = 1;
 
@@ -30,9 +30,11 @@ sub Help {
 	my $text  = '';
 	my $csign = $c->{csign};
 
-	$text .= "${csign}help    - это сообщение\n";
+	$text .= "${csign}help                   - это сообщение\n";
-	$text .= "${csign}ls      - список репозиториев образов\n";
+	$text .= "${csign}ls                     - список репозиториев образов\n";
-	$text .= "${csign}ls REPO - список тэгов образов в репозитории\n";
+	$text .= "${csign}ls REPO                - список тэгов образов в репозитории\n";
+	$text .= "${csign}delete | ${csign}del REPO:TAG - удалить тэг из репозитория\n";
+	$text .= "${csign}remove | ${csign}rm REPO:TAG  - удалить тэг из репозитория\n";
 
 	return $text;
 }
@@ -69,8 +71,61 @@ sub ListTags {
 		foreach (@{$s->{struct}->{tags}}) {
 			$str .= sprintf "%s:%s\n", $s->{struct}->{name}, $_;
 		}
+
+		if (length($str) == 0) {
+			$str .= 'No tags';
+		}
 	} else {
-		$str = "Unable to list tags for given repository";
+		if ($s->{status} eq '404') {
+			$str = "No such repository";
+		} else {
+			$str = "Unable to list tags for given repository";
+		}
+	}
+
+	return $str;
+}
+
+# Удаляет тэг из репозитория
+sub DeleteTag {
+	my $data = shift;
+
+	my ($repo, $tag) = split (/:/, $data, 2);
+
+	if (!defined($tag) || $tag eq '') {
+		return "Unable to delete tag, no ':' in given string";
+	}
+
+	$repo = urlencode ($repo);
+	$tag  = urlencode ($tag);
+
+	my $str = '';
+
+	# Мы не можем удалить тэг напрямую, только через reference, поэтому запросим оный.
+	my $url       = sprintf '%s/v2/%s/manifests/%s', $c->{registry}->{url}, $repo, $tag;
+	my $s         = httpHead ($url, $c->{registry}->{user}, $c->{registry}->{password});
+
+	unless ($s->{success}) {
+		if ($s->{status} eq '404') {
+			return "$data does not exist";
+		}
+
+		return 'Unable to delete tag';
+	}
+
+	my $reference = $s->{headers}->{'docker-content-digest'};
+
+	unless (defined $reference) {
+		return 'Unable to delete tag - registry error';
+	}
+
+	$url = sprintf '%s/v2/%s/manifests/%s', $c->{registry}->{url}, $repo, $reference;
+	$s   = httpDelete ($url, $c->{registry}->{user}, $c->{registry}->{password});
+
+	if ($s->{success}) {
+		$str = "$data deleted";
+	} else {
+		$str = "Unable to perform deletion";
 	}
 
 	return $str;
@@ -78,7 +133,7 @@ sub ListTags {
 
 # Делает http GET-запрос и возвращает ответ ref-объектиком, ошибку записывает в лог.
 # {success, error, status, text} get (url, user, pass)
-sub get {
+sub httpGet {
 	my $url    = shift;
 	my $user   = shift;
 	my $pass   = shift;
@@ -92,7 +147,7 @@ sub get {
 		timeout => 10,
 		# Просто, отъебитесь с этой хуйнёй
 		verify_SSL => 0,
-		default_headers => { Authorization => $auth },
+		default_headers => { Accept => 'application/vnd.docker.distribution.manifest.v2+json', Authorization => $auth },
 	);
 
 	my $r = $http->get ($url);
@@ -119,7 +174,7 @@ sub getJson {
 	my $user   = shift;
 	my $pass   = shift;
 
-	my $r = get ($url, $user, $pass);
+	my $r = httpGet ($url, $user, $pass);
 	my $ret->{status} = $r->{status};
 	$ret->{success}   = $r->{success};
 
@@ -143,3 +198,73 @@ sub getJson {
 
 	return $ret;
 }
+
+# Делает http DELETE-запрос и возвращает ответ ref-объектиком, ошибку записывает в лог.
+# {success, error, status, text} get (url, user, pass)
+sub httpDelete {
+	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 => { Accept => 'application/vnd.docker.distribution.manifest.v2+json', Authorization => $auth },
+	);
+
+	my $r = $http->delete ($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 DELETE $url: %s %s", $r->{status}, $r->{reason}) );
+	}
+
+	return $ret;
+}
+
+# Делает http HEAD-запрос и возвращает ответ ref-объектиком, ошибку записывает в лог.
+# {success, error, status, text} get (url, user, pass)
+sub httpHead {
+	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 => { Accept => 'application/vnd.docker.distribution.manifest.v2+json', Authorization => $auth },
+	);
+
+	my $r = $http->head ($url);
+
+	if ($r->{success}) {
+		$ret->{success} = $r->{success};
+		$ret->{headers} = $r->{headers};
+		$ret->{status}  = $r->{status};
+	} else {
+		$ret->{error}  = $r->{reason};
+		$ret->{status} = $r->{status};
+
+		$log->error( sprintf ("[ERRO] Unable to HEAD $url: %s %s", $r->{status}, $r->{reason}) );
+	}
+
+	return $ret;
+}