Listing repos & autogenning keys working, next up we get mirroring

Also get the configuration files

bin/git-clone-entity

@@ -39,19 +39,20 @@ git clone-entity --user $user1 --user $user2 --org $org1 --org $org2 --alias $us
 =cut
 
 sub _help {
-    my ($code, $msg) = @_;
+    my ($code, $msg, $cb) = @_;
     $code //= 0;
     $msg //= "";
+	$cb->() if ref $cb eq 'CODE';
     return Pod::Usage::pod2usage( -message => $msg, -exitval => $code);
 }
 
-my $domainRipper = qr{m/^\w+://([\w|\.]+)};
+my $domainRipper = qr{^\w+://([\w|\.]+)};
 
 sub main {
     my @args = @_;
 
     my $help;
-    my ($users, $orgs, $aliases, $tokens, $mirrors, $baseurl, $gogs, $me) = ([],[],[],[],[],"", 0, "");
+    my ($users, $orgs, $aliases, $tokens, $mirrors, $baseurl, $gogs, $me, $insecure) = ([],[],[],[],[],"", 0, "", 0);
 
     GetOptionsFromArray(\@args,
         'me=s'      => \$me,
@@ -62,13 +63,14 @@ sub main {
         '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") unless $me;
+    return _help(3, "Must pass your username as --me") unless $me;
 
     # Parse Alias mappings
     my %alias_map;
@@ -88,44 +90,70 @@ sub main {
         $tokens{$domain} = $token;
     }
 
-    $primary_token = $tokens{$primary_domain};
+    my $primary_token = $tokens{$primary_domain};
     my %args = (
         user    => $me,
         api_uri => $baseurl,
-        token   => $primary_token,
     );
+    $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 => _prompt("Please type in the password for $local->user:"),
+			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->{$domain}{$me} if exists $alias_map->{$domain}{$me};
+        $muser = $alias_map{$mirror_domain}{$muser} if exists $alias_map{$mirror_domain}{$muser};
         my %margs = (
             user    => $muser,
             api_uri => $mirror_url,
-            token   => $tokens{$mirror_domain},
         );
+        $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, \%alias_map);
+    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 {
@@ -156,16 +184,23 @@ sub _fetch_all {
     foreach my $user (@$users) {
         $user = $alias_map->{$domain}{$user} if exists $alias_map->{$domain}{$user};
         my $result = $api->repos->list( user => $user );
-        push(@repos, $result) if $result;
+        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, $result) if $result;
+        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;

lib/Gogs.pm

@@ -5,8 +5,9 @@ use strict;
 use warnings;
 
 use Moo;
-use Mime::Base64;
+use MIME::Base64;
 
+#use Gogs::Repos;
 extends 'Pithub';
 
 =head1 DESCRIPTION
@@ -17,17 +18,18 @@ However the two have a number of differences, so they must be accounted for.
 
 The most important of which being that all requests require an API token.
 
-=head1 SUBROUTINES
+=head1 METHODS
 
 =head2 get_token(%options)
 
-Gogs has no user-facing means of creating tokens like github does.
-You have to POST against the API using HTTP simple auth to acquire them.
+We can simplify tooling around this to not require you enter the "Applications" section of the gogs interface.
 
 Requires that the object is instantiated with a username,
 that you pass a password, and that the api_uri is secure unless you pass the 'insecure' option.
 
-Will either fetch (if it exists) or create the named token.
+If the named token exists already it will delete and re-create the named token.
+
+It is HIGHLY RECOMMENDED you delete the token at the end of your session with the delete_token() method.
 
 =cut
 
@@ -35,23 +37,37 @@ Will either fetch (if it exists) or create the named token.
 # As such, I'm restricting every call not ending in /tokens
 my @TOKEN_REQUIRED_REGEXP = (qr{(?!/tokens$)});
 
-sub get_token {
-    my ($self, %options) = @_;
-
+sub _validate_tok_args {
+	my ($self,%options) = @_;
     die "Must instantiate with username" unless $self->user;
-    die "Must pass token name" unless $options{name};
-    die "Refuse to operate over insecure connections" if !$options{insecure} && _insecure($uri);
+    die "Must pass token name or sha1" unless $options{name} || $options{sha1};
+    die "Refuse to operate over insecure connections" if !$options{insecure} && _insecure($self->api_uri);
     die "Must provide password to fetch tokens" unless $options{password};
+}
 
-    my %auth_headers = (
-        'Authorization' => "Basic ".encode_base64("$self->user:$options{password}"),
+sub _build_tok_headers {
+	my ($self, %options) = @_;
+    return (
+        'Authorization' => "Basic ".encode_base64($self->user.":$options{password}"),
         'Content-type'  => "application/json",
     );
 
-    my $token_endpoint = "/api/v1/users/$self->user/tokens";
+}
+
+sub get_token {
+    my ($self, %options) = @_;
+
+	# unset the token if passed, so that we use simple auth
+	my $tok = $self->token();
+	$self->token("") if $tok;
+
+	$self->_validate_tok_args(%options);
+	my %auth_headers = $self->_build_tok_headers(%options);
+
+    my $token_endpoint = "/users/".$self->user."/tokens";
     my %req = (
-         method  => 'GET',
-        path    => $tokens_endpoint,
+        method  => 'GET',
+        path    => $token_endpoint,
         headers => \%auth_headers,
     );
     my $result = $self->request(%req);
@@ -60,21 +76,62 @@ sub get_token {
 
     my $token_actual;
     foreach my $token (@$content) {
-        next unless $token->{name} eq $options{name};
-        return $token->{sha1};
+		# If it exists, we have no means of deleteing it unless we actually have the real SHA1 (the one in list is not real).
+        # As such just die.
+        die "Token with name $options{name} already exists, cannot continue.  Please delete it manually." if $token->{name} eq $options{name};
     }
 
     # No such token named, so let's just make one.
     $req{method} = 'POST';
-    my $result = $self->request(%req);
-    my $content = $result->content();
+	$req{data} = qq|{ "name":"$options{name}" }|;
+    $result = $self->request(%req);
+    $content = $result->content();
+
+	# Set the token again, since we are done with the requests
+	$self->token($tok) if $tok;
+
     die "Got bad response from server" unless ref $content eq "HASH";
     return $content->{sha1};
 }
 
+=head2 delete_token(%options)
+
+Delete the token identified by the provided sha1 in %options.
+
+Should return a token name.
+
+Dies when unsuccessful.
+
+=cut
+
+sub delete_token {
+	my ($self, %options) = @_;
+
+	# unset the token if passed, so that we use simple auth
+	my $tok = $self->token();
+	$self->token("") if $tok;
+
+	$self->_validate_tok_args(%options);
+	my %auth_headers = $self->_build_tok_headers(%options);
+
+    my %req = (
+        method  => 'DELETE',
+        path    => "/users/".$self->user."/tokens",
+        headers => \%auth_headers,
+    );
+	$req{data} = qq|{ "sha1":"$options{sha1}" }|;
+	my $result = $self->request(%req);
+
+	# Set the token again, since we are done with the requests
+	$self->token($tok) if $tok;
+
+	die "Got bad response from server on DELETE of token" unless $result &&  $result->response->is_success;
+	return $result;
+}
+
 sub _insecure {
     my $uri = shift;
-    return m/^http:\/\//;
+    return $uri =~ m/^http:\/\//;
 }
 
 1;