view release on metacpan or  search on metacpan

lib/App/Diskd.pm  view on Meta::CPAN

		this_ip        => $ip,
		temp_disk_list => [],
		disks_by_ip    => { $ip => {} },
		update_time    => {},
	       }, $class;
}

sub our_ip { (shift)->{this_ip} }

# We update local disk info in two phases, first creating a list to
# store them, then inserting the list into the live data all at once.
# This is so that we can handle disks being detached from the system
# between runs of blkid.

sub add_our_disk_info {

  my ($self,$uuid,$label,$device) = @_;

  my $listref = $self->{temp_disk_list};

  # As a mnemonic for the order below, remember that UUIDs are more
  # unique than labels, which in turn are more unique than device
  # filenames.
  push @$listref, [$uuid,$label,$device];

}

sub commit_our_disk_info {

  my $self = shift;
  my $ip = $self->{this_ip};

  #warn "comitting new blkid data with " . (0+ @{$self->{temp_disk_list}}) .
  #  " entries\n";

  $self->{update_time}->{$ip} = time();
  $self->{disks_by_ip}->{$ip} = $self->{temp_disk_list};
  $self->{temp_disk_list}     = [];

  # TODO: update "last seen" structures for each disk with a label/uuid.
  # for each structure, map the label/uuid to [ip, timestamp] info.
}

sub known_hosts {
  my $self = shift;
  return keys %{$self->{disks_by_ip}};
}
sub disks_by_host {
  my ($self,$host) = @_;

  #warn "looking up host $host";
  return undef unless exists $self->{disks_by_ip}->{$host};
  return $self->{disks_by_ip}->{$host};
}

#
# The routines used to pack and unpack a list of disks for
# transmission could take any form, really. The key things to consider
# are that (a) arbitrary spoofed data can't result in us introducing
# security issues (so solutions that involve eval'ing the packed data
# are out, unless we validate that the data is in the expected form)
# and (b) we take into consideration quoting issues (such as not using
# spaces as separators, since they may appear in disk labels). As it
# happens, YAML can solve both of these problems for us. It may not
# make best use of space, but at least it's quick and easy to
# implement.
#

use YAML::XS;

# assume that we don't need to pack any disk list except our own
sub pack_our_disk_list {
  my $self = shift;
  my $ip = $self->{this_ip};

  return Dump $self->{disks_by_ip}->{$ip};
}

# unpack incoming list of lists
sub unpack_disk_list {
  my ($self,$host,$yaml) = @_;
  my $ip = $self->{this_ip};

  # We shouldn't get here if the calling routine is doing its job right
  if ($host eq $ip) {
    warn "Fatal: caller requested unpack disk list with our IP address";
    return undef;
  }

  my $objref = Load $yaml;

  # Do some basic type checking on the unpacked object. We expect an
  # array of arrays.
  unless (ref($objref) eq "ARRAY") {
    warn "unpacked disk list is not an ARRAY";
    return undef;

    for (@$objref) {
      unless (ref($_) eq "ARRAY") {
	warn "unpacked disk element is not an ARRAY";
	return undef;
      }
    }
  }

  $self->{update_time}->{$host} = time();

  return $self->{disks_by_ip}->{$host} = $objref;
}

#
# The remaining packages are used simply to achieve a clean separation
# between different POE sessions and to encapsulate related methods
# without having to worry about namespace issues (like ensuring event
# names and handler routines are unique across all sessions). As a
# consequence of having distinct sessions for each program area, when
# we need to have inter-session communication, we need to use POE's
# post method. An alias is also used to identify each of the sessions.
#