Brad Fitzpatrick (brad) wrote,
Brad Fitzpatrick

Headache, Perl code --- related?

I have a pretty bad headache today. Think it's related to this: ?

Perl code to act like C and do ioctls to get MegaRAID status info from the kernel:

# ./
 Number of adapters: 1
Yes, that's all it does right now.

Source so far:

use strict;
use Getopt::Long;

use POSIX qw(dup2);
use Devel::Peek;

use constant MEGAIOC_QNADAP     => 'm';   # Query # of adapters
use constant MEGAIOC_QDRVRVER   => 'e';   # Query driver version
use constant MEGAIOC_QADAPINFO  => 'g';   # Query driver version

use constant MEGA_IOCTL => 0xc06e6d00;    # rw + length 110 + 'm' + subcode 0

open (D, "/dev/megadev")
    or open (D, "/dev/megadev0")
    or die "No /dev/megadev or /dev/megadev0 device node found.\n";

# this Perl scalar (SV) will be our ioctl read/write struct that we
# pass to/read from the kernel.

my $struct = "\0"x110;

# now we have to find Perl's char* memory address holding the C string
# in $struct above.  the only default thing in Perl that can do this
# is Devel::Peek, which can only write it to stderr.  And at an XS
# layer, not a PerlIO layer, so we can't even tie the filehandle to a
# Perl class.  The only way to capture Devel::Peek's output is to dup2
# the stderr fd to another file, then parse that file.

open (PEEK, ">.megaadm.peek.tmp") or die "couldn't open temp file in current directory";
dup2(fileno(PEEK), 2);  # 2 is stderr
substr($struct,0,6) = "findme";  # something we can search for later
close PEEK;

my $pv_hex;
open (PEEK, ".megaadm.peek.tmp") or die "couldn't open just-created temp file";
while (<PEEK>) {
    $pv_hex = $1 if /0x([\da-f]+).+findme/;
close PEEK;
substr($struct,0,6) = "\0"x6;  # zero out our struct
die "Couldn't get SV's PV value for data pointer." unless $pv_hex;

# Our (32-bit only for now) userspace address we want our results written back to
# Note that "L" is always 4 bytes, host order, and you need "L!" to get the native
# machine's long length

my $data_ptr = pack("L", hex($pv_hex));

# opcode = 0x82, a driver command (not a mailbox command)
substr($struct, 8, 1) = "\x82";

# subopcode
substr($struct, 9, 1) = MEGAIOC_QNADAP;

# set the data field, with the userspace pointer value to write the results back
substr($struct, 110-8, 4) = $data_ptr;

my $rv = ioctl(D, MEGA_IOCTL, "$struct");  # needs to be in quotes, for reasons only partially understood
# print "rv = $rv ($!)\n";

if ($rv > 0) {
    print "\n Number of adapters: $rv\n\n";
} else {
    print "\n Couldn't find number of adapters.\n";

sub dump_struct {
    print "hex: ", join(' ', map { sprintf("%02x", ord($_)) } split //, $struct), "\n";
    print "asc: ", join(' ', map { $_ =~ /[\w ]/ ? " $_" : " ." } split //, $struct), "\n";
Tags: perl, tech

  • Happy Birthday!

    Happy 20th Birthday, LiveJournal! 🐐🎂🎉

  • hi

    Posting from the iPhone app. Maybe I'm unblocked now.

  • Why, hello...

    Long time no see. How's my baby doing?

  • Post a new comment


    default userpic

    Your reply will be screened

    Your IP address will be recorded 

    When you submit the form an invisible reCAPTCHA check will be performed.
    You must follow the Privacy Policy and Google Terms of use.