From 2ee6113e36b15d91fd11d5f92a135bb5b225b229 Mon Sep 17 00:00:00 2001 From: dormando Date: Tue, 24 May 2011 18:14:20 -0700 Subject: [PATCH] Giant awful patch to enable new object monitoring Both the old code and new code runs in parallel. The patch is mostly awful interspersed with areas of elegance. --- lib/MogileFS/Factory.pm | 1 - lib/MogileFS/Factory/Class.pm | 58 +++++--- lib/MogileFS/NewClass.pm | 1 + lib/MogileFS/NewDevice.pm | 14 +- lib/MogileFS/NewHost.pm | 8 +- lib/MogileFS/ProcManager.pm | 11 +- lib/MogileFS/Server.pm | 9 ++ lib/MogileFS/Util.pm | 41 ++++++ lib/MogileFS/Worker.pm | 7 +- lib/MogileFS/Worker/JobMaster.pm | 16 +-- lib/MogileFS/Worker/Monitor.pm | 292 ++++++++++++++++++++++++++++++++++++++- t/01-domain-class.t | 8 +- 12 files changed, 423 insertions(+), 43 deletions(-) diff --git a/lib/MogileFS/Factory.pm b/lib/MogileFS/Factory.pm index df896ae..089ee4e 100644 --- a/lib/MogileFS/Factory.pm +++ b/lib/MogileFS/Factory.pm @@ -40,7 +40,6 @@ sub get_factory { sub set { my $self = shift; my $obj = shift; - $self->{by_id}->{$obj->id} = $obj; $self->{by_name}->{$obj->name} = $obj; return $obj; diff --git a/lib/MogileFS/Factory/Class.pm b/lib/MogileFS/Factory/Class.pm index a4ec368..5044fcf 100644 --- a/lib/MogileFS/Factory/Class.pm +++ b/lib/MogileFS/Factory/Class.pm @@ -9,15 +9,28 @@ use MogileFS::NewClass; # are not globally unique... uses the same interface. # Stupid/wasteful. sub set { - my ($self, $domain, $args) = @_; + my ($self, $args) = @_; my $domain_factory = MogileFS::Factory::Domain->get_factory; - # FIXME: Inject the dmid into the class somehow. + my $class = MogileFS::NewClass->new_from_args($args, $domain_factory); - $self->{by_id}->{$domain->id}->{$class->id} = $class; - $self->{by_name}->{$domain->id}->{$class->name} = $class; + my $dmid = $class->dmid; + $self->{by_id}->{$dmid}->{$class->id} = $class; + $self->{by_name}->{$dmid}->{$class->name} = $class; return $class; } +# Class factory is very awkward. Lets be very flexible in what we take; a +# domain object + id, a dmid, or a string with dmid-classid. +sub _find_ids { + my $self = shift; + my $dom = shift; + my $dmid = ref $dom ? $dom->id : $dom; + if ($dmid =~ m/^(\d+)-(\d+)$/) { + return $1, $2; + } + return $dmid, @_; +} + # Example of what we could use for testing. # Test creates the object, injects its own factory, then hands it to us. sub set_from_obj { @@ -27,7 +40,7 @@ sub set_from_obj { sub remove { my $self = shift; my $class = shift; - my $domid = $class->domain->id; + my $domid = $class->dmid; my $clsid = $class->id; if (exists $self->{by_id}->{$domid}->{$clsid}) { delete $self->{by_id}->{$domid}->{$clsid}; @@ -36,39 +49,46 @@ sub remove { } sub get_by_id { - my ($self, $domain, $id) = @_; - return $self->{by_id}->{$domain->id}->{$id}; + my $self = shift; + my ($dmid, $id) = $self->_find_ids(@_); + return $self->{by_id}->{$dmid}->{$id}; } sub get_by_name { - my ($self, $domain, $name) = @_; - return $self->{by_name}->{$domain->id}->{$name}; + my $self = shift; + my ($dmid, $name) = $self->_find_ids(@_); + return $self->{by_name}->{$dmid}->{$name}; } sub get_ids { - my ($self, $domain) = @_; - return keys %{$self->{by_id}->{$domain->id}}; + my $self = shift; + my ($dmid) = $self->_find_ids(@_); + return keys %{$self->{by_id}->{$dmid}}; } sub get_names { - my ($self, $domain) = @_; - return keys %{$self->{by_name}->{$domain->id}}; + my $self = shift; + my ($dmid) = $self->_find_ids(@_); + return keys %{$self->{by_name}->{$dmid}}; } sub get_all { - my ($self, $domain) = @_; - return values %{$self->{by_id}->{$domain->id}}; + my $self = shift; + my ($dmid) = $self->_find_ids(@_); + return values %{$self->{by_id}->{$dmid}}; } sub map_by_id { - my ($self, $domain) = @_; - my $set = $self->{by_id}->{$domain->id}; + my $self = shift; + my ($dmid) = $self->_find_ids(@_); + my $set = $self->{by_id}->{$dmid}; return { map { $_ => $set->{$_} } keys %{$set} }; } sub map_by_name { - my ($self, $domain) = @_; - my $set = $self->{by_name}->{$domain->id}; + my $self = shift; + my ($dmid) = $self->_find_ids(@_); + my $set = $self->{by_name}->{$dmid}; return { map { $_ => $set->{$_} } keys %{$set} }; } diff --git a/lib/MogileFS/NewClass.pm b/lib/MogileFS/NewClass.pm index 5bcf050..059c78a 100644 --- a/lib/MogileFS/NewClass.pm +++ b/lib/MogileFS/NewClass.pm @@ -23,6 +23,7 @@ sub new_from_args { sub id { $_[0]{classid} } sub name { $_[0]{classname} } sub mindevcount { $_[0]{mindevcount} } +sub dmid { $_[0]{dmid} } sub repl_policy_string { my $self = shift; diff --git a/lib/MogileFS/NewDevice.pm b/lib/MogileFS/NewDevice.pm index bdae2eb..ce88a37 100644 --- a/lib/MogileFS/NewDevice.pm +++ b/lib/MogileFS/NewDevice.pm @@ -16,8 +16,9 @@ BEGIN { eval "sub TESTING () { $testing }"; } -my @fields = qw/hostid status weight observed_state mb_total mb_used mb_asof -utilization devid/; +my @observed_fields = qw/observed_state utilization/; +my @fields = (qw/hostid status weight mb_total mb_used mb_asof devid/, + @observed_fields); sub new_from_args { my ($class, $args, $host_factory) = @_; @@ -26,10 +27,11 @@ sub new_from_args { %{$args}, }, $class; - $self->host || die "No host for $self->{devid} (host $self->{hostid})"; + # FIXME: No guarantee (as of now?) that hosts get loaded before devs. + #$self->host || die "No host for $self->{devid} (host $self->{hostid})"; croak "invalid device observed state '$self->{observed_state}', valid: writeable, readable, unreachable" - if $self->{observed_state} !~ /^(?:writeable|readable|unreachable)$/; + if $self->{observed_state} && $self->{observed_state} !~ /^(?:writeable|readable|unreachable)$/; return $self; } @@ -85,6 +87,10 @@ sub fields { return $ret; } +sub observed_fields { + return $_[0]->fields(@observed_fields); +} + sub observed_utilization { my $self = shift; diff --git a/lib/MogileFS/NewHost.pm b/lib/MogileFS/NewHost.pm index a39646c..71970c2 100644 --- a/lib/MogileFS/NewHost.pm +++ b/lib/MogileFS/NewHost.pm @@ -13,7 +13,9 @@ MogileFS::NewHost - host class =cut # Centralized here instead of three places. -my @fields = qw/hostid hostname hostip status http_port http_get_port altip altmask/; +my @observed_fields = qw/observed_state/; +my @fields = (qw/hostid hostname hostip status http_port http_get_port altip altmask/, + @observed_fields); # TODO: Validate a few things: state, observed state. sub new_from_args { @@ -64,6 +66,10 @@ sub fields { return { map { $_ => $self->{$_} } @tofetch }; } +sub observed_fields { + return $_[0]->fields(@observed_fields); +} + sub should_get_new_files { return $_[0]->status eq 'alive'; } diff --git a/lib/MogileFS/ProcManager.pm b/lib/MogileFS/ProcManager.pm index 1e8d7a5..224e1a0 100644 --- a/lib/MogileFS/ProcManager.pm +++ b/lib/MogileFS/ProcManager.pm @@ -6,6 +6,7 @@ use Symbol; use Socket; use MogileFS::Connection::Client; use MogileFS::Connection::Worker; +use MogileFS::Util qw(apply_state_events); # This class handles keeping lists of workers and clients and # assigning them to each other when things happen. You don't actually @@ -682,6 +683,14 @@ sub HandleChildRequest { } elsif ($cmd eq ":still_alive") { # a no-op + } elsif ($cmd =~ /^:monitor_events/) { + # Apply the state locally, so when we fork children they have a + # pre-parsed factory. + # Also replay the event back where it came, so the same mechanism + # applies and uses local changes. + apply_state_events(\$cmd); + MogileFS::ProcManager->send_to_all_children($cmd); + } elsif ($cmd eq ":monitor_just_ran") { send_monitor_has_run($child); @@ -819,7 +828,7 @@ sub send_to_all_children { my ($pkg, $msg, $exclude) = @_; foreach my $child (values %child) { next if $exclude && $child == $exclude; - $child->write("$msg\r\n"); + $child->write($msg . "\r\n"); } } diff --git a/lib/MogileFS/Server.pm b/lib/MogileFS/Server.pm index 60b4340..2bb9de9 100644 --- a/lib/MogileFS/Server.pm +++ b/lib/MogileFS/Server.pm @@ -64,6 +64,15 @@ use MogileFS::Worker::Monitor; use MogileFS::Worker::Fsck; use MogileFS::Worker::JobMaster; +use MogileFS::Factory::Domain; +use MogileFS::Factory::Class; +use MogileFS::Factory::Host; +use MogileFS::Factory::Device; +use MogileFS::NewDomain; +use MogileFS::NewClass; +use MogileFS::NewHost; +use MogileFS::NewDevice; + use MogileFS::HTTPFile; use MogileFS::Class; use MogileFS::Device; diff --git a/lib/MogileFS/Util.pm b/lib/MogileFS/Util.pm index d6d6a48..e908e92 100644 --- a/lib/MogileFS/Util.pm +++ b/lib/MogileFS/Util.pm @@ -11,8 +11,44 @@ our @EXPORT_OK = qw( error undeferr debug fatal daemonize weighted_list every wait_for_readability wait_for_writeability throw error_code max min first okay_args device_state eurl decode_url_args + encode_url_args apply_state_events ); +# Applies monitor-job-supplied state events against the factory singletons. +# Sad this couldn't be an object method, but ProcManager doesn't base off +# anything common. +sub apply_state_events { + my @events = split(/\s/, ${$_[0]}); + shift @events; # pop the :monitor_events part + + # This will needlessly fetch domain/class/host most of the time. + # Maybe replace with something that "caches" factories? + my %factories = ( 'domain' => MogileFS::Factory::Domain->get_factory, + 'class' => MogileFS::Factory::Class->get_factory, + 'host' => MogileFS::Factory::Host->get_factory, + 'device' => MogileFS::Factory::Device->get_factory, ); + + for my $ev (@events) { + my $args = decode_url_args($ev); + my $mode = delete $args->{ev_mode}; + my $type = delete $args->{ev_type}; + my $id = delete $args->{ev_id}; + + my $old = $factories{$type}->get_by_id($id); + if ($mode eq 'setstate') { + # Host/Device only. + # FIXME: Make objects slightly mutable and directly set fields? + $factories{$type}->set({ %{$old->fields}, %$args }); + } elsif ($mode eq 'set') { + # Re-add any observed data. + my $observed = $old ? $old->observed_fields : {}; + $factories{$type}->set({ %$args, %$observed }); + } elsif ($mode eq 'remove') { + $factories{$type}->remove($old) if $old; + } + } +} + sub every { my ($delay, $code) = @_; my ($worker, $psock_fd); @@ -255,6 +291,11 @@ sub eurl { return $a; } +sub encode_url_args { + my $args = shift; + return join('&', map { eurl($_) . "=" . eurl($args->{$_}) } keys %$args); +} + sub decode_url_args { my $a = shift; my $buffer = ref $a ? $a : \$a; diff --git a/lib/MogileFS/Worker.pm b/lib/MogileFS/Worker.pm index d432a3a..75a1534 100644 --- a/lib/MogileFS/Worker.pm +++ b/lib/MogileFS/Worker.pm @@ -11,7 +11,7 @@ use fields ('psock', # socket for parent/child communications 'queue_todo', # aref of hrefs of work sent from parent ); -use MogileFS::Util qw(error eurl decode_url_args); +use MogileFS::Util qw(error eurl decode_url_args apply_state_events); use MogileFS::Server; use vars ( @@ -263,6 +263,11 @@ sub process_generic_command { return 1; } + if ($$lineref =~ /^:monitor_events/) { + apply_state_events($lineref); + return 1; + } + if ($$lineref =~ /^:monitor_has_run/) { $self->{monitor_has_run} = 1; return 1; diff --git a/lib/MogileFS/Worker/JobMaster.pm b/lib/MogileFS/Worker/JobMaster.pm index 3d3663d..b9c2f66 100644 --- a/lib/MogileFS/Worker/JobMaster.pm +++ b/lib/MogileFS/Worker/JobMaster.pm @@ -12,7 +12,7 @@ use fields ( 'dele_queue_limit', 'rebl_queue_limit', ); -use MogileFS::Util qw(every error debug eurl); +use MogileFS::Util qw(every error debug encode_url_args); use MogileFS::Config; use constant DEF_FSCK_QUEUE_MAX => 20_000; @@ -72,7 +72,7 @@ sub _check_delete_queues { return unless @to_del; for my $todo (@to_del) { $self->send_to_parent("queue_todo delete " . - _eurl_encode_args($todo)); + encode_url_args($todo)); } return 1; } @@ -101,7 +101,7 @@ sub _check_replicate_queues { for my $todo (@to_repl) { $todo->{_type} = 'replicate'; # could be 'drain', etc. $self->send_to_parent("queue_todo replicate " . - _eurl_encode_args($todo)); + encode_url_args($todo)); } return 1; } @@ -130,7 +130,7 @@ sub _check_fsck_queues { $self->{fsck_queue_limit} = @to_fsck ? $new_limit : 100; return unless @to_fsck; for my $todo (@to_fsck) { - $self->send_to_parent("queue_todo fsck " . _eurl_encode_args($todo)); + $self->send_to_parent("queue_todo fsck " . encode_url_args($todo)); } return 1; } @@ -183,7 +183,7 @@ sub _check_rebal_queues { return unless @to_rebal; for my $todo (@to_rebal) { $todo->{_type} = 'rebalance'; - $self->send_to_parent("queue_todo rebalance " . _eurl_encode_args($todo)); + $self->send_to_parent("queue_todo rebalance " . encode_url_args($todo)); } return 1; } @@ -274,12 +274,6 @@ sub queue_depth_check { return (0, $limit); } -# TODO: Move this into Util.pm? -sub _eurl_encode_args { - my $args = shift; - return join('&', map { eurl($_) . "=" . eurl($args->{$_}) } keys %$args); -} - 1; # Local Variables: diff --git a/lib/MogileFS/Worker/Monitor.pm b/lib/MogileFS/Worker/Monitor.pm index 073a1c8..ba7a68b 100644 --- a/lib/MogileFS/Worker/Monitor.pm +++ b/lib/MogileFS/Worker/Monitor.pm @@ -10,11 +10,14 @@ use fields ( 'seen_hosts', # IP -> 1 (reset every loop) 'ua', # LWP::UserAgent for checking usage files 'iow', # MogileFS::IOStatWatcher object + 'prev_data', # DB data from previous run + 'devutil', # Running tally of device utilization + 'events', # Queue of state events ); use Danga::Socket 1.56; use MogileFS::Config; -use MogileFS::Util qw(error debug); +use MogileFS::Util qw(error debug encode_url_args); use MogileFS::IOStatWatcher; use constant UPDATE_DB_EVERY => 15; @@ -27,6 +30,10 @@ sub new { $self->{last_db_update} = {}; $self->{last_test_write} = {}; $self->{iow} = MogileFS::IOStatWatcher->new; + $self->{prev_data} = { domain => {}, class => {}, host => {}, + device => {} }; + $self->{devutil} = { cur => {}, prev => {} }; + $self->{events} = []; return $self; } @@ -49,6 +56,7 @@ sub work { # Lets not propagate devices that we accidentally find. # This does hit the DB every time a device does not exist, so # perhaps should add negative caching in the future. + $self->{devutil}->{cur}->{$devid} = $util; my $dev = MogileFS::Device->of_devid($devid); next unless $dev->exists; $dev->set_observed_utilization($util); @@ -85,11 +93,176 @@ sub work { }; $main_monitor->(); + + my $db_monitor; + $db_monitor = sub { + $self->parent_ping; + print STDERR "New monitor for db data running\n"; + $self->validate_dbh; + + my $new_data = {}; + my $prev_data = $self->{prev_data}; + my $db_data = $self->grab_all_data; + + # Stack this up to ship back later. + my @events = (); + $self->diff_data($db_data, $prev_data, $new_data, \@events); + + $self->{prev_data} = $new_data; + $self->send_events_to_parent; + Danga::Socket->AddTimer(10, $db_monitor); + print STDERR "New monitor for db finished\n"; + }; + + $db_monitor->(); + # FIXME: Add a "read_from_parent" to ensure we pick up the response for + # populating the factories? + #$self->read_from_parent; + + my $new_monitor; + $new_monitor = sub { + $self->parent_ping; + print STDERR "New monitor running\n"; + $self->validate_dbh; + + my $dev_factory = MogileFS::Factory::Device->get_factory(); + + my $cur_iow = {}; + my @events = (); + # Run check_devices2 to test host/devs. diff against old values. + for my $dev ($dev_factory->get_all) { + if (my $state = $self->is_iow_diff($dev)) { + $self->state_event('device', $dev->id, {utilization => $state}); + } + $cur_iow->{$dev->id} = $self->{devutil}->{cur}->{$dev->id}; + $self->check_device2($dev, \@events); + } + + $self->{devutil}->{prev} = $cur_iow; + # Set the IOWatcher hosts (once old monitor code has been disabled) + + $self->send_events_to_parent; + Danga::Socket->AddTimer(2.5, $new_monitor); + print STDERR "New monitor finished\n"; + }; + + $new_monitor->(); Danga::Socket->EventLoop; } # -------------------------------------------------------------------------- +# Flattens and flips events up to the parent. Can be huge on startup! +# Events: set type foo=bar&baz=quux +# remove type id +# setstate type id foo=bar&baz=quux +# Combined: ev_mode=set&ev_type=device&foo=bar +# ev_mode=setstate&ev_type=device&ev_id=1&foo=bar +sub send_events_to_parent { + my $self = shift; + my @flat = (); + for my $ev (@{$self->{events}}) { + my ($mode, $type, $args) = @$ev; + $args->{ev_mode} = $mode; + $args->{ev_type} = $type; + push(@flat, encode_url_args($args)); + } + return unless @flat; + $self->{events} = []; + print STDERR "SENDING STATE CHANGES ", join(' ', ':monitor_events', @flat), "\n"; + $self->send_to_parent(join(' ', ':monitor_events', @flat)); +} + +sub add_event { + push(@{$_[0]->{events}}, $_[1]); +} + +sub set_event { + # Allow callers to use shorthand + $_[3]->{ev_id} = $_[2]; + $_[0]->add_event(['set', $_[1], $_[3]]); +} +sub remove_event { $_[0]->add_event(['remove', $_[1], { ev_id => $_[2] }]); } +sub state_event { + $_[3]->{ev_id} = $_[2]; + $_[0]->add_event(['setstate', $_[1], $_[3]]); +} + +sub is_iow_diff { + my ($self, $dev) = @_; + my $devid = $dev->id; + my $p = $self->{devutil}->{prev}->{$devid}; + my $c = $self->{devutil}->{cur}->{$devid}; + if ( ! defined $p || $p ne $c ) { + return $c; + } + return undef; +} + +sub diff_data { + my ($self, $db_data, $prev_data, $new_data, $ev) = @_; + + for my $type (keys %{$db_data}) { + my $d_data = $db_data->{$type}; + my $p_data = $prev_data->{$type}; + my $n_data = {}; + + for my $item (@{$d_data}) { + my $id = $type eq 'domain' ? $item->{dmid} + : $type eq 'class' ? $item->{dmid} . '-' . $item->{classid} + : $type eq 'host' ? $item->{hostid} + : $type eq 'device' ? $item->{devid} : die "Unknown type"; + my $old = delete $p_data->{$id}; + # Special case: for devices, we don't care if mb_asof changes. + # FIXME: Change the grab routine (or filter there?). + delete $item->{mb_asof} if $type eq 'device'; + if (!$old || $self->diff_hash($old, $item)) { + $self->set_event($type, $id, { %$item }); + } + $n_data->{$id} = $item; + } + for my $id (keys %{$p_data}) { + $self->remove_event($type, $id); + } + + $new_data->{$type} = $n_data; + } +} + +# returns 1 if the hashes are different. +sub diff_hash { + my ($self, $old, $new) = @_; + + my %keys = (); + map { $keys{$_}++ } keys %$old, keys %$new; + for my $k (keys %keys) { + return 1 unless ((exists $old->{$k} && + exists $new->{$k}) && + ( (! defined $old->{$k} && ! defined $new->{$k}) || + ($old->{$k} eq $new->{$k}) ) + ); + } + return 0; +} + +sub grab_all_data { + my $self = shift; + my $sto = Mgd::get_store(); + + # Normalize the domain data to the rest to simplify the differ. + # FIXME: Once new objects are swapped in, fix the original + my %dom = $sto->get_all_domains; + my @fixed_dom = (); + while (my ($name, $id) = each %dom) { + push(@fixed_dom, { namespace => $name, dmid => $id }); + } + my %ret = ( domain => \@fixed_dom, + class => [$sto->get_all_classes], + host => [$sto->get_all_hosts], + device => [$sto->get_all_devices], ); + return \%ret; +} + sub ua { my $self = shift; return $self->{ua} ||= LWP::UserAgent->new( @@ -98,6 +271,123 @@ sub ua { ); } +sub check_device2 { + my ($self, $dev, $ev) = @_; + + my $devid = $dev->id; + my $host = $dev->host; + + my $port = $host->http_port; + my $get_port = $host->http_get_port; # || $port; + my $hostip = $host->ip; + my $url = $dev->usage_url; + + $self->{seen_hosts}{$hostip} = 1; + + # now try to get the data with a short timeout + my $timeout = MogileFS::Config->config('conn_timeout') || 2; + my $start_time = Time::HiRes::time(); + + my $ua = $self->ua; + my $response = $ua->get($url); + my $res_time = Time::HiRes::time(); + + $hostip ||= 'unknown'; + $get_port ||= 'unknown'; + $devid ||= 'unknown'; + $timeout ||= 'unknown'; + $url ||= 'unknown'; + unless ($response->is_success) { + my $failed_after = $res_time - $start_time; + if ($failed_after < 0.5) { + $self->state_event('device', $dev->id, {observed_state => 'unreachable'}) + if (!$dev->observed_unreachable); + error("Port $get_port not listening on $hostip ($url)? Error was: " . $response->status_line); + } else { + $failed_after = sprintf("%.02f", $failed_after); + $self->state_event('host', $dev->hostid, {observed_state => 'unreachable'}) + if (!$host->observed_unreachable); + $self->{skip_host}{$dev->hostid} = 1; + error("Timeout contacting $hostip dev $devid ($url): took $failed_after seconds out of $timeout allowed"); + } + return; + } + + # at this point we can reach the host + $self->state_event('host', $dev->hostid, {observed_state => 'reachable'}) + if (!$host->observed_reachable); + $self->{iow}->restart_monitoring_if_needed($hostip); + + my %stats; + my $data = $response->content; + foreach (split(/\r?\n/, $data)) { + next unless /^(\w+)\s*:\s*(.+)$/; + $stats{$1} = $2; + } + + my ($used, $total) = ($stats{used}, $stats{total}); + unless ($used && $total) { + $used = "" unless defined $used; + $total = "" unless defined $total; + my $clen = length($data || ""); + error("dev$devid reports used = $used, total = $total, content-length: $clen, error?"); + return; + } + + # only update database every ~15 seconds per device + my $last_update = $self->{last_db_update}{$dev->id} || 0; + my $next_update = $last_update + UPDATE_DB_EVERY; + my $now = time(); + if ($now >= $next_update) { + Mgd::get_store()->update_device_usage(mb_total => int($total / 1024), + mb_used => int($used / 1024), + devid => $devid); + $self->{last_db_update}{$devid} = $now; + } + + # next if we're not going to try this now + return if ($self->{last_test_write}{$devid} || 0) + UPDATE_DB_EVERY > $now; + $self->{last_test_write}{$devid} = $now; + + # now we want to check if this device is writeable + + # first, create the test-write directory. this will return + # immediately after the first time, as the 'create_directory' + # function caches what it's already created. + $dev->create_directory("/dev$devid/test-write"); + + my $num = int(rand 100); # this was "$$-$now" before, but we don't yet have a cleaner in mogstored for these files + my $puturl = "http://$hostip:$port/dev$devid/test-write/test-write-$num"; + my $content = "time=$now rand=$num"; + my $req = HTTP::Request->new(PUT => $puturl); + $req->content($content); + + # TODO: guard against race-conditions with double-check on failure + + # now, depending on what happens + my $resp = $ua->request($req); + if ($resp->is_success) { + # now let's get it back to verify; note we use the get_port to verify that + # the distinction works (if we have one) + my $geturl = "http://$hostip:$get_port/dev$devid/test-write/test-write-$num"; + my $testwrite = $ua->get($geturl); + + # if success and the content matches, mark it writeable + if ($testwrite->is_success && $testwrite->content eq $content) { + $self->state_event('device', $devid, {observed_state => 'writeable'}) + if (!$dev->observed_writeable); + debug("dev$devid: used = $used, total = $total, writeable = 1"); + return; + } + } + + # if we fall through to here, then we know that something is not so good, so mark it readable + # which is guaranteed given we even tested writeability + $self->state_event('device', $devid, {observed_state => 'readable'}) + if (!$dev->observed_readable); + debug("dev$devid: used = $used, total = $total, writeable = 0"); +} + sub check_device { my ($self, $dev) = @_; diff --git a/t/01-domain-class.t b/t/01-domain-class.t index 69336da..e3133d6 100644 --- a/t/01-domain-class.t +++ b/t/01-domain-class.t @@ -41,7 +41,7 @@ ok($domfac != $classfac, "factories are not the same singleton"); is($dom->name, 'toast', 'domain namespace is toast'); # Add in a test class. - my $cls = $classfac->set($dom, { classid => 1, dmid => 1, mindevcount => 3, + my $cls = $classfac->set({ classid => 1, dmid => 1, mindevcount => 3, replpolicy => '', classname => 'fried'}); ok($cls, "got a class object"); is($cls->id, 1, "class id is 1"); @@ -53,11 +53,11 @@ ok($domfac != $classfac, "factories are not the same singleton"); # Add a few more classes and domains. { my $dom2 = $domfac->set({ dmid => 2, namespace => 'harro' }); - $classfac->set($dom2, { classid => 1, dmid => 2, mindevcount => 2, + $classfac->set({ classid => 1, dmid => 2, mindevcount => 2, replpolicy => '', classname => 'red' }); - $classfac->set($dom2, { classid => 2, dmid => 2, mindevcount => 3, + $classfac->set({ classid => 2, dmid => 2, mindevcount => 3, replpolicy => 'MultipleHosts(2)', classname => 'green' }); - $classfac->set($dom2, { classid => 3, dmid => 2, mindevcount => 4, + $classfac->set({ classid => 3, dmid => 2, mindevcount => 4, replpolicy => 'MultipleHosts(5)', classname => 'blue' }); } -- 2.11.4.GIT