Получение размера буфера в Perl через FFI :: Platypus - PullRequest
Новая
       99

Получение размера буфера в Perl через FFI :: Platypus

2 голосов
/ 05 августа 2020

Я использую FFI :: Platypus для вызова функции C. Функция принимает четыре аргумента: две строки, указатель на буфер и размер буфера: 

int helper_getAddr(
    const char *firstName,
    const char *lastName,
    char **address,
    size_t *addressLen);

Я определяю это так через FFI :: Platypus: 

$self->{ffi}->attach( [helper_getAddr => 'get_addr']
    => ['string', 'string', 'string', 'size_t'] => 'int' );

И затем вызывается так: 

my $contents_ptr = malloc 100;
my $size;
my $success = get_addr( "Tom", "Baker", \$contents_ptr, \$size );

Итак, я могу использовать buffer_to_scalar для получения содержимого буфера.

Вызов работает - $success = 0 и $contents_ptr определены - но $size - это не .

Я очень мало работал с C / C ++, поэтому не уверен, что моя проблема в объявлении $size , или если мне нужно изменить мой вызов на get_addr().

В качестве альтернативы, есть ли способ использовать $contents_ptr непосредственно в Perl, чтобы найти длину буфера перед вызовом buffer_to_scalar ?

1 Ответ

2 голосов
/ 05 августа 2020

Следующее неверно: 

[ 'string', 'string', 'string', 'size_t' ]
  • Третий аргумент helper_getAddr не является строкой.
  • Четвертый аргумент helper_getAddr не является size_t.

Прежде чем продолжить, мы должны определить, чего ожидает функция. Это проблема c, потому что аргументы функции не имеют особого смысла.

Если helper_getAddr заполняет существующий буфер, я ожидаю, что 

int helper_getAddr(
   const char *firstName,
   const char *lastName,
   char **address,
   size_t *addressLen
);

Если helper_getAddr выделяет и возвращает строку, я бы ожидал 

char *helper_getAddr(
   const char *firstName,
   const char *lastName
);

или 

int helper_getAddr(
   const char *firstName,
   const char *lastName,
   char **address
);

Помимо лишнего бесполезного аргумента, helper_getAddr больше всего напоминает функцию, которая выделяет и возвращает строку. Итак, я буду исходить из предположения, что helper_getAddr выделяет и возвращает строку.

Учитывая нашу функцию, у нас может возникнуть соблазн использовать следующее: 

$ffi->attach(
   [ 'helper_getAddr' => '_get_addr' ],
   [ 'string', 'string', 'string*', 'size_t*' ],    # XXX
   'int',
);

Проблема в том, что это не дает нам доступа к указателю, который нам нужно освободить. Поэтому мы будем использовать 

$ffi->attach(
   [ 'helper_getAddr' => '_get_addr' ],
   [ 'string', 'string', 'opaque*', 'size_t*' ],
   'int',
);

Простая оболочка придаст функции вид Perl -i sh и обработает освобождение буфера. 

sub get_addr {
   _get_addr($_[0], $_[1], \my $buf, \my $buf_size)
      or return undef;

   my $addr = $ffi->cast('opaque' => 'string', $buf);
   free($buf);
   return $addr;
}
  • Мы не вызываем malloc в Perl, потому что функция просто перезапишет указатель, что приведет к утечке памяти.
  • Приведя буфер к типу string, Platypus :: FFI создаст строка Perl из содержимого возвращаемого буфера с завершающим NUL, поэтому нет необходимости и в buffer_to_scalar.

Пример использования: 

say get_addr("Tom", "Baker") // "[undef]";

Полное решение следует .

lookup

#!/home/ikegami/usr/perlbrew/perls/5.32.0t/bin/perl

use strict;
use warnings;
use feature qw( say state );

use FindBin qw( $RealBin );

use FFI::Platypus         qw( );
use FFI::Platypus::Memory qw( free );

my $ffi = FFI::Platypus->new( api => 1 );
$ffi->find_lib(
   lib     => 'lookup',
   libpath => $RealBin,
);

$ffi->attach(
   [ 'get_addr' => '_get_addr' ],
   [ 'string', 'string', 'opaque*', 'size_t*' ],
   'int',
);

sub get_addr {
   _get_addr($_[0], $_[1], \my $buf, \my $buf_size)
      or return undef;

   my $addr = $ffi->cast('opaque' => 'string', $buf);
   free($buf);
   return $addr;
}

say get_addr("Tom", "Baker") // "[undef]";

liblookup.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

int get_addr(
   const char *first_name,
   const char *last_name,
   char **address_ptr,
   size_t *address_size_ptr
) {
   const char *prefix = "Address of ";

   const size_t len_prefix = strlen(prefix);
   const size_t len_f_n    = strlen(first_name);
   const size_t len_l_n    = strlen(last_name);

   *address_size_ptr = len_prefix + len_f_n + 1 + len_l_n + 1;
   *address_ptr = malloc(*address_size_ptr);
   if (!*address_ptr)
      return 0;

   char *p = *address_ptr;
   memmove(p, prefix, len_prefix);   p += len_prefix;
   memmove(p, first_name, len_f_n);  p += len_f_n;
   *p = ' ';                         ++p;
   memmove(p, last_name, len_l_n);   p += len_l_n;
   *p = 0;                           ++p;

   return 1;
}

run

#!/bin/bash
trap 'printf '\''error!\n'\''; exit 1' ERR

script="$( readlink -e -- "$0" )"
script_dir="$( dirname -- "$script" )"
home_dir="$script_dir"
cd "$home_dir"

prog=./lookup

# Use the PATH to locate the program.
prog="$( which -- "$prog" )"

# Use the program's shebang to locate the appropriate perl.
perl="$( perl -ne'chomp; print s/^#!//r; exit;' "$prog" )"

# Extract compiler and linker information from the correct perl.
get_config() { "$perl" -MConfig -e'print $Config{$ARGV[0]}' "$1"; }
cc="$( get_config cc )"
ccflags="$( get_config ccflags )"
optimize="$( get_config optimize )"
cccdlflags="$( get_config cccdlflags )"
ld="$( get_config ld )"
lddlflags="$( get_config lddlflags )"

# Build the shared library.
"$cc" -c $ccflags $optimize $cccdlflags liblookup.c -o liblookup.o
"$ld" $lddlflags liblookup.o -o liblookup.so

# Run our test.
"$prog"
...