Tuesday, August 9, 2011

Clearing my mental hang-ups about Perl

The script below does some simple things to demonstrate to myself how a number of things work in Perl. Simple things, but ones that I sometimes have to stop and think twice about.

use Config::Auto;

# Test Config::Auto output, which should be a reference
my $ca = Config::Auto->new(
source => "test.conf",
format => "equal"
);

my $config = $ca->parse;

print "\$config is a " . ref($config) . " reference\n" if (ref $config);
print "c_one undefined\n" unless (defined $config->{'c_one'});
print "c_two undefined\n" unless (defined $config->{'c_two'});
print "c_three undefined\n" unless (defined $config->{'c_three'});
print "c_one non-existent\n" unless (exists $config->{'c_one'});
print "c_two non-existent\n" unless (exists $config->{'c_two'});
print "c_three non-existent\n" unless (exists $config->{'c_three'});


# Test a non-referenced hash
my %harsh=(
'one' => 1,
'two',
);
print "\$harsh is a " . ref($harsh) . " reference\n" if (ref $harsh);
print "one undefined\n" unless (defined $harsh{'one'});
print "two undefined\n" unless (defined $harsh{'two'});
print "three undefined\n" unless (defined $harsh{'three'});
print "one non-existent\n" unless (exists $harsh{'one'});
print "two non-existent\n" unless (exists $harsh{'two'});
print "three non-existent\n" unless (exists $harsh{'three'});

# Test array interpolation
my @array = ("one", "two");
print "\@array interpolated is: @array\n\@array not interpolated is " . @array . "\n\$\#array is $#array\n";

The test.conf file referred to above contains the following:

c_one = 1
c_two =

The following output is generated by the script:

$config is a HASH reference
c_three undefined
c_three non-existent
two undefined
three undefined
three non-existent
@array interpolated is: one two
@array not interpolated is 2
$#array is 1

Thursday, August 4, 2011

Renaming user-defined ZFS properties

Here is a short script I cooked up to rename the namespace of all the ZFS user-defined properties on a host. Useful if you need to change com.foo:beans to com.bar:beans for more than a couple of properties on a couple of filesystems.

#!/usr/local/bin/perl

#
# This script looks at the properties for every zfs filesystem and snapshot on
# a server and changes every occurance of a property in in namespace $old to
# namespace $old.
#

use strict;

my ($old, $new) = ("com.foo", "com.bar");
my $overwrite = "yes"; # overwrite existing $new properties
my $localonly = "yes"; # do not move inherited properties

for my $fs ( `zfs list -Ho name` ) {
chomp $fs;
&do_rename($fs);
}

for my $snap ( `zfs list -Ho name -t snapshot` ) {
chomp $snap;
&do_rename($snap);
}

sub do_rename {
#print "Renaming $old to $new on $_[0]\n";
# get list of properties with $old
for my $prop ( `zfs get -Ho property,source,value all $_[0] | grep $old` ) {
$prop =~ m/$old:([a-z._:][a-z.\-_:]*)\t([a-z0-9\/\- ]+)\t(.*)\n/;
#print "Examining property $old:$1 on $_[0] with value $3\n";
my ($suffix, $value) = ($1, $3);
# local check, if enabled
next if (( $localonly eq "yes" ) and ( $2 ne "local" ));
next if (( $overwrite eq "no" ) and ( &check_exists($_[0],"$old:$suffix") == 0 ));
print "Setting $new:$suffix=$value and inheriting (erasing) $old:$suffix on $_[0]\n";
( system("zfs set $new:$suffix=$value $_[0]") == 0 ) or die "Error during zfs set operation";
( system("zfs inherit $old:$suffix $_[0]") == 0 ) or die "Error during zfs inherit operation";
}
}

sub check_exists {
# Return 0 if the specified property [1] exists on object [0]
if ( system("zfs get -Ho value $_[1] $_[0] | grep -qE '^-\$'") == 0 ) {
# DNE
return 1;
} else {
print "$_[1] exists on $_[0]!\n";
return 0;
}
}

Monday, August 1, 2011

Undocumented zfs command

In the process of tracking down a ZFS mount problem (btw, a zpool will not mount automatically if the mount point exists), I realized that my ZFS swap volume was not available to FreeBSD. After some poking around, I found the /etc/rc.d/zvol script, which led me to the 'zfs volinit' command. This command is not documented in the man page or command usage, but it seems to be the goo that gets volumes going. Also, set the org.freebsd:swap=on property on your swap volume, to have it started automatically by the rc scripts.