File: build-firmware-map

package info (click to toggle)
hw-detect 1.142
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 1,664 kB
  • sloc: sh: 1,408; makefile: 103; perl: 102; ansic: 39
file content (138 lines) | stat: -rwxr-xr-x 4,111 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#!/usr/bin/perl
# © 2016 Cyril Brulebois <kibi@debian.org>

use strict;
use warnings;

use Getopt::Long;
use Crypt::GPG;
use Digest::SHA;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use List::MoreUtils qw(uniq);
use LWP::UserAgent;

# Parameter handling:
my $mirror     = 'http://ftp.fr.debian.org/debian';
my $suite      = 'testing';
my $archs      = 'ANY';
my $components = 'main,contrib,non-free';
my $verbose    = 0;

GetOptions (
    'mirror=s'     => \$mirror,
    'suite=s'      => \$suite,
    'archs=s'      => \$archs,
    'components=s' => \$components,
    'verbose'      => \$verbose,
) or die "Error in command line parameters; supported: --mirror,--suite,--archs,--components,--verbose";

# Let's start:
my $ua = LWP::UserAgent->new;
$ua->env_proxy;

# Getting Release and Release.gpg files:
my $response = $ua->get("$mirror/dists/$suite/Release");
die "failing while fetching dists/$suite/Release"
    if ! $response->is_success;
my $release = $response->content;

$response = $ua->get("$mirror/dists/$suite/Release.gpg");
die "failing while fetching dists/$suite/Release.gpg"
    if ! $response->is_success;
my $release_gpg = $response->content;

# Checking GPG:
# XXX: we're getting debug output from gpg every time.
my $gpg = new Crypt::GPG;
$gpg->gpgopts('--no-default-keyring --keyring=/usr/share/keyrings/debian-archive-keyring.gpg');
my ($plaintext, $sig) = $gpg->verify([$release_gpg], [$release]);
die "failed to verify signature: Release/Release.gpg"
    if ! $sig or $sig->validity ne 'GOOD';

# Iterating on all architectures:
if ($archs eq 'ANY') {
    foreach my $line (split /\n/, $release) {
        if ($line =~ /^Architectures: (.+)$/) {
            # Switch to comma-separated values to make the next bit work:
            $archs = $1;
            $archs =~ s/ /,/g;
        }
    }
}
print STDERR "architectures: $archs\n"
    if $verbose;

# Extract the SHA256 block (ugly) and remember checksum/size:
(my $sha256 = $release) =~ s/.*^SHA256:\n((?: .+?\n)+).*/$1/ms;
my %checksum;
my %size;
my @filenames;
foreach my $line (split /\n/, $sha256) {
    my @bits = split /\s+/, $line;
    my $filename = $bits[3];
    $checksum{ $filename } = $bits[1];
    $size{ $filename } = $bits[2];
    push @filenames, $filename;
}

# Extract interesting filenames from Release files:
# XXX: this isn't too nice
my @files;
(my $c_pattern = $components) =~ s/,/|/g;
(my $a_pattern = $archs)      =~ s/,/|/g;
foreach my $filename (@filenames) {
    # Note: only picking up .gz compressed files (no other compression
    #       as of 2016-05-22); not looking at Contents-udeb-$arch.gz
    if ($filename =~ m{^((?:$c_pattern)/Contents-(?:$a_pattern)\.gz)$}) {
        push @files, $1;
    }
}
@files = uniq sort @files;

# Iterate on all filenames:
my %map;
foreach my $file (@files) {
    # Fetch Contents-$arch.gz file:
    my $url = "$mirror/dists/$suite/$file";
    print STDERR "url: $url\n"
        if $verbose;
    my $content = $ua->get($url);
    die "failing while fetching $url"
        if ! $content->is_success;

    # Check sha256 sum and size:
    my $compressed = $content->content;
    if (length $compressed != $size{$file}) {
        die "size error for $file";
    }
    if (Digest::SHA::sha256_hex($compressed) ne $checksum{$file}) {
        die "checksum error for $file";
    }

    # Uncompress:
    my $uncompressed;
    gunzip \$compressed, \$uncompressed
      or die "gunzip failed: $GunzipError.\n";

    # Extract firmware files:
    (my $component = $file) =~ s{^(.+?)/.*}{$1};
    print STDERR "$file:\n"
        if $verbose;
    foreach my $line (split /\n/, $uncompressed) {
        if ($line =~ m{^(\S+)\s+(.+)/(.+)$}) {
            my ($filename, $section, $package) = ($1, $2, $3);
            if ($filename =~ m{^lib/firmware/}) {
                $map{ $filename } = "$package $component";
                print STDERR "  $line\n"
                    if $verbose;
            }
        }
    }
    print STDERR "\n"
        if $verbose;
}

# Output the results:
foreach my $file (sort keys %map) {
    printf "%s %s\n", $file, $map{ $file };
}