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.04";
  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
  36 sub zone_for_ip {
  37     my $class = shift;
  38     my $ip = shift;
  39
  40     return unless $ip;
  41
  42     check_cache();
  43
  44     return $trie->match_string($ip);
  45 }
  46
  47 sub check_cache {
  48     # Reload the trie if it's expired
  49     return unless (time() >= $next_reload);
  50
  51     $trie = Net::Patricia->new();
  52
  53     my @zones = split(/\s*,\s*/, get_setting("network_zones"));
  54
  55     my @netmasks; # [ $bits, $netmask, $zone ], ...
  56
  57     foreach my $zone (@zones) {
  58         my $zone_masks = get_setting("zone_$zone");
  59
  60         if (not $zone_masks) {
  61             warn "couldn't find network_zone <<zone_$zone>> check your server settings";
  62             next;
  63         }
  64
  65         foreach my $network_string (split /[,\s]+/, $zone_masks) {
  66             my $netmask = Net::Netmask->new2($network_string);
  67
  68             if (Net::Netmask::errstr()) {
  69                 warn "couldn't parse <$zone> as a netmask. error was <" . Net::Netmask::errstr().
  70                      ">. check your server settings";
  71                 next;
  72             }
  73
  74             push @netmasks, [$netmask->bits, $netmask, $zone];
  75         }
  76     }
  77
  78     # Sort these by mask bit count, because Net::Patricia doesn't say in its docs whether add order
  79     # or bit length is the overriding factor.
  80     foreach my $set (sort { $a->[0] <=> $b->[0] } @netmasks) {
  81         my ($bits, $netmask, $zone) = @$set;
  82
  83         if (my $other_zone = $trie->match_exact_string("$netmask")) {
  84             warn "duplicate netmask <$netmask> in network zones '$zone' and '$other_zone'. check your server settings";
  85         }
  86
  87         $trie->add_string("$netmask", $zone);
  88     }
  89
  90     my $interval = get_setting("network_reload_interval") || DEFAULT_RELOAD_INTERVAL;
  91
  92     $next_reload = time() + $interval;
  93
  94     return 1;
  95 }
  96
  97 # This is a separate subroutine so I can redefine it at test time.
  98 sub get_setting {
  99     my $key = shift;
 100     return MogileFS::Config->server_setting($key);
 101 }
 102
 103 sub test_config {
 104     my $class = shift;
 105
 106     my %config = @_;
 107
 108     no warnings 'redefine';
 109
 110     *get_setting = sub {
 111         my $key = shift;
 112         return $config{$key};
 113     };
 114
 115     $next_reload = 0;
 116 }
 117
 118 =head1 COPYRIGHT
 119
 120 Copyright 2011 - Jonathan Steinert
 121
 122 =head1 AUTHOR
 123
 124 Jonathan Steinert
 125
 126 =head1 LICENSE
 127
 128 This module is licensed under the same terms as Perl itself.
 129
 130 =cut
 131
 132 1;