path: root/lib/MGA/Mirrors/DB.pm

package MGA::Mirrors::DB;

# $Id$

use strict;
use warnings;
use Config::IniFiles;
use URI;
use DBI;
use File::Temp qw(tempfile);
use Net::DNS;

sub configfile { '/etc/mga-mirror.ini' }

sub new {
    my ($class) = @_;

    my $conf = (-f './mga-mirror.ini')
        ? Config::IniFiles->new(-file => './mga-mirror.ini')
        : Config::IniFiles->new(-file => configfile())
            or return;

    my $db = DBI->connect(
        'dbi:Pg:' . $conf->val('db', 'pgconn', ''),
        $conf->val('db', 'user') || undef,
        $conf->val('db', 'password') || undef,
        {
            AutoCommit => 0,
            PrintError => 1,
        }
    ) or return;

    bless {
        db => $db,
        conf => $conf,
    }, $class;
}

sub host_ips {
    my ($self, $hostname) = @_;

    my $resolver = Net::DNS::Resolver->new;
    my @addresses;
    foreach my $type (qw'A AAAA') {
        my $packet = $resolver->search($hostname, $type) or next;
        foreach ($packet->answer) {
            $_->type eq $type or next;
            push(@addresses, $_->address);
        }
    }
    @addresses;
}

sub db { $_[0]->{db} }

sub locate_ips {
    my ($self, @ips) = @_;

    my $find = $self->db->prepare(q{
        select countries.* from geoip 
        join countries on geoip.code = countries.code
        where ipmin <= $1 and ipmax >= $1
    });

    foreach (@ips) {
        $find->execute($_);
        my $res = $find->fetchrow_hashref;
        if ($res) {
            $find->finish;
            return $res;
        }
    }

    return;
}

sub protocol_list {
    my ($self) = @_;
    my $select = $self->db->prepare(q{
        select name from protocol order by name
    });
    $select->execute;
    return keys %{ $select->fetchall_hashref([ 'name' ]) }
}

sub bandwidth_name {
    my ($self, $value) = @_;
    $value or return;
    my $select = $self->db->prepare(q{
        select name from bandwidth where value = ?
    });
    $select->execute($value);
    my $res = $select->fetchrow_hashref;
    $select->finish;
    $res->{name}
}

sub bandwidth_list {
    my ($self) = @_;
    my $list = $self->db->prepare(q{
        select * from bandwidth order by value
    });
    $list->execute;
    return $list->fetchall_arrayref({});
}

sub country_info {
    my ($self, $code) = @_;
    my $list = $self->db->prepare(q{
        select * from countries where code = ?
    });
    $list->execute($code);
    my $res = $list->fetchrow_hashref;
    $list->finish;
    $res
}

sub country_list {
    my ($self) = @_;
    my $list = $self->db->prepare(q{
        select * from countries order by name
    });
    $list->execute;
    return $list->fetchall_arrayref({});
}

sub version_list {
    my ($self) = @_;
    my $list = $self->db->prepare(q{
        select * from distributions
    });
    $list->execute;
    return $list->fetchall_hashref([qw(version)]);
}

sub arch_list {
    my ($self, $version) = @_;
    my $list = $self->db->prepare(q{
        select * from distributions
        } . ($version
        ? q{ where version = ? }
        : q{})
        );
    $list->execute($version ? $version : ());
    return $list->fetchall_hashref([qw(arch)]);
}

sub mirror_validity {
    my ($self, $uri) = @_;
    my $listf = $self->db->prepare(q{
        select * from global_files
    });
    $listf->execute;
    while (my $res = $listf->fetchrow_hashref) {
        my $furi = URI->new($uri . $res->{relpath});
        $self->_check_url($furi) or return;
    }

    1;
}

sub check_distributions {
    my ($self) = @_;

    my $uneeded_check = $self->db->prepare(q{
        select * from distributions_validity where
        lastcheck > now() - '6 hours'::interval
        });
    $uneeded_check->execute();
    my $uch = $uneeded_check->fetchall_hashref([ qw(urlskey distributionkey) ]);

    my $listd = $self->db->prepare(q{
        select * from toplevel_urls, distributions
        where toplevel_urls.valid = true
        });

    my $addstatus = $self->db->prepare(q{
        insert into distributions_validity (urlskey, distributionkey, exists)
        values (?,?,?)
        });

    my $updstatus = $self->db->prepare(q{
        update distributions_validity set lastcheck = now(), exists = ?
        where urlskey = ? and distributionkey = ?
        });
    my $upd_lastok = $self->db->prepare(q{
        update distributions_validity set lastok = now()
        where urlskey = ? and distributionkey = ?
        });

    my %urls_status = ();

    my $updurl = $self->db->prepare(q{
        update toplevel_urls set lastcheck = now(), valid = ?
        where key = ?
    });
    my $upd_url_lastok = $self->db->prepare(q{
        update toplevel_urls set lastok = now()
        where key = ?
    });

    $listd->execute();
    while (my $res = $listd->fetchrow_hashref) {
        $uch->{$res->{key}}{$res->{dkey}} and next;
        my $url = $self->fmt_url($res);
        if (!exists($urls_status{$res->{key}})) {
            $self->update_host_ips($res->{hostname});
            my $ok = $self->mirror_validity($url);
            $updurl->execute($ok ? 1 : 0, $res->{key});
            $upd_url_lastok->execute($res->{key}) if ($ok);
            $urls_status{$res->{key}} = $ok;
        }
        $urls_status{$res->{key}} or next;
        my $furi = URI->new(join('/', $url, $res->{relpath}, $res->{relfile}));
        my $exists = $self->_check_url($furi);
        if ($updstatus->execute($exists, $res->{key}, $res->{dkey}) == 0) {
            $addstatus->execute($res->{key}, $res->{dkey}, $exists);
        }
        $upd_lastok->execute($res->{key}, $res->{dkey}) if ($exists);
        $self->db->commit;
    }
}

sub _check_url {
    my ($self, $furi) = @_;
    my ($fh, $filename) = tempfile();
    close($fh);
    my $cmd = 
    $furi->scheme =~ /^http|ftp$/ ? "wget --no-check-certificate -nv -t 1 -T 4 -O $filename " . $furi->as_string :
    $furi->scheme eq 'rsync' ? "rsync --timeout 4 -q " . $furi->as_string . " $filename" : '';
    my $ok = (system($cmd) == 0);
    unlink($filename);
    return $ok
}

sub get_protocol_info {
    my ($self, $protocol) = @_;
    my $get = $self->db->prepare(q{
        select * from protocol where name = ?
    });
    $get->execute($protocol);
    my $res = $get->fetchrow_hashref;
    $get->finish;
    $res;
}

sub find_mirrors {
    my ($self, $filters, $key) = @_;

    my $query = q{
        select *,
        coalesce(hosts.latitude, countries.latitude) as latitude,
        coalesce(hosts.longitude, countries.longitude) as longitude
        from hosts
        left join countries on countries.code = hosts.country
        where hosts.hostname in (select hostname from toplevel_urls %s)
        %s
    };

    my (@mvals, @uvals);
    my (@mw, @uw);
    if (keys %{ $filters || {}}) {
        foreach (keys %$filters) {
            $filters->{$_} or next;
            if (my $field = {
                hostname => 'hosts.hostname',
                country => 'countries.code',
                continent => 'countries.contienent_code',
            }->{$_}) {
                push(@mw, sprintf('%s = any(?)', $field));
                push(@mvals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]);
            }
            if (my $field = {
                protocol => 'protocol',
                valid => 'url.valid',
            }->{$_}) {
                push(@uw, sprintf('%s = any(?)', $field));
                push(@uvals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]);
            }
        }
    }
    my $list = $self->db->prepare(sprintf(
        $query,
        (@uw ? 'where ' . join(' and ', @uw) : ''),
        (@mw ? 'and '   . join(' and ', @mw) : ''),
    ));
    $list->execute(@uvals, @mvals);
    return $list->fetchall_arrayref({});
}

sub _find_urls {
    my ($self, $filters, $key) = @_;

    my $query = q{
        select toplevel_urls.* from toplevel_urls join
        hosts on hosts.hostname = toplevel_urls.hostname
    };
    my @vals;
    if (keys %{ $filters || {} }) {
        my @w;
        foreach (keys %$filters) {
            $filters->{$_} or next;
            my $field = {
                hostname => 'hosts.hostname',
                protocol => 'toplevel_urls.protocol',
            }->{$_} or next;

            push(@w, sprintf('%s = any(?)', $field));
            push(@vals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]);
        }
        $query .= ' where ' if (@w);
        $query .= join(' and ', @w);
    }
    my $list = $self->db->prepare($query);
    $list->execute(@vals);
    return $list->fetchall_arrayref({});
}

sub find_distributions {
    my ($self, $filters, $key) = @_;
    return [
        map { $_->{url} = $self->fmt_url($_); $_ }
        @{ $self->_find_distributions($filters) || []}]
}

sub _find_distributions {
    my ($self, $filters, $key) = @_;

    my $query = q{
    select *, toplevel_urls.path || distributions.relpath as path from hosts
    join toplevel_urls on toplevel_urls.hostname = hosts.hostname
    join distributions_validity on toplevel_urls.key = distributions_validity.urlskey
    join distributions on distributions.dkey = distributions_validity.distributionkey
    };

    my @vals;
    if (keys %{ $filters || {} }) {
        my @w;
        foreach (keys %$filters) {
            $filters->{$_} or next;
            my $field = {
                hostname => 'hosts.hostname',
                protocol => 'topelvel_urls.protocol',
                version => 'distributions.version',
                arch => 'distributions.arch',
                country => 'mirrors.country',
            }->{$_} or next;

            push(@w, sprintf('%s = any(?)', $field));
            push(@vals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]);
        }
        $query .= ' where ' if (@w);
        $query .= join(' and ', @w);
    }
    my $list = $self->db->prepare($query);
    $list->execute(@vals);
    return $list->fetchall_arrayref({});
}

sub find_host_ip_overlap {
    my ($self, $hostname) = @_;

    my @addresses = $self->host_ips($hostname);

    my $list = $self->db->prepare(q{
        select * from ips where ip = any(?)
            and hostname != ?
    });
    $list->execute(\@addresses, $hostname);
    my $res = $list->fetchall_hashref('hostname');
    return keys %{ $res };
}

sub add_or_update_host {
    my ($self, $hostname, %info) = @_;

    my (@fields, @vals);
    while (my ($field, $val) = each(%info)) {
        push(@fields, $field);
        push(@vals,   $val || undef);
    }
    if (keys %info) {
        my $upd = $self->db->prepare(sprintf(q{
            update hosts set %s where hostname = ?
        }, join(', ', map { "$_ = ?" } @fields)));
        if ($upd->execute(@vals, $hostname) == 0) {
            my $add = $self->db->prepare(sprintf(q{
                insert into hosts (%s) values (%s)
                }, join(', ', (@fields, 'hostname')),
                join(',', ('?') x (scalar(@fields)+1))
            ));
            $add->execute(@vals, $hostname) or do {
                $self->db->rollback;
                return;
            };
        }
    }

    $self->update_host_ips($hostname);

    1;
}

sub add_or_update_url {
    my ($self, $uri) = @_;
    if (!ref $uri) {
        $uri = URI->new($uri);
    }

    my $update = $self->db->prepare(q{
        update toplevel_urls set path = ?, port = ?, valid = true
        where hostname = ? and protocol = ?
    });

    if ($update->execute(
            $uri->path, $uri->port == $uri->default_port ? undef : $uri->port,
            $uri->host, $uri->scheme
        ) == 0) {
        my $add = $self->db->prepare(q{
            insert into toplevel_urls (path, port, hostname, protocol)
            values (?,?,?,?)
            });
        $add->execute($uri->path, $uri->port == $uri->default_port ? undef : $uri->port,
            $uri->host, $uri->scheme) or do {
            $self->db->rollback;
            return;
        }
    }

    1;
}

sub update_host_ips {
    my ($self, $hostname) = @_;

    my @addresses = $self->host_ips($hostname);
    my $delete = $self->db->prepare(
        q{delete from ips where hostname = ?
            and ip != any(?)
        }
    );

    $delete->execute($hostname, [ @addresses ]);

    my $getip = $self->db->prepare(q{
        select 1 from ips where hostname = ? and ip = ?
    });
    my $addip = $self->db->prepare(q{
        insert into ips (hostname, ip) values (?,?)
    });
    foreach (@addresses) {
        if ($getip->execute($hostname, $_) == 0) {
            $addip->execute($hostname, $_);
        }
        $getip->finish;
    }
    
    1;
}

sub find_urls {
    my ($self, $filters, $key) = @_;
    return [
        map { $_->{url} = $self->fmt_url($_); $_ }
        @{ $self->_find_urls($filters) || []}]
}

sub fmt_url {
    my ($self, $dburl) = @_;

    $dburl->{path} =~ s:/+:/:g;
    my $uri = URI->new(
        sprintf('%s://%s%s',
            $dburl->{protocol},
            $dburl->{hostname},
            $dburl->{path} || '/',
        )        
    );
    $uri->port($dburl->{port});

    return $uri->as_string;
}

1;