perl-Gogs/bin/git-clone-entity

#!/usr/bin/env perl

package Git::CloneEntity;

use strict;
use warnings;

use FindBin::libs;

use Getopt::Long qw{GetOptionsFromArray};
use Pod::Usage;
use Pithub;
use Gogs;

use Term::ReadKey();
use IO::Interactive::Tiny();

=head1 DESCRIPTION

It is a common pattern in organizations to have their own git resources, but mirror everything public on one of the big platforms with network effect.

Currently (AD 2024), and for the forseeable future, github.com will be such a platform.

It is also a common pattern to need to clone basically everything for a given user/org when new development environments are instantiated.
Alternatively, you may just want to keep your local development environment up to date for said users/projects.

This program facilitiates cloning your (public) repositories for given users/orgs from either a local gogs/github instance and configuring pushurls for both it and github, or any other github-api compatible mirror(s).

It will warn you whenever a repository is missing from either, so you can make it go whirr appropriately.

Using this you can easily migrate an organization from being entirely on github to using private resources or vice versa.

=head1

=head1 USAGE

git clone-entity --user $user1 --user $user2 --org $org1 --org $org2 --alias $user1:$mirror_domain:$mirrorUser1 --baseurl=https://my.local.install/ [--gogs] [--mirror https://github.com] [--help]

=cut

sub _help {
    my ($code, $msg, $cb) = @_;
    $code //= 0;
    $msg //= "";
	$cb->() if ref $cb eq 'CODE';
    return Pod::Usage::pod2usage( -message => $msg, -exitval => $code);
}

my $domainRipper = qr{^\w+://([\w|\.]+)};

sub main {
    my @args = @_;

    my $help;
    my ($users, $orgs, $aliases, $tokens, $mirrors, $baseurl, $gogs, $me, $insecure) = ([],[],[],[],[],"", 0, "", 0);

    GetOptionsFromArray(\@args,
        'me=s'      => \$me,
        'user=s@'   => \$users,
        'alias=s@'  => \$aliases,
        'token=s@'  => \$tokens,
        'org=s@'    => \$orgs,
        'baseurl=s' => \$baseurl,
        'mirror=s@' => \$mirrors,
        'gogs'      => \$gogs,
        'insecure'  => \$insecure,
        'help'      => \$help,
    );

    return _help() if $help;
    return _help(1, "Must pass at least one user or organization") unless (@$users + @$orgs);
    return _help(2, "Must pass baseurl") unless $baseurl;
    return _help(3, "Must pass your username as --me") unless $me;

    # Parse Alias mappings
    my %alias_map;
    if (@$aliases) {
        foreach my $arg (@$aliases) {
            my ($actual, $domain, $alias) = split(/:/, $arg);
            return _help(3, "aliases must be of the form user:domain:alias") unless $actual && $domain && $alias;
            $alias_map{$domain}{$actual} = $alias;
        }
    }

    my ($primary_domain) = $baseurl =~ $domainRipper;
    my %tokens;
    foreach my $tok (@$tokens) {
        my ($domain, $token) = split(/:/, $tok);
        return _help(4, "tokens must be of the form domain:token") unless $domain && $token;
        $tokens{$domain} = $token;
    }

    my $primary_token = $tokens{$primary_domain};
    my %args = (
        user    => $me,
        api_uri => $baseurl,
    );
    $args{token} = $primary_token if $primary_token;

    # It's important which is the primary, because we can have only one pull url, and many push urls.
    my $local  = $gogs ? Gogs->new(%args) : Pithub->new( %args );

    # If the primary is gogs and we have no token passed, let's make one.
	my $password;
	if (!$primary_token && $gogs) {
		_help(5, "Program must be run interactively to auto-create keys on Gogs installs.") unless IO::Interactive::Tiny::is_interactive();
		# Stash the password in case we gotta clean up
		$password = _prompt("Please type in the password for ".$local->user.":");
		$primary_token = $local->get_token(
			name     => "git-clone-entity",
			password => $password,
            insecure => $insecure,
		);
        _help(6, "Could not fetch token from gogs!  Check that you supplied the correct username & password.") unless $primary_token;
        $local->token($primary_token);
	}

	my $cleanup = sub { _cleanup_token( $local, $password, $insecure ) if $password };

	# TODO XXX this is not appending /api/v1 for some reason
    my @repos_local = _fetch_all($local, $users, $orgs);
    _help(7, "Server at $baseurl could not list repos!", $cleanup ) unless @repos_local;

    my %repos_mirror;
    foreach my $mirror_url (@$mirrors) {
        my ($mirror_domain) = $mirror_url =~ $domainRipper;
        my $muser = $me;
        $muser = $alias_map{$mirror_domain}{$muser} if exists $alias_map{$mirror_domain}{$muser};
        my %margs = (
            user    => $muser,
            api_uri => $mirror_url,
        );
        $args{token} = $tokens{$mirror_domain} if $tokens{$mirror_domain};

        my $mirror = Pithub->new( api_uri => $mirror_url );
        $repos_mirror{$mirror_url} = _fetch_all($mirror, $users, $orgs, \%alias_map);
        _help(8, "The provided mirror ($mirror_url) could not list repos!", $cleanup ) unless @{$repos_mirror{$mirror_url}};
    }

	# Clean up
	$cleanup->();

    use Data::Dumper;
    die Dumper(\%repos_mirror, \@repos_local);
}

sub _cleanup_token {
	my ( $api, $password, $insecure ) = @_;

	my $tok = $api->token();
	# unset the token, so that we use simple auth once more
	$api->token("");

	my $result = $api->delete_token( sha1 => $tok, password => $password, insecure => $insecure );

	die "Could not clean up token" unless $result && $result->response->is_success;
}

sub _prompt {
	my ( $prompt ) = @_;
    $prompt ||= "";
    my $input = "";

    print $prompt;

	# We are readin a password
    Term::ReadKey::ReadMode('noecho');
    {
    	local $SIG{'INT'} = sub { Term::ReadKey::ReadMode(0); exit 130; };
        $input = <STDIN>;
        chomp($input) if $input;
    }
    Term::ReadKey::ReadMode(0);
    print "\n";
    return $input;
}

sub _fetch_all {
    my ($api, $users, $orgs, $alias_map) = @_;

    my ($domain) = $api->api_uri =~ $domainRipper;

    my @repos;
    foreach my $user (@$users) {
        $user = $alias_map->{$domain}{$user} if exists $alias_map->{$domain}{$user};
        my $result = $api->repos->list( user => $user );
        push(@repos, _array_content($result));
    }
    foreach my $org (@$orgs) {
        $org = $alias_map->{$domain}{$org} if exists $alias_map->{$domain}{$org};
        my $result = $api->repos->list( org => $org );
        push(@repos, _array_content($result));
    }
    return @repos;
 }

sub _array_content {
	my ($result) = @_;
	return () unless $result && $result->response->is_success;
	return @{$result->content()} if ref $result->content() eq 'ARRAY';
	return ();
}

exit main(@ARGV) unless caller;

1;