| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202 | #!/usr/bin/perluse Modern::Perl;# Авторизация для Дарсана# Ю. Жиловец, 17.02.2015, 12.05.2023package 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}->socket_options({LocalAddr => $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;  }  my $auth_server = ref $auth_servers ? $auth_servers->[0] : $auth_servers;  return bless {auth_server=>$auth_server, 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;  my $auth_server = ref $auth_servers ? $auth_servers->[0] : $auth_servers;  return bless {auth_server=>$auth_server, 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;   undef $self->{error};  return $self->{token} if $self->{token} && $self->{expire}>time();  my ($err,$token,$expire) = $self->_fetch_token_sync;  if ($err)  {    $self->{error} = $err;    return undef;  }  $self->{token} = $token;  $self->{expire} = $expire;  return $token;}sub token_p{  my $self = shift;  return Mojo::Promise->resolve($self->{token}) if $self->{token} && $self->{expire}>time();  $self->_fetch_token_async->then(sub  {    my ($token, $expire) = @_;    $self->{token} = $token;    $self->{expire} = $expire;    return $token;  });}sub _token_query{  my $self = shift;  if ($self->{login})  {    return ( "$self->{auth_server}/token", {ver=>2, login=>$self->{login}, password=>$self->{password}} );  }  else  {    my $t = time();    my $sign = $self->{private}->sign("$self->{name}/$t");    return ( "$self->{auth_server}/server-token/$self->{name}", {ver=>2, time=>$t, sign=>ascii85_encode($sign)} );  }}sub _fetch_token_sync{  my $self = shift;  my ($url, $form) = $self->_token_query;  my $tx = $self->{ua}->post($url => form => $form);  return $self->_parse_reply($tx);}sub _fetch_token_async{  my $self = shift;  my $sub = shift;  my ($url, $form) = $self->_token_query;    $self->{ua}->post_p($url => form => $form)  ->catch(sub  {    my $err = shift;    die {url=>$url, code=>500, message=>$err, body=>""};  })  ->then(sub  {    my $tx = shift;    my ($error, $token, $expires) = $self->_parse_reply($tx);    die $error if $error;    return ($token, $expires);  })}sub _parse_reply{  my $self = shift;  my $tx = shift;    my $body = $tx->res->body;  $body = j($body) if $tx->res->headers->content_type  && $tx->res->headers->content_type =~ m|^application/json|;        if (my $e = $tx->error)  {    $e->{code} ||= 500;    my $err = {url=>$tx->req->url."", code=>$e->{code}, message=>$e->{message}, body=>$tx->res->body};    return ($err);  }  my $token = $body->{token};  my $expires = $body->{expires};  my $exp = parse_time($expires);  return (undef, $token, $exp);}sub parse_time {  no warnings;  my $s           = shift;  my $time_format = "%Y-%m-%d %H:%M:%S%z";  $s =~ /([+-])(\d{4})$/;  my $tz_sign = $1;  my $tz      = $2;  $s =~ s/[+-]\d{4}$//;  my $time = timegm(POSIX::strptime($s, $time_format));  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;
 |