2

I wanted to send/receive MQTT messages from Perl. For various reasons (MQTT 5 support, TLS) I don't want to use existing Perl libraries. So I tried to create XS bindings to Paho MQTT C Library. I somehow adapted provided example to link Perl module to Paho library using relly basic Perl XS:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <MQTTClient.h>
#define CLIENTID    "ExampleClientPub"
#define QOS         1
#define TIMEOUT     10000L

MODULE = paho              PACKAGE = paho         

int
mqtt_connect_and_send (server_address, username, topic, payload)
    char * server_address
    char * username
    char * topic
    char * payload
CODE:
    MQTTClient client;
    MQTTClient_connectOptions conn_opts = MQTTClient_connectOptions_initializer;
    MQTTClient_message msg = MQTTClient_message_initializer;
    MQTTClient_deliveryToken token;
    int rc;

    /* connect to server */
    MQTTClient_create(&client, server_address, CLIENTID,
        MQTTCLIENT_PERSISTENCE_NONE, NULL);
    conn_opts.keepAliveInterval = 20;
    conn_opts.cleansession = 1;
    conn_opts.username = username;

    if ((rc = MQTTClient_connect(client, &conn_opts)) != MQTTCLIENT_SUCCESS)
    {
        /* didn't connect */
        die("Failed to connect, return code %d", rc);
    }

    /* fill in message data and send it */
    msg.payload = payload;
    msg.payloadlen = strlen(payload);
    msg.qos = QOS;
    msg.retained = 0;
    MQTTClient_publishMessage(client, topic, &msg, &token);
    rc = MQTTClient_waitForCompletion(client, token, TIMEOUT);

    /* shutdown connection */
    MQTTClient_disconnect(client, 10000);
    MQTTClient_destroy(&client);

    if (rc != MQTTCLIENT_SUCCESS) {
        /* didn't send the message */
        die("Failed to send message, return code %d", rc);
    }

    RETVAL = 1;
OUTPUT:
    RETVAL

This is working OK. But now I want to split function mqtt_connect_and_send to 3 functions: mqtt_connect, mqtt_send_message, mqtt_disconnect. And my question is - how to do this? How to create a handle (client in my case) in XS in one function, return it to Perl to somehow store it in a scalar and use that handle in ahother XS function to be used to send more messages? I want to be able to do this in Perl:

my $client = paho::mqtt_connect($server_spec, $username, $password, $more_opts);
$success = paho::mqtt_send($client, $data, $message_opts);
# ... more of mqtt_send's
paho::mqtt_disconnect($server)

I tried to set RETVAL RETVAL = &client or mXPUSHu(&client) but that I didn't get anywhere with that. Can you point me to some example how to get client to Perl and then back to XS to be used again?

Thank you.

ico
  • 25
  • 5
  • 2
    `client` has "automatic storage" (basically, on the stack), which means it's only valid to access it while the function is being executed. You'll need to dynamically allocate it. – ikegami Jul 29 '20 at 15:38
  • 2
    Then, you'll need to create a class with a destructor that can free the dynamically-allocated client, and return an instance of that class instead of the pointer itself. – ikegami Jul 29 '20 at 15:39
  • Tip: Lower-case module names are conventionally reserved for pragmas – ikegami Jul 29 '20 at 15:43
  • You mean `client = (MQTTClient *) malloc(sizeof(MQTTClient));` ...usage... `free(client);`? Destructor: The Perl part I understand. I just don't know how to get that `client` from XS to Perl. Return via RETVAL? Lower-case pragmas: Originally in my proof of concept I used single-letter 'p' as a name :) Would change in usable version. – ico Jul 29 '20 at 18:05
  • @ico How did you install the C Library? – Håkon Hægland Jul 29 '20 at 18:51
  • What value do you use for `server_address` ? Please provide some values that we can test with – Håkon Hægland Jul 29 '20 at 19:37
  • Library install: According to [their docs](http://www.eclipse.org/paho/clients/c/) - I cloned from git and `make`d it. Then I created a package for my Slackware Linux and installed libs into `/usr/lib64` and headers into `/usr/include`. Simple test source compiles and runs OK. – ico Jul 30 '20 at 08:15
  • Example values: In my Perl script: my `$rv = paho::mqtt_connect_and_send("tcp://127.0.0.1:1883","username","topic",scalar(localtime));` E.g. I have local MQTT server (mosquitto) running on loopback. I started with plain TCP, no passwords. When my Perl bindings get usable, I will of course switch to TLS, ACLs and our company's mosquitto installation. – ico Jul 30 '20 at 08:20
  • @Håkon Hægland When I tested to compile Paho library, without installation, I did this: `cd paho.mqtt.c; make; cd build/output`, then saved example synchronous client into `client.c`. Compiled it: `gcc -I../../src -L. -lpaho-mqtt3c -o client client.c` and run it: `LD_LIBRARY_PATH=. ./client`. Maybe that could be done also for testing XS... – ico Jul 30 '20 at 08:35
  • Note that using libraries compiled with different options than `perl` itself might not work well. If you're going to release this to CPAN, you could look into building a copy specifically for Perl. IIRC, XML::LibXML does this (but I think it's a C++ library). Some examples can probably be found in Alien::* – ikegami Jul 30 '20 at 23:38

2 Answers2

2

Here is an example of how you can return the client as a perl object:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"       // allow the module to be built using older versions of Perl

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <MQTTClient.h>
#define CLIENTID    "ExampleClientPub"
#define QOS         1
#define TIMEOUT     10000L

UV get_hash_uv(HV *hash, const char *key) {
#define get_hash_uv(a,b) get_hash_uv(aTHX_ a,b)
    SV * key_sv = newSVpv (key, strlen (key));
    UV value;
    if (hv_exists_ent (hash, key_sv, 0)) {
        HE *he = hv_fetch_ent (hash, key_sv, 0, 0);
        SV *val = HeVAL (he);
        STRLEN val_length;
        char * val_pv = SvPV (val, val_length);
        if (SvIOK (val)) {
            value = SvUV (val);
        }
        else {
            croak("Value of hash key '%s' is not a number", key);
        }
    }
    else {
        croak("The hash key for '%s' doesn't exist", key);
    }
    return value;
}


MODULE = Paho   PACKAGE = Paho
PROTOTYPES: DISABLE

SV *
mqtt_connect(server_address, username)
    char *server_address
    char *username
  CODE:
    int rc;
    MQTTClient client;  // void *
    MQTTClient_connectOptions conn_opts = MQTTClient_connectOptions_initializer;

    MQTTClient_create(&client, server_address, CLIENTID,
        MQTTCLIENT_PERSISTENCE_NONE, NULL);
    conn_opts.keepAliveInterval = 20;
    conn_opts.cleansession = 1;
    conn_opts.username = username;

    if ((rc = MQTTClient_connect(client, &conn_opts)) != MQTTCLIENT_SUCCESS)
    {
        MQTTClient_destroy(&client);
        croak("Failed to connect, return code %d", rc);
    }
    HV *hash = newHV();
    SV *self = newRV_noinc( (SV *)hash );
    SV *sv = newSVuv(PTR2IV(client));
    hv_store (hash, "client", strlen ("client"), sv, 0);
    RETVAL = sv_bless(self, gv_stashpv( "Paho::Client", GV_ADD ) );

  OUTPUT:
    RETVAL

MODULE = Paho  PACKAGE = Paho::Client

void
DESTROY(self)
       SV *self
   CODE:
       MQTTClient client;  // void *

       HV *hv = (HV *) SvRV(self);
       UV addr = get_hash_uv(hv, "client");
       client = (MQTTClient ) INT2PTR(SV*, addr);

       MQTTClient_destroy(&client);
       printf("Paho::Client destroy\n");

I am not able to test this yet, because I do not have good values for the input parameters server_address and username. Please provide data that we can test with.

ico
  • 25
  • 5
Håkon Hægland
  • 39,012
  • 21
  • 81
  • 174
  • 1
    After I added single line [as described here](https://stackoverflow.com/questions/63006281/looking-for-a-way-to-call-perl-xs-c-api-functions-macros-from-helper-functions) `#define get_hash_uv(a,b) get_hash_uv(aTHX_ a,b)` it worked. Great! – ico Jul 30 '20 at 09:49
  • 1
    Thanks for saving me the time of writing this :) – ikegami Jul 30 '20 at 23:30
  • 1
    fyi, you could have avoided all the hash stuff using `SV *self = newRV_noinc(sv);` and `UV addr = SvUV(SvRV(self));` – ikegami Jul 30 '20 at 23:30
  • 1
    Good job using `INT2PTR`, but you defied the point of using it the way you used it. `(MQTTClient ) INT2PTR(SV*, addr)` should be `INT2PTR(MQTTClient, addr)` – ikegami Jul 30 '20 at 23:31
1

There's no point in building a hash unless you want the class to be extensible.[1] As such, Håkon Hægland's solution can be simplified by returning a scalar-based object. Doing so is quite common for XS-based classes.

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"       // allow the module to be built using older versions of Perl

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <MQTTClient.h>

#define CLIENTID    "ExampleClientPub"
#define QOS         1
#define TIMEOUT     10000L

MODULE = paho              PACKAGE = paho         

PROTOTYPES: DISABLE

SV *
mqtt_connect(server_address, username)
    char *server_address
    char *username
  CODE:
    int rc;
    MQTTClient client;  // void *
    MQTTClient_connectOptions conn_opts = MQTTClient_connectOptions_initializer;

    MQTTClient_create(&client, server_address, CLIENTID,
        MQTTCLIENT_PERSISTENCE_NONE, NULL);
    conn_opts.keepAliveInterval = 20;
    conn_opts.cleansession = 1;
    conn_opts.username = username;

    if ((rc = MQTTClient_connect(client, &conn_opts)) != MQTTCLIENT_SUCCESS)
    {
        MQTTClient_destroy(&client);
        croak("Failed to connect, return code %d", rc);
    }

    SV *sv = newSVuv(PTR2IV(client));
    SV *self = newRV_noinc(sv);
    RETVAL = sv_bless(self, gv_stashpv("Paho::Client", GV_ADD));

  OUTPUT:
    RETVAL

void
DESTROY(self)
       SV *self
   CODE:
       MQTTClient client;  // void *
       client = INT2PTR(MQTTClient, SvUV(SvRV(self)));

       MQTTClient_destroy(&client);
       printf("Paho::Client destroy\n");

  1. It can still be extended using the inside-out object technique. And of course, it can still be wrapped.
ikegami
  • 367,544
  • 15
  • 269
  • 518