File Coverage

blib/lib/WWW/Suffit/UserAgent.pm

Criterion	Covered	Total	%
statement	33	241	13.6
branch	0	70	0.0
condition	0	83	0.0
subroutine	11	33	33.3
pod	21	21	100.0
total	65	448	14.5

package WWW::Suffit::UserAgent;
use warnings;
use strict;
use utf8;

=encoding utf-8

=head1 NAME

WWW::Suffit::UserAgent - Suffit API user agent library

=head1 SYNOPSIS

    use WWW::Suffit::UserAgent;

    my $clinet = WWW::Suffit::UserAgent->new(
        url                 => "https://localhost",
        username            => "username", # optional
        password            => "password", # optional
        max_redirects       => 2, # Default: 10
        connect_timeout     => 3, # Default: 10 sec
        inactivity_timeout  => 5, # Default: 30 sec
        request_timeout     => 10, # Default: 5 min (300 sec)
    );
    my $status = $client->check();

    if ($status) {
        print STDOUT $client->res->body;
    } else {
        print STDERR $clinet->error;
    }

=head1 DESCRIPTION

Suffit API user agent library

=head2 new

    my $clinet = WWW::Suffit::UserAgent->new(
        url                 => "https://localhost",
        username            => "username", # optional
        password            => "password", # optional
        max_redirects       => 2, # Default: 10
        connect_timeout     => 3, # Default: 10 sec
        inactivity_timeout  => 5, # Default: 30 sec
        request_timeout     => 10, # Default: 5 min (300 sec)
    );

Returns the client instance

=over 8

=item B

Sets the authentication scheme. HTTP Authentication Schemes: Bearer, Basic, ApiKey

Default: ApiKey (use token header)

=item B

Enables ask username and password from terminal

=item B

Maximum number of redirects the user agent will follow before it fails. Default - 10

=item B

Default password for basic authentication

=item B<*timeout>

Timeout for connections, requests and inactivity periods in seconds.

=item B

The Mojo UserAgent object

=item B

Full URL of the WEB Server

=item B

Default username for basic authentication

=back

=head1 METHODS

List of the User Agent interface methods

=head2 cleanup

    $client->cleanup;

Cleanup all variable data in object and returns client object

=head2 code

    my $code = $clinet->code;
    $client  = $clinet->code(200);

Returns HTTP code of the response

=head2 credentials

    my $userinfo = $client->credentials(1);

Gets credentials for User Agent

=head2 error

    print $clinet->error;
    $clinet = $clinet->error("My error");

Returns error string

=head2 path2url

    # For url = http://localhost:8695/api
    my $url_str = $client->path2url("/foo/bar");
        # http://localhost:8695/api/foo/bar

Merges path to tail of url

    # For url = http://localhost:8695/api
    my $url_str = $client->path2url("/foo/bar", 1);
        # http://localhost:8695/foo/bar

Sets path to url

=head2 private_key

    $clinet = $clinet->private_key("---- BEGIN ... END -----");
    my $private_key = $client->private_key;

Sets or returns RSA private key

=head2 public_key

    $clinet = $clinet->public_key("---- BEGIN ... END -----");
    my $public_key = $client->public_key;

Sets or returns RSA public key

=head2 proxy

    my $proxy = $client->proxy;
    $client->proxy('http://47.88.62.42:80');

Get or set proxy

=head2 req

    my $request = $clinet->req;

Returns Mojo::Message::Request object

=head2 request

    my $json = $clinet->request("METHOD", "PATH", ...ATTRIBUTES...);

Send request

=head2 res

    my $response = $clinet->res;

Returns Mojo::Message::Response object

=head2 status

    my $status = $clinet->status;
    $clinet    = $clinet->status(1);

Returns object status value. 0 - Error; 1 - Ok

=head2 str2url

    # http://localhost/api -> http://localhost/api/foo/bar
    my $url = $self->str2url("foo/bar");

    # http://localhost/api -> http://localhost/foo/bar
    my $url = $self->str2url("/foo/bar");

    # http://localhost/api/baz -> http://localhost/api/baz
    my $url = $self->str2url("http://localhost/api/baz");

Returns URL from specified sting

=head2 token

    $clinet = $clinet->token("abc123...fcd");
    my $token = $client->token;

Returns token

=head2 trace

    my $trace = $client->trace;
    print $client->trace("New trace record");

Gets trace stack or pushes new trace record to trace stack

=head2 tx

    my $status = $clinet->tx($tx);

Works with Mojo::Transaction object, interface with it

=head2 tx_string

    print $client->tx_string;

Retruns transaction status string

=head2 ua

    my $ua = $clinet->ua;

Returns Mojo::UserAgent object

=head2 url

    my $url_object = $clinet->url;

Returns Mojo::URL object

=head1 API METHODS

List of predefined the Suffit API methods

=head2 check

    my $status = $client->check;
    my $status = $client->check( URLorPath );

Returns check-status of server. 0 - Error; 1 - Ok

=head1 HTTP BASIC AUTHORIZATION

For pass HTTP Basic Authorization with ask user credentials from console use follow code:

    my $client = WWW::Suffit::UserAgent->new(
        ask_credentials => 1,
        auth_scheme => 'Basic',
        # ...
    );

... and without ask:

    my $client = WWW::Suffit::UserAgent->new(
        username => 'test',
        password => 'test',
        # ...
    );

You can also use credentials in the userinfo part of a base URL:

    my $client = WWW::Suffit::UserAgent->new(
        url => 'https://test:test@localhost',
        # ...
    )

=head1 TLS CLIENT CERTIFICATES

    $client->ua->cert('tls.crt')->key('tls.key')->ca('ca.crt');

See L, L, L and L

=head1 PROXY

In constructor:

    my $client = WWW::Suffit::UserAgent->new(
        proxy => 'http://47.88.62.42:80',
        # ...
    );

Before request:

    my $status = $client
        ->proxy('http://47.88.62.42:80')
        ->request(GET => $client->str2url('http://ifconfig.io/all.json'));

    # Socks5
    my $status = $client
        ->proxy('socks://socks:socks@192.168.201.129:1080')
        ->request(GET => $client->str2url('http://ifconfig.io/all.json'));

Directly:

    $client->ua->proxy
        ->http('http://47.88.62.42:80')
        ->https('http://188.125.173.185:8080');

    my $status = $client
        ->proxy('http://47.88.62.42:80')
        #->proxy('socks://socks:socks@192.168.201.129:1080')
        ->request(GET => $client->str2url('http://ifconfig.io/all.json'));

=head1 DEPENDENCIES

L, L

=head1 TO DO

See C file

=head1 SEE ALSO

L

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L [e-mail]

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C file or L for details

=cut

our $VERSION = '1.02';

use Mojo::UserAgent;
use Mojo::UserAgent::Proxy;
use Mojo::Asset::File;
use Mojo::URL;
use Mojo::Util qw/steady_time b64_encode/;

use WWW::Suffit::Const qw/ DEFAULT_URL TOKEN_HEADER_NAME /;
use Acrux::Util qw/ fbytes fduration /;

use constant {
        MAX_REDIRECTS       => 10,
        CONNECT_TIMEOUT     => 10,
        INACTIVITY_TIMEOUT  => 30,
        REQUEST_TIMEOUT     => 180,
        TRANSACTION_MASK    => "%s %s >>> %s %s [%s in %s%s]", # GET /info >>> 200 OK [1.04 KB in 0.0242 seconds (43.1 KB/sec)]
        CONTENT_TYPE        => 'application/json',
        REALM               => 'Restricted zone',
    };

sub new {
    my $class = shift;
    my %args  = @_;

    # General
    $args{status} = 1; # Boolean status: 0 - error, 1 - ok
    $args{error} = ""; # Error string (message) or HTTP Error message
    $args{code} = 0;   # HTTP Error code (integer) or error code string value (default is integer)

    # Base URL & URL Prefix
    $args{url} = Mojo::URL->new($args{url} || DEFAULT_URL); # base url
    $args{prefix} = $args{url}->path->to_string // ''; $args{prefix} =~ s/\/+$//;

    # HTTP Basic Authorization credentials
    $args{credentials} = "";
    $args{auth_scheme} ||= "";
    $args{username} //= $args{url}->username // '';
    $args{password} //= $args{url}->password // '';
    $args{ask_credentials} ||= 0;

    # API/Access/Session token
    $args{token} //= "";
    $args{token_name} ||= TOKEN_HEADER_NAME;

    # Security
    $args{public_key} //= "";
    $args{private_key} //= "";

    # Proxy string
    $args{proxy} //= "";

    # Transaction (tx)
    $args{trace} = []; # trace pool
    $args{tx_string} = "";
    $args{tx_time} = 0;
    $args{req} = undef;
    $args{res} = undef;

    # User Agent
    my $ua = $args{ua};
    unless ($ua) {
        # Create the instance
        $ua = Mojo::UserAgent->new(
                max_redirects       => $args{max_redirects} || MAX_REDIRECTS,
                connect_timeout     => $args{connect_timeout} || CONNECT_TIMEOUT,
                inactivity_timeout  => $args{inactivity_timeout} || INACTIVITY_TIMEOUT,
                request_timeout     => $args{request_timeout} || REQUEST_TIMEOUT,
                insecure            => $args{insecure} || 0,
            );
        $ua->transactor->name(sprintf("%s/%s", __PACKAGE__, __PACKAGE__->VERSION));

        # Set proxy
        my $proxy = Mojo::UserAgent::Proxy->new;
        $ua->proxy($proxy->http($args{proxy})->https($args{proxy})) if $args{proxy};

        $args{ua} = $ua;
    }

    my $self = bless {%args}, $class;
    return $self;
}

## INTERFACE METHODS

sub error {
    my $self = shift;
    my $e = shift;
    if (defined $e) {
        $self->{error} = $e;
        return $self;
    }
    return $self->{error};
}
sub status {
    my $self = shift;
    my $s = shift;
    if (defined $s) {
        $self->{status} = $s;
        return $self;
    }
    return $self->{status};
}
sub code {
    my $self = shift;
    my $c = shift;
    if (defined $c) {
        $self->{code} = $c;
        return $self;
    }
    return $self->{code};
}
sub trace {
    my $self = shift;
    my $v = shift;
    if (defined($v)) {
        my $a = $self->{trace};
        push @$a, $v;
        return $v;
    }
    my $trace = $self->{trace} || [];
    return join("\n",@$trace);
}
sub token {
    my $self = shift;
    my $t = shift;
    if (defined $t) {
        $self->{token} = $t;
        return $self;
    }
    return $self->{token};
}
sub public_key {
    my $self = shift;
    my $k = shift;
    if (defined $k) {
        $self->{public_key} = $k;
        return $self;
    }
    return $self->{public_key};
}
sub private_key {
    my $self = shift;
    my $k = shift;
    if (defined $k) {
        $self->{private_key} = $k;
        return $self;
    }
    return $self->{private_key};
}
sub proxy {
    my $self = shift;
    my $p = shift;
    return $self->{proxy} unless defined $p;
    $self->{proxy} = $p;

    # Set proxy
    $self->ua->proxy->http($p)->https($p) if length $p;

    return $self;
}
sub cleanup {
    my $self = shift;
    $self->{status} = 1;
    $self->{error} = "";
    $self->{code} = 0;
    $self->{tx_string} = "";
    undef $self->{req};
    $self->{req} = undef;
    undef $self->{res};
    $self->{res} = undef;
    undef $self->{trace};
    $self->{trace} = [];
    return $self;
}
sub req {
    my $self = shift;
    return $self->{req};
}
sub res {
    my $self = shift;
    return $self->{res};
}
sub url {
    my $self = shift;
    return $self->{url};
}
sub tx_string {
    my $self = shift;
    return $self->{tx_string} // '';
}
sub path2url {
    my $self = shift;
    my $p = shift // "/";
    my $r = shift; # Is root, no use preffix
    my $url = $self->url->clone;
    my $path = $r ? $p : sprintf("%s/%s", $self->{prefix}, $p);
    $path =~ s/\/{2,}/\//g;
    return $url->path_query($path)->to_string;
}
sub str2url {
    my $self = shift;
    my $str = shift // "";
    if ($str =~ /^https?\:\/\//) { # url (http/https)
        return $str;
    } elsif ($str =~ /^\//) { # absolute path (started from root, e.g.: /foo/bar)
        return $self->path2url($str, 1);
    } elsif (length $str) { # relative path (started from tail of base url, e.g.: foo/bar)
        return $self->path2url($str);
    }
    return $self->url->clone->to_string;
}
sub ua {
    my $self = shift;
    return $self->{ua};
}
sub tx {
    my $self = shift;
    my $tx = shift;

    # Check Error
    my $err = $tx->error;
    unless (!$err || $err->{code}) {
        $self->error($err->{message});
        $self->status(0);
    }
    $self->code($tx->res->code || "000");
    $self->status($tx->res->is_success ? 1 : 0);
    $self->error($tx->res->json("/error") || $tx->res->json("/message") || $err->{message} || "Unknown transaction error" )
        if $tx->res->is_error && !$self->error;

    # Transaction string
    my $length = $tx->res->body_size || 0;
    my $rtime = $self->{tx_time} // 0;
    $self->{tx_string} = sprintf(TRANSACTION_MASK,
        $tx->req->method, $tx->req->url->to_abs, # Method & URL
        $self->code, $tx->res->message || $err->{message} || "Unknown error", # Line
        fbytes($length), # Length
        fduration($rtime), # Duration
        $rtime ? sprintf(" (%s/sec)", fbytes($length/$rtime)) : "",
    );

    # Tracing
    $self->trace($self->{tx_string});
    my $req_hdrs = $tx->req->headers->to_string;
    if ($req_hdrs) {
        $self->trace(join("\n", map {$_ = "> $_"} split(/\n/, $req_hdrs)));
        $self->trace(">");
    }
    my $res_hdrs = $tx->res->headers->to_string;
    if ($res_hdrs) {
        $self->trace(join("\n", map {$_ = "< $_"} split(/\n/, $res_hdrs)));
        $self->trace("<");
    }

    # Request And Response
    $self->{req} = $tx->req;
    $self->{res} = $tx->res;

    return $self->status;
}
sub request {
    my $self = shift;
    my $meth = shift;
    my $_url = shift;
    my @params = @_;
    $self->cleanup(); # Cleanup first

    # Set URL
    my $url = $_url ? Mojo::URL->new("$_url") : $self->url->clone;
    my $credentials = $self->credentials(0); # No ask!
    $url->userinfo($credentials) if $credentials; # + credentials

    # Request
    my $start_time = steady_time() * 1;
    my $tx = $self->ua->build_tx($meth, $url, @params); # Create transaction (tx)
       $self->_set_authorization_header($tx);
    my $res_tx = $self->ua->start($tx); # Run it!
    $self->{tx_time} = sprintf("%.*f",4, steady_time()*1 - $start_time) * 1;
    my $status = $self->tx($res_tx); # Validate!);

    # Auth required? - for Basic scheme set credentials to URL
    if (!$status && $self->{ask_credentials} && ($self->code == 401) && lc($self->{auth_scheme}) eq 'basic') {
        $self->cleanup();
        $credentials = $self->credentials(1); # Ask!;
        $url->userinfo($credentials) if $credentials;

        # Request
        $tx = $self->ua->build_tx($meth, $url, @params); # Create transaction (tx)
        $self->_set_authorization_header($tx);
        $res_tx = $self->ua->start($tx); # Run it!
        $self->{tx_time} = sprintf("%.*f",4, steady_time()*1 - $start_time) * 1;
        $status = $self->tx($res_tx); # Validate!;
    }

    return $status;
}
sub credentials {
    my $self = shift;
    my $ask = shift(@_) ? 1 : 0;

    # Return predefined credentials
    return $self->{credentials} if $self->{credentials};

    # Return predefined credentials if username and password are specified
    if (length($self->{username}) && length($self->{password})) {
        $self->{credentials} = sprintf("%s:%s", $self->{username}, $self->{password});
        return $self->{credentials};
    }

    # Prompt if ask flag is true and has terminal
    if ($ask && -t STDIN) {
        my ($username, $password);
        printf STDERR "Enter username for %s at %s: ", REALM, $self->url->host_port;
        $username = ;
        chomp($username);
        if (length($username)) {
            print STDERR "Password: ";
            system("stty -echo");
            $password = ;
            system("stty echo");
            print STDERR "\n"; # because we disabled echo
            chomp($password);
            $self->{username} = $username;
            $self->{password} = $password;
        } else {
            return "";
        }
        $self->{credentials} = sprintf("%s:%s", $username, $password);
        return $self->{credentials};
    }

    return "";
}

## SUFFIT API COMMON METHODS

sub check {
    my $self = shift;
    my $url = shift // ''; # URL or String (api)
    return $self->request(HEAD => $self->str2url($url));
}

## INTERNAL METHODS

sub _set_authorization_header {
    my $self = shift;
    my $tx = shift;
    my $scheme = lc($self->{auth_scheme});
    my $header_name = 'Authorization';
    my $header_value = '';

    # HTTP Authentication Schemes: https://www.iana.org/assignments/http-authschemes/http-authschemes.xhtml
    if ($scheme eq 'bearer') { # Bearer [RFC6750]
        $header_value = sprintf('Bearer %s', $self->token) if $self->token;
    } elsif ($scheme eq 'basic') { # Basic [RFC7617]
        $header_value = sprintf('Basic %s',
            b64_encode(sprintf('%s:%s',
                $self->{username} // 'anonymous',
                $self->{password} // ''
            ), '')
        );
    } elsif ($self->token) { # Oops! Use custom header
        $tx->req->headers->header($self->{token_name}, $self->token);
        return $self->token;
    } else {
        return undef;
    }

    # Set header
    $tx->req->headers->header($header_name, $header_value) if $header_value;
    return $header_value;
}

1;

__END__