#!/usr/bin/env perl
#
# Copyright(C) 2016-2021
#
# This is proprietary information of
# Crypto-Pro company.
#
# Any part of this file can not be copied,
# corrected, translated into other languages,
# localized or modified by any means,
# compiled, transferred over a network from or to
# any computer system without preliminary
# agreement with Crypto-Pro company

###############################

package JSON::Tiny;

# Minimalistic JSON. Adapted from Mojo::JSON. (c)2012-2015 David Oswald
# License: Artistic 2.0 license.
# http://www.perlfoundation.org/artistic_license_2_0

use strict;
use warnings;
use Carp 'croak';
use Scalar::Util 'blessed';
use B;

our $VERSION = '0.58';
our @EXPORT_OK = qw(decode_json encode_json false from_json j to_json true);

# Literal names
# Users may override Booleans with literal 0 or 1 if desired.
our($FALSE, $TRUE) = map { bless \(my $dummy = $_), 'JSON::Tiny::_Bool' } 0, 1;

# Escaped special character map with u2028 and u2029
my %ESCAPE = (
  '"'     => '"',
  '\\'    => '\\',
  '/'     => '/',
  'b'     => "\x08",
  'f'     => "\x0c",
  'n'     => "\x0a",
  'r'     => "\x0d",
  't'     => "\x09",
  'u2028' => "\x{2028}",
  'u2029' => "\x{2029}"
);
my %REVERSE = map { $ESCAPE{$_} => "\\$_" } keys %ESCAPE;

for(0x00 .. 0x1f) {
  my $packed = pack 'C', $_;
  $REVERSE{$packed} = sprintf '\u%.4X', $_ unless defined $REVERSE{$packed};
}

sub decode_json {
  my $err = _decode(\my $value, shift);
  return defined $err ? croak $err : $value;
}

sub encode_json {
  my $str = shift;
  utf8::encode(encode_value($str));
  return $str;
}

sub false () {$FALSE}  ## no critic (prototypes)

sub from_json {
  my $err = _decode(\my $value, shift, 1);
  return defined $err ? croak $err : $value;
}

sub j {
  return encode_json $_[0] if ref $_[0] eq 'ARRAY' || ref $_[0] eq 'HASH';
  return decode_json $_[0];
}

sub to_json { _encode_value(shift) }

sub true () {$TRUE} ## no critic (prototypes)

sub _decode {
  my $valueref = shift;

  eval {

    # Missing input
    die "Missing or empty input\n" unless length( local $_ = shift );

    # UTF-8
    $_ = eval { utf8::decode($_) ? $_ : '' } unless shift;
    die "Input is not UTF-8 encoded\n" unless defined $_;

    # Value
    $$valueref = _decode_value();

    # Leftover data
    return m/\G[\x20\x09\x0a\x0d]*\z/gc || _throw('Unexpected data');
  } ? return undef : chomp $@;

  return $@;
}

sub _decode_array {
  my @array;
  until (m/\G[\x20\x09\x0a\x0d]*\]/gc) {

    # Value
    push @array, _decode_value();

    # Separator
    redo if m/\G[\x20\x09\x0a\x0d]*,/gc;

    # End
    last if m/\G[\x20\x09\x0a\x0d]*\]/gc;

    # Invalid character
    _throw('Expected comma or right square bracket while parsing array');
  }

  return \@array;
}

sub _decode_object {
  my %hash;
  until (m/\G[\x20\x09\x0a\x0d]*\}/gc) {

    # Quote
    m/\G[\x20\x09\x0a\x0d]*"/gc
      or _throw('Expected string while parsing object');

    # Key
    my $key = _decode_string();

    # Colon
    m/\G[\x20\x09\x0a\x0d]*:/gc
      or _throw('Expected colon while parsing object');

    # Value
    $hash{$key} = _decode_value();

    # Separator
    redo if m/\G[\x20\x09\x0a\x0d]*,/gc;

    # End
    last if m/\G[\x20\x09\x0a\x0d]*\}/gc;

    # Invalid character
    _throw('Expected comma or right curly bracket while parsing object');
  }

  return \%hash;
}

sub _decode_string {
  my $pos = pos;
  
  # Extract string with escaped characters
  m!\G((?:(?:[^\x00-\x1f\\"]|\\(?:["\\/bfnrt]|u[0-9a-fA-F]{4})){0,32766})*)!gc; # segfault on 5.8.x in t/20-mojo-json.t
  my $str = $1;

  # Invalid character
  unless (m/\G"/gc) {
    _throw('Unexpected character or invalid escape while parsing string')
      if m/\G[\x00-\x1f\\]/;
    _throw('Unterminated string');
  }

  # Unescape popular characters
  if (index($str, '\\u') < 0) {
    $str =~ s!\\(["\\/bfnrt])!$ESCAPE{$1}!gs;
    return $str;
  }

  # Unescape everything else
  my $buffer = '';
  while ($str =~ m/\G([^\\]*)\\(?:([^u])|u(.{4}))/gc) {
    $buffer .= $1;

    # Popular character
    if ($2) { $buffer .= $ESCAPE{$2} }

    # Escaped
    else {
      my $ord = hex $3;

      # Surrogate pair
      if (($ord & 0xf800) == 0xd800) {

        # High surrogate
        ($ord & 0xfc00) == 0xd800
          or pos($_) = $pos + pos($str), _throw('Missing high-surrogate');

        # Low surrogate
        $str =~ m/\G\\u([Dd][C-Fc-f]..)/gc
          or pos($_) = $pos + pos($str), _throw('Missing low-surrogate');

        $ord = 0x10000 + ($ord - 0xd800) * 0x400 + (hex($1) - 0xdc00);
      }

      # Character
      $buffer .= pack 'U', $ord;
    }
  }

  # The rest
  return $buffer . substr $str, pos $str, length $str;
}

sub _decode_value {

  # Leading whitespace
  m/\G[\x20\x09\x0a\x0d]*/gc;

  # String
  return _decode_string() if m/\G"/gc;

  # Object
  return _decode_object() if m/\G\{/gc;

  # Array
  return _decode_array() if m/\G\[/gc;

  # Number
  my ($i) = /\G([-]?(?:0|[1-9][0-9]*)(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?)/gc;
  return 0 + $i if defined $i;

  # True
  return $TRUE if m/\Gtrue/gc;

  # False
  return $FALSE if m/\Gfalse/gc;

  # Null
  return undef if m/\Gnull/gc;  ## no critic (return)

  # Invalid character
  _throw('Expected string, array, object, number, boolean or null');
}

sub _encode_array {
  '[' . join(',', map { _encode_value($_) } @{$_[0]}) . ']';
}

sub _encode_object {
  my $object = shift;
  my @pairs = map { _encode_string($_) . ':' . _encode_value($object->{$_}) }
    sort keys %$object;
  return '{' . join(',', @pairs) . '}';
}

sub _encode_string {
  my $str = shift;
  $str =~ s!([\x00-\x1f\x{2028}\x{2029}\\"/])!$REVERSE{$1}!gs;
  return "\"$str\"";
}

sub _encode_value {
  my $value = shift;

  # Reference
  if (my $ref = ref $value) {

    # Object
    return _encode_object($value) if $ref eq 'HASH';

    # Array
    return _encode_array($value) if $ref eq 'ARRAY';

    # True or false
    return $$value ? 'true' : 'false' if $ref eq 'SCALAR';
    return $value  ? 'true' : 'false' if $ref eq 'JSON::Tiny::_Bool';

    # Blessed reference with TO_JSON method
    if (blessed $value && (my $sub = $value->can('TO_JSON'))) {
      return _encode_value($value->$sub);
    }
  }

  # Null
  return 'null' unless defined $value;


  # Number (bitwise operators change behavior based on the internal value type)

  return $value
    if B::svref_2object(\$value)->FLAGS & (B::SVp_IOK | B::SVp_NOK)
    # filter out "upgraded" strings whose numeric form doesn't strictly match
    && 0 + $value eq $value
    # filter out inf and nan
    && $value * 0 == 0;

  # String
  return _encode_string($value);
}

sub _throw {

  # Leading whitespace
  m/\G[\x20\x09\x0a\x0d]*/gc;

  # Context
  my $context = 'Malformed JSON: ' . shift;
  if (m/\G\z/gc) { $context .= ' before end of data' }
  else {
    my @lines = split "\n", substr($_, 0, pos);
    $context .= ' at line ' . @lines . ', offset ' . length(pop @lines || '');
  }

  die "$context\n";
}

# Emulate boolean type
package JSON::Tiny::_Bool;
use overload '""' => sub { ${$_[0]} }, fallback => 1;
1;

###############################

package MIME::Base64::Perl;

use vars qw(@EXPORT $VERSION);

@EXPORT = qw(encode_base64 decode_base64);

$VERSION = '1.00';

sub encode_base64 ($;$)
{
    if ($] >= 5.006) {
        require bytes;
        if (bytes::length($_[0]) > length($_[0]) ||
            ($] >= 5.008 && $_[0] =~ /[^\0-\xFF]/))
        {
            require Carp;
            Carp::croak("The Base64 encoding is only defined for bytes");
        }
    }

    use integer;

    my $eol = $_[1];
    $eol = "\n" unless defined $eol;

    my $res = pack("u", $_[0]);
    # Remove first character of each line, remove newlines
    $res =~ s/^.//mg;
    $res =~ s/\n//g;

    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    # break encoded string into lines of no more than 76 characters each
    if (length $eol) {
        $res =~ s/(.{1,76})/$1$eol/g;
    }
    return $res;
}

sub decode_base64 ($)
{
    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
    use integer;

    my $str = shift;
    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
    if (length($str) % 4) {
        require Carp;
        Carp::carp("Length of base64 data not a multiple of 4")
    }
    $str =~ s/=+$//;                        # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
    return "" unless length $str;

    ## I guess this could be written as
    #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
    #                   $str =~ /(.{1,60})/gs) ) );
    ## but I do not like that...
    my $uustr = '';
    my ($i, $l);
    $l = length($str) - 60;
    for ($i = 0; $i <= $l; $i += 60) {
        $uustr .= "M" . substr($str, $i, 60);
    }
    $str = substr($str, $i);
    # and any leftover chars
    if ($str ne "") {
        $uustr .= chr(32 + length($str)*3/4) . $str;
    }
    return unpack ("u", $uustr);
}

# encode_base64url and decode_base64url from modern versions of MIME::Base64

sub my_encode_base64url {
    my $e = encode_base64(shift, "");
    $e =~ s/=+\z//;
    $e =~ tr[+/][-_];
    return $e;
}

sub my_decode_base64url {
    my $s = shift;
    $s =~ tr[-_][+/];
    $s .= '=' while length($s) % 4;
    return decode_base64($s);
}

###############################

#package URI::Escape;

use strict;
use warnings;

use Exporter 5.57 'import';
our %escapes;
our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
our @EXPORT_OK = qw(%escapes);
our $VERSION = '5.10';

use Carp ();

# Build a char->hex map
for (0..255) {
    $escapes{chr($_)} = sprintf("%%%02X", $_);
}

my %subst;  # compiled patterns

my %Unsafe = (
    RFC2732 => qr/[^A-Za-z0-9\-_.!~*'()]/,
    RFC3986 => qr/[^A-Za-z0-9\-\._~]/,
);

sub uri_escape {
    my($text, $patn) = @_;
    return undef unless defined $text;
    if (defined $patn){
        unless (exists  $subst{$patn}) {
            # Because we can't compile the regex we fake it with a cached sub
            (my $tmp = $patn) =~ s,/,\\/,g;
            eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
            Carp::croak("uri_escape: $@") if $@;
        }
        &{$subst{$patn}}($text);
    } else {
        $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
    }
    $text;
}

sub _fail_hi {
    my $chr = shift;
    Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
}

sub uri_escape_utf8 {
    my $text = shift;
    return undef unless defined $text;
    utf8::encode($text);
    return uri_escape($text, @_);
}

sub uri_unescape {
    # Note from RFC1630:  "Sequences which start with a percent sign
    # but are not followed by two hexadecimal characters are reserved
    # for future extension"
    my $str = shift;
    if (@_ && wantarray) {
        # not executed for the common case of a single argument
        my @str = ($str, @_);  # need to copy
        for (@str) {
            s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
        }
        return @str;
    }
    $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
    $str;
}

## XXX FIXME escape_char is buggy as it assigns meaning to the string's storage format.
#sub escape_char {
#    # Old versions of utf8::is_utf8() didn't properly handle magical vars (e.g. $1).
#    # The following forces a fetch to occur beforehand.
#    my $dummy = substr($_[0], 0, 0);
#
#    if (utf8::is_utf8($_[0])) {
#        my $s = shift;
#        utf8::encode($s);
#        unshift(@_, $s);
#    }
#
#    return join '', @URI::Escape::escapes{split //, $_[0]};
#}

###############################

sub is_macos() {
    return ($^O eq 'darwin');
}

sub is_windows() {
    return ($^O =~ /win32/i);
}

sub get_exit_code() {
    # $? is just the 16-bit status word returned by the traditional Unix wait() system call (or else is made up to look like it).
    # Thus, the exit value of the subprocess is really ($? >> 8). https://metacpan.org/pod/perlvar#pod32
    return ($? >> 8);
}

# global constants
# command to call this application
my $oauthapp = $0;
my $unquoted_window_title = 'Authentication - CryptoPro DSS';
my $window_title = '"' . $unquoted_window_title .'"';
# Timeout value (in seconds) for dialogs. It is used only if timeouts are supported by frontend.
my $dialog_timeout = 600;
my $window_width = 400;
my $tmp_folder = is_windows() ? $ENV{'TEMP'} . '\\' : '/var/opt/cprocsp/tmp/';
# command to call curl and options for it
my $curl = '/opt/cprocsp/bin/amd64/curl';
my $opts = '--silent';
my $empty_string = '';
my $EXIT_SUCCESS = 0;
my $EXIT_FAIL = 1;
my $false = 0;
my $true = 1;

my $CLOUD_ERR_SUCCESS = "success";
my $CLOUD_ERR_INTERNAL_ERROR = "internal_error";
my $CLOUD_ERR_INVALID_CERT = "invalid_certificate";
my $CLOUD_ERR_INVALID_USERNAME = "invalid_username";
my $CLOUD_ERR_INVALID_PASSWORD = "invalid_password";
my $CLOUD_ERR_UNEXPECTED_RESPONSE = "unexpected_response";
my $CLOUD_ERR_LAUNCH_FAILED = "launch_failed";
my $CLOUD_ERR_CANCELLED_BY_USER = "cancelled_by_user";

my $SPECIAL_VALUE_CANCELLED_BY_USER = "SPECIAL_VALUE_CANCELLED_BY_USER";

# global variables
my $child_process = $false;
my $output_file = $empty_string;
my $username = $empty_string;
my $password = $empty_string;
my $is_password_set = $false;
my $frontend = 'console';

# --- user interface ---

my $use_zenity_timeouts = $true;
my $use_zenity_nomarkup = $true;
my $use_zenity_list_text = $true;

sub is_zenity_version_or_newer($$$) {
    my $major_req = shift;
    my $minor_req = shift;
    my $patch_req = shift;
    my $version = `zenity --version`;
    if ($version =~ m/^(\d+)\.(\d+).(\d+)/) {
        my $major = $1;
        my $minor = $2;
        my $patch = $3;
        if (($major < $major_req) or
            ($major == $major_req and $minor < $minor_req) or
            ($major == $major_req and $minor == $minor_req and $patch < $patch_req))
        {
            return $false;
        }
    }
    return $true;
}

sub init_zenity_frontend() {
    $use_zenity_timeouts = is_zenity_version_or_newer(3, 8, 0);
    $use_zenity_nomarkup = is_zenity_version_or_newer(3, 1, 5);
    $use_zenity_list_text = is_zenity_version_or_newer(2, 6, 2);
}

sub mac_prepare_text($) {
    my $message = shift;
    $message =~ s/'/`/g;
    $message =~ s/"/`/g;
    # many message strings contain trailing newlines for console output
    chomp($message);
    chomp($message);
    return $message;
}

sub zenity_prepare_text($$) {
    my $message = shift;
    my $nomarkup_param = shift;
    $message =~ s/"/\\"/g;
    if ($nomarkup_param eq $empty_string) {
        $message =~ s/'/\\'/g;
        $message =~ s/&//g;
    }
    # many message strings contain trailing newlines for console output
    chomp($message);
    chomp($message);
    return $message;
}

# ---

sub mac_get_user_string($$) {
    my $message = shift;
    my $options = shift;
    my $buttons = 'buttons {"Cancel", "OK"} default button "OK" cancel button "Cancel"';
    my $cmd = 'display dialog "' . mac_prepare_text($message) . '" with title ' . $window_title . ' giving up after ' . $dialog_timeout . ' ' . $buttons . ' default answer "" ' . $options;
    my $rettext = `osascript -e '$cmd'`;
    if ($rettext =~ m/button returned:OK, text returned:(.*), gave up:false/) {
        return $1;
    }
    return $SPECIAL_VALUE_CANCELLED_BY_USER;
}

sub zenity_get_user_string($$) {
    my $message = shift;
    my $options = shift;
    my $window_size = '--width ' . $window_width;
    my $timeout_param = $use_zenity_timeouts ? '--timeout ' . $dialog_timeout : $empty_string;
    my $cmd = 'zenity --entry --text "' . zenity_prepare_text($message, $empty_string) . '" --title ' . $window_title . ' ' . $window_size . ' ' . $timeout_param . ' ' . $options;
    my $rettext = `$cmd`;
    if (get_exit_code() == $EXIT_SUCCESS) {
        chomp($rettext);
        return $rettext;
    }
    return $SPECIAL_VALUE_CANCELLED_BY_USER;
}

sub console_get_user_string($) {
    my $message = shift;
    print STDERR "$message";
    my $answer = <STDIN>;
    chomp($answer);
    return $answer;
}

sub get_user_string($) {
    my $message = shift;
    my $result = '';
    # If user entered empty string then ask him again.
    # Empty login or confirmation code is not possible.
    do {
        $result = mac_get_user_string($message, $empty_string) if ($frontend eq 'macos');
        $result = zenity_get_user_string($message, $empty_string) if ($frontend eq 'zenity');
        $result = console_get_user_string($message) if ($frontend eq 'console');
    } while ($result eq $empty_string);
    return $result;
}

# ---

sub mac_get_secret_string($) {
    my $message = shift;
    return mac_get_user_string($message, 'with icon caution with hidden answer')
}

sub zenity_get_secret_string($) {
    my $message = shift;
    return zenity_get_user_string($message, '--hide-text')
}

sub console_get_secret_string($) {
    my $message = shift;
    # Temporary disable echo. Ignore possible errors here.
    # Unfortunately, on Windows we can do it only via imported modules.
    # First of all, we check if shell is interactive.
    `test -t 0 && stty -echo` if (!is_windows());
    my $result = console_get_user_string($message);
    `test -t 0 && stty echo` if (!is_windows());
    print STDERR "\n";
    return $result;
}

sub get_secret_string($) {
    my $message = shift;
    my $result = '';
    # If user entered empty string then ask him again.
    # If this function is called then we already unsuccessfully tried empty password.
    do {
        $result = mac_get_secret_string($message) if ($frontend eq 'macos');
        $result = zenity_get_secret_string($message) if ($frontend eq 'zenity');
        $result = console_get_secret_string($message) if ($frontend eq 'console');
    } while ($result eq $empty_string);
    return $result;
}

# ---

sub first_index_or_cancelled($$) {
    my $query = shift;
    my $elts_ref = shift;
    my @elts = @{$elts_ref};
    my $elts_size = scalar @elts;
    if (!utf8::decode($query)) {
        return $SPECIAL_VALUE_CANCELLED_BY_USER;
    }
    chomp($query);
    for (my $i = 0; $i < $elts_size; $i++) {
        return $i if ($elts[$i] eq $query);
    }
    return $SPECIAL_VALUE_CANCELLED_BY_USER;
}

sub mac_get_list_choice($$) {
    my $message = shift;
    my $elts_ref = shift;
    my @elts = @{$elts_ref};
    my $first_elt = "{\"$elts[0]\"}";
    my $list = '{';
    foreach my $elt (@elts) {
        $list .= "\"$elt\",";
    }
    # remove trailing "," symbol
    chop($list);
    $list .= '}';
    my $cmd = 'choose from list ' . $list . ' with prompt "' . mac_prepare_text($message) . '" with title ' . $window_title . ' default items ' . $first_elt;
    my $rettext = `osascript -e '$cmd'`;
    return first_index_or_cancelled($rettext, $elts_ref);
}

sub zenity_get_list_choice($$$) {
    my $message = shift;
    my $column_name = shift;
    my $elts_ref = shift;
    my @elts = @{$elts_ref};
    my $elts_size = scalar @elts;
    my $text_param = $use_zenity_list_text ? '--text "' . zenity_prepare_text($message, $empty_string) . '"' : $empty_string;
    my $window_size = '--width ' . $window_width . ' --height 200';
    my $timeout_param = $use_zenity_timeouts ? '--timeout ' . $dialog_timeout : $empty_string;
    my $cmd = 'zenity --list ' . $text_param . ' --title ' . $window_title . ' ' . $window_size . ' ' . $timeout_param . ' --column="' . $column_name . '" ';
    foreach my $elt (@elts) {
        $cmd .= "\"$elt\" ";
    }
    # if user pressed "OK" without making choice then ask him again
    my $rettext = '';
    do {
        $rettext = `$cmd`;
    } while (get_exit_code() == $EXIT_SUCCESS and $rettext eq $empty_string);
    return first_index_or_cancelled($rettext, $elts_ref);
}

sub console_get_list_choice($$$) {
    my $message = shift;
    my $column_name = shift;
    my $elts_ref = shift;
    my @elts = @{$elts_ref};
    my $elts_size = scalar @elts;

    print STDERR "$message";
    for (my $i = 0; $i < $elts_size; $i++) {
        print STDERR ($i+1) . ". $elts[$i]\n";
    }
    print STDERR "\n";

    my $choice = $empty_string;
    for (;;) {
        $choice = console_get_user_string("$column_name (1..$elts_size): ");
        $choice = int($choice);
        last if (1 <= $choice and $choice <= $elts_size);
        print STDERR "Enter a number between 1 and $elts_size.\n\n";
    }
    print STDERR "\n";

    return ($choice - 1);
}

sub get_list_choice($$$) {
    my $message = shift;
    my $column_name = shift;
    my $elts_ref = shift;
    my @elts = @{$elts_ref};
    my $elts_size = scalar @elts;
    fail_with_message("Error: empty choice list.\n", $CLOUD_ERR_UNEXPECTED_RESPONSE) if ($elts_size == 0);
    return mac_get_list_choice($message, $elts_ref) if ($frontend eq 'macos');
    return zenity_get_list_choice($message, $column_name, $elts_ref) if ($frontend eq 'zenity');
    return console_get_list_choice($message, $column_name, $elts_ref);
}

# ---

sub mac_get_yes_or_no($) {
    my $message = shift;
    my $buttons = 'buttons {"Yes", "No"} default button "No" cancel button "No"';
    my $cmd = 'display dialog "' . mac_prepare_text($message) . '" with title ' . $window_title . ' giving up after ' . $dialog_timeout . ' ' . $buttons;
    my $rettext = `osascript -e '$cmd'`;
    if ($rettext =~ m/button returned:Yes/) {
        return 'yes';
    }
    return 'no';
}

sub zenity_get_yes_or_no($) {
    my $message = shift;
    my $window_size = '--width ' . $window_width;
    my $timeout_param = $use_zenity_timeouts ? '--timeout ' . $dialog_timeout : $empty_string;
    my $nomarkup_param = $use_zenity_nomarkup ? '--no-markup' : $empty_string;
    my $cmd = 'zenity --question --text "' . zenity_prepare_text($message, $nomarkup_param) . '" --title ' . $window_title . ' ' . $nomarkup_param . ' ' . $window_size . ' ' . $timeout_param;
    `$cmd`;
    if (get_exit_code() == $EXIT_SUCCESS) {
        return 'yes';
    }
    return 'no';
}

sub console_get_yes_or_no($) {
    my $message = shift;
    my $answer = console_get_user_string("$message (y/n)");
    return (lc($answer) eq 'y' ? 'yes' : 'no');
}

sub get_yes_or_no($) {
    my $message = shift;
    return mac_get_yes_or_no($message) if ($frontend eq 'macos');
    return zenity_get_yes_or_no($message) if ($frontend eq 'zenity');
    return console_get_yes_or_no($message);
}

# ---

sub mac_show_message($$$) {
    my $message = shift;
    my $should_wait = shift;
    if ($should_wait) {
        my $cancellable = shift;
        my $options = ($message =~ m/Error/) ? 'with icon stop' : $empty_string;
        my $buttons = $cancellable ?
            'buttons {"Cancel", "OK"} default button "OK" cancel button "Cancel"' :
            'buttons {"OK"} default button "OK"';
        my $cmd = 'display dialog "' . mac_prepare_text($message) . '" with title ' . $window_title . ' giving up after ' . $dialog_timeout . ' ' . $buttons . ' ' . $options;
        my $rettext = `osascript -e '$cmd'`;
        if ($rettext =~ m/button returned:OK/) {
            return 'OK';
        }
        return $SPECIAL_VALUE_CANCELLED_BY_USER;
    }
    else {
        my $cmd = 'display notification "' . mac_prepare_text($message) . '" with title ' . $window_title;
        `osascript -e '$cmd'`;
        return 'OK';
    }
}

sub zenity_show_message($) {
    my $message = shift;
    my $cmd = $empty_string;
    my $type = ($message =~ m/Error/) ? '--error' : '--info';
    my $window_size = '--width ' . $window_width;
    my $timeout_param = $use_zenity_timeouts ? '--timeout ' . $dialog_timeout : $empty_string;
    my $nomarkup_param = $use_zenity_nomarkup ? '--no-markup' : $empty_string;
    $cmd = 'zenity ' . $type . ' --text "' . zenity_prepare_text($message, $nomarkup_param) . '" --title ' . $window_title . ' ' . $nomarkup_param . ' ' . $window_size . ' ' . $timeout_param;
    `$cmd`;
    if (get_exit_code() == $EXIT_SUCCESS) {
        return 'OK';
    }
    return $SPECIAL_VALUE_CANCELLED_BY_USER;
}

sub console_show_message($$) {
    my $message = shift;
    my $should_wait = shift;
    $message = "\n$message";
    if ($should_wait) {
        # hide user input because we're waiting for newline
        console_get_secret_string($message);
    }
    else {
        print STDERR "$message";
    }
    return 'OK';
}

# show status information
sub show_notification($) {
    my $message = shift;
    console_show_message($message, $false); # always print notification to console
    return mac_show_message($message, $false, $false) if ($frontend eq 'macos');
    # zenity: non-blocking notifications aren't implemented, so for debugging we rely on console output.
}

# show information, ensure that user can read it
sub show_message($) {
    my $message = shift;
    return mac_show_message($message, $true, $false) if ($frontend eq 'macos');
    return zenity_show_message($message) if ($frontend eq 'zenity');
    return console_show_message($message, ($child_process or is_windows()));
}

# show information, ensure that user will accept it
sub show_waiting_message($) {
    my $message = shift;
    return mac_show_message($message, $true, $true) if ($frontend eq 'macos');
    return zenity_show_message($message) if ($frontend eq 'zenity');
    return console_show_message($message, $true);
}

# --- authentication itself ---

sub finalize($;$) {
    my $msg_for_library = shift;
    my $msg_for_user = shift || "Internal error occured";
    # parent process creates and deletes output file
    unlink($output_file) if (!($child_process) and -e $output_file);
    if ($msg_for_library ne $CLOUD_ERR_SUCCESS) {
        print "error_message=$msg_for_library\n";
    }
    # we can't use fail_with_message() here
    close(STDOUT) or (show_message("Error: can't close STDOUT.\n") and $msg_for_library = $CLOUD_ERR_INTERNAL_ERROR);
    my $retval = $EXIT_SUCCESS;
    if ($msg_for_library ne $CLOUD_ERR_SUCCESS and
        $msg_for_library ne $CLOUD_ERR_CANCELLED_BY_USER)
    {
        $retval = $EXIT_FAIL;
        show_message($msg_for_user);
    }
    exit $retval;
}

sub fail_with_message($;$) {
    my $msg_for_user = shift;
    my $msg_for_library = shift || $CLOUD_ERR_INTERNAL_ERROR;
    finalize($msg_for_library, $msg_for_user);
}

sub fail_with_dump($$;$) {
    my $dump = shift;
    my $msg_for_user = shift;
    my $msg_for_library = shift || $CLOUD_ERR_INTERNAL_ERROR;
    finalize($msg_for_library, $msg_for_user . "Response dump:\n$dump\n");
}

sub unexpected_response($) {
    my $response = shift;
    fail_with_dump($response, "Error: unexpected server response.\n", $CLOUD_ERR_UNEXPECTED_RESPONSE);
}

# this operation does nothing because oauthapp doesn't save cookies between invocations
sub exit_if_sign_out_url($) {
    my $url = shift;
    my $sign_out_url_regexp = '^(https?://[^/]+/.+)/Authentication/SignOut$';
    if ($url =~ m/$sign_out_url_regexp/) {
        my $server_and_path = $1;
        my $message = "Successfully signed out from '$server_and_path' CryptoPro DSS server.\n";
        show_message($message);
        finalize($CLOUD_ERR_CANCELLED_BY_USER);
    }
}

sub get_data_from_url($) {
    my $url = shift;
    # additional arguments at the end of url is normal
    my $proper_url_regexp = '^(https?://[^/]+)/(.+)/oauth/authorize\?client_id=cryptopro.cloud.csp&response_type=[%\w]+&scope=[+\w]*&redirect_uri=https?%3A%2F%2Fdss.cryptopro.ru%2Foauth2redirect%2Fcloudcsp&resource=(urn:cryptopro:dss:signserver:[^&]+)(&dss_transaction_token_id=([-\w]+))?(&dss_operation_id=([-\w]+))?(&id_token_hint=[-=\.\w]+)?(&license_permissions=([\d]+))?(&response_mode=[-=\.\w]+)?(&prompt=[-=\.\w]+)?(&sign_api_version=([\d]+))?';
    if ($url =~ m/$proper_url_regexp/) {
        my $server = $1;
        my $path = $2;
        my $resource = $3;
        my $transaction = defined $4 ? $5 : $empty_string;
        my $operation = defined $6 ? $7 : $empty_string;
        my $license = defined $9 ? $10 : $empty_string;
        my $api_version = defined $13 ? int($14) : 1;
        return ($server, $path, $resource, $transaction, $operation, $license, $api_version);
    }
    else {
        my $message = "Error: unexpected format of URL address in command line argument:\n" .
                      "$url\n" .
                      "Probably you've made a misprint in authentication server's URL address.\n";
        fail_with_message($message);
    }
}

sub set_credentials_from_url($) {
    my $url = shift;
    my $id_token_hint = 'id_token_hint=([-\w]*)\.eyJleHAiOjIxNDc0ODM2NDd9Cg==\.([-\w]*)';
    if ($url =~ m/$id_token_hint/) {
        $username = my_decode_base64url($1);
        $password = my_decode_base64url($2);
        $is_password_set = $true;
        return $true;
    }
    my $login_hint = 'login_hint=([-.~%\w]*)';
    if ($url =~ m/$login_hint/) {
        $username = uri_unescape($1);
        # password may be set later if needed
        return $true;
    }
    return $false;
}

sub set_username_from_user($$) {
    my $server = shift;
    my $path = shift;
    my $output_text = "Authenticate on '$server/$path' CryptoPro DSS server\n\nUsername: ";
    $username = get_user_string($output_text);
    if ($username eq $SPECIAL_VALUE_CANCELLED_BY_USER) {
        my $message = "Authentication is cancelled by user.\n";
        show_notification($message);
        finalize($CLOUD_ERR_CANCELLED_BY_USER);
    }
}

sub set_password_from_user() {
    my $output_text = "Password: ";
    $password = get_secret_string($output_text);
    $is_password_set = $true;
    if ($password eq $SPECIAL_VALUE_CANCELLED_BY_USER) {
        my $message = "Authentication is cancelled by user.\n";
        show_notification($message);
        finalize($CLOUD_ERR_CANCELLED_BY_USER);
    }
}

sub is_curl_exists($) {
    my $curl_cmd = shift;
    my $OLD_CURL_EXIT_SUCCESS = 2;
    `$curl_cmd --version 2>&1`;
    my $exit_code = get_exit_code();
    if ($exit_code == $EXIT_SUCCESS or $exit_code == $OLD_CURL_EXIT_SUCCESS) {
        return $true;
    }
    return $false;
}

#sub search_system_curl() {
#    my $curl_cmd = 'curl';
#    if (!is_curl_exists($curl_cmd)) {
#        my $message = "Error: can't find system curl.\n" .
#                      "Try to install 'curl' package for your system or check your 'PATH' " .
#                      "environment variable.\n";
#        fail_with_message($message);
#    }
#    return $curl_cmd;
#}

# we should try this fallback only once
#my $already_tried = $false;
#sub use_system_curl() {
#    if ($already_tried) {
#        my $message = "Error: fallback to system curl failed.\n" .
#                      "Both CryptoPro curl (if it was installed) and system curl programs " .
#                      "returned error 'curl: (58) Problem with the local SSL certificate'. If " .
#                      "you didn't installed cpcurl package then try to install it. Also, it may " .
#                      "be caused by absence of some required certificate in your local root " .
#                      "certificate store.\n";
#        fail_with_message($message, $CLOUD_ERR_INVALID_CERT);
#    }
#    $already_tried = $true;
#    $curl = search_system_curl();
#}

sub check_connection($) {
    my $url = shift;
    my ($server, $path, undef, undef, undef, undef, undef) = get_data_from_url($url);
    my $SSL_CONNECT_ERROR = 35;
    my $SSL_CERT_PROBLEM = 58;
    my $SSL_CACERT_PROBLEM = 60;

    # sign out page should always exist so let's try to retrieve it
    `$curl $opts "$server/$path/Authentication/SignOut"`;

    my $exit_code = get_exit_code();

    ## deprecated fallback to system curl
    ## if we've got "Problem with the local SSL certificate" error then we should try fallback to system curl
    #if ($exit_code == $SSL_CERT_PROBLEM) {
    #    # this is the normal situation, so don't issue a warning here
    #    use_system_curl();
    #    check_connection($url);
    #}

    # if we've got "SSL certificate problem, verify that the CA cert is OK" or
    # "Problem with the local SSL certificate" error then we should stop
    if ($exit_code == $SSL_CONNECT_ERROR or $exit_code == $SSL_CACERT_PROBLEM or $exit_code == $SSL_CERT_PROBLEM) {
        my $message = "Error: SSL connection problem.\n" .
                      "Your local root certificate store probably doesn't contain root " .
                      "certificate from this server's certificate chain.\n" .
                      "server: $server/$path\n" .
                      "curl exit code: $exit_code\n";
        fail_with_message($message, $CLOUD_ERR_INVALID_CERT);
    }

    if ($exit_code != $EXIT_SUCCESS) {
        my $message = "Error: can't connect to $server/$path.\n" .
                      "curl exit code: $exit_code\n";
        fail_with_message($message, $CLOUD_ERR_INTERNAL_ERROR);
    }

    # else just return
}

sub method_requires_simple_confirmation($) {
    my $method = shift;
    my $METHOD_SIM = 'http://dss.cryptopro.ru/identity/authenticationmethod/simauth';
    my $METHOD_APP = 'http://dss.cryptopro.ru/identity/authenticationmethod/mobile';
    my $METHOD_MYDSS = 'http://dss.cryptopro.ru/identity/authenticationmethod/mydss';

    if ($method eq $METHOD_SIM or $method eq $METHOD_APP or $method eq $METHOD_MYDSS) {
        return $true;
    }
    return $false;
}

sub escape_quotes($)
{
    my $s = shift;
    $s =~ s/\"/\\\"/g;
    return $s;
}

sub process_challenge($$$) {
    my $challenge_ref = shift;
    my %challenge = %{$challenge_ref};
    my $raw_data = shift;
    my $url = shift;
    my (undef, undef, $resource, undef, undef, $license, undef) = get_data_from_url($url);

    my $output_text = "$unquoted_window_title\n";
    if (defined $challenge{Title} and defined $challenge{Title}{Value}) {
        $output_text = "$challenge{Title}{Value}\n";
    }
    if (defined $challenge{TextChallenge} and defined $challenge{TextChallenge}[0]) {
        my $text_challenge_ref = $challenge{TextChallenge}[0];
        my %text_challenge = %{$text_challenge_ref};
        unexpected_response($raw_data) if (!defined $text_challenge{RefID} or !defined $text_challenge{AuthnMethod});
        $output_text .= "$text_challenge{Label}\n" if (defined $text_challenge{Label});
        my $ref_id = $text_challenge{RefID};

        if (method_requires_simple_confirmation($text_challenge{AuthnMethod})) {
            $output_text = "Confirm this operation with application or SIM card and press Enter.\n\n$output_text";
            my $answer = show_waiting_message($output_text);
            if ($answer eq $SPECIAL_VALUE_CANCELLED_BY_USER) {
                my $message = "Authentication is cancelled by user.\n";
                show_notification($message);
                finalize($CLOUD_ERR_CANCELLED_BY_USER);
            }
            return escape_quotes('{"Resource":"' . $resource . '"' .
                (($license ne $empty_string) ? ',"LicensePermissions":' . $license : '') .
                ',"ChallengeResponse":{"TextChallengeResponse":[{"RefId":"' . $ref_id . '"}]},"ClientId":"cryptopro.cloud.csp"}');
        }
        else {
            $output_text .= "\nConfirmation code: ";
            my $confirm_code = get_user_string($output_text);
            if ($confirm_code eq $SPECIAL_VALUE_CANCELLED_BY_USER) {
                my $message = "Authentication is cancelled by user.\n";
                show_notification($message);
                finalize($CLOUD_ERR_CANCELLED_BY_USER);
            }
            return escape_quotes('{"Resource":"' . $resource . '"' .
                (($license ne $empty_string) ? ',"LicensePermissions":' . $license : '') .
                ',"ChallengeResponse":{"TextChallengeResponse":[{"RefId":"' . $ref_id . '","Value":"' . $confirm_code . '"}]},"ClientId":"cryptopro.cloud.csp"}');
        }
    }
    elsif (defined $challenge{ChoiceChallenge} and defined $challenge{ChoiceChallenge}[0]) {
        my $choice_challenge_ref = $challenge{ChoiceChallenge}[0];
        my %choice_challenge = %{$choice_challenge_ref};
        unexpected_response($raw_data) if (!defined $choice_challenge{RefID} or !defined $choice_challenge{Choice} or !defined $choice_challenge{Choice}[0]);
        my @choices = $choice_challenge{Choice};
        my $subchoices = scalar $choices[0];
        my $subchoices_max_index = $#$subchoices;
        my @names;
        for (my $i = 0; $i <= $subchoices_max_index; $i++) {
            unexpected_response($raw_data) if (!defined $choices[0][$i]);
            my $choice_ref = $choices[0][$i];
            my %choice = %{$choice_ref};
            unexpected_response($raw_data) if (!defined $choice{RefID} or !defined $choice{Label});
            push(@names, $choice{Label});
        }

        my $auth_method_index = get_list_choice($output_text, 'Authentication method', \@names);
        if ($auth_method_index eq $SPECIAL_VALUE_CANCELLED_BY_USER) {
            my $message = "Authentication is cancelled by user.\n";
            show_notification($message);
            finalize($CLOUD_ERR_CANCELLED_BY_USER);
        }

        my $ref_id = $choice_challenge{RefID};
        my $choice = $choice_challenge{Choice}[$auth_method_index]{RefID};
        return escape_quotes('{"Resource":"' . $resource . '"' .
            (($license ne $empty_string) ? ',"LicensePermissions":' . $license : '') .
            ',"ChallengeResponse":{"ChoiceChallengeResponse":[{"RefId":"' . $ref_id . '","ChoiceSelected": [{"RefID":"' . $choice . '",}]}]},"ClientId":"cryptopro.cloud.csp"}');
    }
    else {
        unexpected_response($raw_data);
    }
}

sub log_in($) {
    my $url = shift;
    my ($server, $path, $resource, $transaction, $operation, $license, $api_version) = get_data_from_url($url);


    if (!set_credentials_from_url($url)) {
        # don't ask for password now, try to log in without it
        set_username_from_user($server, $path);
    }

    my $json_data = escape_quotes('{"Resource":"' . $resource . '"' .
        (($transaction ne $empty_string) ? ',"TransactionTokenId":"' . $transaction . '"' : '') .
        (($operation ne $empty_string) ? ',"OperationId":"' . $operation . '"' : '') .
        (($license ne $empty_string) ? ',"LicensePermissions":' . $license : '') .
        ',"ClientId":"cryptopro.cloud.csp"}');

    for (;;) {
        # shell-escaped username and password for substitution in single quotes
        my $shell_login_data = "$username:$password";
        # single quote symbols need special preparation for this
        $shell_login_data =~ s/'/'"'"'/g;

        my $endpoint = "$server/$path/confirmation";
        if ($api_version > 1) {
            $endpoint = "$server/$path/v2.0/confirmation";
        }

        my $raw_data = `$curl $opts --user '$shell_login_data' --header "Content-Type: application/json" --data "$json_data" "$endpoint"`;

        my $exit_code = get_exit_code();

        if ($exit_code != $EXIT_SUCCESS) {
            my $message = "curl returned error $exit_code.\n";
            fail_with_message($message, $CLOUD_ERR_INTERNAL_ERROR);
        }

        # For simplicity, we think that empty response means invalid username or password.
        # Because of this, in case of nonexistent or blocked username we needlessly ask for a
        # password and finally return error "Invalid password" to library.
        # We could check HTTP status to be sure, but there is no easy way to get HTTP status and
        # HTTP data simultaneously from curl in separate variables:
        # https://superuser.com/questions/272265/getting-curl-to-output-http-status-code
        if ($raw_data eq $empty_string) {
            # if we tried to log in without password then ask for password and try again
            if (!$is_password_set) {
                set_password_from_user();
                next;
            }
            else {
                fail_with_message("Error: username or password is invalid.\n", $CLOUD_ERR_INVALID_PASSWORD);
            }
        }

        my $response_ref;
        eval { $response_ref = JSON::Tiny::decode_json($raw_data); };
        if ($@ ne $empty_string) {
            fail_with_dump($raw_data, "Error: JSON decoding failed.\n");
        }
        my %response = %{$response_ref};

        if (defined $response{Error} and defined $response{ErrorDescription}) {
            fail_with_message("Error: " . $response{ErrorDescription} . "\n", $response{Error});
        }

        unexpected_response($raw_data) if (!defined $response{IsFinal} or !defined $response{IsError});
        if ($response{IsError}) {
            fail_with_dump($raw_data, "Error: server response indicates an error.\n");
        }
        elsif ($response{IsFinal}) {
            print_response($response_ref);
        }
        elsif (defined $response{Challenge}) {
            $json_data = process_challenge($response{Challenge}, $raw_data, $url);
        }
        else {
            unexpected_response($raw_data);
        }
    }
}

# our caller expect key names in snake case
sub decamelize {
    my ($s) = @_;
    $s =~ s{(\w+)}{
        ($a = $1) =~ s<(^[A-Z]|(?![a-z])[A-Z])><
            "_" . lc $1
        >eg;
        substr $a, 1;
    }eg;
    $s;
}

sub print_response($) {
    my $response_ref = shift;
    my %response = %{$response_ref};

    # get parts of the response one by one, then print them at once
    my $id_token = my_encode_base64url($username) . '.eyJleHAiOjIxNDc0ODM2NDd9Cg==.' . my_encode_base64url($password);
    my $final_string = "id_token=$id_token&";
    foreach my $key (keys %response) {
        $final_string .= decamelize($key) . "=$response{$key}&";
    }
    # remove trailing "&" symbol
    chop($final_string);
    print "$final_string\n";
    finalize($CLOUD_ERR_SUCCESS);
}

sub create_temporary_file() {
    # generate a random filename
    my $suffix = int(rand(1000000));
    my $file_name = $tmp_folder . "oauth.$suffix";
    if (-e $file_name) {
        fail_with_message("Error: can't create file '$file_name' because it already exists.\n");
    }
    my $open_error_message = "Error: can't write to temporary file '$file_name'.\n" .
                             "Check it's access rights and umask value of current user.\n";
    open(my $OUT_FILE, '>', $file_name) or fail_with_message($open_error_message);
    close($OUT_FILE) or fail_with_message("Error: can't close temporary file '$file_name'.\n");
    return $file_name;
}

sub create_named_pipe() {
    # generate a random filename
    my $suffix = int(rand(1000000));
    my $file_name = $tmp_folder . "oauth.$suffix";
    if (-e $file_name) {
        fail_with_message("Error: can't create file '$file_name' because it already exists.\n");
    }
    require POSIX;  # delayed loading of heavy module
    my $message = "Error: can't create named pipe '$file_name'.\n" .
                  "Check access rights for it's parent directory.\n";
    POSIX::mkfifo($file_name, 0666) or fail_with_message($message);
    return $file_name;
}

sub find_terminal_emulator() {
    my $titleParameter = ' --title=' . $window_title;
    # list of terminal emulators with blocking support and "-e COMMAND" option
    # emulators should block execution of parent process until they finish
    # if some options are not supported then terminal won't be found
    my @terms = ('gnome-terminal --disable-factory' . $titleParameter,
                 'xterm -title ' . $window_title,
                 'konsole --nofork -p tabtitle=' . $window_title,
                 'xfce4-terminal --disable-server' . $titleParameter,
                 'mate-terminal --disable-factory' . $titleParameter);
    # try to find some terminal emulator on the system
    foreach my $term (@terms) {
        # try to execute a simple command in terminal emulator with this options
        `$term -e 'true' 2>&1`;
        if (get_exit_code() == $EXIT_SUCCESS) {
            return $term;
        }
    }
    # if search wasn't successful
    return $empty_string;
}

sub get_relaunching_help() {
    if (is_windows() or is_macos() or $frontend ne 'console') {
        return $empty_string;
    }

    my $message = "For best user experience, we recommend you to install 'zenity' package for " .
                  "your system. You can disable relaunching of this application in a new " .
                  "terminal window by setting 'CPRO_DISABLE_OAUTHAPP_GUI' environment variable.\n\n";
    return $message;
}

# try to launch application in a new terminal window
# this function returns on non-critical error,
# finishes program on success and on critical error
sub try_relaunching_in_terminal($) {
    my $url = shift;
    my $final_command = $empty_string;

    if (is_windows()) {
        return;
    }

    if (is_macos()) {
        # standard terminal emulator in macOS is non-blocking, so we have to use named pipe for communication
        $output_file = create_named_pipe();
        # Note the double quoting here: besides usual quoting we have to use quotes in osascript.
        my $recursion_command = "echo -n -e \\\"\\\\033]0;$unquoted_window_title\\\\007\\\";clear; $oauthapp \\\"$url\\\" \\\"$output_file\\\"; exit";
        $final_command = "osascript -e \'tell application \"Terminal\" to do script \"$recursion_command\"\'";
    }
    else {
        my $found_term = find_terminal_emulator();
        # this error is not critical
        if ($found_term eq $empty_string) {
            my $message = "Warning: can't find any proper terminal emulator to relaunch application in new window.\n";
            $message .= get_relaunching_help();
            show_notification($message);
            return;
        }
        # run this application recursively inside a terminal. application's output is redirected to temporary file
        $output_file = create_temporary_file();
        my $recursion_command = "$oauthapp \'$url\' \'$output_file\'";
        $final_command = "$found_term -e \"$recursion_command\"";
    }
    `$final_command`;
    my $ret = get_exit_code();
    # this error is not critical
    if ($ret != $EXIT_SUCCESS) {
        my $message = "Warning: command '$final_command' for launching terminal emulator returned error code '$ret'.\n";
        $message .= get_relaunching_help();
        show_notification($message);
        return;
    }
    # to return application's output to our caller, we print and delete this file, then exit
    my $open_error_message = "Error: can't read from output file '$output_file'.\n" .
                             "Check it's access rights and umask value of current user.\n";
    open(my $OUT_FILE, '<', $output_file) or fail_with_message($open_error_message);
    my $output = $empty_string;
    while(<$OUT_FILE>) {
        # collect all output in a variable
        $output .= "$_";
    }
    close($OUT_FILE) or fail_with_message("Error: can't close output file '$output_file'.\n");
    if ($output eq $empty_string) {
        my $message = "Warning: output file is empty! Probably user closed the child window.\n";
        show_notification($message);
        finalize($CLOUD_ERR_CANCELLED_BY_USER);
    }
    # print all output at once
    print "$output";
    finalize($CLOUD_ERR_SUCCESS);
}

sub is_env_variable_set($) {
    my $name = shift;
    if (defined $ENV{$name} and $ENV{$name} ne $empty_string) {
        return $true;
    }
    return $false;
}

sub set_frontend($) {
    my $url = shift;

    $frontend = 'console';

    # redirect STDOUT to file if needed
    if ($child_process) {
        my $message = "Error: can't write to output file '$output_file'.\n" .
                      "Check it's access rights and umask value of current user.\n";
        open(STDOUT, '>', $output_file) or fail_with_message($message);
        return;
    }

    # on Windows this script will be opened in new window automatically, so we don't need to relaunch it
    if (is_windows()) {
        return;
    }

    # don't launch GUI if user asked for it
    if (is_env_variable_set('CPRO_DISABLE_OAUTHAPP_GUI')) {
        return;
    }

    if (is_macos()) {
        # user can set DISPLAY to explicitly request GUI
        if (is_env_variable_set('DISPLAY')) {
            $frontend = 'macos';
            return;
        }

        # don't launch GUI if user is connected via SSH
        if (is_env_variable_set('SSH_TTY') or is_env_variable_set('SSH_CONNECTION') or is_env_variable_set('SSH_CLIENT')) {
            return;
        }

        # use GUI
        $frontend = 'macos';
        return;
    }

    # if we have X Window System then we should try to launch terminal
    if (is_env_variable_set('DISPLAY')) {
        `which zenity`;
        if (get_exit_code() == $EXIT_SUCCESS) {
            $frontend = 'zenity';
            init_zenity_frontend();
            return;
        }
        try_relaunching_in_terminal($url);
        return;
    }

    # otherwise use console
}

sub main {
    # We will print UTF-8 strings. Ignore possible errors here.
    `chcp 65001` if is_windows();
    # suppress debug output in cpcurl because such output breaks parsing
    delete $ENV{CP_PRINT_CHAIN_DETAIL};

    my $argc = scalar @ARGV;
    if ($argc != 1 and $argc != 2) {
        my $message = "Error: format: $oauthapp url_for_authentication\n";
        fail_with_message($message, $CLOUD_ERR_LAUNCH_FAILED);
    }
    my $url = $ARGV[0];
    # if we've got output file then it's the bottom of recursion
    $child_process = ($argc == 2);
    $output_file = $child_process ? $ARGV[1] : $empty_string;

    set_frontend($url);

    exit_if_sign_out_url($url);

    # if CryptoPro curl isn't found then exit
    if (!is_curl_exists($curl)) {
        my $message = "Error: can't find CryptoPro curl program.\n";
        fail_with_message($message);
        # deprecated fallback to system curl
        #my $message = "Warning: can't find CryptoPro curl program. Trying to use system curl.\n";
        #show_notification($message);
        #use_system_curl();
    }

    check_connection($url);
    log_in($url);
}

main();
