Hi,
On Sun, May 18, 2014 at 07:24:25PM +0200, Guillem Jover wrote:
> Well, I think going for now with the pure perl version would solve
> our immediate problem, we could go over the rest separately. I just
> mentioned it now because it would avoid dropping an then having to
> reintroduce the XS code again.
Fine. I'm in the process of doing some clean-up and will send
it wen done.
> > a) add File::FcntlLock in XS form directly as Dpkg::Lock (or
> > a simplified version since obviously only locks on whole
> > files are required)
> > b) add the pure Perl version
> > c) add a version that is modified so that it determines the lay-
> > out of the C flock struct somewhere in a BEGIN block by com-
> > piling and running a C program and then using its output (as
> > I can see libdpkg-perl requires the availability of a C com-
> > piler). I'd write that for you if you like.
>
> Because the File::FcntlLock module is generally useful, I'd rather see
> it improved, instead of forking a local copy for dpkg-dev alone. I don't
> think option c) would solve the issue I described, though.
Wouldn't it? It always evaluates the C flock struct whenever
'use'd, so it should get it right on the system used, even if
the C fcntl(2) function should be modified. And if there's a
new Perl version will update the dpkg-dev package and with
this a Dpkg::FcntlLock submodule, wouldn't you? Well, as I
said, all this is a bit above my level;-) But since I just
got it finished and it seems to work I'll append it anyway.
(I pared it back a bit to make it smaller, so it may now be
a bit easier to read, and it's just a single .pm file meant
to be dropped into the scripts/Dpkg directory of dpkg.)
> I think the conventional way of doing what I was proposing might be:
>
> * Create a File::FcntlLock::XS module that loads the XS code,
> which would only contain C_fcntl_lock.
> * Either create another module, say File::FcntlLock::Perl or ::Pure
> or similar name with the pure perl implementation, or embed the pure
> perl code in the File::FcntlLock module at build time. The former
> would in addition get rid of your CPAN upload concerns, as you could
> ship the .pm module normally.
> * In File::FcntlLock decide which implementation to use depending on
> File::FcntlLock::XS being available or not through an evaled require.
> * Then in Debian the File::FcntlLock::XS and corresponding .so file
> could be split into a different package.
>
> Hope that clarifies.
Yes, I guess so. Give me a bit of time for this. The build process
could be a bit more tricky, though;-)
Best regards, Jens
--
\ Jens Thoms Toerring ________ j...@toerring.de
\_______________________________ http://toerring.de
# -*- cperl -*-
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Copyright (C) 2002-2014 Jens Thoms Toerring <j...@toerring.de>
package File::FcntlLock;
use v5.6.1;
use strict;
use warnings;
use Fcntl;
use POSIX;
use Errno;
use Carp;
use Config;
use File::Temp qw/ /;
use File::Spec;
require Exporter;
our @ISA = qw( Exporter );
# Items to export into callers namespace by default.
our @EXPORT = qw( F_GETLK F_SETLK F_SETLKW
F_RDLCK F_WRLCK F_UNLCK
SEEK_SET SEEK_CUR SEEK_END );
our $VERSION = '0.15';
my ( $packstr, @member_list );
###########################################################
BEGIN {
# Create a C file in the prefered directory for temporary files for
# probing the layout of the C 'flock struct'. Since __DATA__ can't
# be used in a BEGIN block we've got to do this via a HEREDOC.
my $c_file = File::Temp->new( TEMPLATE => 'File_FcntlLock-XXXXXX',
SUFFIX => '.c',
DIR => File::Spec->tmpdir( ) );
print $c_file <<EOF;
#include <stdio.h>
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
#include <limits.h>
#define membersize( type, member ) ( sizeof( ( ( type * ) NULL )->member ) )
#define NUM_ELEMS( p ) ( sizeof p / sizeof *p )
typedef struct {
const char * name;
size_t size;
size_t offset;
} Params;
/*-------------------------------------------------*
* Called from qsort() for sorting an array of Params structures
* in ascending order of their 'offset' members
*-------------------------------------------------*/
static int
comp( const void * a,
const void * b )
{
if ( a == b )
return 0;
return ( ( Params * ) a )->offset < ( ( Params * ) b )->offset ? -1 : 1;
}
/*-------------------------------------------------*
*-------------------------------------------------*/
int
main( void )
{
Params params[ ] = { { "l_type",
CHAR_BIT * membersize( struct flock, l_type ),
CHAR_BIT * offsetof( struct flock, l_type ) },
{ "l_whence",
CHAR_BIT * membersize( struct flock, l_whence ),
CHAR_BIT * offsetof( struct flock, l_whence ) },
{ "l_start",
CHAR_BIT * membersize( struct flock, l_start ),
CHAR_BIT * offsetof( struct flock, l_start ) },
{ "l_len",
CHAR_BIT * membersize( struct flock, l_len ),
CHAR_BIT * offsetof( struct flock, l_len ) },
{ "l_pid",
CHAR_BIT * membersize( struct flock, l_pid ),
CHAR_BIT * offsetof( struct flock, l_pid ) } };
size_t size = CHAR_BIT * sizeof( struct flock );
size_t i;
size_t pos = 0;
char packstr[ 128 ] = "";
/* All sizes and offsets must be divisable by 8 and the sizes of the
members must be either 8-, 16-, 32- or 64-bit values, otherwise
there's no good way to pack them. */
if ( size % 8 )
exit( EXIT_FAILURE );
size /= 8;
for ( i = 0; i < NUM_ELEMS( params ); ++i )
{
if ( params[ i ].size % 8
|| params[ i ].offset % 8
|| ( params[ i ].size != 8
&& params[ i ].size != 16
&& params[ i ].size != 32
&& params[ i ].size != 64 ) )
exit( EXIT_FAILURE );
params[ i ].size /= 8;
params[ i ].offset /= 8;
}
/* Sort the array of structures for the members in ascending order of
the offset */
qsort( params, NUM_ELEMS( params ), sizeof *params, comp );
/* Cobble together the template string to be passed to pack(), taking
care of padding and also extra members we're not interested in. All
the interesting members have signed integer types. */
for ( i = 0; i < NUM_ELEMS( params ); ++i )
{
if ( pos != params[ i ].offset )
sprintf( packstr + strlen( packstr ), "x%lu",
( unsigned long )( params[ i ].offset - pos ) );
pos = params[ i ].offset;
switch ( params[ i ].size )
{
case 1 :
strcat( packstr, "c" );
break;
case 2 :
strcat( packstr, "s" );
break;
case 4 :
strcat( packstr, "l" );
break;
case 8 :
strcat( packstr, "q" );
break;
default :
exit( EXIT_FAILURE );
}
pos += params[ i ].size;
}
if ( pos < size )
sprintf( packstr + strlen( packstr ), "x%lu",
(unsigned long ) ( size - pos ) );
printf( "%s\\n", packstr );
for ( i = 0; i < NUM_ELEMS( params ); ++i )
printf( "%s\\n", params[ i ].name );
return 0;
}
EOF
# Try to compile the file. We close the resulting executable file since
# it can't be run while it's still open,
my $exec_file = File::Temp->new( TEMPLATE => 'File_FcntlLock-XXXXXX',
DIR => File::Spec->tmpdir( ) );
close $exec_file;
die "Failed to run the C compiler '$Config{cc}'\n"
if system "$Config{cc} -o $exec_file $c_file";
# Run the program and read it's output, it writes out the template string
# we need for packing and unpacking the binart C struct flock required for
# fcntk() and then the members of the structures in the sequence they are
# defined in there.
open my $pipe, '-|', $exec_file
or die "Failed to run a compiled program: $!\n";
chomp( $packstr = <$pipe> );
while ( <$pipe> ) {
chomp;
push @member_list, $_;
}
# Make sure we got all information needed
die "Failed to obtain all needed data about the C struct flock\n"
unless @member_list == 5;
}
###########################################################
sub new {
my $inv = shift;
my $pkg = ref( $inv ) || $inv;
my $self = { l_type => F_RDLCK,
l_whence => SEEK_SET,
l_start => 0,
l_len => 0,
l_pid => 0 };
if ( @_ % 2 ) {
carp "Missing value in key-value initializer list " .
"in call of new method";
return;
}
while ( @_ ) {
my $key = shift;
no strict 'refs';
unless ( defined &$key ) {
carp "Flock structure has no '$key' member " .
"in call of new method";
return;
}
&$key( $self, shift );
use strict 'refs';
}
bless $self, $pkg;
}
###########################################################
sub l_type {
my $flock_struct = shift;
if ( @_ ) {
my $l_type = shift;
unless ( $l_type == F_RDLCK
or $l_type == F_WRLCK
or $l_type == F_UNLCK ) {
carp "Invalid argument in call of l_type method";
return;
}
$flock_struct->{ l_type } = $l_type;
}
return $flock_struct->{ l_type };
}
###########################################################
sub l_whence {
my $flock_struct = shift;
if ( @_ ) {
my $l_whence = shift;
unless ( $l_whence == SEEK_SET
or $l_whence == SEEK_CUR
or $l_whence == SEEK_END ) {
carp "Invalid argument in call of l_whence method";
return;
}
$flock_struct->{ l_whence } = $l_whence;
}
return $flock_struct->{ l_whence };
}
###########################################################
sub l_start {
my $flock_struct = shift;
$flock_struct->{ l_start } = shift if @_;
return $flock_struct->{ l_start };
}
###########################################################
sub l_len {
my $flock_struct = shift;
$flock_struct->{ l_len } = shift if @_;
return $flock_struct->{ l_len };
}
###########################################################
sub l_pid {
return shift->{ l_pid };
}
###########################################################
sub lock {
my ( $flock_struct, $fh, $action ) = @_;
my $buf = pack_flock( $flock_struct );
my $ret = fcntl( $fh, $action, $buf );
unpack_flock( $flock_struct, $buf ) if $ret;
return $ret;
}
###########################################################
# Method for packing the data from the 'flock_struct' into a
# binary blob to be passed to fcntl().
sub pack_flock {
my $fs = shift;
my @args;
push @args, $fs->{ $_ } for @member_list;
return pack $packstr, @args;
}
###########################################################
# Method for unpacking the binary blob received from a call of
# fcntl() into the 'flock_struct'.
sub unpack_flock {
my ( $fs, $data ) = @_;
my @res = unpack $packstr, $data;
my $i = 0;
$fs->{ $_ } = $res[ $i++ ] for @member_list;
}
=cut
1;
