report repositories that are gone
[opensuse:webpin2.git] / repomanager
1 #!/usr/bin/perl
2 # vim: set ai et sw=3 ts=3 nu:
3 #
4 # Updates Solr with repository metadata
5 #
6 # by Pascal Bleser <pascal.bleser@opensuse.org>
7 #
8 #     This library is free software; you can redistribute it and/or modify it
9 #     under the terms of the GNU Lesser General Public License as published by
10 #     the Free Software Foundation; either version 2.1 of the License, or (at
11 #     your option) any later version.
12 #                 
13 #     This library is distributed in the hope that it will be useful, but
14 #     WITHOUT ANY WARRANTY; without even the implied warranty of
15 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 #     Lesser General Public License for more details.
17 #      
18 #     You should have received a copy of the GNU Lesser General Public
19 #     License along with this library; if not, write to the Free Software
20 #     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307,
21 #     USA.
22
23 use strict;
24 use warnings;
25 use LWP::UserAgent;
26 use HTTP::Date;
27 use File::Spec;
28 use File::Basename;
29 use HTML::Entities ();
30 use XML::LibXML;
31 use POSIX;
32 use IO::Uncompress::Gunzip;
33 use Term::ProgressBar;
34 use WebService::Solr;
35 use Getopt::Long;
36
37 use lib './lib';
38 use RPM_MD;
39 use YaST2_MD;
40
41 my $repos = "./repos.d";
42 my $cache_dir = "./cache.d";
43 my $verbose = undef;
44
45 GetOptions(
46    'v|verbose' => \$verbose,
47 );
48
49 my $solr_escape_chars = quotemeta( '+-&|!(){}[]^"~*?:\\' );
50 my @repos = ();
51
52 my @rfiles = ();
53 if (scalar(@ARGV) > 0) {
54    push(@rfiles, @ARGV);
55 } else {
56    @rfiles = grep { -f } glob($repos.'/*.conf');
57 }
58
59 foreach my $rfile (@rfiles) {
60    open(my $fh, '<', $rfile) or die "failed to open $rfile: $!";
61    while (<$fh>) {
62       chomp;
63       s/#.*$//;
64       s/^\s*//;
65       s/\s*//;
66       next if /^$/;
67       if (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)(?:\s+(\S+))?$/) {
68          my $r = {
69             repoid         => $1,
70             distname       => $2,
71             distversion    => $3,
72             baseurl        => $4,
73             configfile     => $rfile,
74          };
75          $r->{mdtype} = defined $5 ? $5 : 'rpmmd';
76          push(@repos, $r);
77       } else {
78          die "invalid repo spec in $rfile at line $.";
79       }
80    }
81    close($fh);
82 }
83
84 my $ua = LWP::UserAgent->new(
85    timeout      => 10,
86    agent        => "webpin-repomanager/1.0",
87    max_redirect => 4,
88 );
89 $ua->env_proxy();
90
91 my $solr = WebService::Solr->new("http://localhost:8983/solr", {
92     autocommit => 0,
93 });
94 $solr->ping() or die "failed to ping Solr";
95
96 sub f($$) {
97     my $name = shift;
98     my $value = shift;
99     my $field = WebService::Solr::Field->new($name => $value);
100     return $field;
101 }
102
103 sub solr_escape($) {
104    my $v = shift;
105    $v =~ s{([$solr_escape_chars])}{\\$1}g;
106    return $v;
107 }
108
109 my @gone = ();
110 my $total = 0;
111 foreach my $r (@repos) {
112    print $r->{repoid}, "\n" if $verbose;
113
114    my $cache = File::Spec->catfile($cache_dir, $r->{repoid}.".cache");
115    {
116       my $dir = dirname($cache);
117       mkdir($dir, 0750) unless -d $dir;
118    }
119
120    my $timestamp = undef;
121    my $last_modified = undef;
122    my $etag = undef;
123    {
124       if (-e $cache) {
125          open(my $fh, '<', $cache) or die "failed to open cache file $cache: $!";
126          chomp($timestamp = <$fh>);
127          chomp($last_modified = <$fh>);
128          chomp($etag = <$fh>);
129          close($fh);
130       }
131    }
132
133    my $h = {
134       last_modified => $last_modified,
135       etag          => $etag,
136       timestamp     => $timestamp,
137    };
138
139    my @docs = ();
140    my $packages = undef;
141    my $repoheaders = undef;
142    {
143       my $pr = undef;
144       if ($r->{mdtype} eq 'rpmmd') {
145          eval {
146             $pr = parse_rpmmd($r, $h, $ua, $verbose);
147             #($packages, $repoheaders) = parse_rpmmd($r, $h, $ua, $verbose);
148          };
149          if ($@) {
150             warn "failed to parse repository ".$r->{repoid}.": ".$@;
151             next;
152          }
153       } elsif ($r->{mdtype} eq 'yast2') {
154          eval {
155             $pr = parse_y2md($r, $h, $ua, $verbose);
156          };
157          if ($@) {
158             warn "failed to parse repository ".$r->{repoid}.": ".$@;
159             next;
160          }
161       } else {
162          warn "unsupported repository type \"".$r->{mdtype}."\"";
163          next;
164       }
165
166       if (ref($pr) eq 'ARRAY') {
167          $packages = $pr->[0];
168          $repoheaders = $pr->[1];
169       } elsif (ref($pr) eq 'HASH') {
170          push(@gone, $r);
171          next;
172       } elsif (not defined($pr)) {
173          next;
174       } else {
175          warn "unsupported scalar returned by parser: $pr";
176          next;
177       }
178
179       foreach my $p (@$packages) {
180          die "missing summary in ".join('-', map { $p->{$_} } qw(name version release arch)) unless exists $p->{summary};
181          while (my ($k, $v) = each(%$p)) {
182             die "found undef for $k in package ".join('-', map { $p->{$_} } qw(name version release arch)) unless defined $v;
183             if (ref($v) eq 'ARRAY') {
184                foreach (@$v) {
185                   die "found undef in list $k in package ".join('-', map { $p->{$_} } qw(name version release arch)) unless defined $_;
186                }
187             }
188          }
189       }
190
191       foreach my $p (@$packages) {
192          next if $p->{name} =~ /\-debug(info|source)$/;
193          next if $p->{arch} eq "src";
194
195          foreach (qw(repoid distname distversion)) {
196             $p->{$_} = $r->{$_};
197          }
198
199          # post-process
200          if (exists $p->{description} and defined $p->{description}) {
201             $p->{description} =~ s/\s*\bAuthors?:?.*$//ms;
202          }
203          
204          if (exists $p->{packager} and defined $p->{packager}) {
205             $p->{packager} =~ s/\s*<.+@.+>//;
206             $p->{packager} =~ s/\w.+@.+\w//;
207             $p->{packager} = HTML::Entities::encode_numeric($p->{packager});
208          }
209
210          {
211             foreach my $tag (qw(requires provides)) {
212                my @pp = grep { not /^(rpmlib|libc\.so|debuginfo\()/ } @{$p->{$tag}};
213                $p->{$tag} = \@pp;
214             }
215          }
216
217          $p->{mime} = [];
218          $p->{perl} = [];
219          foreach ($p->{provides}) {
220             push(@{$p->{mime}}, $1) if /^(?:mimetype|mimehandler)\(.+?\)/;
221             push(@{$p->{perl}}, $1) if /^perl\(.+?\)/;
222          }
223
224          $p->{tag} = [];
225          push(@{$p->{tag}}, 'doc') if $p->{name} =~ /-doc$/;
226          push(@{$p->{tag}}, 'lang') if $p->{name} =~ /-lang$/;
227          push(@{$p->{tag}}, 'devel') if $p->{name} =~ /-devel$/;
228          push(@{$p->{tag}}, 'perl') if $p->{name} =~ /^perl-\D$/;
229          push(@{$p->{tag}}, 'python') if $p->{name} =~ /^python-\D$/;
230          push(@{$p->{tag}}, 'ruby') if $p->{name} =~ /^ruby(gem)?-\D$/;
231          push(@{$p->{tag}}, 'lib') if $p->{name} =~ /^lib/;
232
233          # make a Solr document from that
234          my @fields = ();
235          while (my ($k, $v) = each(%$p)) {
236             next if $k eq 'configfile';
237
238             if (ref($v) eq 'ARRAY') {
239                foreach (@$v) {
240                   die "undef found for $k in ".join("-", ($p->{name}, $p->{version}, $p->{release})) if not defined $_;
241                   push(@fields, f($k, $_));
242                }
243             } elsif (ref($v) eq '') {
244                push(@fields, f($k, $v));
245             } else {
246                die "wtf, a ref ? ($k)";
247             }
248          }
249          my $doc = WebService::Solr::Document->new;
250          $doc->add_fields(@fields);
251          push(@docs, $doc);
252       }
253
254       my $solr_repoid = solr_escape($r->{repoid});
255       print "\t", "deleting repoid:", $solr_repoid, "\n" if $verbose;
256       $solr->delete_by_query('repoid:'.$solr_repoid) or die "failed to delete repoid:".$solr_repoid;
257       if (scalar(@docs) > 0) {
258          my $progress = undef;
259          if ($verbose) {
260             $progress = Term::ProgressBar->new({
261                count => scalar(@docs),
262                name  => "adding to Solr",
263                ETA   => 'linear',
264             });
265             $progress->minor(0);
266          }
267          #print "\t", "adding ", scalar(@docs), " docs to Solr", "\n" if $verbose;
268          foreach my $doc (@docs) {
269             $solr->add($doc, { overwrite => 1 });
270             $progress->update() if $progress;
271          }
272          $total += scalar(@docs);
273          #$solr->add(@docs, { overwrite => 1 });
274       }
275       print "\t", "committing Solr", "\n" if $verbose;
276       $solr->commit();
277       print "\n";
278    }
279
280    # save to cache
281    if (exists $repoheaders->{timestamp} and defined $repoheaders->{timestamp} and exists $repoheaders->{last_modified} and defined $repoheaders->{last_modified}) {
282       open(my $fh, '>', $cache) or die "failed to open cache for write: $cache: $!";
283       print $fh $repoheaders->{timestamp}, "\n";
284       print $fh $repoheaders->{last_modified}, "\n";
285       if (exists $repoheaders->{etag} and defined $repoheaders->{etag}) {
286          print $fh $repoheaders->{etag}, "\n"; #->header("etag"), "\n";
287       } else {
288          print $fh "\n";
289       }
290       close($fh);
291       print "saved cache to $cache\n";
292    }
293
294 }
295
296 if ($total > 0) {
297    print "optimizing Solr index\n" if $verbose;
298    $solr->optimize();
299 }
300
301 if (scalar(@gone) > 0) {
302    print "The following repositories have disappeared:", "\n";
303    foreach my $r (@gone) {
304       print join("    ", map { $r->{$_} } qw(configfile repoid distname distversion baseurl)), "\n";
305    }
306 }
307