#!/usr/bin/perl use Modern::Perl; # Авторизация для Дарсана # Ю. Жиловец, 17.02.2015, 12.05.2023 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}->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($/); }; close(K); $private = Crypt::OpenSSL::RSA->new_private_key($key); $private->use_sha256_hash; $private->use_pkcs1_oaep_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;