report repositories that are gone
[opensuse:webpin2.git] / lib / RPM_MD.pm
1 # vim: set ai et sw=3 ts=3 nu:
2 package RPM_MD;
3
4 use strict;
5 use warnings;
6 use IO::Uncompress::Gunzip;
7 use LWP::UserAgent;
8 use HTTP::Date;
9 use HTTP::Status qw(:constants);
10 use POSIX;
11 use XML::LibXML;
12 use Term::ProgressBar;
13
14 BEGIN {
15    use Exporter();
16    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
17
18    $VERSION     = 1.00;
19    @ISA         = qw(Exporter);
20    @EXPORT      = qw(&parse_rpmmd);
21    %EXPORT_TAGS = ();
22    @EXPORT_OK   = qw(&parse_rpmmd);
23
24    our $parser = XML::LibXML->new();
25    $parser->validation(0);
26    $parser->no_network(1);
27    $parser->load_ext_dtd(0);
28 }
29 our @EXPORT_OK;
30 our $parser;
31
32 use constant {
33    NS_REPO   => 'http://linux.duke.edu/metadata/repo',
34    NS_RPM    => 'http://linux.duke.edu/metadata/rpm',
35    NS_COMMON => 'http://linux.duke.edu/metadata/common',
36 };
37
38 sub ct($$$) {
39    my $node = shift;
40    my $ns = shift;
41    my $tag = shift;
42    my @children = $node->getChildrenByTagNameNS($ns, $tag);
43    if (@children and (scalar(@children) > 0)) {
44       return $children[0]->textContent;
45    } else {
46       die "no $tag under ".($node->nodeName);
47    }
48 }
49
50 sub cto($$$) {
51    my $node = shift;
52    my $ns = shift;
53    my $tag = shift;
54    my @children = $node->getChildrenByTagNameNS($ns, $tag);
55    if (@children and (scalar(@children) > 0)) {
56       return $children[0]->textContent;
57    } else {
58       return undef;
59    }
60 }
61
62 sub ce($$$) {
63    my $node = shift;
64    my $ns = shift;
65    my $tag = shift;
66    my @children = $node->getChildrenByTagNameNS($ns, $tag);
67    if (@children and (scalar(@children) > 0)) {
68       return $children[0];
69    } else {
70       die "no $tag under ".($node->nodeName);
71    }
72 }
73
74 sub ceo($$$) {
75    my $node = shift;
76    my $ns = shift;
77    my $tag = shift;
78    my @children = $node->getChildrenByTagNameNS($ns, $tag);
79    if (@children and (scalar(@children) > 0)) {
80       return $children[0];
81    } else {
82       return undef;
83    }
84 }
85
86 sub _a($$$) {
87    my $h = shift;
88    my $k = shift;
89    my $v = shift;
90    $h->{$k} = $v if defined $v;
91 }
92
93 sub parse_rpmmd($$$$) {
94    my $r = shift;
95    my $h = shift;
96    my $ua = shift;
97    my $verbose = shift;
98
99    die "no baseurl ?" unless exists $r->{baseurl} and defined $r->{baseurl};
100    my $repomd_xml_url = $r->{baseurl}.'/repodata/repomd.xml';
101
102    print "\t", "downloading ", $repomd_xml_url, ": " if $verbose;
103    my %headers = ();
104    $headers{'If-Modified-Since'} = $h->{last_modified} if exists $h->{last_modified} and defined $h->{last_modified};
105    $headers{'Etag'} = $h->{etag} if exists $h->{etag} and defined $h->{etag};
106
107    my $resp = $ua->get($repomd_xml_url, %headers) or die "failed to get $repomd_xml_url: $!";
108
109    my $ri = {};
110
111    my $repomd_timestamp = undef;
112    my $repomd_lastmod = undef;
113    my $repomd_location = undef;
114    my $repomd_checksum = undef;
115    my $repomd_checksum_type = undef;
116
117    my $needs_processing = undef;
118    print $resp->status_line, "\n" if $verbose;
119    if ($resp->code eq HTTP_NOT_MODIFIED or ($resp->is_success and exists $h->{last_modified} and defined $h->{last_modified} and $h->{last_modified} ne $resp->last_modified)) {
120       print "\t", "not modified", "\n" if $verbose;
121       return (undef, undef);
122    } elsif ($resp->is_success) {
123       my $content = $resp->content;
124       {
125          my $tree = $parser->load_xml(string => $content);
126          my $root = $tree->getDocumentElement();
127          foreach my $data ($root->getChildrenByTagNameNS(NS_REPO, 'data')) {
128             next unless $data->getAttribute('type') eq 'primary';
129             my $location = ce($data, NS_REPO, 'location');
130             $repomd_location = $location->getAttribute('href');
131             $repomd_timestamp = ct($data, NS_REPO, 'timestamp');
132             my $checksum = ce($data, NS_REPO, 'checksum');
133             $repomd_checksum = $checksum->textContent;
134             $repomd_checksum_type = $checksum->getAttribute('type');
135          }
136          my $revision = cto($root, NS_REPO, 'revision');
137          $ri->{timestamp} = defined $revision ? $revision : $repomd_timestamp;
138          $ri->{last_modified} = $resp->header('Last-Modified');
139          $ri->{etag} = $resp->header('Etag');
140       }
141
142       return (undef, undef) if exists $h->{timestamp} and defined $h->{timestamp} and $h->{timestamp} eq $repomd_timestamp;
143    } else {
144       warn "failed to retrieve $repomd_xml_url: ".$resp->status_line;
145       return {};
146    }
147   
148    my $primary_url = $r->{baseurl}.'/'.$repomd_location;
149
150    $ua->show_progress(1) if $verbose;
151    my $primary_resp = $ua->get($primary_url);
152    $ua->show_progress(0);
153
154    if (not $primary_resp->is_success) {
155       warn "failed to download $primary_url: ".$primary_resp->status_line;
156       return {};
157    }
158
159    my $content_ref = $primary_resp->content_ref;
160    my $z = new IO::Uncompress::Gunzip($content_ref);
161
162    my $tree = $parser->load_xml(IO => $z);
163    my $root = $tree->getDocumentElement();
164    my $total = $root->getAttribute("packages");
165
166    my $progress = undef;
167    if ($verbose) {
168       $progress = Term::ProgressBar->new({
169          count => $total,
170          name  => "        parsing XML",
171          ETA   => 'linear',
172       });
173       $progress->minor(0);
174    }
175
176    my @packages = ();
177    foreach my $package ($root->getChildrenByTagNameNS(NS_COMMON, 'package')) {
178       $progress->update() if defined $progress;
179
180       my $name = ct($package, NS_COMMON, 'name');
181       my $arch = ct($package, NS_COMMON, 'arch');
182
183       my $d = ();
184       $d->{name} = $name;
185       $d->{arch} = $arch;
186
187       my $version_elt = ce($package, NS_COMMON, 'version');
188       $d->{version} = $version_elt->getAttribute('ver');
189       $d->{release} = $version_elt->getAttribute('rel');
190       $d->{summary} = HTML::Entities::encode_numeric(ct($package, NS_COMMON, 'summary'));
191       my $packager = ct($package, NS_COMMON, 'packager');
192       $d->{packager} = $packager if $packager and length($packager) > 0;
193
194       $d->{description} = HTML::Entities::encode_numeric(ct($package, NS_COMMON, 'description'));
195
196       my $format = ce($package, NS_COMMON, 'format');
197       $d->{vendor} = HTML::Entities::encode_numeric(ct($format, NS_RPM, 'vendor'));
198
199       my $size_elt = ce($package, NS_COMMON, 'size');
200       $d->{size_package} = $size_elt->getAttribute('package');
201       $d->{size_installed} = $size_elt->getAttribute('installed');
202
203       my $location_elt = ce($package, NS_COMMON, 'location');
204       $d->{location} = $r->{baseurl}.'/'.$location_elt->getAttribute('href');
205
206       $d->{buildtime} = strftime("%Y-%m-%dT%H:%M:%S.000Z", gmtime(ce($package, NS_COMMON, 'time')->getAttribute('build')));
207
208       my $url_elt = ce($package, NS_COMMON, 'url');
209       if ($url_elt) {
210          my $url = $url_elt->textContent;
211          HTML::Entities::encode_numeric($url);
212          $d->{url} = $url if $url and length($url) > 0;
213       }
214
215       $d->{sha} = ct($package, NS_COMMON, 'checksum');
216
217       _a($d, 'sourcerpm', cto($format, NS_RPM, 'sourcerpm'));
218       _a($d, 'group', cto($format, NS_RPM, 'group'));
219       _a($d, 'license', cto($format, NS_RPM, 'license'));
220
221       while (my ($k, $v) = each(%$d)) {
222          die "undefined value for key $k" unless defined $v;
223       }
224
225       $d->{file} = [];
226       foreach my $file (map { $_->textContent } $format->getChildrenByTagNameNS(NS_COMMON, 'file')) {
227          push(@{$d->{file}}, $file);
228       }
229
230       for my $tag (qw(provides requires supplements conflicts obsoletes recommends)) {
231          $d->{$tag} = [];
232          my $e = ceo($format, NS_RPM, $tag);
233          next unless defined $e;
234          foreach my $entry ($e->getChildrenByTagNameNS(NS_RPM, 'entry')) {
235             push(@{$d->{$tag}}, $entry->getAttribute('name'));
236          }
237       }
238
239       push(@packages, $d);
240    }
241    close($z);
242
243    return (\@packages, $ri);
244 }
245
246 1;