summaryrefslogtreecommitdiffstats
path: root/lib/Smokeping/Slave.pm
blob: 0931c805bff26d1f2cac2cd1589ec05a12c51523 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
# -*- perl -*-
package Smokeping::Slave;
use warnings;
use strict;
use Data::Dumper;
use Storable qw(nstore retrieve);
use Digest::HMAC_MD5 qw(hmac_md5_hex);
use LWP::UserAgent;
use Safe;
use Smokeping;
# keep this in sync with the Slave.pm part
# only update if you have to force a parallel upgrade
my $PROTOCOL = "2";

=head1 NAME

Smokeping::Slave - Slave functionality for Smokeping

=head1 OVERVIEW

The Module inmplements the functionality required to run in slave mode.

=head2 IMPLEMENTATION

=head3 submit_results

In slave mode we just hit our targets and submit the results to the server.
If we can not get to the server, we submit the results in the next round.
The server in turn sends us new config information if it sees that ours is
out of date.

=cut

sub get_results;
sub get_results {
    my $slave_cfg = shift;
    my $cfg = shift;
    my $probes = shift;
    my $tree = shift;
    my $name = shift;
    my $justthisprobe = shift; # if defined, update only the targets probed by this probe
    my $probe = $tree->{probe};
    my $results = [];
    return [] unless $cfg;
    foreach my $prop (keys %{$tree}) {
        if (ref $tree->{$prop} eq 'HASH'){
            my $subres = get_results $slave_cfg, $cfg, $probes, $tree->{$prop}, $name."/$prop", $justthisprobe;
            push @{$results}, @{$subres};
        } 
        next unless defined $probe;
        next if defined $justthisprobe and $probe ne $justthisprobe;
        my $probeobj = $probes->{$probe};
        if ($prop eq 'host') {
            #print "update $name\n";
            my $updatestring = $probeobj->rrdupdate_string($tree);
            push @$results, "$name\t".time()."\t$updatestring";
        }
    }
    return $results;
}
         
sub submit_results {    
    my $slave_cfg = shift;
    my $cfg = shift;
    my $myprobe = shift;
    my $probes = shift;
    my $store = $slave_cfg->{cache_dir}."/data";
    $store .= "_$myprobe" if $myprobe;
    $store .= ".cache";
    my $restore = -f $store ? retrieve $store : []; 
    unlink $store;
    my $new =  get_results($slave_cfg, $cfg, $probes, $cfg->{Targets}, '', $myprobe);    
    push @$restore, @$new;
    my $data_dump = join("\n",@{$restore}) || "";
    my $ua = LWP::UserAgent->new(
        agent => 'smokeping-slave/1.0',
        timeout => 60,
        env_proxy => 1 );

    my $response = $ua->post(
        $slave_cfg->{master_url},
        Content_Type => 'form-data',
        Content => [
            slave => $slave_cfg->{slave_name},
            key  => hmac_md5_hex($data_dump,$slave_cfg->{shared_secret}),
            protocol => $PROTOCOL,
            data => $data_dump,
            config_time => $cfg->{__last} || 0,
        ],
    );
    if ($response->is_success){
        my $data = $response->content;
        my $key = $response->header('Key');
        my $protocol = $response->header('Protocol') || '?';

        if ($response->header('Content-Type') ne 'application/smokeping-config'){
            warn "$data\n" unless $data =~ /OK/;
            Smokeping::do_debuglog("Sent data to Server. Server said $data");
            return undef;
        };

        if ($protocol ne $PROTOCOL){
            warn "WARNING $slave_cfg->{master_url} sent data with protocol $protocol. Expected $PROTOCOL.";
            return undef;
        }
        if (hmac_md5_hex($data,$slave_cfg->{shared_secret}) ne $key){
            warn "WARNING $slave_cfg->{master_url} sent data with wrong key";
            return undef;
        }
        my $zone = new Safe;
        # $zone->permit_only(???); #input welcome as to good settings
        my $config = $zone->reval($data);
        if ($@){
            warn "WARNING evaluating new config from server failed: $@ --\n$data";
        } elsif (defined $config and ref $config eq 'HASH'){
            $config->{General}{piddir} = $slave_cfg->{pid_dir};
            Smokeping::do_log("Sent data to Server and got new config in response.");
            return $config;
        }                       
    } else {
        # ok did not manage to get our data to the server.
        # we store the result so that we can try again later.
        warn "WARNING Master said ".$response->status_line()."\n";
        nstore $restore, $store;
    }
    return undef;
}

1;

__END__

=head1 COPYRIGHT

Copyright 2007 by Tobias Oetiker

=head1 LICENSE

This program is free software; you can redistribute it
and/or modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.  See the GNU General Public License for more
details.

You should have received a copy of the GNU General Public
License along with this program; if not, write to the Free
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
02139, USA.

=head1 AUTHOR

Tobias Oetiker E<lt>tobi@oetiker.chE<gt>

=cut