- handle distributions, protocol andothers things

4 files changed, 221 insertions, 8 deletions

diff --git a/lib/MGA/Mirrors/Controller/Distrib.pm b/lib/MGA/Mirrors/Controller/Distrib.pm
new file mode 100644
index 0000000..0d49e55
--- /dev/null
+++ b/lib/MGA/Mirrors/Controller/Distrib.pm
@@ -0,0 +1,48 @@
+package MGA::Mirrors::Controller::Distrib;
+use Moose;
+use namespace::autoclean;
+
+BEGIN {extends 'Catalyst::Controller'; }
+
+=head1 NAME
+
+MGA::Mirrors::Controller::Distrib - Catalyst Controller
+
+=head1 DESCRIPTION
+
+Catalyst Controller.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 index
+
+=cut
+
+sub index :Path :Args(0) {
+    my ( $self, $c ) = @_;
+
+}
+
+sub list :Path :Args(1) {
+    my ( $self, $c ) = @_;
+    $c->stash->{current_view} = 'TTBlock';
+    $c->stash->{template} = 'distrib/distrib.tt';
+}
+
+=head1 AUTHOR
+
+Olivier Thauvin
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/lib/MGA/Mirrors/Controller/Mirrors.pm b/lib/MGA/Mirrors/Controller/Mirrors.pm
new file mode 100644
index 0000000..5d07ca5
--- /dev/null
+++ b/lib/MGA/Mirrors/Controller/Mirrors.pm
@@ -0,0 +1,66 @@
+package MGA::Mirrors::Controller::Mirrors;
+use Moose;
+use namespace::autoclean;
+
+BEGIN {extends 'Catalyst::Controller'; }
+
+=head1 NAME
+
+MGA::Mirrors::Controller::Mirrors - Catalyst Controller
+
+=head1 DESCRIPTION
+
+Catalyst Controller.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 index
+
+=cut
+
+sub index :Path :Args(0) {
+    my ( $self, $c ) = @_;
+
+    $c->response->body('Matched MGA::Mirrors::Controller::Mirrors in Mirrors.');
+}
+
+sub mirror :Path :Args(1) {
+    my ( $self, $c, $host ) = @_;
+    $c->stash->{hostname} = $host;
+
+    if ($c->req->param('hostinfo')) {
+        my $hinfo = $c->model('Mirrors')->find_mirrors({
+            hostname => $host,
+        })->[0];
+        if (! $hinfo->{readonly}) {
+            $c->model('Mirrors')->add_or_update_host($host,
+                bandwidth => $c->req->param('bandwidth'),
+                city => $c->req->param('city'),
+                country => $c->req->param('country'),
+                syncfrom=> $c->req->param('syncfrom'),
+            );
+        }
+    }
+
+    $c->stash->{host} = $c->model('Mirrors')->find_mirrors({
+        hostname => $host,
+    })->[0];
+}
+
+=head1 AUTHOR
+
+Olivier Thauvin
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/lib/MGA/Mirrors/Controller/New.pm b/lib/MGA/Mirrors/Controller/New.pm
index fbb1fbe..d3ec38c 100644
--- a/lib/MGA/Mirrors/Controller/New.pm
+++ b/lib/MGA/Mirrors/Controller/New.pm
@@ -44,8 +44,10 @@ sub index :Path :Args(0) {
                 hostname => $uri->host, });
         if (@{$urls || []}) {
             $c->stash->{exists_url} = $urls;
-            $c->stash->{subtemplate} = 'new/mirror_exists.tt';
-            return;
+            if ($urls->[0]->{valid}) {
+                $c->stash->{subtemplate} = 'new/mirror_exists.tt';
+                return;
+            }
         }
 
         if (!$c->model('Mirrors')->mirror_validity($uri)) {
@@ -62,17 +64,18 @@ sub index :Path :Args(0) {
         my @ips = $c->model('Mirrors')->host_ips($uri->host);
 
         $c->stash->{location} = $c->model('Mirrors')->locate_ips(@ips);
+        $c->stash->{host}{country} = $c->stash->{location}{code};
 
         my $mirror = $c->model('Mirrors')->find_mirrors(
             { hostname => $uri->host, });
         if (@{ $mirror || []}) {
             $c->stash->{mirror} = $mirror->[0];
         } elsif ($c->req->param('hostinfo')) {
-            foreach (qw(city country)) {
+            foreach (qw(city country syncfrom bandwidth)) {
                 $c->session->{hostinfo}{$_} = $c->req->param($_);
             }
         } else {
-            $c->stash->{subtemplate} = 'new/host_information.tt';
+            $c->stash->{subtemplate} = 'new/new_host.tt';
             return;
         }
 
@@ -94,6 +97,8 @@ sub confirm :Path :Args(1) {
                     $uri->host,
                     city => $c->session->{hostinfo}{city},
                     country => $c->session->{hostinfo}{country},
+                    bandwidth => $c->session->{hostinfo}{bandwidth},
+                    syncfrom => $c->session->{hostinfo}{syncfrom},
                 );
             } else {
                 return;
diff --git a/lib/MGA/Mirrors/DB.pm b/lib/MGA/Mirrors/DB.pm
index 5ff0649..31eb4cc 100644
--- a/lib/MGA/Mirrors/DB.pm
+++ b/lib/MGA/Mirrors/DB.pm
@@ -74,6 +74,35 @@ sub locate_ips {
     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) = @_;
+    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_list {
     my ($self) = @_;
     my $list = $self->db->prepare(q{
@@ -83,6 +112,27 @@ sub country_list {
     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{
@@ -153,7 +203,7 @@ sub _check_url {
     my ($fh, $filename) = tempfile();
     close($fh);
     my $cmd = 
-    $furi->scheme =~ /^http|ftp$/ ? "wget -nv -t 1 -T 4 -O $filename " . $furi->as_string :
+    $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);
@@ -196,6 +246,7 @@ sub find_mirrors {
             }
             if (my $field = {
                 protocol => 'protocol',
+                valid => 'url.valid',
             }->{$_}) {
                 push(@uw, sprintf('%s = any(?)', $field));
                 push(@uvals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]);
@@ -220,17 +271,59 @@ sub _find_urls {
     };
     my @vals;
     if (keys %{ $filters || {} }) {
-        $query .= ' where ';
         my @w;
         foreach (keys %$filters) {
+            $filters->{$_} or next;
+            my $field = {
+                hostname => 'hosts.hostname',
+                protocol => '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 *, urls.path || distributions.relpath as path from hosts
+    join urls on urls.hostname = hosts.hostname
+    join mirrors_distributions on urls.key = mirrors_distributions.urlskey
+    join distributions on distributions.dkey = mirrors_distributions.distributionkey
+    };
+
+    my @vals;
+    if (keys %{ $filters || {} }) {
+        my @w;
+        foreach (keys %$filters) {
+            $filters->{$_} or next;
             my $field = {
                 hostname => 'hosts.hostname',
                 protocol => '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);
@@ -258,7 +351,7 @@ sub add_or_update_host {
     my (@fields, @vals);
     while (my ($field, $val) = each(%info)) {
         push(@fields, $field);
-        push(@vals,   $val);
+        push(@vals,   $val || undef);
     }
     if (keys %info) {
         my $upd = $self->db->prepare(sprintf(q{
@@ -289,7 +382,7 @@ sub add_or_update_url {
     }
 
     my $update = $self->db->prepare(q{
-        update urls set path = ?, port = ?
+        update urls set path = ?, port = ?, valid = true
         where hostname = ? and protocol = ?
     });
 
@@ -349,6 +442,7 @@ sub find_urls {
 sub fmt_url {
     my ($self, $dburl) = @_;
 
+    $dburl->{path} =~ s:/+:/:g;
     my $uri = URI->new(
         sprintf('%s://%s%s',
             $dburl->{protocol},