Engwar

Perl embedding example

Since there was no progress from my last experiment, writing a rudimentary program without any WSF/C code seemed like a logical next step. For those of you who don’t know what I tried to do, here’s a brief explanation. I want to let other people provide Web services in Perl. My objective is to enable people to just copy their Perl scripts to, say, a folder and it’ll automatically become a Web service. Let me explain that with an example. Say you have the following Perl script,

#!/usr/bin/env perl
 
sub getRandomNumber {
    return 4;
}

I’m going to assuming you have configured your web server to execute Perl scripts ending with .pl via ModPerl for a directory called perl. You copy the file and it’s accessible from http://localhost/perl/random.pl. And it’s a web service now. So you can send an XML payload like,

<getRandomNumber />

And get back something like,

<number>4</number>

Since I’m using WSF/C as the underlying Web service engine and it provides various other facilities like WS-Security, WS-ReliableMessaging etc… at blazing speed, I wanna use it.

Here’s a simplified graphical version of the story,

1. Request comes to rand.pl via ModPerl and it gets executed.
2. rand.pl then calls some methods in Service.pm module which in turn calls to some C functions.
3. From one of those C functions we need to call a Perl function residing in the script the request came into.

If you’re wondering how the graphic relates to the story of copying your Perl script and making it a service (’cos there’s a Service.pm in the picture), please note that I’ve not yet figured out every detail in the system

Perl is segfaulting at all the bizzare places when this is executed. When things get this bad it’s time to write a very simple application that does the same thing without any WSF/C code. Here’s how I did it.

I started by creating a new Perl extension in C.

$ h2xs -A -n ICanHaz

This’ll create the skeleton and all I have to do is edit the .xs file and put my code there. Here’s my ICanHaz.xs file,

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <string.h>
 
#include "ppport.h"
 
static	PerlInterpreter *my_perl;
 
void cheeseburger( void )
{
    char *embedding[] = {"/usr/local/apache2/perl/exec-this.pl"};
 
    my_perl = perl_alloc();
    perl_construct(my_perl);
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    perl_parse(my_perl, NULL, 1, embedding, NULL);
    perl_run(my_perl);
    perl_destruct(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM();
}
 
MODULE = ICanHaz		PACKAGE = ICanHaz		
 
void
cheeseburger()

Now you have to edit Makefile.PL and give the output of, perl -MExtUtils::Embed -e ccopts -e ldopts to the compiler flags. After that you can compile and install the module. Here’s what’s inside exec-this.pl,

sub keele_teh_urth {
    print "oh noez. i iz gud kitteh";
}

Just a simple function. Then I wrote another Perl script to invoke the method in my C extension. Here’s the program,

#!/usr/local/bin/perl
 
use ICanHaz;
 
ICanHaz::cheeseburger();
 
print "Content-type: text/html\n\n";
print "dis segfaults, srsly.\n";

Executing this file via ModPerl results in a segmentation fault. As you can see even the simplest case of embedding will not execute through ModPerl. Switched to CGI and got the same results. Possible alternatives to try is 1) move all the embedding stuff to it’s own executable, when you need to call the Perl function from C do a fork followed by exec, pass the payload as a parameter, store the result in a shared memory and once done read from it (this .. um .. a bit ugly to say the least). Second alternative is to use PPI. I haven’t looked into PPI yet so don’t know for sure whether it’s possible.

Comments (1)

Perl embedding woes

While developing server side components that enables providing Web services using Perl bumped into a brick wall. First the requirement is when a client request comes, need to extract the payload and pass it to WSF/C which acts as the underlying Web services engine. So WSF/C knows how to process the incoming XML payload and do what it does and return another XML payload which is then passed back to the client who send the request. And the business logic is written using Perl. Simple, I know.

We used SWIG to generate some wrapper functions (plus some custom written C code) which belongs to WSF/C and wrote a Perl module encapsulating the lower level stuff. So when you have to write a Web service in Perl all you have to do is use WSO2::WSF::Service; in your script and call a couple of functions. As the deployment scenario we choose Apache with ModPerl. That combination seemd logical and some of the heavy trafficked sites are using that.

It gets interesting when you test the whole thing. Apache is configured to run ModPerl on a folder named /perl so requests matching /perl/something will go through ModPerl. ResponseHandler is ModPerl::Registry and also GlobalRequest has been enabled to get the global request via Apache::RequestUtil->request().

Say, we have a service script named echo_service.pl which simply return back whatever it gets. Here’s the code,

#!/usr/bin/perl
 
use strict;
use WSO2::WSF;
use WSO2::WSF::WSService;
use Apache2::RequestUtil ();
 
my $payload =<<E;
<ns1:echoString xmlns:ns1="http://perl.axis2.org/samples">
  <text>plurk u can haz</text>
</ns1:echoString>
E
 
sub echoFunction {
    my $arg = $_[0];
    my $message = new WSO2::WSF::WSMessage ({'payload' => $arg});
    return $message;
}
 
my %operations = ( 'echoString' => 'echoFunction');
 
if (defined $ENV{MOD_PERL}) {
  my $r = Apache2::RequestUtil->request();
 
  my $service = new WSO2::WSF::WSService(
    {'operations' => \%operations, 'action' => 'testAction'}
  );
 
  $service->reply( $r );
}

When it goes to the reply method it’ll call up some C routines. Inside one of those C functions, after determining the function name to call by looking at the request payload, we need to call it. From a C function. How can you do that? By embedding the Perl interpreter. AFAIK, you cannot call a Perl function from C without embedding the interpreter (please correct me if I’m wrong). In WSF/Ruby server side there was no such issue because the entire Ruby module (WSService class and methods) is written in C.

Let me show you the code that embeds the interpreter and calls the function after looking at the XML payload in the request,

static axiom_node_t *
wsf_xml_msg_recv_invoke_other(axis2_msg_recv_t* msg_recv,
        const axutil_env_t* env,
        wsf_svc_info_t* svc_info,
        axis2_msg_ctx_t* in_msg_ctx,
        axis2_msg_ctx_t* out_msg_ctx,
        axis2_char_t* function_name,
        axis2_char_t* class_name)
{
    AXIS2_PARAM_CHECK(env->error, svc_info, NULL);
    AXIS2_PARAM_CHECK(env->error, in_msg_ctx, NULL);
    AXIS2_PARAM_CHECK(env->error, out_msg_ctx, NULL);
 
    axiom_node_t *node = NULL;
    axiom_node_t *om_node = NULL;
    axiom_soap_envelope_t *envelope = NULL;
    axiom_soap_body_t *body = NULL;
    axis2_char_t *retstr = NULL;
    axiom_node_t *soap_body_node = NULL;
 
    /* extracting payload from the soap message */
    envelope = axis2_msg_ctx_get_soap_envelope(in_msg_ctx, env);
    if (!envelope)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "[wsf-perl-service] soap envelope not found");
        return NULL;
    }
 
    body = axiom_soap_envelope_get_body(envelope, env);
    if (!body)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "[wsf-perl-service] soap body not found");
        return NULL;
    }
 
    soap_body_node = axiom_soap_body_get_base_node(body, env);
    if (!soap_body_node)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "[wsf-perl-service] soap body base node not found");
        return NULL;
    }
 
    om_node = axiom_node_get_first_child(soap_body_node, env);
    if (!om_node)
    {
        return NULL;
    }
 
    axis2_char_t *embedding[] = {"-M'WSO2::WSF::C; WSO2::WSF::Service;'", ""};
    if (!svc_info->script_filename)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI,
                "perl function invocation failed, script_file name not found for "
                "service %s", svc_info->svc_name);
        return NULL;
    }
    /* passing script real path into perl interpreter. */
    embedding[1] = svc_info->script_filename;
 
    my_perl = perl_alloc();
    PL_perl_destruct_level = 0;
/*    PL_use_safe_putenv = 1; */
    PERL_SET_CONTEXT(my_perl);
    perl_construct(my_perl);
 
    PL_origalen = 1;
    PERL_SET_CONTEXT(my_perl);
    if (perl_parse(my_perl, xs_init, 2, embedding, NULL))
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "perl_parse method failed");
        return NULL;
    }
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    /* perl_run(my_perl); */
 
    if (SvTRUE(ERRSV))
    {
        AXIS2_LOG_DEBUG(env->log, AXIS2_LOG_SI, "invoke perl function failed");
    }
 
    retstr = invoke_perl_function(env, om_node, function_name, NULL);
 
    if (retstr)
    {
        node = wsf_util_deserialize_buffer(env, retstr);
    }
 
    PERL_SET_CONTEXT(my_perl);
    perl_destruct(my_perl);
    PERL_SET_CONTEXT(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM();
    AXIS2_LOG_DEBUG(env->log, AXIS2_LOG_SI, axiom_node_to_string(node, env));
    return node;
}
 
static axis2_char_t *
invoke_perl_function(const axutil_env_t *env, axiom_node_t *om_node,
        axis2_char_t *operation, axis2_char_t *class_name)
{
    int count = 0;
    axis2_char_t *inmsg = NULL;
    SV **wsmsg_str = NULL; /* hold the value for the key 'payload' in WSMessage */
    SV *wsmsg_ref = NULL; /* reference to a WSMessage object */
    HV *wsmsg = NULL; /* WSMessage object */
    char *tmp_str = NULL;
    axis2_char_t *res_payload_str = NULL;
 
    if (!operation)
    {
        AXIS2_LOG_DEBUG(env->log, AXIS2_LOG_SI,
                "invoking perl function failed, operation not available");
        return NULL;
    }
 
    if (om_node)
    {
        inmsg = axiom_node_to_string(om_node, env);
    }
 
    /* declare and init a local copy of the Perl stack pointer */
    dSP;
 
    /* mortal SVs for the stack */
    ENTER;
    SAVETMPS;
 
    /* "record" the current stack pointer */
    PUSHMARK(SP);
 
    /* push parameters to the stack */
    XPUSHs(sv_2mortal(newSVpv(inmsg, 0)));
 
    /* make the global copy of the stack pointer same as the local copy */
    PUTBACK;
 
    /* call the Perl function, expecting a scalar to be returned */
    count = call_pv(operation, G_SCALAR);
 
    /* refreshing the local copy of the stack pointer, call_pv might have reallocated it */
    SPAGAIN;
 
    if (count != 1)
    {
        croak("perl function invocation failed") ;
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "perl function %s invocation failed", operation);
    }
 
    /* get the scalar reference from the stack */
    wsmsg_ref = (SV *) POPs;
 
    /* getting the object from the reference */
    wsmsg = SvRV(wsmsg_ref);
 
    /* fetching the value of the member variable 'payload' from WSMessage */
    wsmsg_str = hv_fetch(wsmsg, "payload", 7, FALSE);
 
    /* perl scalar to c string */
    tmp_str = SvPVutf8_nolen(*wsmsg_str);
    res_payload_str = (axis2_char_t *) savepvn(tmp_str, strlen(tmp_str));
 
    PUTBACK;
 
    /* cleaning up mortal SVs */
    FREETMPS;
    LEAVE;
 
    return res_payload_str;
}

Full source is here (note that the actual source might be different from what you see here since it’s being modified at the time of this writing). Also my_perl is declared as a static variable. The problem is when my_perl gets freed it looks like ModPerl is also affected. A valgrind report shows that it tries to read from a pointer after perl_free() gets called. As the following valgrind exerpt shows,

==16101== Invalid read of size 4
==16101==    at 0x62AD118: _wrap_wsf_worker_process_request (wsf_wrap.c:4167)
==16101==    by 0x5476D68: Perl_pp_entersub (pp_hot.c:2847)
==16101==    by 0x5438092: Perl_runops_debug (dump.c:1931)
==16101==    by 0x546FF97: Perl_call_sv (perl.c:2646)
==16101==    by 0x4DC2AF3: modperl_callback (modperl_callback.c:101)
==16101==    by 0x4DC388B: modperl_callback_run_handlers (modperl_callback.c:262)
==16101==    by 0x4DC4289: modperl_callback_per_dir (modperl_callback.c:369)
==16101==    by 0x4DBB53E: modperl_response_handler_run (mod_perl.c:1004)
==16101==    by 0x4DBB704: modperl_response_handler_cgi (mod_perl.c:1099)
==16101==    by 0x25A6C: ap_run_handler (config.c:158)
==16101==    by 0x295BE: ap_invoke_handler (config.c:372)
==16101==    by 0x35D80: ap_process_request (http_request.c:258)
==16101==  Address 0x649051c is 12 bytes inside a block of size 1,692 free'd
==16101==    at 0x480590A: free (vg_replace_malloc.c:323)
==16101==    by 0x546AED4: perl_free (perl.c:1394)
==16101==    by 0x62BD599: wsf_xml_msg_recv_invoke_business_logic_sync (wsf_xml_msg_recv.c:452)
==16101==    by 0x613D503: axis2_msg_recv_invoke_business_logic (msg_recv.c:392)
==16101==    by 0x613DB34: axis2_msg_recv_receive_impl (msg_recv.c:319)
==16101==    by 0x613D583: axis2_msg_recv_receive (msg_recv.c:431)
==16101==    by 0x61327D4: axis2_engine_receive (engine.c:315)
==16101==    by 0x6167177: axis2_http_transport_utils_process_http_post_request (http_transport_utils.c:595)
==16101==    by 0x62BE9B3: wsf_worker_process_request (wsf_worker.c:301)
==16101==    by 0x62AD0F7: _wrap_wsf_worker_process_request (wsf_wrap.c:4166)
==16101==    by 0x5476D68: Perl_pp_entersub (pp_hot.c:2847)
==16101==    by 0x5438092: Perl_runops_debug (dump.c:1931)

Still haven’t been able to pin down what exactly happens when perl_free() gets called

Comments (2)

WSF/Perl 1.1

Just uploaded WSF/Perl 1.1 to CPAN. Doesn’t show up there yet but will be available within a few hours. This has many things added since the last release (which was ages ago). You could now do WS-ReliableMessaging, WS-Security, WS-SecurityPolicy. The release became ridiculously late due to couple of bugs which took me REALLY LONG to debug and fix. Ouch. Download and give it a shot. It’ll take couple of seconds to compile. If you’re in a generous mood I recommend contributing to a good cause in those few seconds.

This release again has only support only on the client side, if you’re looking forward to write/host services with WSF/Perl you still have to wait a bit more. Dinesh and Danushka has done some excellent progress on that front and will be finishing it soon. If you wanna know how it’s taking shape, then by all means.

Comments (0)