上回分析lbnamed的时候,开玩笑说自己也可以试试在模块基础上加点啥功能。国庆节前最后一天,没啥事情做,就写个小demo续貂。代码如下:

#!/usr/bin/perl
use warnings;
use strict;
use autodie;
use Sys::Hostname;
use YAML::Syck;
use Net::IP::Match::Regexp qw( create_iprange_regexp match_ip );
use Stanford::DNS;
use Stanford::DNSserver;
$SIG{'HUP'} = 'catch_hup';
my $need_reload;
my $hostmaster = 'domain.chenlinux.com';
my $soa        = rr_SOA(hostname(), $hostmaster, time(), 3600, 1800, 86400, 0);
my $ns         = Stanford::DNSserver->new( listen_on => [ hostname() ],
#                                           debug     => 1,
                                           loopfunc  => \&conf_reload,
#                                           daemon    => 'no',
                                         );
my $regexp;
my @domains;
my $arealist;
my $templist;
my $config_path = '/data/chenlinux.com/perl/';
my $ns_domain = 'test.domain.chenlinux.com';
$ns->add_dynamic("$domain" => \&dyn_lb ) foreach my $domain ( @domains );
$ns->add_static( "$ns_domain", T_SOA, $soa);
$ns->add_static( "$ns_domain", T_NS, rr_NS($hostmaster));

$ns->answer_queries();

sub catch_hup {
    $need_reload = 1;
};

sub conf_reload {
    if( $need_reload ) {
        load_config();
        $need_reload = 0;
    };
};

sub load_config {
    $regexp = ip2area("ip.list");
    @domains = grep {s/${config_path}config-(.+?)\.yml/$1/} glob("${config_path}*");
    foreach my $domain ( @domains ) {
      $arealist->{"$domain"} = LoadFile("${config_path}config-${domain}.yml");
      @{$templist->{"$domain"}->{"$_"}} = @{$arealist->{"$domain"}->{"$_"}->{'per'}} foreach keys %{$arealist->{"$domain"}};
  };
};

sub dyn_lb {
    my ($domain,$residual,$qtype,$qclass,$dm,$from) = @_;
    my $ttl = 3600;
    my $ip = area2resolv($domain, $from);
    $dm->{'answer'} .= dns_answer(QPTR, T_A, C_IN, $ttl, rr_A($ip));
    $dm->{'ancount'} += 1;
    return 1;
};

sub ip2area {
    my $file = shift;
    my $area = {};
    my $last_area;
    open my $fh, '<', $file;
    while(<$fh>){
        if ( /^acl (\w+)/ ) {
            $last_area = $1;
        } elsif ( /^((\d{1,3}\.?){4});/ ) {
            $area->{"$1"} = $last_area;
        } else {
            next;
        };
    };
    my $regexp = create_iprange_regexp($area);
    return $regexp;
};

sub area2resolv {
    my $from = shift;
    my $area = match_ip( "$from", $regexp );
    my $ip;
    my $len = $#{$arealist->{"$domain"}->{"$area"}->{'per'}};
    for ( 0 .. $len ) {
        if ( $arealist->{"$domain"}->{"$area"}->{'per'}->[$_] ) {
            $ip = $arealist->{"$domain"}->{"$area"}->{'ip'}->[$_];
            $arealist->{"$domain"}->{"$area"}->{'per'}->[$_]--;
            last;
        };
        if ( $_ == $len ) {
            @{$arealist->{"$domain"}->{"$area"}->{'per'}} = @{$templist->{"$domain"}->{"$area"}};
            redo;
        };
    };
    return ip_conv("$ip");
};

sub ip_conv {
    my $ip = shift;
    return ($1<<24)|($2<<16)|($3<<8)|$4 if $ip =~ m/(\d+)\.(\d+)\.(\d+)\.(\d+)/;
}```
其中调用的ip.list是bind9用的acl格式,即:
```bash
acl cnc_beijing {
202.106.0.0/24;
...
}
...```
这种格式。
调用的config-www.domain.com.yml是YAML格式定义的地区指向ip,即:
```yaml
ctc_hebei:
    ip:
      - 10.168.168.1
      - 10.168.169.2
      - 10.168.170.3
    per:
      - 50
      - 30
      - 20

超级简单(其实是我没想到好的weight实现方式)的算法,就是找到这个ctc_hebei的时候,依次序返回ip,同时每返回一次对应的per就减1,减到0就换下一个ip,都0了就复原从头开始。

严重缺失的地方:读取不同域名配置;对server的监控;对config.yml的reload