POSIX threads id

[dadv]

При написании перлового кода для модуля dhcp в freeradius 2.x столкнулся с тем, что в таком коде threads->tid не может использоваться для идентификации отдельных тредов в логах, у всех тредов одно значение. К счастью, есть ещё thread ids (tid) уровня ядра и теоретически можно идентифицировать треды ими.

Практически, потратив полдня на гугление, не нашел ни единого готового способа получить перловому потоку свой собственный POSIX thread id. Отчаявшись, решил разобраться, как пишутся XS-модули для Perl (модули, вызывающие предкомпилированный код на C) и на этом пути понял, почему не нашел готового модуля. Оказывается, в POSIX threads просто нет функции, которая возвращала бы этот id. В AIX и в FreeBSD, начиная с __FreeBSD_version >= 900031, есть non-POSIX функция pthread_getthreadid_np(), возвращающая этот tid в виде int.

В FreeBSD этот tid хранится в первом поле struct pthread в виде long, но к сожалению, эта структура является "непрозрачной" (opaque), её определение недоступно приложениям, скрыто внутри libthr (текущая реализация pthreads) и для FreeBSD 8 и более ранних версий тред не имеет API для получения своего tid, а только может вызвать функцию pthread_self(), возвращающую pthread_t - указатель на struct pthread. В этом случае пришлось использовать работающий, но грязный хак в виде *((long*)pthread_self())

Микро-модуль Pthreads.xs, предоставляющий единственную функцию Pthreads::getthreadid_np, получился таким:

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

#include <osreldate.h>
#include <pthread.h>
#include <pthread_np.h>

MODULE = Pthreads PACKAGE = Pthreads

long getthreadid_np()
  CODE:
#if __FreeBSD_version >= 900031
    RETVAL = (long) pthread_getthreadid_np();
#else
    /* dirty hack for FreeBSD 8 and earlier missing pthread_getthreadid_np() */
    RETVAL = *((long*)pthread_self());
#endif

  OUTPUT:
    RETVAL

Вдобавок этому файлу ещё два, Pthreads.pm:

package Pthreads;

use 5.008;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );
our $VERSION = '0.01';

require XSLoader;
XSLoader::load('Pthreads', $VERSION);

# Preloaded methods go here.

1;
__END__
# Below is the stub of documentation.

И Makefile.PL:

use ExtUtils::MakeMaker;

WriteMakefile(
  NAME => 'Pthreads',
  VERSION_FROM => 'Pthreads.pm',        # finds $VERSION
  LIBS => ['-lpthread'],                # e.g., '-lm'
  DEFINE => '',                         # e.g., '-DHAVE_SOMETHING'
  INC => '',                            # e.g., '-I/usr/include/other'
);

Дальше как обычно: perl Makefile.PL && make && make install. И уже в целевом скрипте:

require 5.10.0;
use threads;
use Try::Tiny;
our $systid = 0;

sub CLONE_SKIP {
  try {
    require Pthreads;
    $systid = Pthreads::getthreadid_np();
  };
  ...
  syslog(LOG_DEBUG, "thread $systid CLONE_SKIP started") if $systid;
  return 0;
}

В итоге всё заработало.