abonbot/lib/darsan_auth.pm

#!/usr/bin/perl

use Modern::Perl;

# Авторизация для Дарсана
# Ю. Жиловец, 17.02.2015

package darsan_auth;

use Crypt::OpenSSL::RSA;
use Mojo::JSON qw/j/;
use Mojo::UserAgent;
use Convert::Ascii85 qw/ascii85_encode/;
use Time::timegm qw/timegm/;
use POSIX::strptime;
use Data::Dumper;
use Mojo::Promise;

sub error
{
  return $_[0]->{error};
}

sub source_ip
{   
  my $self = shift;
  my $ip = shift;
  $self->{ua}->local_address($ip);
}

sub as_server
{
  my $class = shift;
  my $auth_servers = shift;
  my $name = shift;
  my $private = shift;

  if (ref($private) ne "Crypt::OpenSSL::RSA")
  {
    open(K,$private) or do die "No private key found: $private: $!";
    my $key = do { local($/); <K>};
    close(K);
    $private = Crypt::OpenSSL::RSA->new_private_key($key);
    $private->use_sha1_hash;
    $private->use_pkcs1_padding;
  }

  $auth_servers = [ $auth_servers ] unless ref $auth_servers;
  return bless {auth_servers=>$auth_servers, name=>$name, private=>$private, error=>undef, ua=>new Mojo::UserAgent},$class;
}

sub as_user
{
  my $class = shift;
  my $auth_servers = shift;
  my $login = shift;
  my $password = shift;

  $auth_servers = [ $auth_servers ] unless ref $auth_servers;
  return bless {auth_servers=>$auth_servers, login=>$login, password=>$password, error=>undef, ua=>new Mojo::UserAgent},$class;
}

sub set_token
{
  my $self = shift;
  my $token = shift;
  my $exp_stamp = shift;

  $self->{token} = $token;
  $self->{expire} = $exp_stamp;
}

sub token
{
  my $self = shift;
  my $sub = shift;
 
  my $deferred;

  if ($sub && $sub eq "promise")
  {
    $deferred = new Mojo::Promise;
    $sub = sub {

      my ($err,$body) = @_;
      if ($err)
      {
        $deferred->reject($err);
      }
      else
      {
        $deferred->resolve($body);
      }
    };
  }

  undef $self->{error};
  if ($self->{token} && $self->{expire}>time())
  {
    if ($sub)
    {
      $sub->(undef,$self->{token});
      return $deferred;
    }
    else
    {
      return $self->{token};
    }
  }

  if ($sub)
  {
    $self->_token(sub {
      my ($err,$token,$expire) = @_;

      if ($err)
      {
        $self->{error} = $err;
        return $sub->($err);
      }

      $self->{token} = $token;
      $self->{expire} = $expire;
      $sub->(undef,$token);
    });

    return $deferred;
  }
  else
  {
    my ($err,$token,$expire) = $self->_token;
    if ($err)
    {
      $self->{error} = $err;
      return undef;
    }

    $self->{token} = $token;
    $self->{expire} = $expire;

    return $token;
  }
}

sub _token
{
  my $self = shift;
  my $sub = shift;

  if ($self->{login})
  {
    return $self->_fetch_token($sub, "token",
                               {ver=>2, login=>$self->{login}, password=>$self->{password}} );
  }
  else
  {
    my $t = time();
    my $sign = $self->{private}->sign("$self->{name}/$t");
    return $self->_fetch_token($sub, "server-token/$self->{name}",
                               {ver=>2, time=>$t, sign=>ascii85_encode($sign)} );
  }
}

sub _fetch_token
{
  my $self = shift;
  my $sub = shift;
  my $url = shift;
  my $form = shift;

  if ($sub)
  {
    $self->_fetch_token_async($sub,$url,$form);
  }
  else
  {
    $self->_fetch_token_sync($url,$form);
  }
}

sub _fetch_token_sync
{
  my $self = shift;
  my $url = shift;
  my $form = shift;

  my $tx;

  LOOP: {
  foreach my $server (@{ $self->{auth_servers} })
  {
    $tx = $self->{ua}->post("$server/$url" => form => $form);

    last LOOP if $tx->result;
    last if $tx->error && $tx->error->{status} && $tx->error->{status}==400;
  }

  my $e = $tx->error;
  $e->{code} ||= 500;
  my $err = {code=>$e->{code}, message=> $e->{message}, body => $tx->res->body};
  return ($err);
}

  my $body = j($tx->res->body);
  my $token = $body->{token};
  my $expires = $body->{expires};
  my $exp = $self->parse_time($expires);

  return (undef,$token,$exp);
}

sub _fetch_token_async
{
  my $self = shift;
  my $sub = shift;
  my $url = shift;
  my $form = shift;

  my $server = $self->{auth_servers}->[0];
  $self->{ua}->post_p("$server/$url" => form => $form)
    ->then(sub
  {
    my $tx = shift;
    
    if (my $e = $tx->error)
    {
      return $sub->( {code=>$e->{code}, url=>"$server/$url", message=>$e->{message}, body=>$tx->result->body} );
    }
                      
    my $body = j($tx->result->body);
    my $token = $body->{token};
    my $expires = $body->{expires};
    my $exp = $self->parse_time($expires);
    $sub->(undef,$token,$exp);
  })
    ->catch(sub
  {
    my $e = shift;
    unless (ref $e)
    {
      $sub->( {code=>500, url=>"$server/$url", message=>$e, body=>""} );
    }
    else
    {
      $e->{code} ||= 500;
      $sub->( {code=>$e->{code}, url=>"$server/$url", message=>$e->{message}, body=>""} );
    }
  });
}

sub parse_time
{
  no warnings;
  my $self = shift;
  my $s = shift;

  $s =~ /([+-])(\d{4})$/;
  my $tz_sign = $1;
  my $tz = $2;
  $s =~ s/[+-]\d{4}$//;

  my $time = timegm(POSIX::strptime($s,"%Y-%m-%d %H:%M:%S%z"));

  if ($tz)
  {
    my $h = substr($tz,0,2);
    my $s = substr($tz,2,2);
    my $offset = ($h*60+$s)*60;
    $offset = -$offset if $tz_sign eq "+";
    $time += $offset;
  }

  return $time;
}

1;