I tried asking this in c.l.p.misc last week with no results, so now
I'm giving more detail and posting here.

I'm trying to make some C encryption functions available to perl,
but my code ends up segfaulting, apparently in the xs glue.

I'd like to have a perl interface like:

        my $text = "This is some text. It can have nulls (\0) in it.";
        my $key  = "\0\cA\cB\cC";

        my $crypt   =   crypt($text,  $key);

        my $decrypt = decrypt($crypt, $key);

        # $crypt eq $decrypt

Since I am passing strings back and forth and they need to change
size, I tried to think of some other XS module that would do that.
I came up with Compress::LZO, and based my XS code on that module.

Below I have all the files and code necessary to duplicate the
problem. I've greatly simplified the encryption for purposes of
illustration.

It can be extracted, compiled, and run with:

perl -x <thispost> && cd Crypt-Mine && perl Makefile.PL && make test

Some help please?

Elijah
------
#!/usr/bin/perl
# like a shar, this is a plar (perl archive). Extract by hand or
# perl -x <file>
#
# Files herein:
#       Crypt-Mine/MANIFEST
#       Crypt-Mine/Makefile.PL
#       Crypt-Mine/Mine.pm
#       Crypt-Mine/Mine.xs
#       Crypt-Mine/mine.c
#       Crypt-Mine/mine.h
#       Crypt-Mine/typemap
#       Crypt-Mine/t/test.t

use File::Path;
mkpath(['Crypt-Mine', 'Crypt-Mine/t'], 1, 0755);

open(OUT,">Crypt-Mine/MANIFEST") or die "Cannot open MANIFEST: $!\n";
print OUT <<'__END_file__MANIFEST';
MANIFEST
Makefile.PL
Mine.pm
Mine.xs
main.c
mine.c
mine.h
typemap
t/test.t
__END_file__MANIFEST
close OUT;

open(OUT,">Crypt-Mine/Makefile.PL") or die "Cannot open Makefile.PL: $!\n";
print OUT <<'__END_file__Makefile.PL';
#! /usr/local/bin/perl

use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile being created.
WriteMakefile(
        'NAME' => 'Crypt::Mine',
        'DISTNAME' => 'Crypt-Mine',
        'VERSION_FROM' => 'Mine.pm',
        'OBJECT' => 'Mine.o mine.o',
        'INC' => '-I.',
        'dist'   => {COMPRESS=>'gzip', SUFFIX=>'gz'}
);

__END_file__Makefile.PL
close OUT;

open(OUT,">Crypt-Mine/Mine.pm") or die "Cannot open Mine.pm: $!\n";
print OUT <<'__END_file__Mine.pm';

package Crypt::Mine;

require 5.004 ;
require Exporter;
require DynaLoader;
use AutoLoader;
use Carp;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);

@ISA = qw(Exporter DynaLoader);

@EXPORT_OK = qw(
        crypt decrypt
);

$VERSION = "1.00";

bootstrap Crypt::Mine $VERSION;

# Preloaded methods go here.

1 ;
# Autoload methods go after __END__, and are processed by the autosplit program.

1;
__END__

=cut

=head1 NAME

Crypt::Mine

=head1 SYNOPSIS

    use Crypt::Mine

=head1 DESCRIPTION

=head1 FUNCTIONS

=head1 AUTHOR

=head1 MODIFICATION HISTORY

__END_file__Mine.pm
close OUT;

open(OUT,">Crypt-Mine/Mine.xs") or die "Cannot open Mine.xs: $!\n";
print OUT <<'__END_file__Mine.xs';

#include "mine.h"

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

/***********************************************************************
// XSUB start
************************************************************************/

MODULE = Crypt::Mine   PACKAGE = Crypt::Mine   PREFIX = X_

PROTOTYPES: DISABLE

#########################################################################
#   crypt
#########################################################################
SV *
X_crypt(sv, svkey)
    PREINIT:
        SV *       sv;
        STRLEN     len;
        SV *       svkey;
        STRLEN     keylen;
        mykey_t    key;
        char*      keystr;
        char*      in;
        char*      out;
        char*      wrkmem;
        int        in_len;
        int        out_len;
        int        new_len;
        int        pad;
        int        err;
        int        i;
    CODE:
        in = (char*) SvPV(sv, len);
        keystr = (char*) SvPV(svkey, keylen);
        for (i=0; i < KEY_BYTES; i++) {
          if (i < keylen) {
            key.key[i] = keystr[i];
          } else {
            key.key[i] = '\0';
          }
        }
        in_len = len;
        pad = (DATA_BYTES - (in_len % DATA_BYTES)) % DATA_BYTES;
        out_len = in_len + pad + HEAD_SIZE;
        RETVAL = newSV(out_len);
        err = encrypt(in,in_len,&out,&new_len,&key);
        if (err != 0 || new_len != out_len)
        {  
            SvREFCNT_dec(RETVAL);
            XSRETURN_UNDEF;
        }
        SvCUR_set(RETVAL,new_len);
    OUTPUT:
        RETVAL

#########################################################################
# decrypt
#########################################################################
SV *
X_decrypt(sv, svkey)
        PREINIT:
                SV *       sv;
                STRLEN     len;
                SV *       svkey;
                STRLEN     keylen;
                mykey_t    key;
                char*      keystr;
                char*      in;
                char*      out;
                char*      wrkmem;
                int        in_len;
                int        out_len;
                int        new_len;
                int        pad;
                int        err;
                int        i;
        CODE:
                in = (char*) SvPV(sv, len);
                keystr = (char*) SvPV(svkey, keylen);
                for (i=0; i < KEY_BYTES; i++) {
                  if (i < keylen) {
                    key.key[i] = keystr[i];
                  } else {
                    key.key[i] = '\0';
                  }
                }
                in_len = len;
                pad = in[0] - '0';
                out_len = in_len - pad - HEAD_SIZE;
                RETVAL = newSV(out_len);
                err = decrypt(in,in_len,&out,&new_len,&key);
                if (err != 0 || new_len != out_len)
                {
                        SvREFCNT_dec(RETVAL);
                        XSRETURN_UNDEF;
                }
                SvCUR_set(RETVAL,new_len);
        OUTPUT:
                RETVAL

__END_file__Mine.xs
close OUT;

open(OUT,">Crypt-Mine/mine.c") or die "Cannot open mine.c: $!\n";
print OUT <<'__END_file__mine.c';

/*
 * My simple "encryption"
 */

#include "mine.h"

int  
encrypt(char *in, int inlen, char **out, int *outlen, mykey_t *key)
{
        int i,k;
        int n;
        int pad;
        char *p;
        mykey_t thekey;
        char data[DATA_BYTES];

        thekey = *key;

        pad = (DATA_BYTES - (inlen % DATA_BYTES)) % DATA_BYTES;
        *outlen = inlen + pad + HEAD_SIZE;

        *out = (char *)malloc(*outlen);
        if(*out == 0)
                return 1;

        p = (char *)*out;
        sprintf(p, "%s%c", MAGICNUM, pad);
        p += HEAD_SIZE;

        i = 0;
        do {
                if(DATA_BYTES > (inlen - i)) {
                        n = DATA_BYTES - pad;
                        memset(&data[n], 0, pad);
                }
                else
                        n = DATA_BYTES;

                memcpy(data, in, n);

                for(k=0; k < n; k++) {
                  data[k] ^= (char)k;
                  data[k] ^= thekey.key[k % KEY_BYTES];
                }

                memcpy(p, &data[0], DATA_BYTES);

                p  += DATA_BYTES;
                in += DATA_BYTES;
                i  += DATA_BYTES;
        } while(i < inlen);

        return 0;

int
decrypt(char *in, int inlen, char **out, int *outlen, mykey_t *key)
{
        int i,k;
        int n;
        int pad;
        char *p, *p2;
        mykey_t thekey;
        char data[DATA_BYTES];

        thekey = *key;

        /* Check size for sanity */
        if((inlen - HEAD_SIZE) % DATA_BYTES)
                return 1;

        /* Check magic number */
        if (0 != strncmp(in, MAGICNUM, strlen(MAGICNUM)))
                return 1;

        p = (char *)in;
        p += HEAD_SIZE - 1;
        pad = (int)*p;
        p ++;

        if(pad >= DATA_BYTES)
                return 2;

        *outlen = inlen - pad - HEAD_SIZE;

        /* Need at least DATA_BYTES past the end for the
         * memcpy() into p2. We'll use one byte for the \0
         */
        *out = (char *)malloc(*outlen + DATA_BYTES);
        if(*out == 0)
                return 1;

        p2 = *out;
        i = 0;
        do {
                if(DATA_BYTES > (*outlen - i)) {
                        n = DATA_BYTES - pad;
                        memset(&data[n], 0, pad);
                }
                else
                        n = DATA_BYTES;

                memcpy(data, p, n);

                for(k=0; k < n; k++) {
                  data[k] ^= (char)k;
                  data[k] ^= thekey.key[k % KEY_BYTES];
                }

                memcpy(p2, &data[0], DATA_BYTES);

                p2 += DATA_BYTES;
                p  += DATA_BYTES;
                i  += DATA_BYTES;
        } while(i < *outlen);

        (*out)[*outlen] = '\0';

        return 0;

__END_file__mine.c
close OUT;

open(OUT,">Crypt-Mine/mine.h") or die "Cannot open mine.h: $!\n";
print OUT <<'__END_file__mine.h';

/*
 * My simple "encryption"
 */

/* KEY_BYTES and DATA_BYTES should fit in a char
 * HEAD_SIZE >= lenght(MAGICNUM) + 1
 */
#define KEY_BYTES   4
#define DATA_BYTES  8
#define HEAD_SIZE   4

#define MAGICNUM    "<c>"

typedef struct mykey {
        unsigned char key[KEY_BYTES];

int encrypt(char *in, int inlen, char **out, int *outlen, mykey_t *key);
int decrypt(char *in, int inlen, char **out, int *outlen, mykey_t *key);

__END_file__mine.h
close OUT;

open(OUT,">Crypt-Mine/typemap") or die "Cannot open typemap: $!\n";
print OUT <<'__END_file__typemap';

const char *                    T_PV
char *                          T_PV

int                             T_UV

########################################################################### ##
INPUT
T_UV
        $var = (unsigned long)SvUV($arg)
########################################################################### ##
OUTPUT
T_UV
        sv_setuv($arg, (IV)$var);
__END_file__typemap
close OUT;

open(OUT,">Crypt-Mine/t/test.t") or die "Cannot open t/test.t: $!\n";
print OUT <<'__END_file__t/test.t';
#! /usr/bin/env perl
##
## vi:ts=4
##

use Crypt::Mine;

# /***********************************************************************
# // a very simple test driver...
# ************************************************************************/

sub ok {
        my ($no, $ok) = @_;
        ## $total++;
        ## $totalBad++ unless $ok;
        print "ok $no\n" if $ok;
        print "not ok $no\n" unless $ok;

sub test {
        my ($no, $txt, $key) = @_;

        my $c    = Crypt::Mine::crypt($txt,$key);
        if (!defined($c)) {
          &ok($no, 0);
          return;
        }
        my $ntxt = Crypt::Mine::decrypt($c,$key);
        if (!defined($ntxt)) {
          &ok($no, 0);
          return;
        }
        my $bad  = Crypt::Mine::decrypt($c,$key ^ (chr(100) x length($key)));
        if (!defined($bad)) {
          &ok($no, 0);
          return;
        }

        &ok($no, ($txt eq $ntxt && $txt ne $bad) );

sub main {

        print "1..7\n";
        $i = 1;
        # try some simple strings
        &test($i++,"aaaaaaaaaaaaaaaaaaaaaaaa","yaha\0\n\cX");
        &test($i++,"abcabcabcabcabcabcabcabc","yaha\0\n\cX");
        &test($i++,"abcabcabcabcabcabcabcabc","yaha\0\n\cX");
        &test($i++," " x 131072,"yaha\0\n\cX");
        &test($i++,"","yaha\0\n\cX");
        &test($i++,1234567,"yaha\0\n\cX");                # integer
        &test($i++,3.1415e10,"yaha\0\n\cX");              # double

&main();

__END_file__t/test.t
close OUT;

__END__
perl -Mcharnames=latin -wle 'print "\N{J}\N{u}\N{s}\N{t} \N{A}\N{n}\N{o}" . ...

read more »

Eli the Bearded <eli...@workspot.net> writes:
)         char*      out;
[...]
)         pad = (DATA_BYTES - (in_len % DATA_BYTES)) % DATA_BYTES;
)         out_len = in_len + pad + HEAD_SIZE;
)         RETVAL = newSV(out_len);
)         err = encrypt(in,in_len,&out,&new_len,&key);
)         if (err != 0 || new_len != out_len)
)         {  
)             SvREFCNT_dec(RETVAL);
)             XSRETURN_UNDEF;
)         }
)         SvCUR_set(RETVAL,new_len);
)     OUTPUT:
)         RETVAL

Okay, so encrypt() is supposed to allocate a buffer of size
C<new_len> and stuff a pointer to it into C<out> (which you passed
in by reference), right?  Well you never do anything with the
pointer that should now be in C<out> so C<RETVAL> is whatever
C<newSV> then C<SvCUR_set> leaves in there (nulls or garbage?).

The biggest pain with XS is that Perl refuses to deal with buffers
that it didn't allocate.  With much work you can get Perl do keep
the buffer around and let you write all of the code to deal with
it.  The other option is to just move the data into a buffer that
Perl did allocate.  Your solution almost does that so we'll go
that way.

You need to copy the data from the buffer that C<out> now points to
and then free that buffer:

        pad = (DATA_BYTES - (in_len % DATA_BYTES)) % DATA_BYTES;
        out_len = in_len + pad + HEAD_SIZE;
        err = encrypt(in,in_len,&out,&new_len,&key);
        if (err != 0 || new_len != out_len)
        {  
            SvREFCNT_dec(RETVAL);
            XSRETURN_UNDEF;
        }
        RETVAL = newSVpv(out,out_len);
        free(out);
    OUTPUT:
        RETVAL

If encrypt() doesn't allocate its own buffer, then something like
this makes more sense:

        pad = (DATA_BYTES - (in_len % DATA_BYTES)) % DATA_BYTES;
        out_len = in_len + pad + HEAD_SIZE;
        RETVAL = newSV(out_len);
        out= SvPV( RETVAL, new_len/*don't care*/ );
        err = encrypt(in,in_len,out,&new_len,&key);
        if (err != 0 || new_len != out_len)
        {  
            SvREFCNT_dec(RETVAL);
            XSRETURN_UNDEF;
        }
        SvCUR_set(RETVAL,new_len);
    OUTPUT:
        RETVAL

which looks like what the original code was probably doing but not
what your code needs to do since encrypt() does appear to be allocating
its own buffers.

If encrypt() isn't allocating its own buffers, you might want to
look at how I deal with these things in Win32API::Registry.
--
Tye McQueen    Nothing is obvious unless you are overlooking something
         http://www.metronet.com/~tye/ (scripts, links, nothing fancy)

In comp.lang.perl.moderated, Tye McQueen  <t...@metronet.com> wrote:

Hmmm. Good to know.

I tried this and it still didn't work. By email Brian Ingerson
helped me to get this to work with his Inline module. (I had not
even tried that before I posted my message.) There was the odd
occurance that perl core dumped when I called my C function
'encrypt' but not when I called it 'my_encrypt' which Brian
suspects to be a dynamic linking problem. (Sounds reasonable to
me.)

Let me say that the Inline module is the coolest thing for Perl
since the Benchmark module.

Elijah
------
use Inline C=>qq<#include <string.h>\nSV*japh(){char*JAPH="Just Another>
.qq< Perl Hacker\\n";return newSVpv(JAPH,strlen(JAPH)+1);}>;print japh()

Brian Ingerson replied to my post by mail and asked me to post his
reply. Here it is.

Elijah
------
From: Brian Ingerson <br...@ingerson.com>
Subject: Re: what's wrong with my XS code? (long)
Date: Tue, 26 Sep 2000 23:03:49 -0700

--- ~500 lines deleted ---

ETB,

The subject of this message is your answer. XS *is* the problem. Here is
my idea of what you would probably rather do.

--- BEGIN crypt.pl ---
#!/usr/bin/perl

use Inline;
Inline->import(C => <DATA>);
*my_decrypt = \&my_encrypt; # For this implementation anyway.

$key = "xyz\0abc\t";
$encrypt = my_encrypt("Just Another \0Perl Hacker\n", $key);
$decrypt = my_decrypt($encrypt, $key);
print $decrypt if $encrypt ne $decrypt;

__END__

SV * my_encrypt(SV * text_sv, SV * key_sv)
{
    int i = 0;
    int j = 0;
    STRLEN key_len;
    STRLEN crypt_len;
    char * key = SvPV(key_sv, key_len);

    SV * crypt_sv = newSVsv(text_sv);
    char * crypt = SvPV_force(crypt_sv, crypt_len);

    for (i = 0; i < crypt_len; i++) {
        *crypt++ ^= *(key + j++);
        if (j == key_len)
          j = 0;
    }
    return crypt_sv;

--- END crypt.pl ---

Cut out the snippet and run it. It's self-compiling. Make sure you have
Inline.pm installed first.

This is a perfect example to support perl6-RFC270
http://dev.perl.org/rfc/270.html

All you wanted to do was implement an encryption algorithm in C, not
maintain a 500+ line monster.

Brian

PS Read the Inline.pm doc and 'perldoc perlapi' (from 5.6.0) for more
info. I replaced your buffer management code with Perl API calls, which
is simpler and safer. BTW, turning this into a module is a cinch. See
the doc.