Embedding Perl with Inline - Using Perl to Tame your Daemons

Author: Piers Harding

Copyright © 2002  Piers Harding

"Embedding Perl with Inline - Using Perl and Inline to Tame your Daemons"

From the abstract:
This talk [1] shows a Cookbook style recipes for embedding Perl interpreters into Daemon programs (or vice versa).

Many server type products provide an API for calling out to custom code (e.g. Apache has mod_perl [2] and the Apache API [3], jabberd and jsm modules [4], etc), so how do you embed Perl into these products?

Furthermore, these products will often contain other APIs for data manipulation (jabberd has an xml manipulation library based on expat) that would also be useful inside your embedded Perl interpreter - how do you do this?

The answer is Inline [5], and the standard Perl API [6]. This talk was born from the learning experience of embedding Perl into Jabber C++ components, and jabberd itself.


Introduction: So whats this all about then?

Whats this all about?

  • Using perl inside server/daemon type applications [mod_perl]
  • or, Intertwining Perl with event driven libraries [Internet protocol clients etc.]
  • "Suffering a small amount of pain, to get maximum gain."

Who is this for?

This is for developers:

  • who are strongest/most comfortable in Perl
  • have some C/C++ knowledge
  • and want to make use of Perl where ever possible

Benefits?

Spend time making Perl available in your environment, so that you can:

  • Scratch an Itch! I wanted to develop fast, and scaleable Jabber Components - but code in Perl
  • incorporate 3rd party products/libraries, to get that bit more out of them
  • Best of most worlds: get speed, and programming flexibility (usually)
  • Access to the plethora of perl libraries available eg. DBI
  • Get back to Perl where you belong - "The Prime Directive"
  • ....and have some fun!

A few key people

  • Larry Wall
  • Brian Ingerson
  • Neil Watkiss
  • and many more...

Contents: What are we going to cover?

The Toolset - what you need to know

  • Inline ( or XS )
  • the standard perlapi
  • Basic C/C++ programming

The HOWTO:

  • daemons
    • manage your own Perl interpreter
    • create a Perl callback framework
    • create function and object wrappers
  • event driven libraries
    • dont need to worry aobut your own interpreter
    • Inline the library as a basis to your application
    • create function and object wrappers
  • Deployment

Contents: What are we going to cover? - continued

Common Issues:

  • accessing functions/objects in the calling daemon
  • encapsulating C/C++ objects for access in perl
  • using anonymous perl subroutines
  • Threading
  • Avoiding typdef clashes
  • Taintedness, and setuid programs

Two examples:

  • wu-ftpd - role your own mod_perl for ftp
    • Embedding perl in a daemon process
    • accessing daemon functions from perl
  • Jabber::JAX::Component - the day of the JECL?
    • a specific example that I needed to solve
    • Building a multi-threaded toolkit based on JECL
    • generating perl callbacks in an embedded library
    • encapsulating objects of the embedded library for later access
    • using it to create a Publish & Subscribe Component for Jabber

Resources

  • Perl
  • Inline
  • Jabber
  • WU-FTPD

The Toolset

Inline ( or XS )

Inline is used to bind other languages in to your Perl program.

  • Inline is the easiest way to bind other languages to Perl
  • Inline uses XS under the covers to do the binding
  • XS should have a slightly faster startup time, in that Inline will do some of its own checking/processing before the extension is loaded, but after that there should be no difference performance wise.
  • Use Inline to pull in the event driven library
  • Use Inline to encapsulate C functions, and C++ objects within the Perl callbacks
  • As Ingy would say - "Just use Inline; "

the standard perlapi

  • Perl has a comprehensive API built into the interpreter
  • Create an interpreter in exactly the same way as the Perl executable does
  • Access to a myriad of functions and macros to define Perl data types, and to coerce in and out of native values (most likely C/C++)

The HOWTO

Daemons

  • Embed the Perl Interpreter
    • initialise the interpreter
    • load perl module/s
    • create Perl method callbacks
    • Destroy Interpreter
  • Create the container module for Perl callbacks
    • create callback functions to access parent Daemon code
    • encapsulate Daemon functions for callback in Perl (Inline C/C++)

Event driven libraries

  • Library encapsulating Module
    • parameter control for library initialisation ( port, etc. )
    • Inline code to bind in library functions
    • event loop control/launch
    • insert callback method for accessing Perl subroutine/s
  • Library objects/function encapsulating module
    • encapsulate library objects/functions for access within Perl (Inline)
    • Bless Perl structure containing pointer into object and pass into Perl

Deployment

  • How to install
  • Perl Module location
  • Perl Module reloading

HOWTO Daemons

Example is based on the embedding Perl into the WU-FTPD server.

  • Loads the interpreter before the Daemon forks for each request handled
  • Destroys and cleans up the interpreter on shutdown signals
  • Provides Perl callbacks for manipulating the files/names before and after STOR and RETR ftp functions
Fig. 1. Sample Process flow in WU-FTPD


Embed the Perl Interpreter

The Perl interpreter is managed in 4 phases.
These 4 phases need to be invoked by the calling daemon process at the appropriate times (to do this you may need to modify the daemon- eg. Wu-FTPD ).

  • Initialise Interpreter
  • load Perl modules
  • Perform calls
  • Destroy Interpreter and cleanup resources


Initialise Interpreter

  • Declare a single global Interpreter instance
  • declare sudo command line arguments for Interpreter - Additional libray paths etc.
  • allocate/construct Interpreter
  • Parse initial program/arguments passed (NULL/empty program in this case - returns true)
  • Run the program
static PerlInterpreter *my_perl_interpreter;
char *embedding[] = { "", "-I", "/some/path/to/lib", "-e", "1" };
my_perl_interpreter = perl_alloc();
perl_construct( my_perl_interpreter );
perl_parse(my_perl_interpreter, xs_init, no_parms, embedding, NULL);
perl_run(my_perl_interpreter);


Load Perl Modules

Evaluate code fragments to "use" modules, including those that contain methods for later execution
...
my_perl_eval_pv("use My_Module;");


Perform calls

  • declare local argument stack pointer
  • preserve a marker for the current stack pointer
  • push arguments onto the stack (local copy)
  • give the interpreter the local stack pointer
  • Call the subroutine (using the SV* flavour)
  • retrieve the stack pointer
  • test the result
  • get a local copy of the stack pointer
  • retrieve the return values(make sure that you take copies)
  • give back the original stack pointer
  • free up temporary variables
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpvf("%s",parm1)));
...
PUTBACK;
sv_subroutine = newSVpv(subroutine, PL_na);
sv_setpv(sv_subroutine, "My_Module::handler");
result = perl_call_sv(sv_subroutine, G_EVAL | G_SCALAR );
if(SvTRUE(ERRSV))
    fprintf(stderr, "perl call errored: %s", SvPV(ERRSV,PL_na));
SPAGAIN;
ptr = POPp;
fprintf( stderr, "And after the Perl call (%s) I got %s \n", SvPV(sv_subroutine,PL_na), ptr );
PUTBACK;
FREETMPS;
LEAVE;


Perform calls - continued

Coresponding Static Method in Perl
Package My_Module;

...

sub handler{
  my ($parm1) = @_;

  ...

  return $some_value;
}



Destroy and Cleanup

  • shutdown the interpreter
  • free up any resources
perl_destruct(my_perl_interpreter);
perl_free(my_perl_interpreter);


Container Module for Perl Callbacks

  • create callback functions to access parent Daemon code
  • encapsulate Daemon functions for callback in Perl (Inline C/C++)


Callback functions to access Parent daemon

These functions could be built directly into the Inline code instead of being abstracted out, although, this way avoids namespace clashes with Perl declared data, and #includes
void my_perl_dologout(char *message)
{
     reply(451, "Error in server: %s\n Closing connection.", message);
     my_perl_set_msg_flag(true);
     dologout( 0 );
}


Encapsulate Daemon functions for callback in Perl (Inline)

The binding from within a Perl module that enables access to an external function (Daemon)
void my_logout( SV* message ) {
    my_perl_dologout(SvPV( message, PL_na ));
}

Wrap Inline function in Perl subroutine.
A further opportunity for parameter validation.
sub logout {
  my $message = shift;
  $message =~ s/[^\w\s\-\.]//g;
  return my_logout($message);
}


HOWTO - Event Driven Libraries

Starting with Perl is completely different to starting with a Daemon.

  • Processing control starts and ends with Perl
  • There is no need to worry about managing the Perl Interpreter
  • Anonymous Subroutines can easily be passed in for the callbacks


HOWTO - Event Driven Libraries - continued

Example is based on the mio (managed input/output) library for the 1.5 JabberD server, for managing socket connections/events for the JabberD, or Jabber Components. User has choice to build using select(), or poll().

  • creates an mio manager
  • creates an event loop
  • provides Perl callbacks at read events
  • provides access to triggering read, write, or close events
Fig. 1. Sample Process flow for Jabber::MIO


How the Module is Invoked

use Jabber::MIO;
my $cnt = 0;
my $mio = new Jabber::MIO( 'max' => 50,
                           'timeout' => 30 );

$mio->addListener( 'port' => 5555,
                   'handler' => sub { 
		                     my ($e) = @_; 
				     my $buf = $e->buffer();
				     $e->end() if $cnt++ >= 5;
				     $buf =~ s/(\r|\n)//g;
				     return join('',reverse split(//,$buf))."\r\n";
				 },
			 );
$mio->start();


Library Encapsulation Module

  • parameter control for library initialisation ( port, etc. ), and Perl wrapper methods
  • Inline code to bind in library functions
  • event loop control/launch
  • insert callback method for accessing Perl subroutine/s


Parameter control for library initialisation

Bless a new Perl object, and parse all the necessary parameters to to create an MIO object (all standard stuff).
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {
         'max' => 50,
         'timeout' => 30,
        @_
        };
    bless ($self, $class);
    # instantiate the mio object
    my_new_mio($self);
    return $self;
}

Call out to Inline code to set up the mio instance ( just a struct ) and tie that to the Perl object.


Parameter control for library initialisation - continued

Add port listeners
sub addListener {
  my $self = shift;
  my $parms = {
         'port' => '5555',
         @_
         };
  $self->{'listener'}->{$parms->{'port'}} = $parms;
  my_add_listener( $self, $parms );
}

expect a parameter called handler that is an anonymous subroutine ref. eg.
sub addListener {
  my $self = shift;
  my $parms = {
         'port' => '5555',
         @_
         };
  die "MIO allready exists for port: ".$parms->{'port'}."\n"
     if exists $self->{'listener'}->{$parms->{'port'}};
  die "listener must have a handler\n" unless exists $parms->{'handler'};
  $self->{'listener'}->{$parms->{'port'}} = $parms;
  return my_add_listener( $self, $parms );
}


Inline code to bind in library functions

Access the scalar parameter values passed in for listening port, maximum file descriptiors, and timeout frequency

Create the mio object
package Jabber::MIO;
...

__DATA__

__C__

#include "mio.h"

void my_new_mio(SV* self)
{
    mio_t m;
    SV* sv_max = NULL;
    HV* hv_self = NULL;
    SV* obj_ref = NULL;
    SV* obj = NULL;

    hv_self = (HV*) SvRV(self);
    sv_max = *hv_fetch(hv_self, "max", 3, FALSE);

    m = mio_new(SvIV(sv_max));

    // a ZERO value integer scalar that will be turned into a reference
    obj_ref = newSViv(0);
    // (1) create a scalar that will contain the C pointer to the object 
    // (2)  set the obj_ref scalar to be a scalar ref to this new scalar
    obj = newSVrv(obj_ref, NULL);
    // set the value of the new scalar ( pointed to by obj_ref )
    //   to be the pointer of our object
    sv_setiv(obj, (IV) m);
    // make the scalar that contains the pointer ead only for protection
    SvREADONLY_on(obj);

    hv_store(hv_self,"fds",3,newRV_inc((SV*) newHV()),0);
    hv_store(hv_self,"mio",3,obj_ref,0);
}


Inline code to bind in library functions - continued

Tie in each handler subroutine ref to the associated listener port
typedef struct jabber_mio_st *jabber_mio_t;
struct jabber_mio_st
{
    /* pointer to self object from Perl land */
    SV* self;
    /* pointer to port parameters for the given port */
    SV* parms;
};

void my_add_listener(SV* self, SV* parms)
{
    jabber_mio_t jm;
    SV* sv_port = NULL;
    SV* sv_mio = NULL;

    sv_mio = *hv_fetch(SvRV(self), "mio", 3, FALSE);
    sv_port = *hv_fetch(SvRV(parms), "port", 4, FALSE);

    // setup the structure linking back the Perl object and 
    // parameters relatingto this listening port 
    jm = (jabber_mio_t)malloc(sizeof(struct jabber_mio_st));
    memset(jm, 0, sizeof(struct jabber_mio_st));

    jm->parms = newRV_inc(SvRV(parms));
    jm->self = newRV_inc(SvRV(self));

    mio_listen(((mio_t*) SvIV(SvRV(sv_mio))),SvIV(sv_port),NULL,actor,(void*)jm);
}


Event Loop Control/Launch

Trigger the object to enter into the event loop.
package Jabber::MIO;
...

sub start {

  my ($self) = @_;
  my_start( $self );
  return 1;

}

Trigger the main event loop that generates the file descriptor events
bool run_flag = TRUE;

void my_start(SV* self)
{
    mio_t m = NULL;
    SV* sv_timeout = NULL;
    SV* sv_mio = NULL;

    sv_timeout = *hv_fetch(SvRV(self), "timeout", 7, FALSE);
    sv_mio = *hv_fetch(SvRV(self), "mio", 3, FALSE);
    m = (mio_t*) SvIV(SvRV(sv_mio));
    while(run_flag) mio_run(m,SvIV(sv_timeout));
    mio_free(m);
}

void terminate(){
    run_flag = FALSE;
}


Callback wrapper function - the callback framework

  • mio takes a function pointer (actor), and passes in details about the socket and it's event including the struct containing the Perl subroutine ref.
  • we keep a hash table of file descriptors, and data to write to them. This can be accessed by the Perl callback.
  • READ - If we get some data to read then do the callback, else close the socket.
  • WRITE - If we get write event - check the fd hash to see if we have data to write.
// In Inline section of Jabber::MIO
int actor(mio_t m, mio_action_t a, int fd, void *data, void *arg)
{
    ...
    switch(a)
    {
    ...
    case action_READ:
        if((len = read(fd,buf,1024)) > 0)
	{
	    buf[len] = '\0';
	    if (callback(m, fd, buf))
              mio_write(m, fd);
	} else {
            mio_close(m, fd);
	}
        return 1; /* get more read events */
        break;
    case action_WRITE:
        memset(h_key,0,sizeof(h_key));
        sprintf(h_key,"%d",fd);
	if (hv_exists(hv_fds,h_key,strlen(h_key))){
	  sv_write = *hv_fetch(hv_fds, h_key, strlen(h_key), FALSE);
          printf("writing to %d\n",fd);
          write(fd,SvPV(sv_write,SvCUR(sv_write)),SvCUR(sv_write));
          hv_delete(hv_fds,h_key,strlen(h_key),G_DISCARD);
	}
        return 0; /* no more write events please */
        break;
    ...


Callback wrapper function - Invoking Perl

Same as for callback in Daemon program

  • declare local argument stack pointer
  • preserve a marker for the current stack pointer
  • push arguments onto the stack (local copy)
  • give the interpreter the local stack pointer
  • Call the subroutine (using the SV* flavour)
  • retrieve the stack pointer
  • test the result
  • get a local copy of the stack pointer
  • retrieve the return values(make sure that you take copies)
  • give back the original stack pointer
  • free up temporary variables
// In Inline section of Jabber::MIO
int callback(mio_t m, int fd, char* buffer){
    ...

    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    XPUSHs(jm->self);
    XPUSHs(jm->parms);
    XPUSHs(newSViv(fd));
    XPUSHs(newSVpvf("%s",buffer));
    PUTBACK;

    result = perl_call_pv("Jabber::MIO::handler", G_ARRAY | G_EVAL );
    if(SvTRUE(ERRSV)) fprintf(stderr, "perl call errored: %s", SvPV(ERRSV,PL_na));
    SPAGAIN;
    memset(h_key,0,sizeof(h_key));
    sprintf(h_key,"%d",fd);
    hv_fds = (HV*) SvRV(*hv_fetch(SvRV(jm->self), "fds", 3, FALSE));
    if ( result > 0 ){
        res = sv_mortalcopy(POPs);
        if (SvTRUE(res)){
          SvREFCNT_inc(res);
          hv_store(hv_fds,h_key, strlen(h_key),res,0);
        } else {
          hv_delete(hv_fds,h_key,strlen(h_key),G_DISCARD);
        }
    } else {
        hv_delete(hv_fds,h_key,strlen(h_key),G_DISCARD);
    };
    PUTBACK;
    FREETMPS;
    LEAVE;
    ...


Library objects/function encapsulating module

This is where we get access to call/manipulate data in the external library from within the Perl callback.

  • encapsulate library objects/functions for access within Perl (Inline)
  • Bless Perl structure containing pointer into object and pass into Perl

This could be done within a separate Module to the parent Module, but is generally easier if it is all rolled into one.


Encapsulate library objects/functions for access in Perl

Create wrappers for accessing library functions
// In Inline section of Jabber::MIO

void my_mio_read(SV* m, SV* fd){
    mio_read(((mio_t*) SvIV(SvRV(m))), SvIV(fd));
}

void my_mio_write(SV* m, SV* fd, SV* data){
    SV* res;
    char h_key[20];

    memset(h_key,0,sizeof(h_key));
    sprintf(h_key,"%d",SvIV(fd));
    res = sv_mortalcopy(data);
    if (SvTRUE(res)){
      SvREFCNT_inc(res);
      hv_store(hv_fds,h_key, strlen(h_key),res,0);
    } else {
      hv_delete(hv_fds,h_key,strlen(h_key),G_DISCARD);
    }
    mio_write(((mio_t*) SvIV(SvRV(m))), SvIV(fd));
}

void my_mio_close(SV* m, SV* fd){
    mio_close(((mio_t*) SvIV(SvRV(m))), SvIV(fd));
}


void my_mio_close(SV* m, SV* fd){
    mio_close(((mio_t*) SvIV(SvRV(m))), SvIV(fd));
}


Encapsulate library objects/functions for access in Perl - continued

Create corresponding Perl methods
package Jabber::MIO;
...

sub read {
  die "Must have 2 arguments to Jabber::MIO::Manager::read(self, fd)\n"
      unless scalar @_ == 2;
  my ($self, $fd) = @_;
  return my_mio_read($self->{'mio'}, $fd);
}

sub write {
  die "Must have 3 arguments to Jabber::MIO::Manager::wite(self, fd, data)\n"
      unless scalar @_ == 3;
  my ($self, $fd, $data) = @_;
  my_mio_write($self->{'mio'}, $fd, $data);
}

sub close {
  die "Must have 2 arguments to Jabber::MIO::Manager::close(self, fd)\n"
      unless scalar @_ == 2;
  my ($self, $fd) = @_;
  return my_mio_close($self->{'mio'}, $fd);
}
...


Bless Perl data structure into an object containing the object/function pointer

Bless the mio object reference into a package so that method calls can be performed on it.
package Jabber::MIO;
...
sub handler {
  my ($self, $parms, $fd, $buffer) = @_;
  my $event = {
                'fd' => $fd,
                'buffer' => $buffer,
                'mio' => $self,
                'eventhandler' => $parms
              };
  bless($event, "Jabber::MIO::FDEvent");
  #my @result = &{$parms->{'handler'}}($self, $fd, $buffer);
  my @result = &{$parms->{'handler'}}($event);
  return @result;
}


Common Issues

  • accessing functions/objects in the calling daemon
  • Perl Header file definition clashes (farm out to your own library)
  • encapsulating C/C++ objects for access in perl
  • using anonymous perl subroutines
  • Threading
  • Taintedness, and setuid programs


Examples

wu-ftpd - role your own mod_perl for ftp

Jabber::JAX::Component - the day of the JECL?


Example 1: Embedding Perl in wu-ftpd

Business case - I have had ocassion to need to trigger a business event based on the receipt of a file via ftp. Place callbacks to enable modification of file names being stored or retrieved, and access to the event of a file being uploaded or downloaded

  • roll your own mod_perl for ftp - Embed a Perl Interpreter into the WU-FTPD server daemon
  • playing with filenames store and retrieve - forcing user logouts, and error messages
  • triggering events in perl on file receipts
Fig. 1. The WU-FTPD Server


Example 2: Jabber Components with Jabber::JAX::Component

Write highspeed components for Jabber in perl using a threaded C++ library

  • a specific example that I needed to solve
  • Building a multi-threaded toolkit based on JECL
  • generating perl callbacks in an embedded library
  • encapsulating objects of the embedded library for later access
  • using it to create a Publish & Subscribe Component for Jabber


Resources

Perl:

Inline:

Jabber:

WU-FTPD:


List of Links

URL
[1] http://conferences.oreillynet.com/cs/os2002/view/e_sess/2731
[2] http://perl.apache.org
[3] http://httpd.apache.org/docs/misc/API.html
[4] http://www.jabber.org
[5] http://inline.perl.org
[6] http://www.perldoc.com/perl5.6/pod/perlguts.html
[7] http://www.perldoc.com/perl5.6.1/pod/perlembed.html
[8] http://www.perldoc.com/perl5.6.1/pod/perlapi.html
[9] http://www.perldoc.com/perl5.6.1/pod/perlcall.html
[10] http://www.perldoc.com/perl5.6.1/pod/perlguts.html
[11] http://www.perldoc.com/perl5.6.1/pod/perlxs.html
[12] http://www.perldoc.com/perl5.6.1/pod/perlxstut.html
[13] http://inline.perl.org/
[14] http://search.cpan.org/doc/INGY/Inline-0.43/C/C-Cookbook.pod
[15] http://search.cpan.org/doc/INGY/Inline-0.43/C/C.pod
[16] http://search.cpan.org/doc/NEILW/Inline-CPP-0.23/CPP.pod
[17] http://www.jabber.org/
[18] http://www.jabberstudio.org/
[19] http://www.jabberstudio.org/cgi-bin/viewcvs.cgi/jecl/
[20] http://www.wu-ftpd.org/
[21] ftp://ftp.wu-ftpd.org/pub/wu-ftpd-attic/wu-ftpd-2.6.2.tar.gz