Categories
Perl XS

More refactor to our XS module. Bringing the internals to a private C file.

In this article the code I did in the last article to allow the usage of the arguments list as a Hash is going to be moved to a C file to provide a way to reuse this code in all my subroutines of this module without exposing this API to Perl. (In Perl this job is already done.)

Let’s see how, first we are going to make the following directories into mega_openssl_helper_xs src and src/include and we are going to add to the Makefile.PL of mega_openssl_helper_xs an OBJECT and postamble directive so it gets the code into that folders.

use ExtUtils::MakeMaker;

WriteMakefile(
    NAME    => 'Peertube::DL::Mega::Helper',
    VERSION => '0.1',
    XS      => { 'mega.xs' => 'mega.o' },
    INC     => '-Isrc/include',
    OBJECT  => 'src/private.o mega.o',
    LDFLAGS => '-Wl-t',
    DIR     => ['src'],
);  
        
package MY {
            
    sub postamble {
        return . "src: src/Makefile\n" . "\tcd src && $(MAKE) $(PASSTHRU)\n";
    }       
} 

Now we are making a mega_openssl_helper_xs/src/Makefile.PL to compile the C that I am going to put into that directory:

use ExtUtils::MakeMaker;

WriteMakefile(
    NAME    => 'Peertube::DL::Mega::Helper::SRC',
    VERSION => '0.1',
    INC     => '-I./include',
    C       => [ 'private.c', ],
    OBJECT  => '${O_FILES}',
    LDFLAGS => '-Wl-t',
);

We make the src/include/private.h file to declare the subroutines for code reuse:

#include "EXTERN.h"
#include "perl.h"

HV * hash_from_list(SV **, size_t list_len);

And we move the code handling the hashes to this subroutine into src/private.c

#include "EXTERN.h"
#include "perl.h"

HV * hash_from_list(SV **list, size_t list_len) {
    HV * hash = newHV();
    bool is_key = true;
    char *key;
    STRLEN key_len;
    for ( int i = 0; i < list_len; i++ ) {
        if (is_key) {
            key = SvPV(list[i], key_len);
        } else {
            SvREFCNT_inc(list[i]);
            if ( !hv_store(hash, key, key_len, list[i], 0) ) {
                warn("Failed to write into hash.");
                SvREFCNT_dec(list[i]);
            }
        }
        is_key = !is_key;
    }
    if ( !is_key ) {
        warn("Even number of parameters in hash argument list.");
        SV *undef = sv_newmortal();
        SvREFCNT_inc(undef);
        if ( !hv_store(hash, key, key_len, sv_newmortal(), 0) ) {
            warn("Failed to write into hash.");
            SvREFCNT_dec(undef);
        }
    } 
    return hash;
}

Now our mega.xs print XSUB is more compact:

void
print(self, ...)
    Peertube_DL_Mega_Helper self 
    CODE:
        if ( items <= 1 ) {
            croak("Less parameters than expected.");
        }
        size_t list_len = items - 1;
        SV **list = malloc(sizeof (SV *) * list_len);
        for ( int i = 1; i < items; i++ ) {
            list[i-1] = ST(i);
        }

        HV *hash = hash_from_list(list, list_len);        
        free(list);
        char *key = "hello";
        SV **hello = hv_fetch(hash, key, strlen(key), 0);
        if ( hello != NULL && *hello != NULL ) {
            if ( !SvOK(*hello) ) {
                warn("hello is undef.");
            }
            printf("hello: %s\n", SvPV_nolen(*hello));
        } else {
            croak("Parameter hello required.");
        }

I hope you have enjoy this article about XS.

Erratas: sizeof was unfortunatelly not enought to get the size of the array, so I did it passing the size manually to the subroutine which sightly complicates the code.

Erratas II: I left some printf statements not needed.

Erratas III: I left a stdio.h import in the C file which was no longer needed, I used it with debugging purposes.

Categories
Perl XS

Playing more with XS: Retrieving subroutine arguments as a hash.

It’s common to use the argument list as a hash in Perl to provide a easier way for the Perl developers interface with subroutines, in this article I will explain how to do the same in XS. Note: not as easy as in Perl.

First we will change the signature like this to take variadic arguments:

void
print(self, ...)
    Peertube_DL_Mega_Helper self
CODE:

As you may now self is the caller object in Perl, not too much trouble, and … is saying basically “Pass me whatever and I will handle it.”, Peertube_DL_Mega_Helper is a custom typemap made by me in the last XS article.

Now we are going to check if users passed us more than a value, for example:

if ( item <= 1 ) {
    croak("Less parameters than expected.");
}

This is a little agresive way to handle this suppose, but this is a demo, feel free to take whatever behaviour you feel more appropiate for your case use.

Now we are going to define a hash to hold our arguments:

HV *hash = newHV();

And some variables useful in the argument processing loop:

bool is_key = true;
char *key;
STRLEN key_len;

And we define the loop to introduce those arguments into a our hash:

for ( int i = 1; i < items; i++ ) {
    if (is_key) {
        key = SvPV(ST(i), key_len);
    } else {    
        SvREFCNT_inc(ST(i));
        if ( !hv_store(hash, key, key_len, ST(i), 0) ) {
            SvREFCNT_dec(ST(i));
        }
    }
    is_key = !is_key;
}

Unfortunatelly this loop misses warning the developer if a even number of elements is passed with default to the last element without value to be undef, we are going to implement also that:

if ( !is_key ) { 
    warn("Even number of parameters in hash argument list.");
    SV *undef = sv_newmortal();
    SvREFCNT_inc(undef);
    if ( !hv_store(hash, key, key_len, sv_newmortal(), 0) ) {
        SvREFCNT_dec(undef);
    }
}

Croak is also an option, but this introduces how to add undefs and I thought would be educative to handle that case as Perl does™

Now we are going to use what we just did to search for the named parameter “hello”, let’s see how:

// Reusing the variable since the name is really convenient and descriptive.
key = "hello"; 
SV **hello = hv_fetch(hash, key, strlen(key), 0);
if ( hello != NULL && *hello != NULL ) {
    if ( !SvOK(*hello) ) {
        warn("hello is undef.");
    }
    printf("hello: %s\n", SvPV_nolen(*hello));
} else {
    croak("Parameter hello required.");
}

After compiling with cpanm . -v to catch errors we are going to run the usual oneliners to check the capabilities we added, I may do an article of testing in Perl later, now I am just learning XS.

sergio@tiki ~/Peertube-dl $ perl -MPeertube::DL::Mega::Helper -e 'Peertube::DL::Mega::Helper->new(3)->print("hello" => "world")';
hello: world
sergio@tiki ~/Peertube-dl $ perl -MPeertube::DL::Mega::Helper -e 'Peertube::DL::Mega::Helper->new(3)->print';
Less parameters than expected. at -e line 1.
sergio@tiki ~/Peertube-dl $ perl -MPeertube::DL::Mega::Helper -e 'Peertube::DL::Mega::Helper->new(3)->print("hello" => "world", "hello" => )';
Even number of parameters in hash argument list. at -e line 1.
hello is undef. at -e line 1.
hello: 

I hope you enjoyed the article.

Categories
Perl XS

Perl niceness, building a XS module that acts like a Perl object.

I have been trying the last days to add Mega.nz support to Peertube-dl, it is not an easy task since Mega.nz implements encryption with AES in the files so the server owner is not able in theory to read the users files. (My opinion is anyway the server admins would be able to get access to those files by simply parsing the server logs.)

I have not success yet, because the lack of good Perl libraries and the bad Perl is for parsing binary data and then I thought, why not try to use XS to solve this problem as I did before with the Javascript interpreter need for Youtube?

So this I am trying, and in the process I did a little improvement in my way to write XS thanks to the learn about how to use typemaps to build more ideomatic for both Perl and C XS modules.

Let’s start the house by the roof, would not be great being able to write a XS module like this:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <stdio.h>

typedef struct helper {
    int value;
} * Peertube_DL_Mega_Helper;

MODULE = Peertube::DL::Mega::Helper  PACKAGE = Peertube::DL::Mega::Helper
PROTOTYPES: DISABLE

Peertube_DL_Mega_Helper
new(class, value)
    char *class
    int value
    CODE:
        RETVAL = malloc(sizeof (struct helper));
        RETVAL->value = value;
    OUTPUT:
        RETVAL

void
print(self)
    Peertube_DL_Mega_Helper self
    CODE:
        printf("%d\n", self->value);

void
DESTROY(self)
    Peertube_DL_Mega_Helper self
    CODE:
        free(self);

This code can be achieved with the help of the file typemap, with the help of https://perldoc.perl.org/perlxstypemap I discovered that, and the following typemap will look familiar to anybody which have read that document.

TYPEMAP
    Peertube_DL_Mega_Helper T_PTROBJ_SPECIAL

INPUT
T_PTROBJ_SPECIAL
    if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")){
        IV tmp = SvIV((SV*)SvRV($arg));
        $var = INT2PTR($type, tmp);
    } else {
        croak(\"$var is not of type ${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\");
    }

OUTPUT
T_PTROBJ_SPECIAL
    sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\",
           (void*)$var);

Of course some more additions will be needed to make this code run, like the clasical xsloader Perl module and some lines in the Makefile.PL which is out of scope in this document.

We will be able to run this code like this and check it works:

perl -MPeertube::DL::Mega::Helper -e 'Peertube::DL::Mega::Helper->new(3)->print';

It should print 3.

It is true XS is scaring because strange subroutines and magical variable names and tons of rare sections difficult to understand on the first read of the docs, but this kind of sugar makes my day, it is a shame there aren’t much XS articles and Stackoverflow responses because makes the language slower to learn.

Categories
C Perl XS

If you program in Perl and learn XS is like you have super powers.

Perl has a big amount of modules available, but sometimes you need a library from C, in my case that library was Duktape to embed a JS interpreter in my application to be able to use a scrapped function from the Youtube video player to implement download videos with obfuscated signatures in Peertube-dl.

XS allows you to embed C libraries in Perl, this opens the door to many applications from writting programs using GTK to fast a critical in performance subroutine, tons of CPAN modules use it to extend the Perl’s capabilities.

The main resources to learn XS are: https://perldoc.perl.org/perlxs and https://perldoc.perl.org/perlguts.

This is how a very basic XS Perl module look:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "duktape.h"
#include "duk_config.h"
#include "javascript_builtins.h"

MODULE = Peertube::DL::Javascript  PACKAGE = Peertube::DL::Javascript
PROTOTYPES: ENABLE

SV *
_duk_create_heap_default()
    CODE:
        duk_context *context = duk_create_heap_default();
        if (context) {
            duk_push_c_function(context, js_builtin_print, 1);
            duk_put_global_string(context, "print");
            RETVAL = newSVuv((size_t)context);
        } else {
            RETVAL = &PL_sv_undef;
        }
    OUTPUT:
        RETVAL

This is how the loader Perl module would look:

package Peertube::DL::Javascript;

use strict;
use warnings;

use feature 'say';

use XSLoader;
use Data::Dumper;

XSLoader::load();

sub new {
    my $class = shift;
    my $self  = bless {}, $class;
    $self->{___ContextPrivateDONOTTOUCH} =
      Peertube::DL::Javascript::_duk_create_heap_default();
    return $self;
}

You can check for a complete example on the source of Peertube-dl: https://gitea.sergiotarxz.freemyip.com/sergiotarxz/Peertube-dl

Categories
C Docker Javascript Peertube-dl Perl XS

What is Peertube-dl?

Peertube-dl aims to be a alternative to youtube-dl written in Perl providing a library, a cli utility and a webpage.

I am currently developing that project, I licensed it under the AGPLv3, a Free Software license.

It provides a Dockerfile which allows you to run the program in a container.

I hope you find it useful, beware it is provided to you without any warranty, but I will be happy to help you with any issues you find on https://gitea.sergiotarxz.freemyip.com/sergiotarxz/Peertube-dl/issues