#!/bin/sh
#! -*-perl-*-
eval 'exec perl -x -wS $0 ${1+"$@"}' if 0;
#
# -*- mode: cperl; eval: (follow-mode) -*-
#
use strict;
use warnings;
use diagnostics;
use Data::Printer caller_info => 1, print_escapes => 1, output => 'stdout', class => { expand => 2 };
use Getopt::Long qw(:config no_ignore_case gnu_getopt auto_help auto_version);
use Pod::Usage qw(pod2usage);
use File::Basename;
use LWP::UserAgent;
use JSON;
use Time::Piece;
my @PROGARG = ($0, @ARGV);
my $PROGNAM = fileparse($0);
our $VERSION = '0.7';
my $caller_message = "Printing in line __LINE__ of __FILENAME__; ";
my $pkg = {
alpine => 1,
api => 1,
app => 1,
scheduler => 1,
};
my $re = {
alpine => '^(?:docker-base-layer|develop|release|master|v[0-9]+\.[0-9]+\.[0-9]+)$',
api => '^(?:docker-base-layer|develop|release|master|v[0-9]+\.[0-9]+\.[0-9]+)$',
app => '^(?:docker-base-layer|develop|qa|release|master|v[0-9]+\.[0-9]+\.[0-9]+)$',
scheduler => '^(?:docker-base-layer|develop|release|master|v[0-9]+\.[0-9]+\.[0-9]+)$',
};
my ( $age, $d, $delete, $dry_run, $package, $repo, $rows_number, $single_iteration, $token, $url, $user, $v );
our $colored;
my $getopt_result =
GetOptions (
'a|age=i' => \$age,
'U|url=s' => \$url,
'u|user=s' => \$user,
'T|token=s' => \$token,
'R|repository=s' => \$repo,
'P|package=s' => \$package,
'n|dry-run' => \$dry_run,
'N|rows-number=i' => \$rows_number,
'C|colored' => \$colored,
'D|delete' => \$delete,
's|single-iteration' => \$single_iteration,
'v|package-version=s' => \$v,
'h|help' => sub { pod2usage(-exitval => 0, -verbose => 2); exit 0 },
'd|debug+' => \$d,
'V|version' => sub { print "$PROGNAM, version $VERSION\n"; exit 0 },
);
pod2usage(-exitval => 0, -verbose => 2, -msg => "\nERROR: repository owner not provided, option -u\n\n")
if ! $user;
pod2usage(-exitval => 2, -verbose => 2, -msg => "\nERROR: repository name is not provided, option -R\n\n" )
if ! $repo;
pod2usage(-exitval => 2, -verbose => 2, -msg => "\nERROR: package name not provided, option -P\n\n")
if ! $package;
pod2usage(-exitval => 2, -verbose => 2, -msg => "\nERROR: not supported package\n\n")
if $package && ! exists $pkg->{$package};
pod2usage(-exitval => 2, -verbose => 2, -msg => "\nERROR: requested rows number should be 1..100\n\n")
if $rows_number && ( $rows_number < 1 || $rows_number > 100 );
# pod2usage(-exitval => 0, -verbose => 2, -msg => "\nERROR: -v is mandatory when -D and -s are used together\n\n")
# if $delete && $single_iteration && ! $v;
$url = 'https://api.github.com/graphql' if ! $url;
$rows_number = 100 if ! $rows_number;
$age = 60*60*24*14 if ! $age;
my $versions = [];
my $lwp = LWP::UserAgent->new( agent => "$PROGNAM/$VERSION ", timeout => 120, );
my $req = HTTP::Request->new( 'POST', $url, [ 'Authorization' => 'bearer ' . $token ] );
my $jso = JSON->new->allow_nonref;
my $to_delete;
if ( ! $v ) {
my $res = get_versions ({
lwp => $lwp,
req => $req,
jso => $jso,
usr => $user,
pkg => $package,
num => $rows_number,
rep => $repo,,
res => $versions,
dbg => $d,
sit => $single_iteration
});
my $t_now = localtime;
my $t_ver;
# my $i = 0;
foreach ( @{$versions} ) {
next if $_->{version} =~ /$re->{$package}/;
if ( defined $_->{files}->{nodes}->[0]->{updatedAt} ) {
$t_ver = Time::Piece->strptime( $_->{files}->{nodes}->[0]->{updatedAt},
"%Y-%m-%dT%H:%M:%SZ" );
next if ($t_ver->epoch + $age ) >= $t_now->epoch;
}
# $to_delete->{ defined $_->{files}->{nodes}->[0]->{updatedAt} ?
# $_->{files}->{nodes}->[0]->{updatedAt} : sprintf('NODATE_%04d', $i++) } = $_->{version};
$to_delete->{ $_->{id} } = { version => $_->{version},
ts => $_->{files}->{nodes}->[0]->{updatedAt} };
}
} else {
$to_delete->{ $v } = { version => 'STUB VERSION',
ts => 'STUB TS' };
}
if ( $delete ) {
del_versions ({
lwp => $lwp,
req => $req,
jso => $jso,
del => $to_delete,
dbg => $d,
dry => $dry_run
});
} else {
p ( $to_delete, colored => $colored );
}
######################################################################
sub del_versions {
my $args = shift;
my $arg = {
lwp => $args->{lwp}, # LWP::UserAgent
req => $args->{req}, # HTTP::Request
jso => $args->{jso}, # JSON
del => $args->{del} // [], # IDs to delete array
dbg => $args->{dbg} // 0, # verbose
dry => $args->{dry} # dry run
};
$arg->{req}->header(Accept => 'application/vnd.github.package-deletes-preview+json');
my $query;
foreach ( keys( %{$arg->{del}} ) ) {
$query = sprintf('mutation { deletePackageVersion(input:{packageVersionId:"%s"}) { success }}', $_);
p ( $query, colored => $colored ) if $arg->{dbg} > 1 || $arg->{dry};
next if $arg->{dry};
# my $json = $arg->{jso}->encode( { query => $query } );
$arg->{req}->content( $arg->{jso}->encode({ query => $query }) );
my $res = $arg->{lwp}->request($arg->{req});
if ( ! $res->is_success ) {
my $res_cont = $arg->{jso}->decode( $res->content );
my $res_error = sprintf("--- ERROR ---\n\n%s\n\nMessage: %s\n doc: %s\n\n",
$res->status_line,
$res_cont->{message},
$res_cont->{documentation_url} );
print $res_error;
exit 1;
}
my $reply = $arg->{jso}->decode( $res->decoded_content );
if ( exists $reply->{errors} ) {
unshift @{$reply->{errors}}, "--- ERROR ---";
p ( $reply->{errors}, colored => $colored );
exit 1;
}
p ( $reply, colored => $colored );
print "package of version ID: $_, has been successfully deleted\n" if $arg->{dbg} > 0;
}
}
sub get_versions {
my $args = shift;
my $arg = {
lwp => $args->{lwp}, # LWP::UserAgent
req => $args->{req}, # HTTP::Request
jso => $args->{jso}, # JSON
usr => $args->{usr}, # user
pkg => $args->{pkg}, # package
num => $args->{num} // 100, # number of rows to request
rep => $args->{rep}, # repository
res => $args->{res}, # result
sit => $args->{sit} // 0, # single run
dbg => $args->{dbg} // 0, # verbose
inf => $args->{inf} // { # pageInfo
startCursor => undef,
endCursor => undef,
hasNextPage => -1,
hasPreviousPage => -1
}
};
my $query =
{
query => sprintf('query { repository(name: "%s", owner: "%s") {
packages(first: %d names: ["%s"]) {
nodes {
id
name
versions(last: %d%s) {
nodes {
id
version
files(first:1, orderBy: {direction: DESC, field: CREATED_AT}) {
totalCount
nodes {
updatedAt
}
}
}
pageInfo {
endCursor
hasNextPage
hasPreviousPage
startCursor
}
}
}
}
}
}',
$arg->{rep},
$arg->{usr},
$arg->{num},
$arg->{pkg},
$arg->{num},
$arg->{inf}->{hasPreviousPage} == 1 ? sprintf(', before: "%s"', $arg->{inf}->{startCursor}) : '' )
};
p ( $query, colored => $colored ) if $arg->{dbg} > 1;
my $json = $arg->{jso}->encode( $query );
$arg->{req}->content( $json );
my $res = $arg->{lwp}->request($arg->{req});
if ( ! $res->is_success ) {
my $res_cont = $arg->{jso}->decode( $res->content );
my $res_error = sprintf("--- ERROR ---\n\n%s\n\nMessage: %s\n doc: %s\n\n",
$res->status_line,
$res_cont->{message},
$res_cont->{documentation_url} );
print $res_error;
exit 1;
}
my $reply = $arg->{jso}->decode( $res->decoded_content );
if ( exists $reply->{errors} ) {
unshift @{$reply->{errors}}, "--- ERROR ---";
p ( $reply->{errors}, colored => $colored );
exit 1;
}
push @{$arg->{res}}, @{$reply->{data}->{repository}->{packages}->{nodes}->[0]->{versions}->{nodes}};
p ( $reply, colored => $colored ) if $arg->{dbg} > 2;
return 1 if $arg->{inf}->{hasPreviousPage} == 0 || $arg->{sit} == 1;
my $pageInfo = $reply->{data}->{repository}->{packages}->{nodes}->[0]->{versions}->{pageInfo};
get_versions ({
lwp => $arg->{lwp},
req => $arg->{req},
jso => $arg->{jso},
usr => $arg->{usr},
pkg => $arg->{pkg},
num => $arg->{num},
rep => $arg->{rep},
res => $arg->{res},
dbg => $arg->{dbg},
inf => {
startCursor => $pageInfo->{startCursor},
endCursor => $pageInfo->{endCursor},
hasNextPage => $arg->{jso}->decode( $pageInfo->{hasNextPage} ),
hasPreviousPage => $arg->{jso}->decode( $pageInfo->{hasPreviousPage} ),
}
});
return 0;
}
__END__
=head1 NAME
gqmt - Graphql Query Mutation Tool
=head1 SYNOPSIS
gqmt [-h] <-u USER -R REPO -T TOKEN -P PACKAGE> REST OF OPTIONS
=head1 DESCRIPTION
script to clean up old package versions from GitHub repository
currently it (packages list) is fixed, hardcoded list of packages (may
be in future it becomes configurable)
=head1 OPTIONS
=over 4
=item B<-a | --age> I<INTEGER>
in seconds, default is 2 weeks
=item B<-u | --user> I<STRING>
user name of repository owner
=item B<-R | --repository> I<STRING>
name of the repository to manipulate images of
=item B<-T | --token> I<STRING>
personal access token to access the GitHub API
=item B<-U | --url> I<STRING>
GraphQL API endpoint, default is I<https://api.github.com/graphql>
=item B<-P | --package> I<STRING>
package name to manage versions of
supported packages are:
=over
api
app
scheduler
=back
=item B<-N | --rows-number> I<INTEGER>
number of rows for reply pagination, max 100 (default 100)
=item B<-C | --colored>
to use terminal colors in output
=item B<-D | --delete>
if set, then all versions selected are to be deleted, if option I<-v>
is set, then the only one single version is to be deleted (the one, set
with I<-v>)
=item B<-s | --single-run>
process only first page of rows
=item B<-v | --package-version>
package version to manipulate with
=item B<-V | --version>
version information
=item B<-d | --debug>
be verbose
=item B<-h | --help>
help message
=back
=head1 EXAMPLE
=over
gqmt < -u user-name -R repo-name -P pkg-name -T xxxxxxxxxxxxxxxxxx >
=back
=head1 SEE ALSO
L<https://docs.github.com/en/graphql/guides/forming-calls-with-graphq>
=head1 AUTHOR
Zeus Panchenko <zeus@gnu.org.ua>
=head1 COPYRIGHT
Copyright 2020 Zeus Panchenko.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
=cut