perl-Gogs/bin/git-clone-entity

#!/usr/bin/env perl

package Git::CloneEntity;

use strict;
use warnings;

use FindBin::libs;

use List::Util qw{first any uniq all};
use HTTP::Tiny;
use Config::Simple;
use Getopt::Long qw{GetOptionsFromArray};
use Pod::Usage;
use Pithub;
use Gogs;
use Git;
use Clone qw{clone};

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

use Data::Dumper;
$Data::Dumper::Purity=1;
$Data::Dumper::Deepcopy=1;

=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.

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 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 configure your 'origin' & 'upstream' remote to fetch from the baseurl provided, and push to it and the mirror(s) provided.
Regardless, remotes for the users/orgs provided will also be set up in case individual pushes must be made.

In the event that two different users/orgs have the same named repository (e.g. forks) it
will set up remotes named after the user/org in the event the repo is a fork, and set the 'upstream' name to be the parent repository.
This will not recursively scan for the oldest ancestor as parent; most of the time that's a bad idea.

In the event that all the copies of a repo happen to be a fork on the passed users/orgs,
whatever the --primary_user or --primary_org will be preferred.

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
	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/ [--mirror https://github.com] [--nossh] [--insecure] [--help]

=head1 OPTIONS

=head3 me

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

All this users' repositories will be cloned.  Additional users' repos will be added as remotes if your interests intersect.

	--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 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 primary_user, primary_org

Primary entity to clone.  Defaults to --me in the event neither are passed.  Considers their repository to be the canonical one.  In the event both are, the org is preferred.

In most organizations, you will have the org hold the primary copy of a repo, with developers forking copies.  This will become the "upstream" remote.

	--primary_org 'BigHugsLLC'

=head3 user

Add remotes for this user's repositories if interests intersect.  May be passed multiple times.

	--user fred

=head3 org

Add remotes for this org's repositories if interests intersect.  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.

Also used to alias --me in the case it's different on the primary and mirrors.

	--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

=head3 remote

Name of primary remote.  By default will be 'origin', but 'all' is popular.
In the event this is not origin, origin will be set to be the push/pull for the repo at the baseurl.

	--remote all

=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 or baseurl 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|\.]+)};
my $verbose;

sub LOG {
	print shift."\n" if $verbose;
}

sub main {
    my @args = @_;

	my %options = (
		help 	 => undef,
		users	 => [],
		orgs  	 => [],
		aliases  => [],
		tokens   => [],
		mirrors  => [],
		baseurl  => "",
		me       => undef,
		create   => undef,
		sync     => undef,
		insecure => undef,
		nossh    => undef,
		remote   => 'origin',
		primary_user  => undef,
		primary_org   => undef,
		verbose       => 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},
        'insecure'  => \$options{insecure},
		'nossh'     => \$options{nossh},
        'help'      => \$options{help},
		'primary_user=s' => \$options{primary},
		'primary_org=s'  => \$options{primary_org},
		'verbose'        => \$options{verbose},
		'create'         => \$options{create},
		'sync'           => \$options{sync},
    );
	$verbose = $options{verbose};

	$options{primary_user} = $options{me} if !$options{primary_user} || !$options{primary_org};

	# Tiebreaker vote in the event of conflicting forks
	push(@{$options{users}}, $options{primary_user}) if $options{primary_user};
	push(@{$options{orgs}},  $options{primary_org})  if $options{primary_org};
	push(@{$options{users}}, $options{me})           if $options{me};
	my $prime_name = $options{primary_org} || $options{primary_user};

    return _help() if $options{help};
	return _help(1, "Must pass either primary_user or primary_org") unless $prime_name;
    return _help(1, "Must pass at least one of: user or org") 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, %alias_reverse);
	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;
		$alias_reverse{$domain}{$alias} = $actual;
	}

	# Parse tokens
    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;
    }

	# Simplify code below by making the primary just another mirror to fetch
	my @mirror_domains = map {
		my $subj = $_;
		my ($dom) = $subj =~ $domainRipper;
		$dom
	} @{$options{mirrors}};
	unshift(@{$options{mirrors}}, $options{baseurl});

	my $field_name = $options{nossh} ? 'clone_url' : 'ssh_url';

    my @repos;
	my (%passwords, %clients);

	my $cleanup = sub { _cleanup_tokens( \%clients, \%passwords, $options{insecure} ) if %passwords };

    foreach my $mirror_url (@{$options{mirrors}}) {
		my $server_is_github = _server_is_github($mirror_url);

        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,
        );
        $margs{token} = $tokens{$mirror_domain} if $tokens{$mirror_domain};

        my $mirror = $server_is_github ? Pithub->new(%margs) : Gogs->new(%margs);

		# Then it's gogs, and we can just make one.
		if (!$margs{token} && !$server_is_github) {
			_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
			$passwords{$mirror_domain} = _prompt("Please type in the password for ".$mirror->user.":");
			$tokens{$mirror_domain} = $mirror->get_token(
				name     => "git-clone-entity",
				password => $passwords{$mirror_domain},
				insecure => $options{insecure},
			);
			_help(6, "Could not fetch token from gogs!  Check that you supplied the correct username & password.") unless $tokens{$mirror_domain};
			$mirror->token($tokens{$mirror_domain});
			# Stash for later use by cleanup routines if needed
			$clients{$mirror_domain} = $mirror;
		}

		my @fetched = _fetch_all($mirror, clone($options{users}), clone($options{orgs}), \%alias_map, $field_name);
        _help(7, "The provided server ($mirror_url) could not list repos!", $cleanup ) unless @fetched;

		# GOGS will list all the repos the user *has access to* not all the ones they own.
		@fetched = grep { $_->{owner}{login} eq $_->{user} } @fetched;

        push(@repos, @fetched);
    }

    my ($primary_domain) = $options{baseurl} =~ $domainRipper;

	my $transform = sub {
		my $repo = shift;
		my $reversed = $alias_reverse{$repo->{domain}} // {};
		my $aliased = exists $reversed->{$repo->{owner}{login}} ? $reversed->{$repo->{owner}{login}} : $repo->{owner}{login};
		my $on_baseurl = $repo->{domain} eq $primary_domain;
		my $is_prime   = $aliased eq $prime_name;
		return {
			name                => $repo->{name},
			clone_uri           => $repo->{$field_name},
			parent              => $repo->{upstream_uri},
			private             => $repo->{private},
			is_primary_domain   => $repo->{domain} eq $primary_domain,
			domain              => $repo->{domain},
			upstream            => $on_baseurl && $is_prime,
			owner               => $aliased,
			owner_noalias       => $repo->{owner}{login},
			origin              => $repo->{owner}{login} eq $options{me},
			api					=> $clients{$repo->{domain}},
		};
	};

	# get rid of everything that doesn't matter
	@repos = map { $transform->($_)	} @repos;
	my @names = uniq map { $_->{name} } @repos;

	my %proper_owner = (
		origin   => $options{me},
		upstream => $prime_name,
	);

	my %repodata;
	foreach my $reponame (@names) {
		my @matching = grep { $_->{name} eq $reponame } @repos;

		# We don't care about cloning anything which do not intersect with our interests.
		# This means we need at least one clone of a repo done by ourself or the prime.
		next unless any { $_->{owner} eq $options{me} || $_->{owner} eq $prime_name } @matching;

		# There's also no point in making local-org copies of stuff on a mirror (say github)
		# Which are forks of other stuff on your users' mirror account (standard workflow).
		# Just clone it and call it a day.
		my $all_on_mirror = all { $_->{domain} ne $primary_domain && $_->{owner} eq $options{me} } @matching;
		my $all_is_forks  = all { $_->{parent} } @matching;
		if ($all_on_mirror && $all_is_forks) {
			# There can only be one at this point.
			my $repo = $matching[0];
			$repodata{$reponame}{origin}{fetch} = $repo->{clone_uri};
			$repodata{$reponame}{origin}{push} //= [];
			push(@{$repodata{$reponame}{origin}{push}}, $repo->{clone_uri});
			$repodata{$reponame}{upstream}{fetch} = $repo->{parent};
			$repodata{$reponame}{upstream}{push} //= [];
			push(@{$repodata{$reponame}{upstream}{push}}, $repo->{parent});
			next;
		}

		# We only care about remote names that aren't already origin or upstream.
		my @owners = grep { $_ ne $prime_name && $_ ne $options{me} } uniq map { $_->{owner} } @matching;		

		$repodata{$reponame} = {};

		# We then need to build all the remotes based on which is appropriate.
		foreach my $remote (qw{origin upstream}, @owners) {
			# Pick the right match.  We may have something on the baseurl or on one of the mirrors.
			my @repos = grep { $_->{$remote} || $_->{owner} eq $remote } @matching;
			my ($baseurl_repo) = grep { $_->{domain} eq $primary_domain } @repos;

			# Figure out where to make it if we have to.
			my $on_baseurl =  any { $remote eq $_ } qw{origin upstream};

			# Supposing we don't have a match, we have to make it.
			if (!$baseurl_repo && $on_baseurl) {
				LOG("Missing $reponame on $options{baseurl}, going to create");
				my $new_repo = _create_repo( $clients{$primary_domain}, $proper_owner{$remote}, $reponame, $primary_domain );
				$baseurl_repo = $transform->($new_repo);
				push(@matching, $baseurl_repo);
				push(@repos, $baseurl_repo);
			}

			foreach my $repo (@repos) {
				# Prefer the baseurl repo if we have it, otherwise just use what you got.
				$repodata{$reponame}{$remote}{fetch} = $baseurl_repo->{clone_uri} // $repo->{clone_uri};
				$repodata{$reponame}{$remote}{push} //= [];
				push(@{$repodata{$reponame}{$remote}{push}}, $repo->{clone_uri});
			}

			# Now that we almost certainly have a match, let's setup the mirror URIs as add'l pushes.
			if ($on_baseurl) {
				LOG("Looking for mirrors to $reponame:$remote");
				foreach my $mirror_dom (@mirror_domains) {
					my ($mirror) = grep { $_->{domain} eq $mirror_dom && $_->{owner} eq $baseurl_repo->{owner} } @matching;
					if (!$mirror) {
						# Create mirror.
						LOG("Missing mirror on $mirror_dom for $reponame, for $baseurl_repo->{owner} creating...");
						my $new_mirror = _create_repo( $clients{$mirror_dom}, $alias_map{$mirror_dom}{$baseurl_repo->{owner}}, $reponame, $mirror_dom );
						$mirror = $transform->($new_mirror);
						push(@matching, $mirror);
					}
					# Then add it.
					push(@{$repodata{$reponame}{$remote}{push}}, $mirror->{clone_uri});
				}
			}

		}

	}

	$cleanup->();
	print Dumper(\%repodata);
	die;

	_clone_repos(%repodata);

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

sub _create_repo {
	my ($api, $user, $repo, $domain) =@_;
	# Double check if the repo actually exists, and just return that (TOCTOU)
	#my $content = _fetch_repo($api, $user, { name => $repo }, 1);

	LOG("Creating $repo on $domain");
	return { name => $repo, 'ssh_url' => "$user\@$domain:$repo TODO", owner => { login => $user }, domain => $domain  };

	#my $result = $api->repos->create( data => { name => $repo } );
	#TODO handle errors
	#my $new_repo = $result->content();

	#TODO fortify the new repo with the needed infos along the lines of L335
	#TODO set upstream fork if applicable
}

sub _clone_repos {
	my (%repodata) = @_;

	foreach my $to_clone (keys(%repodata)) {
		#XXX testing removme
		next unless $to_clone eq 'perl-Gogs';

		my $r = $repodata{$to_clone};

		# Don't clone it if it is already present.
		if (!-d $to_clone) {
			LOG("Cloning $to_clone...");
			my $res = Git::command_oneline([ 'clone', $r->{origin}{fetch} ]);
		}
		LOG("Entering $to_clone...");
		my $repo = Git->repository(Directory => $to_clone);
		# Figure out what the remotes look like
		my $res = $repo->command(qw{remote -v});
		my %remotes = _parse_remotes($res);

		# Make sure all the remotes are setup correctly.
		foreach my $rname (keys(%$r)) {
			my $remote = $r->{$rname};

			LOG("Setting up remote $rname...");
			$repo->command(qw{remote rm}, $rname);
			$repo->command(qw{remote add}, $rname, $remote->{fetch});
			$repo->command(qw{fetch}, $rname);
			foreach my $push_uri (@{$remote->{push}}) {
				next if $push_uri eq $remote->{fetch};
				$res = $repo->command(qw{remote set-url --add --push}, $rname, $push_uri);
			}

		}

		# TODO figure out which mirrors are missing, and add them if needed (consider privacy)

		# Finally, sync up the mirrors if instructed.  This is important, as push URIs which aren't in sync will leave git in an inconsistent state.
	}

}

sub _fetch_repo {
	my ($mirror, $muser, $repo, $nonfatal) = @_;
	my $details = $mirror->repos->get( user => $muser, repo => $repo->{name});
	if (!$details || !$details->response->is_success()) {
		return if $nonfatal;
		_help(9, "Could not fetch repository details for $repo->{name}") unless $details && $details->response->is_success();
	}
	return $details->content();
}

sub _fetch_upstream_uri {
	my ($mirror, $field_name, $muser, $repo) = @_;

	my $upstream_uri;
	if ($repo->{fork}) {
		LOG("Looking up what $repo->{name} was forked from...");
		my $content = _fetch_repo($mirror, $muser, $repo);
		$upstream_uri = $content->{parent}{$field_name};
		_help(10, "Could not discern upstream URI for forked repo $repo->{name}!") unless $upstream_uri;
	}
	return $upstream_uri;
}

sub _parse_remotes {
	my ($raw) = shift;
	my %parsed;
	foreach my $line (split(/\n/, $raw)) {
		my ($name, $uri, $type) = $line =~ m/^(.+)\s+(.+)\s+\((.+)\)$/;
		if ($type eq 'fetch') {
			$parsed{$name}{$type} = $uri;
		} else {
			$parsed{$name}{$type} //= [];
			push(@{$parsed{$name}{$type}}, $uri);
		}
	}
	return %parsed;
}

sub _cleanup_tokens {
	my ( $apis, $passwords, $insecure ) = @_;
	foreach my $domain (keys(%$apis)) {
		my $api = $apis->{$domain};
		my $result = $api->delete_token( sha1 => $api->token, password => $passwords->{$domain}, 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, $field_name) = @_;

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

	# TODO detect which repo among forks is the "primary" (if one of them is not a fork, use it)

    my @repos;
    foreach my $user (@$users) {
		LOG("Fetching repos for $user...");
        $user = $alias_map->{$domain}{$user} if exists $alias_map->{$domain}{$user};
        my $result = $api->repos->list( user => $user );

		my @fetched = _array_content($result);
		@fetched    = _augment_repos($api, $field_name, $user, $domain, @fetched);

        push(@repos, @fetched);
    }
    foreach my $org (@$orgs) {
		LOG("Fetching repos for $org...");
        $org = $alias_map->{$domain}{$org} if exists $alias_map->{$domain}{$org};
        my $result = $api->repos->list( org => $org );

		my @fetched = _array_content($result);
		@fetched    = _augment_repos($api, $field_name, $org, $domain, @fetched);

        push(@repos, @fetched);
    }
    return @repos;
 }

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

sub _augment_repos {
	my ($mirror, $field_name, $muser, $domain, @fetched) = @_;
	@fetched = map {
		my $subj = $_;
		$subj->{domain} = $domain;
		$subj->{upstream_uri} = _fetch_upstream_uri($mirror, $field_name, $muser, $subj);
		$subj->{user} = $muser;
		$subj
	} @fetched;
	return @fetched;
}

sub _server_is_github {
	my ($uri) = @_;
	LOG("Figuring out what kind of server $uri is...");
	my $ua = HTTP::Tiny->new();
	my $res = $ua->get($uri);
	# GOGS will 404 it's api baseurl, github will not
	return $res->{success};
}

exit main(@ARGV) unless caller;

1;