view release on metacpan or  search on metacpan

lib/Gerrit/Client.pm  view on Meta::CPAN

  $cv->cb(
    sub {
      # make sure we stay alive until this callback is executed
      undef $cv;

      my $status = shift->recv();
      if ( $status && $options{on_error} ) {
        $options{on_error}->("$cmdstr exited with status $status");
        return;
      }

      return unless $options{on_success};

      my @results;
      foreach my $line ( split /\n/, $output ) {
        my $data = eval { decode_json($line) };
        if ($EVAL_ERROR) {
          $options{on_error}->("error parsing result `$line': $EVAL_ERROR");
          return;
        }
        next if ( $data->{type} && $data->{type} eq 'stats' );
        push @results, $data;
      }

      $options{on_success}->(@results);
      return;
    }
  );

  return;
}

=item B<< quote $string >>

Returns a copy of the input string with special characters escaped, suitable
for usage with Gerrit CLI commands.

Gerrit commands run via ssh typically need extra quoting because the ssh layer
already evaluates the command string prior to passing it to Gerrit.
This function understands how to quote arguments for this case.

B<Note:> do not use this function for passing arguments to other Gerrit::Client
functions; those perform appropriate quoting internally.

=cut

sub quote {
  my ($string) = @_;

  # character set comes from gerrit source:
  # gerrit-sshd/src/main/java/com/google/gerrit/sshd/CommandFactoryProvider.java
  # 'split' function
  $string =~ s{([\t "'\\])}{\\$1}g;
  return $string;
}

=item B<< http_digest_auth($username, $password) >>

Returns a callback to be used with REST-related Gerrit::Client functions.
The callback enables Digest-based HTTP authentication with the given
credentials.

Note that only the Digest scheme used by Gerrit (as of 2.8) is supported:
algorithm = MD5, qop = auth.

=cut
sub http_digest_auth {
  my ($username, $password, %args) = @_;

  my $cnonce_cb = $args{cnonce_cb} || sub {
    sprintf("%08x", rand() * ( 2**32 ));
  };

  my %noncecount;

  return sub {
    my ($in_headers, $out_headers) = @_;

    my $authenticate = $in_headers->{'www-authenticate'};
    if (!$authenticate || !($authenticate =~ /^Digest /)) {
      warn __PACKAGE__ . ': server did not offer digest authentication';
      return;
    }

    $authenticate =~ s/^Digest //;

    my %attr;
    while ($authenticate =~ /([a-zA-Z0-9\-]+)="([^"]+)"(,\s*)?/g) {
      $attr{$1} = $2;
    }

    if ($attr{qop}) {
      $attr{qop} = [ split(/,/, $attr{qop}) ];
    }

    $attr{algorithm} ||= 'MD5';
    $attr{qop} ||= [];

    _debug_print "digest attrs with defaults filled: "  . Dumper(\%attr);

    unless (grep {$_ eq 'auth'} @{$attr{qop}}) {
      warn __PACKAGE__ . ": server didn't offer qop=auth for digest authentication";
      return;
    }

    unless ($attr{algorithm} eq 'MD5') {
      warn __PACKAGE__ . ": server didn't offer algorithm=MD5 for digest authentication";
    }

    my $nonce = $attr{nonce};
    my $cnonce = $cnonce_cb->();

    $noncecount{$nonce} = ($noncecount{$nonce}||0) + 1;
    my $count = $noncecount{$nonce};
    my $count_hex = sprintf("%08x", $count);

    my $uri = URI->new($in_headers->{URL})->path;
    my $method = $in_headers->{Method};
    _debug_print "uri $uri method $method\n";

    my $ha1 = md5_hex($username, ':', $attr{realm}, ':', $password);