Log in

No account? Create an account
Headache, Perl code --- related? - brad's life — LiveJournal [entries|archive|friends|userinfo]
Brad Fitzpatrick

[ website | bradfitz.com ]
[ userinfo | livejournal userinfo ]
[ archive | journal archive ]

Headache, Perl code --- related? [Nov. 13th, 2004|05:42 pm]
Brad Fitzpatrick
[Tags|, ]

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:

# ./megadm.pl
 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";

[User Picture]From: mulix
2004-11-14 07:07 am (UTC)
that looks painfull... why not just do the ioctl and a reasonable perlish interface to it in C, and then the glue around it in perl?
(Reply) (Thread)
[User Picture]From: brad
2004-11-14 07:20 am (UTC)
Somebody pointed out pack("P", $scalar) and half the code went away.

It's not that bad in Perl. Less dependencies, the better. I like to just copy scripts around and not build/install them, and I think other sysadmins would appreciate it the easier it was, too.
(Reply) (Parent) (Thread)