Async HTTP(S) client

[cavac]

Recently, i've been battling with a few modules made by a former co-worker that are, how should i put it politely, garbage. The modules call a third party web API that could block up to a minute in a cyclic executive that is supposed the have a cycle time of under a second. So he used fork (via the "forks" module), that messes up all kinds of other things (open handles and stuff).

All i needed was a very simple HTTP(s) client that runs a single GET or POST call, non-blocking (except the initial TCP/SSL connect), single-threaded, with just frequent cyclic calls for processing. I couldn't find something that fit my requirements, so i spent a couple of hours writing my own. It's not fully finished and tested yet (haven't tested non-encrypted connection at all), but here it is so you can play with the code:

(Edit: Put the main code in readmore tags because of the length)

package PageCamel::Helpers::AsyncUA;
#---AUTOPRAGMASTART---
use v5.40;
use strict;
use diagnostics;
use mro 'c3';
use English;
use Carp qw[carp croak confess cluck longmess shortmess];
our $VERSION = 4.6;
use autodie qw( close );
use Array::Contains;
use utf8;
use Data::Dumper;
use Data::Printer;
use PageCamel::Helpers::UTF;
#---AUTOPRAGMAEND---

use IO::Socket::SSL;
use IO::Socket::INET;

sub new($proto, %config) {
    my $class = ref($proto) || $proto;

    my $self = bless \%config, $class;

    my $ok = 1;
    foreach my $required (qw[host use_ssl reph ua]) {
        if(!defined($self->{$required})) {
            print STDERR "Configuration $required not defined\n";
            $ok = 0;
        }
    }
    if(!$ok) {
        croak("Configuration error");
    }

    $self->{state} = 'ready';

    return $self;
}

sub get($self, $path) {
    return $self->_start_request('GET', $path);
}


sub post($self, $path, $contenttype, $body) {
    return $self->_start_request('POST', $path, $contenttype, $body);
}

sub _start_request($self, $method, $path, $contenttype = undef, $body 
+= undef) {
    if($self->{state} ne 'ready') {
        $self->{reph}->debuglog("Trying to start a request when not re
+ady, we are in state ", $self->{state});
        return 0;
    }

    $self->{headers} = [];
    $self->{parsedheaders} = {};
    $self->{body} = '';
    $self->{returncode} = '';
    $self->{outbox} = '';
    $self->{headerline} = '';

    $self->{outbox} .= $method . ' ' . $path . ' ' . "HTTP/1.1\r\n";
    $self->{outbox} .= 'Host: ' . $self->{host} . "\r\n";
    $self->{outbox} .= 'User-Agent: ' . $self->{ua} . "\r\n";
    if(defined($contenttype) && length($contenttype)) {
        $self->{outbox} .= 'Content-Type: ' . $contenttype . "\r\n";
    }
    if(defined($body) && length($body)) {
        $self->{outbox} .= 'Content-Length: ' . length($body) . "\r\n"
+;
    }
    $self->{outbox} .= "\r\n";
    if(defined($body) && length($body)) {
        $self->{outbox} .= $body;
    }

    #print Dumper($self->{outbox});

    my $socket;
    if($self->{use_ssl}) {
        $socket = IO::Socket::SSL->new($self->{host} . ':443');
        if(!defined($socket)) {
            $self->{reph}->debuglog("Connection failed! error=", $!, "
+, ssl_error=", $SSL_ERROR);
            return 0;
        }
    } else {
        $socket = IO::Socket::INET->new($self->{host} . ':443');
        if(!defined($socket)) {
            $self->{reph}->debuglog("Connection failed: ", $IO::Socket
+::errstr);
            return 0;
        }
    }

    $socket->blocking(0);

    $self->{socket} = $socket;

    $self->{state} = 'sending';
    return 1;
}

sub finished($self) {
    if($self->{state} eq 'ready') {
        return 0;
    }

    if($self->{state} eq 'sending') {
        $self->_sendData();
        return 0;
    }

    if($self->{state} eq 'readheaders') {
        $self->_readHeaders();
        return 0;
    }

    if($self->{state} eq 'readbody') {
        $self->_readBody();
        return 0;
    }

    if($self->{state} eq 'finished') {
        return 1;
    }

    return 0;
}

sub _sendData($self) {
    my $brokenpipe = 0;

    my $full = $self->{outbox};
    my $written;

    eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEv
+al)
        $written = syswrite($self->{socket}, $full);
    };
    if($EVAL_ERROR) {
        print STDERR "Write error: $EVAL_ERROR\n";
        $self->{state} = 'finished';
        $self->{returncode} = 599;
        delete $self->{socket};
        return;
    }
    if(!defined($written)) {
        $written = 0;
    } elsif($self->{socket}->error || $ERRNO ne '') {
        print STDERR "AsyncUA write failure: $ERRNO / ", $self->{socke
+t}->opened, " / ", $self->{socket}->error, "\n";
        return;
    }
    if($written) {
        $full = substr($full, $written);
        $self->{outbox} = $full;
    }

    if(!length($full)) {
        # We are done writing
        #$self->{reph}->debuglog("Request sent");
        $self->{state} = 'readheaders';
    }

    return;
}

sub _readHeaders($self) {
    #$self->{reph}->debuglog("Read headers");
    while(1) {
        my $buf = undef;
        my $bufstatus = $self->{socket}->sysread($buf, 1);

        my $errorstatus = $self->{socket}->error;
        if(defined($errorstatus) || $ERRNO ne '') {
            if(defined($errorstatus) && $errorstatus ne '') {
                print STDERR "AsyncUA read headers failure: $ERRNO / "
+, $self->{socket}->opened, " / ", $self->{socket}->error, "\n";
            }
            return;
        }

        if(!defined($buf) || !length($buf)) {
            last;
        }

        if($buf eq "\r") {
            next;
        }

        if($buf eq "\n") {
            if(!length($self->{headerline})) {
                $self->{state} = 'readbody';
                last;
            }

            push @{$self->{headers}}, $self->{headerline};
            #$self->{reph}->debuglog('< ', $self->{headerline});
            $self->{headerline} = '';
            next;
        }

        $self->{headerline} .= $buf;
    }

    if($self->{state} eq 'readbody') {
        my $statusline = shift @{$self->{headers}};
        #$self->{reph}->debuglog("Status line: ", $statusline);
        my ($proto, $status, $statustext) = split/\ /, $statusline, 3;
        $self->{returncode} = $status;

        foreach my $line (@{$self->{headers}}) {
            my ($key, $val) = split/\:\ /, $line, 2;
            $self->{parsedheaders}->{lc $key} = $val;
        }
        #$self->{reph}->debuglog("Headers read");
    }

    return;
}

sub _readBody($self) {
    if(!defined($self->{parsedheaders}->{'content-length'}) || !$self-
+>{parsedheaders}->{'content-length'}) {
        # No content, short circuit
        $self->{state} = 'finished';
        delete $self->{socket};
        $self->{reph}->debuglog("No body to read");
        return;
    }

    while(1) {
        my $buf = undef;
        my $bufstatus = $self->{socket}->sysread($buf, 1);

        my $errorstatus = $self->{socket}->error;
        if(defined($errorstatus) || $ERRNO ne '') {
            if(defined($errorstatus) && $errorstatus ne '') {
                print STDERR "AsyncUA read headers failure: $ERRNO / "
+, $self->{socket}->opened, " / ", $self->{socket}->error, "\n";
            }
            return;
        }

        if(!defined($buf) || !length($buf)) {
            last;
        }

        $self->{body} .= $buf;

        if(length($self->{body}) == $self->{parsedheaders}->{'content-
+length'}) {
            $self->{state} = 'finished';
            delete $self->{socket};
            return;
            $self->{reph}->debuglog("Body read");
        }
    }

    return;
}

sub result($self) {
    if($self->{state} ne 'finished') {
        $self->{reph}->debuglog("Tried to get result, but we are not i
+n state finished but in state ", $self->{state});
    }

    $self->{state} = 'ready';
    return ($self->{returncode}, $self->{parsedheaders}, $self->{body}
+);
}

1;

It's part of my PageCamel framework. Don't worry about the $self->{reph}->debuglog() calls, that's just the (rather complex) reporting handler i use for my stuff. The relevant function "debuglog" is easy to simulate. Here's the test program:

#/usr/bin/env perl

use v5.40;
use strict;
use warnings;
our $VERSION = 4.6;

# Simulate the PageCamel reporting handler without all the PostgreSQL 
+and Net::Clacks stuff
package Reporting;
sub new($proto, %config) {
    my $class = ref($proto) || $proto;
    
    my $self = bless \%config, $class;

    return $self;
} 

sub debuglog($self, @data) {
    print join('', @data), "\n";
    return;
}

# Test program here
package main;
use Data::Dumper;
use PageCamel::Helpers::AsyncUA;
use Time::HiRes qw(sleep);
use Carp;

my $reph = Reporting->new();

my $ua = PageCamel::Helpers::AsyncUA->new(host => 'cavac.at', use_ssl 
+=> 1, ua => 'PageCamel_AsyncUA/' . $VERSION, reph => $reph);

if(1){
    # Call the sleeptest with GET, this should return a json after a f
+ew seconds artificial delay
    print "############################## GET ########################
+\n";
    if(!$ua->get('/guest/sleeptest/asdjkhfashdflkahsdflhasas7d8687asd6
+f')) {
        croak("Failed to start request");
    }

    while(!$ua->finished()) {
        print "Do something else...\n";
        sleep(0.05);
    }

    my ($status, $headers, $body) = $ua->result();
    print "Return code: $status\n";
    #print Dumper($headers);
    print Dumper($body);
}

if(1){
    # Call the sleeptest with POST, this should return a our post data
+ in reverse ('dlroW olleH') after a few seconds artificial delay
    print "############################## POST #######################
+#\n";
    if(!$ua->post('/guest/sleeptest/asdjkhfashdflkahsdflhasas7d8687asd
+6f', 'application/octed-stream', 'Hello World')) {
        croak("Failed to start request");
    }

    while(!$ua->finished()) {
        print "Do something else...\n";
        sleep(0.05);
    }

    my ($status, $headers, $body) = $ua->result();
    print "Return code: $status\n";
    #print Dumper($headers);
    print Dumper($body);
}

I'm not sure this will be of use to anyone, but if it is, you're free to "borrow" it Captain Jack Sparrow style for your own purposes.

[choroba]

What about HTTP::Async or AnyEvent::HTTP?

> you're free to "borrow" it Captain Jack Sparrow style for your own purposes

Would be much nicer if you could "publish" it Perlancar style to CPAN ;-)

[ikegami]

And there's LWP::Protocol::AnyEvent::http that allows you to keep using the familiar LWP interface.

If you need async HTTP(S) requests, but don't need to be async with anything else, I recommend Net::Curl::Multi. Powerful engine, and great performance.

[Anonymous Monk]

What about HTTP::Async or AnyEvent::HTTP?

Net::Async::HTTP is more popular and actively maintained than HTTP::Async. Though the requirement on 5.14 makes it less portable.

Would be much nicer if you could "publish" it Perlancar style to CPAN ;-)

Perlancar should be an anti-example of using CPAN. Our company minicpan bans any module he authors or that relies upon one of his. Instead of contributing fixes to other modules, he forks them with his "corrections". "Oh, there's a typo in your docs, I'll fork it and upload a new distribution. All better" (;-P). I think this is a case of extreme resume padding.

[cavac]

Though the requirement on 5.14 makes it less portable.

Then i suggest not using any of my modules. I tend to support only supported Perl versions so i can use fairly recent Perl features (especially sub-signatures). I'm not going to ditch all the advancements of the last decade or two, just because someone wants to run an outdated, unsupported, insecure version of Perl that hasn't been maintained since the release of Minecraft 1.0...

[Anonymous Monk]

Though the requirement on 5.14 makes it less portable.

5.14.0 2011-May-14

lol

[cavac]

Yeah, i'm planning to eventually release it in CPAN. But first i want to test it in my own projects under real world conditions and get at least the major kinks worked out.

I basically do the same with Net::Clacks. Before i release major changes that might affect the stability, it will already have been running for days or even weeks on a few live systems of mine. Since the UA is new (and hasn't been thorougly tested yet), it doesn't yet make sense to publish it on CPAN. That way, i'm free to rumble around in the internals, change the API if necessary, rewrite the whole thing from scratch if i come up with a better solution etc, without me having to worry about other people having to rewrite their code. (I'm not a pythong AI dev, i actually care about backward compatibility somewhat).

[Intrepid]

Hwoa, pythong? I never heard that one before, I like it but a wee bit catty. I suppose in the Perl vs. Python dispute that's par for the course ;-).

Apr 14, 2025 at 18:05 UTC

[Anonymous Monk]

i've been battling with a few modules made by a former co-worker ... so i spent a couple of hours writing my own

So...... who's going to maintain your reinvented wheel... and will they end up calling your code "garbage" too? Mojo::UserAgent

[cavac]

Just for reference: I hardly ever call code "garbage". But this is code that does (or is supposed to) run debit card transactions. I can't post it here (closed source), but the following problems have been observed in prodution systems:

• Timeout mismatches. The code marks transactions as failed even when they went through, with the effect that debit cards were double charged.
• Transactions that don't time out at all, forcing the user to restart the cash register.
• Working on the wrong transaction, with the effect that the customer gets charged the incorrect amount.
• No handling of child process exits, leading, again to forcing the user to restart the cash register.
• Not restart safe. Restarting the cash register (reboot, power loss, etc) while a transaction is in progress can lead, again, to the process working on the wrong transaction, charging the customer the wrong amount.
• A temporary connection loss of connection to the cloud server of the debit terminal provider again can lead to the transaction marked as failed (when it was processed successfully on the provider side), potentially leading to again double charge the customer.

In many cases i can be somewhat lenient about bugs. And as long as the software just crashes and can cleanly restart, nothing will go wrong - this case is already handled by my service manager software. Not good, but we are taking about a downtime of a couple of seconds of a background service, something the user will hardly notice if at all.

But when you are developing software that is dealing with other peoples money (in our case, the customers of our customers), "move fast and break things" is absolutely in no way acceptable. It has to work. Perfectly. Each and every time.

If there is a chance greater than one in a million transactions that a specific error happens, the software needs to handle that error correctly. After all, for busy shops such a "rare" error would at least happen every couple of years. Multiply that by a large number of customers. It's the curse of scaling. And it can easily turn into a PR nightmare, especially since people are trusting that their debit and credit card transactions just work. And, oh, if the problem keeps happening, one can easily loose certification by the debit/credit card terminal provider, which is an even bigger quantum leap in "oh shiiiiiit!".

In cases of critical code like this, frankly, one small bug is a disaster. Multiple large bugs that amplify each other is what made me declare that piece of code "garbage".

[Anonymous Monk]

that adresses exactly zero of the questions raised