git-clone-entity 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  1. #!/usr/bin/env perl
  2. package Git::CloneEntity;
  3. use strict;
  4. use warnings;
  5. use FindBin::libs;
  6. use Getopt::Long qw{GetOptionsFromArray};
  7. use Pod::Usage;
  8. use Pithub;
  9. use Gogs;
  10. use Term::ReadKey();
  11. use IO::Interactive::Tiny();
  12. =head1 DESCRIPTION
  13. 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.
  14. Currently (AD 2024), and for the forseeable future, github.com will be such a platform.
  15. It is also a common pattern to need to clone basically everything for a given user/org when new development environments are instantiated.
  16. Alternatively, you may just want to keep your local development environment up to date for said users/projects.
  17. 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).
  18. It will warn you whenever a repository is missing from either, so you can make it go whirr appropriately.
  19. Using this you can easily migrate an organization from being entirely on github to using private resources or vice versa.
  20. =head1
  21. =head1 USAGE
  22. 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]
  23. =cut
  24. sub _help {
  25. my ($code, $msg) = @_;
  26. $code //= 0;
  27. $msg //= "";
  28. return Pod::Usage::pod2usage( -message => $msg, -exitval => $code);
  29. }
  30. my $domainRipper = qr{m/^\w+://([\w|\.]+)};
  31. sub main {
  32. my @args = @_;
  33. my $help;
  34. my ($users, $orgs, $aliases, $tokens, $mirrors, $baseurl, $gogs, $me) = ([],[],[],[],[],"", 0, "");
  35. GetOptionsFromArray(\@args,
  36. 'me=s' => \$me,
  37. 'user=s@' => \$users,
  38. 'alias=s@' => \$aliases,
  39. 'token=s@' => \$tokens,
  40. 'org=s@' => \$orgs,
  41. 'baseurl=s' => \$baseurl,
  42. 'mirror=s@' => \$mirrors,
  43. 'gogs' => \$gogs,
  44. 'help' => \$help,
  45. );
  46. return _help() if $help;
  47. return _help(1, "Must pass at least one user or organization") unless (@$users + @$orgs);
  48. return _help(2, "Must pass baseurl") unless $baseurl;
  49. return _help(3, "Must pass your username") unless $me;
  50. # Parse Alias mappings
  51. my %alias_map;
  52. if (@$aliases) {
  53. foreach my $arg (@$aliases) {
  54. my ($actual, $domain, $alias) = split(/:/, $arg);
  55. return _help(3, "aliases must be of the form user:domain:alias") unless $actual && $domain && $alias;
  56. $alias_map{$domain}{$actual} = $alias;
  57. }
  58. }
  59. my ($primary_domain) = $baseurl =~ $domainRipper;
  60. my %tokens;
  61. foreach my $tok (@$tokens) {
  62. my ($domain, $token) = split(/:/, $tok);
  63. return _help(4, "tokens must be of the form domain:token") unless $domain && $token;
  64. $tokens{$domain} = $token;
  65. }
  66. $primary_token = $tokens{$primary_domain};
  67. my %args = (
  68. user => $me,
  69. api_uri => $baseurl,
  70. token => $primary_token,
  71. );
  72. # It's important which is the primary, because we can have only one pull url, and many push urls.
  73. my $local = $gogs ? Gogs->new(%args) : Pithub->new( %args );
  74. # If the primary is gogs and we have no token passed, let's make one.
  75. if (!$primary_token && $gogs) {
  76. _help(5, "Program must be run interactively to auto-create keys on Gogs installs.") unless IO::Interactive::Tiny::is_interactive();
  77. $primary_token = $local->get_token(
  78. name => "git-clone-entity",
  79. password => _prompt("Please type in the password for $local->user:"),
  80. );
  81. }
  82. my @repos_local = _fetch_all($local, $users, $orgs);
  83. my %repos_mirror;
  84. foreach my $mirror_url (@$mirrors) {
  85. my ($mirror_domain) = $mirror_url =~ $domainRipper;
  86. my $muser = $me;
  87. $muser = $alias_map->{$domain}{$me} if exists $alias_map->{$domain}{$me};
  88. my %margs = (
  89. user => $muser,
  90. api_uri => $mirror_url,
  91. token => $tokens{$mirror_domain},
  92. );
  93. my $mirror = Pithub->new( api_uri => $mirror_url );
  94. $repos_mirror{$mirror_url} = _fetch_all($mirror, $users, $orgs, \%alias_map);
  95. }
  96. use Data::Dumper;
  97. die Dumper(\%repos_mirror, \@repos_local, \%alias_map);
  98. }
  99. sub _prompt {
  100. my ( $prompt ) = @_;
  101. $prompt ||= "";
  102. my $input = "";
  103. print $prompt;
  104. # We are readin a password
  105. Term::ReadKey::ReadMode('noecho');
  106. {
  107. local $SIG{'INT'} = sub { Term::ReadKey::ReadMode(0); exit 130; };
  108. $input = <STDIN>;
  109. chomp($input) if $input;
  110. }
  111. Term::ReadKey::ReadMode(0);
  112. print "\n";
  113. return $input;
  114. }
  115. sub _fetch_all {
  116. my ($api, $users, $orgs, $alias_map) = @_;
  117. my ($domain) = $api->api_uri =~ $domainRipper;
  118. my @repos;
  119. foreach my $user (@$users) {
  120. $user = $alias_map->{$domain}{$user} if exists $alias_map->{$domain}{$user};
  121. my $result = $api->repos->list( user => $user );
  122. push(@repos, $result) if $result;
  123. }
  124. foreach my $org (@$orgs) {
  125. $org = $alias_map->{$domain}{$org} if exists $alias_map->{$domain}{$org};
  126. my $result = $api->repos->list( org => $org );
  127. push(@repos, $result) if $result;
  128. }
  129. return @repos;
  130. }
  131. exit main(@ARGV) unless caller;
  132. 1;