what's wrong with my XS code? (long)
Eli the Bearded
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];
} mykey_t;
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}" .
"\N{t}\N{h}\N{e}\N{r} \N{P}\N{e}\N{r}\N{l} \N{H}\N{a}\N{c}\N{k}\N{e}\N{r}"'
Tye McQueen
) 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)
Eli the Bearded
> Eli the Bearded <eli...@workspot.net> writes:
> 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.
Hmmm. Good to know.
> You need to copy the data from the buffer that C<out> now points to
> and then free that buffer:
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()
Eli the Bearded
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
Eli the Bearded wrote:
>
> 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.
--- ~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.