lib/MogileFS/Network.pm

   1 package MogileFS::Network;
   2
   3 =head1 NAME
   4
   5 MogileFS::Network - Network awareness and extensions for MogileFS::Server
   6
   7 =head1 DESCRIPTION
   8
   9 This collection of modules adds multiple network awareness to the MogileFS
  10 server. It provides two replication policies, 'MultipleNetworks' and
  11 'HostsPerNetwork'; and also provides a plugin 'ZoneLocal' that causes
  12 get_paths queries to be returned in a prioritized order based on locality of
  13 storage.
  14
  15 For information on configuring a location-aware installation of MogileFS
  16 please check out the MogileFS wiki.
  17
  18 L<http://code.google.com/p/mogilefs/wiki/ConfigureMultiNet>
  19
  20 =cut
  21
  22 use strict;
  23 use warnings;
  24
  25 use Net::Netmask;
  26 use Net::Patricia;
  27 use MogileFS::Config;
  28
  29 our $VERSION = "0.06";
  30
  31 use constant DEFAULT_RELOAD_INTERVAL => 60;
  32
  33 my $trie = Net::Patricia->new(); # Net::Patricia object used for cache and lookup.
  34 my $next_reload = 0;             # Epoch time at or after which the trie expires and must be regenerated.
  35 my $has_cached = MogileFS::Config->can('server_setting_cached');
  36
  37 sub zone_for_ip {
  38     my $class = shift;
  39     my $ip = shift;
  40
  41     return unless $ip;
  42
  43     check_cache();
  44
  45     return $trie->match_string($ip);
  46 }
  47
  48 sub check_cache {
  49     # Reload the trie if it's expired
  50     return unless (time() >= $next_reload);
  51
  52     $trie = Net::Patricia->new();
  53
  54     my @zones = split(/\s*,\s*/, get_setting("network_zones"));
  55
  56     my @netmasks; # [ $bits, $netmask, $zone ], ...
  57
  58     foreach my $zone (@zones) {
  59         my $zone_masks = get_setting("zone_$zone");
  60
  61         if (not $zone_masks) {
  62             warn "couldn't find network_zone <<zone_$zone>> check your server settings";
  63             next;
  64         }
  65
  66         foreach my $network_string (split /[,\s]+/, $zone_masks) {
  67             my $netmask = Net::Netmask->new2($network_string);
  68
  69             if (Net::Netmask::errstr()) {
  70                 warn "couldn't parse <$zone> as a netmask. error was <" . Net::Netmask::errstr().
  71                      ">. check your server settings";
  72                 next;
  73             }
  74
  75             push @netmasks, [$netmask->bits, $netmask, $zone];
  76         }
  77     }
  78
  79     # Sort these by mask bit count, because Net::Patricia doesn't say in its docs whether add order
  80     # or bit length is the overriding factor.
  81     foreach my $set (sort { $a->[0] <=> $b->[0] } @netmasks) {
  82         my ($bits, $netmask, $zone) = @$set;
  83
  84         if (my $other_zone = $trie->match_exact_string("$netmask")) {
  85             warn "duplicate netmask <$netmask> in network zones '$zone' and '$other_zone'. check your server settings";
  86         }
  87
  88         $trie->add_string("$netmask", $zone);
  89     }
  90
  91     my $interval = get_setting("network_reload_interval") || DEFAULT_RELOAD_INTERVAL;
  92
  93     $next_reload = time() + $interval;
  94
  95     return 1;
  96 }
  97
  98 # This is a separate subroutine so I can redefine it at test time.
  99 sub get_setting {
 100     my $key = shift;
 101     if ($has_cached) {
 102         my $val = MogileFS::Config->server_setting_cached($key);
 103         return $val;
 104     }
 105     # Fall through to the server in case we don't have a cached value yet.
 106     return MogileFS::Config->server_setting($key);
 107 }
 108
 109 sub test_config {
 110     my $class = shift;
 111
 112     my %config = @_;
 113
 114     no warnings 'redefine';
 115
 116     *get_setting = sub {
 117         my $key = shift;
 118         return $config{$key};
 119     };
 120
 121     $next_reload = 0;
 122 }
 123
 124 =head1 COPYRIGHT
 125
 126 Copyright 2011 - Jonathan Steinert
 127
 128 =head1 AUTHOR
 129
 130 Jonathan Steinert
 131
 132 =head1 LICENSE
 133
 134 This module is licensed under the same terms as Perl itself.
 135
 136 =cut
 137
 138 1;