perl-Gogs/bin/git-clone-entity

#!/usr/bin/env perl

package Git::CloneEntity;

use strict;
use warnings;

use FindBin::libs;

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

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 IMPORTANT

This assumes that the repo names between the base and mirrors is identical.

=head1 CONFIG FILE

You will notice below that the options of this tool can be quite involved.

To simplify deploying this tool across your organization, you can place a configuration file (Config::Simple) in ~/.git/clone-entity.cfg.  Example:

	baseurl=https://my-gogs-install.test/api/v1
	gogs=true
	nossh=true
	mirrors=https://api.github.com,https://premise-install.github.local/api
	me=jane

Ideally all your users have to do is specify which users/orgs to clone w/mirroring and you should be off to the races.

The name of the setting will be pluralized for any option which may be passed multiple times below.

=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] [--nossh] [--insecure] [--help]

=head1 OPTIONS

=head3 me

Your username on the baseurl.  Relevant to token use, what is visible, etc.

	--me tarzan

=head3 baseurl

URI for your Git management solution.  Currently github and gogs are supported.

	--baseurl https://api.github.com
	--baseurl https://gogs.mydomain.test/api/v1

=head3 gogs

Whether your baseurl is a gogs installation.

While the APIs between gogs and github are compatible there are slight differences which must be accounted for.

	--gogs

=head3 mirror

URI for a git management solution you wish to use for mirroring the repos at the baseurl.  May be passed multiple times.

	--mirror https://on-prem.github.local/api/

=head3 token

Token for a particular baseurl or mirror.  Of the format domain:token.

	--token my.domain.test:DEADBEEF

You can omit the auth token on gogs, as we can create them automatically (we will prompt for your password).

=head3 user

Clone all of this user's repositories.  May be passed multiple times.

	--user fred

=head3 org

Clone all of this organization's repositories.  May be passed multiple times.

	--org 'Granite-Industries'

=head3 alias

Map a user/org on your baseurl to a mirror.  Of the format base_user:mirror_domain:mirror_user.

Obviously won't work if the mirror is on the same hostname as the baseurl; use a subdomain at the very least.

	--alias george:sprockets.spacely.local:gjetson

=head3 nossh

Don't use SSH clone URIs.  Useful for read-only clones & deployments with no ssh-agent.

	--nossh

=head1 CONSEQUENTIAL OPTIONS

=head3 insecure

Allow insecure mirrors or baseurls.  This is just to prevent footgunning by passing auth over plaintext.

	--insecure

=head3 create

Automatically create a copy of the repo on the mirror if it doesn't exist.

	--create

=head3 private

If --create is passed, also mirror repositories marked as private, preserving privacy.

=head3 sync

Force push all refs onto the mirror(s).

	--sync

=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 %options = (
		help 	 => undef,
		users	 => [],
		orgs  	 => [],
		aliases  => [],
		tokens   => [],
		mirrors  => [],
		baseurl  => "",
		me       => undef,
		create   => undef,
		sync     => undef,
		gogs     => undef,
		insecure => undef,
		nossh    => undef,
	);

	# Allow options to override configuration
	my $home = $ENV{HOME};
	mkdir "$home/.git" unless -d "$home/.git";
	my $config_file = "$home/.git/clone-entity.cfg";
	if (-f $config_file) {
		my $conf = Config::Simple->new($config_file);
		my %config;
		%config = %{$conf->param(-block => 'default')} if $conf;

		# Merge the configuration with the options
		foreach my $opt (keys(%options)) {
			if ( ref $options{$opt} eq 'ARRAY' ) {
				next unless exists $config{$opt};
				my @arrayed = ref $config{$opt} eq 'ARRAY' ? @{$config{$opt}} : ($config{$opt});
				push(@{$options{$opt}}, @arrayed);
				next;
			}
			$options{$opt} = $config{$opt} if exists $config{$opt};
		}
	}

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

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

    # Parse Alias mappings
    my %alias_map;
    if (@{$options{aliases}}) {
        foreach my $arg (@{$options{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) = $options{baseurl} =~ $domainRipper;
    my %tokens;
    foreach my $tok (@{$options{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    => $options{me},
        api_uri => $options{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  = $options{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 && $options{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 => $options{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, $options{insecure} ) if $password };

    my @repos_local = _fetch_all($local, $options{users}, $options{orgs});
    _help(7, "Server at $options{baseurl} could not list repos!", $cleanup ) unless @repos_local;

    my @repos_mirror;
    foreach my $mirror_url (@{$options{mirrors}}) {
        my ($mirror_domain) = $mirror_url =~ $domainRipper;
        my $muser = $options{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 );
		my @fetched = _fetch_all($mirror, $options{users}, $options{orgs}, \%alias_map);
        _help(8, "The provided mirror ($mirror_url) could not list repos!", $cleanup ) unless @fetched;
        push(@repos_mirror, @fetched);
    }

	# Build a map of names to clone URIs
	my $field_name = $options{nossh} ? 'clone_url' : 'ssh_url';
	my %names2clone = map { $_->{name} => $_->{$field_name} } @repos_local;
	my %mirror_uris;
	foreach my $repo (@repos_mirror) {
		$mirror_uris{$repo->{name}} //= [];
		push( @{$mirror_uris{$repo->{name}}}, $repo->{$field_name});
	}

	$cleanup->();

    use Data::Dumper;
    die Dumper(\%names2clone, \%mirror_uris);

	my @to_create;
	foreach my $to_clone (keys(%names2clone)) {
		my $res = Git::command_oneline([ 'clone', $names2clone{$to_clone} ]);
		my $repo = Git->repository(Directory => $to_clone);

		#TODO check privacy field

		if (!exists $mirror_uris{$to_clone}) {
			#TODO push into @to_create if $create
			next;
		}
		# TODO check if the repo is missing on just *some* of the mirrors and add to @to_create if $create

		foreach my $mirror (@{$mirror_uris{$to_clone}}) {
			# The real "magic" here -- you can have many push urls.
			$repo->command(qw{git remote set-url --add --push}, 'origin', $mirror);
			#TODO make sure they are all synced up if --sync
		}
	}

	# Clean up
	$cleanup->();
	return 0;
}

sub _cleanup_token {
	my ( $api, $password, $insecure ) = @_;
	my $result = $api->delete_token( sha1 => $api->token, 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;