sendmsg/recvmsg with Perl (on Linux)

Powered by Drupal
Submitted by raf on Thu, 05/22/2008 - 09:29
sendmsg and recvmsg are not builtin in to Perl. The fact that they take complex structures is a good reason not to include it. But sometimes you want to do more complex things, for example pass filedescriptors over Unix sockets. CPAN has some modules (Socket::PassAccessRights and File::FDpasser), but they require you to compile code for each different platform. Can this be done in pure Perl? There are two problems to overcome: creating the iovec, msghdr and cmsghdr structures and initiating the syscalls. With a little help from perlpacktut it is not that difficult to figure out how to make pointers from Perl. To help with unpack, we include the length of the pointed to structure in the pack template (ignored by pack). We can easily write the three structures out has pack templates:
use constant BUFLEN => 128;

# iov: iov_base, iov_len
use constant IOV_PACK => 'P'.BUFLEN.'L!';
use constant IOV_LEN => length(pack(IOV_PACK, 0, 0));

# cmsghdr: cmsg_len, cmsg_level, cmsg_type
use constant CMSGHDR_PACK => 'L!iii';
use constant CMSGHDR_LEN => length(pack(CMSGHDR_PACK, 0, 0, 0, 0, 0));

# msghdr: msg_name, msg_namelen, msg_iov, msg_iovlen,
# msg_control, msg_controllen, msg_flags
use constant MSGHDR_PACK => 'PL!P'.IOV_LEN.'L!P'.CMSGHDR_LEN.'L!i';
Note the use of L! to get native longs (32 or 64 bit depending on the platform). Further, be careful to not let the pointed to objects go out of scope before you are done using the pointer, otherwise you get memory errors. sendmsg/recvmsg were easy on amd64 platform: use Perl's syscall function together with the call numbers:
require 'sys/syscall.ph';
if ($Config{osname} eq 'linux' && $Config{archname} =~ /x86_64/) {
        eval 'sub sendmsg { syscall(SYS_sendmsg, @_) }';
        eval 'sub recvmsg { syscall(SYS_recvmsg, @_) }';
}
It took me a bit more time to figure out that there are no such syscall on i386. Instead, we need to use the socketcall multiplexer. socketcall expects that the arguments to the real syscall are wrapped up in an array:
elsif ($Config{osname} eq 'linux' && $Config{archname} =~ /i486/) {
        eval 'sub sendmsg { syscall(SYS_socketcall, 16, pack("iPi", @_)) }';
        eval 'sub recvmsg { syscall(SYS_socketcall, 17, pack("iPi", @_)) }';
}