1package MogileFS::Util;
2use strict;
3use Carp qw(croak);
4use Time::HiRes;
5use MogileFS::Exception;
6use MogileFS::DeviceState;
7
8require Exporter;
9our @ISA = qw(Exporter);
10our @EXPORT_OK = qw(
11                    error undeferr debug fatal daemonize weighted_list every
12                    wait_for_readability wait_for_writeability throw error_code
13                    max min first okay_args device_state eurl decode_url_args
14                    encode_url_args apply_state_events apply_state_events_list
15                    );
16
17# Applies monitor-job-supplied state events against the factory singletons.
18# Sad this couldn't be an object method, but ProcManager doesn't base off
19# anything common.
20sub apply_state_events {
21    my @events = split(/\s/, ${$_[0]});
22    shift @events; # pop the :monitor_events part
23    apply_state_events_list(@events);
24}
25
26sub apply_state_events_list {
27    # This will needlessly fetch domain/class/host most of the time.
28    # Maybe replace with something that "caches" factories?
29    my %factories = ( 'domain' => MogileFS::Factory::Domain->get_factory,
30        'class'  => MogileFS::Factory::Class->get_factory,
31        'host'   => MogileFS::Factory::Host->get_factory,
32        'device' => MogileFS::Factory::Device->get_factory, );
33
34    for my $ev (@_) {
35        my $args = decode_url_args($ev);
36        my $mode = delete $args->{ev_mode};
37        my $type = delete $args->{ev_type};
38        my $id   = delete $args->{ev_id};
39
40        # This special case feels gross, but that's what it is.
41        if ($type eq 'srvset') {
42            my $val = $mode eq 'set' ? $args->{value} : undef;
43            MogileFS::Config->cache_server_setting($id, $val);
44            next;
45        }
46
47        my $old = $factories{$type}->get_by_id($id);
48        if ($mode eq 'setstate') {
49            # Host/Device only.
50            # FIXME: Make objects slightly mutable and directly set fields?
51            $factories{$type}->set({ %{$old->fields}, %$args });
52        } elsif ($mode eq 'set') {
53            # Re-add any observed data.
54            my $observed = $old ? $old->observed_fields : {};
55            $factories{$type}->set({ %$args, %$observed });
56        } elsif ($mode eq 'remove') {
57            $factories{$type}->remove($old) if $old;
58        }
59    }
60}
61
62sub every {
63    my ($delay, $code) = @_;
64    my ($worker, $psock_fd);
65    if ($worker = MogileFS::ProcManager->is_child) {
66        $psock_fd = $worker->psock_fd;
67    }
68  CODERUN:
69    while (1) {
70        my $start = Time::HiRes::time();
71        my $explicit_sleep = undef;
72
73        # run the code in a loop, so "next" will get out of it.
74        foreach (1) {
75            $code->(sub {
76                $explicit_sleep = shift;
77            });
78        }
79
80        my $now = Time::HiRes::time();
81        my $took = $now - $start;
82        my $sleep_for = defined $explicit_sleep ? $explicit_sleep : ($delay - $took);
83
84        # simple case, not in a child process (this never happens currently)
85        unless ($psock_fd) {
86            Time::HiRes::sleep($sleep_for);
87            next;
88        }
89
90        Time::HiRes::sleep($sleep_for) if $sleep_for > 0;
91        #local $Mgd::POST_SLEEP_DEBUG = 1;
92        # This calls read_from_parent. Workers used to needlessly call
93        # parent_ping constantly.
94        $worker->parent_ping;
95    }
96}
97
98sub debug {
99    my ($msg, $level) = @_;
100    return unless $Mgd::DEBUG >= 1;
101    $msg =~ s/[\r\n]+//g;
102    if (my $worker = MogileFS::ProcManager->is_child) {
103        $worker->send_to_parent("debug $msg");
104    } else {
105        my $dbg = "[debug] $msg";
106        MogileFS::ProcManager->NoteError(\$dbg);
107        Mgd::log('debug', $msg);
108    }
109}
110
111our $last_error;
112sub error {
113    my ($errmsg) = @_;
114    $last_error = $errmsg;
115    if (my $worker = MogileFS::ProcManager->is_child) {
116        my $msg = "error $errmsg";
117        $msg =~ s/\s+$//;
118        $worker->send_to_parent($msg);
119    } else {
120        MogileFS::ProcManager->NoteError(\$errmsg);
121        Mgd::log('debug', $errmsg);
122    }
123    return 0;
124}
125
126# like error(), but returns undef.
127sub undeferr {
128    error(@_);
129    return undef;
130}
131
132sub last_error {
133    return $last_error;
134}
135
136sub fatal {
137    my ($errmsg) = @_;
138    error($errmsg);
139    die $errmsg;
140}
141
142sub throw {
143    my ($errcode) = @_;
144    MogileFS::Exception->new($errcode)->throw;
145}
146
147sub error_code {
148    my ($ex) = @_;
149    return "" unless UNIVERSAL::isa($ex, "MogileFS::Exception");
150    return $ex->code;
151}
152
153sub daemonize {
154    my($pid, $sess_id, $i);
155
156    ## Fork and exit parent
157    if ($pid = fork) { exit 0; }
158
159    ## Detach ourselves from the terminal
160    croak "Cannot detach from controlling terminal"
161        unless $sess_id = POSIX::setsid();
162
163    ## Prevent possibility of acquiring a controlling terminal
164    $SIG{'HUP'} = 'IGNORE';
165    if ($pid = fork) { exit 0; }
166
167    ## Change working directory
168    chdir "/";
169
170    ## Clear file creation mask
171    umask 0;
172
173    print STDERR "Daemon running as pid $$.\n" if $MogileFS::DEBUG;
174
175    ## Close open file descriptors
176    close(STDIN);
177    close(STDOUT);
178    close(STDERR);
179
180    ## Reopen STDERR, STDOUT, STDIN to /dev/null
181    if ( $MogileFS::DEBUG ) {
182        open(STDIN,  "+>/tmp/mogilefsd.log");
183    } else {
184        open(STDIN,  "+>/dev/null");
185    }
186    open(STDOUT, "+>&STDIN");
187    open(STDERR, "+>&STDIN");
188}
189
190# input:
191#   given an array of arrayrefs of [ item, weight ], returns weighted randomized
192#   list of items (without the weights, not arrayref; just list)
193#
194#   a weight of 0 means to exclude that item from the results list; i.e. it's not
195#   ever used
196#
197# example:
198#   my @items = weighted_list( [ 1, 10 ], [ 2, 20 ], [ 3, 0 ] );
199#
200#   returns (1, 2) or (2, 1) with the latter far more likely
201sub weighted_list (@) {
202    my @list = grep { $_->[1] > 0 } @_;
203    my @ret;
204
205    my $sum = 0;
206    $sum += $_->[1] foreach @list;
207
208    my $getone = sub {
209        return shift(@list)->[0]
210            if scalar(@list) == 1;
211
212        my $val = rand() * $sum;
213        my $curval = 0;
214        for (my $idx = 0; $idx < scalar(@list); $idx++) {
215            my $item = $list[$idx];
216            $curval += $item->[1];
217            if ($curval >= $val) {
218                my ($ret) = splice(@list, $idx, 1);
219                $sum -= $item->[1];
220                return $ret->[0];
221            }
222        }
223    };
224
225    push @ret, $getone->() while @list;
226    return @ret;
227}
228
229# given a file descriptor number and a timeout, wait for that descriptor to
230# become readable; returns 0 or 1 on if it did or not
231sub wait_for_readability {
232    my ($fileno, $timeout) = @_;
233    return 0 unless $fileno && $timeout >= 0;
234
235    my $rin = '';
236    vec($rin, $fileno, 1) = 1;
237    my $nfound = select($rin, undef, undef, $timeout);
238
239    # nfound can be undef or 0, both failures, or 1, a success
240    return $nfound ? 1 : 0;
241}
242
243sub wait_for_writeability {
244    my ($fileno, $timeout) = @_;
245    return 0 unless $fileno && $timeout;
246
247    my $rout = '';
248    vec($rout, $fileno, 1) = 1;
249    my $nfound = select(undef, $rout, undef, $timeout);
250
251    # nfound can be undef or 0, both failures, or 1, a success
252    return $nfound ? 1 : 0;
253}
254
255sub max {
256    my ($n1, $n2) = @_;
257    return $n1 if $n1 > $n2;
258    return $n2;
259}
260
261sub min {
262    my ($n1, $n2) = @_;
263    return $n1 if $n1 < $n2;
264    return $n2;
265}
266
267sub first (&@) {
268    my $code = shift;
269    foreach (@_) {
270        return $_ if $code->();
271    }
272    undef;
273}
274
275sub okay_args {
276    my ($href, @okay) = @_;
277    my %left = %$href;
278    delete $left{$_} foreach @okay;
279    return 1 unless %left;
280    Carp::croak("Unknown argument(s): " . join(", ", sort keys %left));
281}
282
283sub device_state {
284    my ($state) = @_;
285    return MogileFS::DeviceState->of_string($state);
286}
287
288sub eurl {
289    my $a = defined $_[0] ? $_[0] : "";
290    $a =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg;
291    $a =~ tr/ /+/;
292    return $a;
293}
294
295sub encode_url_args {
296    my $args = shift;
297    return join('&', map { eurl($_) . "=" . eurl($args->{$_}) } keys %$args);
298}
299
300sub decode_url_args {
301    my $a = shift;
302    my $buffer = ref $a ? $a : \$a;
303    my $ret = {};
304
305    my $pair;
306    my @pairs = grep { $_ } split(/&/, $$buffer);
307    my ($name, $value);
308    foreach $pair (@pairs)
309    {
310        ($name, $value) = split(/=/, $pair);
311        $value =~ tr/+/ /;
312        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
313        $name =~ tr/+/ /;
314        $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
315        $ret->{$name} .= $ret->{$name} ? "\0$value" : $value;
316    }
317    return $ret;
318}
319
3201;
321