File Coverage

blib/lib/MogileFS/Device.pm
Criterion Covered Total %
statement 53 154 34.4
branch 12 72 16.6
condition 6 45 13.3
subroutine 21 47 44.6
pod 0 36 0.0
total 92 354 25.9


line stmt bran cond sub pod time code
1             package MogileFS::Device;
2 21     21   93 use strict;
  21         35  
  21         644  
3 21     21   83 use warnings;
  21         37  
  21         554  
4 21     21   84 use Carp qw/croak/;
  21         41  
  21         1073  
5 21     21   105 use MogileFS::Server;
  21         29  
  21         524  
6 21     21   104 use MogileFS::Util qw(throw);
  21         31  
  21         955  
7 21     21   91 use MogileFS::Util qw(okay_args device_state error);
  21         30  
  21         1614  
8              
9             =head1
10              
11             MogileFS::Device - device class
12              
13             =cut
14              
15             BEGIN {
16 21 50   21   113 my $testing = $ENV{TESTING} ? 1 : 0;
17 21         40567 eval "sub TESTING () { $testing }";
18             }
19              
20             my @observed_fields = qw/observed_state utilization reject_bad_md5/;
21             my @fields = (qw/hostid status weight mb_total mb_used mb_asof devid/,
22             @observed_fields);
23              
24             sub new_from_args {
25 130     130 0 120 my ($class, $args, $host_factory) = @_;
26 130         601 my $self = bless {
27             host_factory => $host_factory,
28 130         112 %{$args},
29             }, $class;
30              
31             # FIXME: No guarantee (as of now?) that hosts get loaded before devs.
32             #$self->host || die "No host for $self->{devid} (host $self->{hostid})";
33              
34 130 50 33     713 croak "invalid device observed state '$self->{observed_state}', valid: writeable, readable, unreachable"
35             if $self->{observed_state} && $self->{observed_state} !~ /^(?:writeable|readable|unreachable)$/;
36              
37 130         334 return $self;
38             }
39              
40             # Instance methods
41              
42 205     205 0 490 sub id { return $_[0]{devid} }
43 130     130 0 482 sub devid { return $_[0]{devid} }
44 130     130 0 216 sub name { return $_[0]{devid} }
45 278     278 0 521 sub status { return $_[0]{status} }
46 0     0 0 0 sub weight { return $_[0]{weight} }
47 134     134 0 280 sub hostid { return $_[0]{hostid} }
48              
49             sub host {
50 104     104 0 80 my $self = shift;
51 104         203 return $self->{host_factory}->get_by_id($self->{hostid});
52             }
53              
54             # returns 0 if not known, else [0,1]
55             sub percent_free {
56 108     108 0 83 my $self = shift;
57 108 50 33     328 return 0 unless $self->{mb_total} && defined $self->{mb_used};
58 108         308 return 1 - ($self->{mb_used} / $self->{mb_total});
59             }
60              
61             # returns undef if not known, else [0,1]
62             sub percent_full {
63 0     0 0 0 my $self = shift;
64 0 0 0     0 return undef unless $self->{mb_total} && defined $self->{mb_used};
65 0         0 return $self->{mb_used} / $self->{mb_total};
66             }
67              
68             # FIXME: $self->mb_free?
69             sub fields {
70 0     0 0 0 my $self = shift;
71 0 0       0 my @tofetch = @_ ? @_ : @fields;
72 0         0 my $ret = { (map { $_ => $self->{$_} } @tofetch),
  0         0  
73             'mb_free' => $self->mb_free };
74 0         0 return $ret;
75             }
76              
77             sub observed_fields {
78 0     0 0 0 return $_[0]->fields(@observed_fields);
79             }
80              
81             sub observed_utilization {
82 0     0 0 0 my $self = shift;
83              
84 0         0 if (TESTING) {
85             my $weight_varname = 'T_FAKE_IO_DEV' . $self->id;
86             return $ENV{$weight_varname} if defined $ENV{$weight_varname};
87             }
88              
89 0         0 return $self->{utilization};
90             }
91              
92             sub host_ok {
93 52     52 0 68 my $host = $_[0]->host;
94 52   33     145 return ($host && $host->observed_reachable);
95             }
96              
97             sub observed_writeable {
98 52     52 0 46 my $self = shift;
99 52 50       67 return 0 unless $self->host_ok;
100 52   33     194 return $self->{observed_state} && $self->{observed_state} eq 'writeable';
101             }
102              
103             sub observed_readable {
104 0     0 0 0 my $self = shift;
105 0 0       0 return 0 unless $self->host_ok;
106 0   0     0 return $self->{observed_state} && $self->{observed_state} eq 'readable';
107             }
108              
109             sub observed_unreachable {
110 0     0 0 0 my $self = shift;
111             # host is unreachability implies device unreachability
112 0 0       0 return 1 unless $self->host_ok;
113 0   0     0 return $self->{observed_state} && $self->{observed_state} eq 'unreachable';
114             }
115              
116             # FIXME: This pattern is weird. Store the object on new?
117             sub dstate {
118 278     278 0 531 my $ds = device_state($_[0]->status);
119 278 50       698 return $ds if $ds;
120 0         0 error("dev$_[0]->{devid} has bogus status '$_[0]->{status}', pretending 'down'");
121 0         0 return device_state("down");
122             }
123              
124             sub can_delete_from {
125 0   0 0 0 0 return $_[0]->host->alive && $_[0]->dstate->can_delete_from;
126             }
127              
128             # this method is for Monitor, other workers should use should_read_from
129             sub can_read_from {
130 0   0 0 0 0 return $_[0]->host->should_read_from && $_[0]->dstate->can_read_from;
131             }
132              
133             # this is the only method a worker should call for checking for readability
134             sub should_read_from {
135 0   0 0 0 0 return $_[0]->can_read_from && ($_[0]->observed_readable || $_[0]->observed_writeable);
136             }
137              
138             # FIXME: Is there a (unrelated to this code) bug where new files aren't tested
139             # against the free space limit before being stored or replicated somewhere?
140             sub should_get_new_files {
141 54     54 0 46 my $self = shift;
142 54         68 my $dstate = $self->dstate;
143              
144 54 100       95 return 0 unless $dstate->should_get_new_files;
145 52 50       63 return 0 unless $self->observed_writeable;
146 52 100       66 return 0 unless $self->host->alive;
147             # have enough disk space? (default: 100MB)
148 42         110 my $min_free = MogileFS->config("min_free_space");
149 42 50 33     100 return 0 if $self->{mb_total} &&
150             $self->mb_free < $min_free;
151              
152 42         141 return 1;
153             }
154              
155             sub mb_free {
156 42     42 0 38 my $self = shift;
157 42 50 33     221 return $self->{mb_total} - $self->{mb_used}
158             if $self->{mb_total} && defined $self->{mb_used};
159             }
160              
161             sub mb_used {
162 0     0 0 0 return $_[0]->{mb_used};
163             }
164              
165             # currently the same policy, but leaving it open for differences later.
166             sub should_get_replicated_files {
167 54     54 0 107 return $_[0]->should_get_new_files;
168             }
169              
170             sub not_on_hosts {
171 0     0 0   my ($self, @hosts) = @_;
172 0 0         my @hostids = map { ref($_) ? $_->id : $_ } @hosts;
  0            
173 0           my $my_hostid = $self->id;
174 0 0         return (grep { $my_hostid == $_ } @hostids) ? 0 : 1;
  0            
175             }
176              
177             # "cached" by nature of the monitor worker testing this.
178             sub doesnt_know_mkcol {
179 0     0 0   return $_[0]->{no_mkcol};
180             }
181              
182             # Gross class-based singleton cache.
183             my %dir_made; # /dev/path -> $time
184             my $dir_made_lastclean = 0;
185              
186             # if no callback is supplied: returns 1 on success, 0 on failure
187             # if a callback is supplied, the return value will be passed to the callback
188             # upon completion.
189             sub create_directory {
190 0     0 0   my ($self, $uri, $cb) = @_;
191 0 0 0       if ($self->doesnt_know_mkcol || MogileFS::Config->server_setting_cached('skip_mkcol')) {
192 0 0         return $cb ? $cb->(1) : 1;
193             }
194              
195             # rfc2518 says we "should" use a trailing slash. Some servers
196             # (nginx) appears to require it.
197 0 0         $uri .= '/' unless $uri =~ m/\/$/;
198              
199 0 0         if ($dir_made{$uri}) {
200 0 0         return $cb ? $cb->(1) : 1;
201             }
202              
203 0           my $res;
204             my $on_mkcol_response = sub {
205 0 0   0     if ($res->is_success) {
    0          
206 0           my $now = time();
207 0           $dir_made{$uri} = $now;
208              
209             # cleanup %dir_made occasionally.
210 0           my $clean_interval = 300; # every 5 minutes.
211 0 0         if ($dir_made_lastclean < $now - $clean_interval) {
212 0           $dir_made_lastclean = $now;
213 0           foreach my $k (keys %dir_made) {
214 0 0         delete $dir_made{$k} if $dir_made{$k} < $now - 3600;
215             }
216             }
217 0           return 1;
218             } elsif ($res->code =~ /\A(?:400|501)\z/) {
219             # if they don't support this method, remember that
220             # TODO: move this into method in *monitor* worker
221 0           $self->{no_mkcol} = 1;
222 0           return 1;
223             } else {
224 0           return 0;
225             }
226 0           };
227              
228 0           my %opts = ( headers => { "Content-Length" => "0" } );
229             $self->host->http("MKCOL", $uri, \%opts, sub {
230 0     0     ($res) = @_;
231 0 0         $cb->($on_mkcol_response->()) if $cb;
232 0           });
233              
234 0 0         return if $cb;
235              
236 0     0     Danga::Socket->SetPostLoopCallback(sub { !defined $res });
  0            
237 0           Danga::Socket->EventLoop;
238 0           return $on_mkcol_response->();
239             }
240              
241             sub fid_list {
242 0     0 0   my ($self, %opts) = @_;
243 0           my $limit = delete $opts{limit};
244 0 0 0       croak("No limit specified") unless $limit && $limit =~ /^\d+$/;
245 0 0         croak("Unknown options to fid_list") if %opts;
246              
247 0           my $sto = Mgd::get_store();
248 0           my $fidids = $sto->get_fidids_by_device($self->devid, $limit);
249 0           return map {
250 0 0         MogileFS::FID->new($_)
251 0           } @{$fidids || []};
252             }
253              
254             sub fid_chunks {
255 0     0 0   my ($self, %opts) = @_;
256              
257 0           my $sto = Mgd::get_store();
258             # storage function does validation.
259 0           my $fidids = $sto->get_fidid_chunks_by_device(devid => $self->devid, %opts);
260 0           return map {
261 0 0         MogileFS::FID->new($_)
262 0           } @{$fidids || []};
263             }
264              
265             sub forget_about {
266 0     0 0   my ($self, $fid) = @_;
267 0           Mgd::get_store()->remove_fidid_from_devid($fid->id, $self->id);
268 0           return 1;
269             }
270              
271             sub usage_url {
272 0     0 0   my $self = shift;
273 0           my $host = $self->host;
274 0           my $get_port = $host->http_get_port;
275 0           my $hostip = $host->ip;
276 0           return "http://$hostip:$get_port/dev$self->{devid}/usage";
277             }
278              
279             sub can_change_to_state {
280 0     0 0   my ($self, $newstate) = @_;
281             # don't allow dead -> alive transitions. (yes, still possible
282             # to go dead -> readonly -> alive to bypass this, but this is
283             # all more of a user-education thing than an absolute policy)
284 0 0 0       return 0 if $self->dstate->is_perm_dead && $newstate eq 'alive';
285 0           return 1;
286             }
287              
288             sub vivify_directories {
289 0     0 0   my ($self, $path, $cb) = @_;
290              
291             # $path is something like:
292             # http://10.0.0.26:7500/dev2/0/000/148/0000148056.fid
293              
294             # three directories we'll want to make:
295             # http://10.0.0.26:7500/dev2/0
296             # http://10.0.0.26:7500/dev2/0/000
297             # http://10.0.0.26:7500/dev2/0/000/148
298              
299 0 0         croak "non-HTTP mode no longer supported" unless $path =~ /^http/;
300 0 0         return 0 unless $path =~ m!/dev(\d+)/(\d+)/(\d\d\d)/(\d\d\d)/\d+\.fid$!;
301 0           my ($devid, $p1, $p2, $p3) = ($1, $2, $3, $4);
302              
303 0 0         die "devid mismatch" unless $self->id == $devid;
304              
305 0 0         if ($cb) {
306             $self->create_directory("/dev$devid/$p1", sub {
307             $self->create_directory("/dev$devid/$p1/$p2", sub {
308 0           $self->create_directory("/dev$devid/$p1/$p2/$p3", $cb);
309 0     0     });
310 0           });
311             } else {
312 0           $self->create_directory("/dev$devid/$p1");
313 0           $self->create_directory("/dev$devid/$p1/$p2");
314 0           $self->create_directory("/dev$devid/$p1/$p2/$p3");
315             }
316             }
317              
318             # Compatibility interface since this old routine is unfortunately called
319             # internally within plugins. This data should be passed into any hooks which
320             # may need it?
321             # Currently an issue with MogileFS::Network + ZoneLocal
322             # Remove this in 2012.
323             sub devices {
324 0     0 0   return Mgd::device_factory()->get_all;
325             }
326              
327             sub reject_bad_md5 {
328 0     0 0   return $_[0]->{reject_bad_md5};
329             }
330              
331             1;