debianforum.de

dpkg-scanpackges - whezzy

SNIPPET_TEXT:

1. #!/usr/bin/perl
2. #
3. # dpkg-scanpackages
4. #
5. # Copyright © 2006-2012 Guillem Jover <guillem@debian.org>
6. #
7. # This program is free software; you can redistribute it and/or modify
8. # it under the terms of the GNU General Public License as published by
9. # the Free Software Foundation; either version 2 of the License, or
10. # (at your option) any later version.
11. #
12. # This program is distributed in the hope that it will be useful,
13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15. # GNU General Public License for more details.
16. #
17. # You should have received a copy of the GNU General Public License
18. # along with this program.  If not, see <http://www.gnu.org/licenses/>.
19.  
20. use warnings;
21. use strict;
22.  
23. use IO::Handle;
24. use IO::File;
25. use Getopt::Long qw(:config posix_default bundling no_ignorecase);
26.  
27. use Dpkg;
28. use Dpkg::Gettext;
29. use Dpkg::ErrorHandling;
30. use Dpkg::Control;
31. use Dpkg::Version;
32. use Dpkg::Checksums;
33. use Dpkg::Compression::FileHandle;
34. use Dpkg::IPC;
35.  
36. textdomain("dpkg-dev");
37.  
38. # Do not pollute STDOUT with info messages
39. report_options(info_fh => \*STDERR);
40.  
41. my (@samemaint, @changedmaint);
42. my @spuriousover;
43. my %packages;
44. my %overridden;
45.  
46. my %options = (help            => sub { usage(); exit 0; },
47.                version         => \&version,
48.                type            => undef,
49.                arch            => undef,
50.                multiversion    => 0,
51.                'extra-override'=> undef,
52.                medium          => undef,
53.               );
54.  
55. my $result = GetOptions(\%options,
56.                         'help|?', 'version', 'type|t=s',
57.                         'arch|a=s', 'multiversion|m!', 'extra-override|e=s',
58.                         'medium|M=s');
59.  
60. sub version {
61.     printf _g("Debian %s version %s.\n"), $progname, $version;
62.     exit;
63. }
64.  
65. sub usage {
66.     printf _g(
67. "Usage: %s [<option>...] <binary-path> [<override-file> [<path-prefix>]] > Packages
68.  
69. Options:
70.   -t, --type <type>        scan for <type> packages (default is 'deb').
71.   -a, --arch <arch>        architecture to scan for.
72.   -m, --multiversion       allow multiple versions of a single package.
73.   -e, --extra-override <file>
74.                            use extra override file.
75.   -M, --medium <medium>    add X-Medium field for dselect multicd access method
76.   -?, --help               show this help message.
77.       --version            show the version.
78. "), $progname;
79. }
80.  
81. sub load_override
82. {
83.     my $override = shift;
84.     my $comp_file = Dpkg::Compression::FileHandle->new(filename => $override);
85.  
86.     while (<$comp_file>) {
87.         s/\#.*//;
88.         s/\s+$//;
89.         next unless $_;
90.  
91.         my ($p, $priority, $section, $maintainer) = split(/\s+/, $_, 4);
92.  
93.         if (not defined($packages{$p})) {
94.             push(@spuriousover, $p);
95.             next;
96.         }
97.  
98.         for my $package (@{$packages{$p}}) {
99.             if ($maintainer) {
100.                 if ($maintainer =~ m/(.+?)\s*=\>\s*(.+)/) {
101.                     my $oldmaint = $1;
102.                     my $newmaint = $2;
103.                     my $debmaint = $$package{Maintainer};
104.                     if (!grep($debmaint eq $_, split(m:\s*//\s*:, $oldmaint))) {
105.                         push(@changedmaint,
106.                              sprintf(_g("  %s (package says %s, not %s)"),
107.                                      $p, $$package{Maintainer}, $oldmaint));
108.                     } else {
109.                         $$package{Maintainer} = $newmaint;
110.                     }
111.                 } elsif ($$package{Maintainer} eq $maintainer) {
112.                     push(@samemaint, "  $p ($maintainer)");
113.                 } else {
114.                     warning(_g("Unconditional maintainer override for %s"), $p);
115.                     $$package{Maintainer} = $maintainer;
116.                 }
117.             }
118.             $$package{Priority} = $priority;
119.             $$package{Section} = $section;
120.         }
121.         $overridden{$p} = 1;
122.     }
123.  
124.     close($comp_file);
125. }
126.  
127. sub load_override_extra
128. {
129.     my $extra_override = shift;
130.     my $comp_file = Dpkg::Compression::FileHandle->new(filename => $extra_override);
131.  
132.     while (<$comp_file>) {
133.         s/\#.*//;
134.         s/\s+$//;
135.         next unless $_;
136.  
137.         my ($p, $field, $value) = split(/\s+/, $_, 3);
138.  
139.         next unless defined($packages{$p});
140.  
141.         for my $package (@{$packages{$p}}) {
142.             $$package{$field} = $value;
143.         }
144.     }
145.  
146.     close($comp_file);
147. }
148.  
149. usage() and exit 1 if not $result;
150.  
151. if (not @ARGV >= 1 && @ARGV <= 3) {
152.     usageerr(_g("one to three arguments expected"));
153. }
154.  
155. my $type = defined($options{type}) ? $options{type} : 'deb';
156. my $arch = $options{arch};
157.  
158. my @find_args;
159. if ($options{arch}) {
160.      @find_args = ('(', '-name', "*_all.$type", '-o',
161.                         '-name', "*_${arch}.$type", ')');
162. }
163. else {
164.      @find_args = ('-name', "*.$type");
165. }
166.  
167. my ($binarydir, $override, $pathprefix) = @ARGV;
168.  
169. -d $binarydir or error(_g("Binary dir %s not found"), $binarydir);
170. defined($override) and (-e $override or
171.     error(_g("Override file %s not found"), $override));
172.  
173. $pathprefix = '' if not defined $pathprefix;
174.  
175. my $find_h = new IO::Handle;
176. open($find_h, '-|', 'find', '-L', "$binarydir/", @find_args, '-print')
177.      or syserr(_g("Couldn't open %s for reading"), $binarydir);
178. FILE:
179.     while (<$find_h>) {
180.         chomp;
181.         my $fn = $_;
182.         my $output;
183.         my $pid = spawn('exec' => [ "dpkg-deb", "-I", $fn, "control" ],
184.                         'to_pipe' => \$output);
185.         my $fields = Dpkg::Control->new(type => CTRL_INDEX_PKG);
186.         $fields->parse($output, $fn)
187.             or error(_g("couldn't parse control information from %s"), $fn);
188.         wait_child($pid, no_check => 1);
189.         if ($?) {
190.             warning(_g("\`dpkg-deb -I %s control' exited with %d, skipping package"),
191.                     $fn, $?);
192.             next;
193.         }
194.        
195.         defined($fields->{'Package'})
196.             or error(_g("No Package field in control file of %s"), $fn);
197.         my $p = $fields->{'Package'};
198.        
199.         if (defined($packages{$p}) and not $options{multiversion}) {
200.             foreach (@{$packages{$p}}) {
201.                 if (version_compare_relation($fields->{'Version'}, REL_GT,
202.                                              $_->{'Version'}))
203.                 {
204.                     warning(_g("Package %s (filename %s) is repeat but newer version;"),
205.                             $p, $fn);
206.                     warning(_g("used that one and ignored data from %s!"),
207.                             $_->{Filename});
208.                     $packages{$p} = [];
209.                 } else {
210.                     warning(_g("Package %s (filename %s) is repeat;"), $p, $fn);
211.                     warning(_g("ignored that one and using data from %s!"),
212.                             $_->{Filename});
213.                     next FILE;
214.                 }
215.             }
216.         }
217.         warning(_g("Package %s (filename %s) has Filename field!"), $p, $fn)
218.             if defined($fields->{'Filename'});
219.        
220.         $fields->{'Filename'} = "$pathprefix$fn";
221.        
222.         my $sums = Dpkg::Checksums->new();
223.         $sums->add_from_file($fn);
224.         foreach my $alg (checksums_get_list()) {
225.             if ($alg eq "md5") {
226.                 $fields->{'MD5sum'} = $sums->get_checksum($fn, $alg);
227.             } else {
228.                 $fields->{$alg} = $sums->get_checksum($fn, $alg);
229.             }
230.         }
231.         $fields->{'Size'} = $sums->get_size($fn);
232.         $fields->{'X-Medium'} = $options{medium} if defined $options{medium};
233.        
234.         push @{$packages{$p}}, $fields;
235.     }
236. close($find_h);
237.  
238. load_override($override) if defined $override;
239. load_override_extra($options{'extra-override'}) if defined $options{'extra-override'};
240.  
241. my @missingover=();
242.  
243. my $records_written = 0;
244. for my $p (sort keys %packages) {
245.     if (defined($override) and not defined($overridden{$p})) {
246.         push(@missingover,$p);
247.     }
248.     for my $package (@{$packages{$p}}) {
249.          print(STDOUT "$package\n") or syserr(_g("Failed when writing stdout"));
250.          $records_written++;
251.     }
252. }
253. close(STDOUT) or syserr(_g("Couldn't close stdout"));
254.  
255. if (@changedmaint) {
256.     warning(_g("Packages in override file with incorrect old maintainer value:"));
257.     warning($_) foreach (@changedmaint);
258. }
259. if (@samemaint) {
260.     warning(_g("Packages specifying same maintainer as override file:"));
261.     warning($_) foreach (@samemaint);
262. }
263. if (@missingover) {
264.     warning(_g("Packages in archive but missing from override file:"));
265.     warning("  %s", join(' ', @missingover));
266. }
267. if (@spuriousover) {
268.     warning(_g("Packages in override file but not in archive:"));
269.     warning("  %s", join(' ', @spuriousover));
270. }
271.  
272. info(_g("Wrote %s entries to output Packages file."), $records_written);
273. [/code]
274.  
275. und so bei mein neuen Jessie Server:
276. [code]
277. #!/usr/bin/perl
278. #
279. # dpkg-scanpackages
280. #
281. # Copyright © 2006-2012 Guillem Jover <guillem@debian.org>
282. #
283. # This program is free software; you can redistribute it and/or modify
284. # it under the terms of the GNU General Public License as published by
285. # the Free Software Foundation; either version 2 of the License, or
286. # (at your option) any later version.
287. #
288. # This program is distributed in the hope that it will be useful,
289. # but WITHOUT ANY WARRANTY; without even the implied warranty of
290. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
291. # GNU General Public License for more details.
292. #
293. # You should have received a copy of the GNU General Public License
294. # along with this program.  If not, see <https://www.gnu.org/licenses/>.
295.  
296. use warnings;
297. use strict;
298.  
299. use IO::Handle;
300. use IO::File;
301. use Getopt::Long qw(:config posix_default bundling no_ignorecase);
302.  
303. use Dpkg ();
304. use Dpkg::Gettext;
305. use Dpkg::ErrorHandling;
306. use Dpkg::Util qw(:list);
307. use Dpkg::Control;
308. use Dpkg::Version;
309. use Dpkg::Checksums;
310. use Dpkg::Compression::FileHandle;
311. use Dpkg::IPC;
312.  
313. textdomain('dpkg-dev');
314.  
315. # Do not pollute STDOUT with info messages
316. report_options(info_fh => \*STDERR);
317.  
318. my (@samemaint, @changedmaint);
319. my @spuriousover;
320. my %packages;
321. my %overridden;
322.  
323. my %options = (help            => sub { usage(); exit 0; },
324.                version         => \&version,
325.                type            => undef,
326.                arch            => undef,
327.                hash            => undef,
328.                multiversion    => 0,
329.                'extra-override'=> undef,
330.                medium          => undef,
331.               );
332.  
333. my @options_spec = (
334.     'help|?',
335.     'version',
336.     'type|t=s',
337.     'arch|a=s',
338.     'hash|h=s',
339.     'multiversion|m!',
340.     'extra-override|e=s',
341.     'medium|M=s',
342. );
343.  
344. sub version {
345.     printf _g("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
346.     exit;
347. }
348.  
349. sub usage {
350.     printf _g(
351. "Usage: %s [<option>...] <binary-path> [<override-file> [<path-prefix>]] > Packages
352.  
353. Options:
354.   -t, --type <type>        scan for <type> packages (default is 'deb').
355.   -a, --arch <arch>        architecture to scan for.
356.   -h, --hash <hash-list>   only generate hashes for the specified list.
357.   -m, --multiversion       allow multiple versions of a single package.
358.   -e, --extra-override <file>
359.                            use extra override file.
360.   -M, --medium <medium>    add X-Medium field for dselect multicd access method
361.   -?, --help               show this help message.
362.       --version            show the version.
363. "), $Dpkg::PROGNAME;
364. }
365.  
366. sub load_override
367. {
368.     my $override = shift;
369.     my $comp_file = Dpkg::Compression::FileHandle->new(filename => $override);
370.  
371.     while (<$comp_file>) {
372.         s/\#.*//;
373.         s/\s+$//;
374.         next unless $_;
375.  
376.         my ($p, $priority, $section, $maintainer) = split(/\s+/, $_, 4);
377.  
378.         if (not defined($packages{$p})) {
379.             push(@spuriousover, $p);
380.             next;
381.         }
382.  
383.         for my $package (@{$packages{$p}}) {
384.             if ($maintainer) {
385.                 if ($maintainer =~ m/(.+?)\s*=\>\s*(.+)/) {
386.                     my $oldmaint = $1;
387.                     my $newmaint = $2;
388.                     my $debmaint = $$package{Maintainer};
389.                     if (none { $debmaint eq $_ } split m{\s*//\s*}, $oldmaint) {
390.                         push(@changedmaint,
391.                              sprintf(_g('  %s (package says %s, not %s)'),
392.                                      $p, $$package{Maintainer}, $oldmaint));
393.                     } else {
394.                         $$package{Maintainer} = $newmaint;
395.                     }
396.                 } elsif ($$package{Maintainer} eq $maintainer) {
397.                     push(@samemaint, "  $p ($maintainer)");
398.                 } else {
399.                     warning(_g('unconditional maintainer override for %s'), $p);
400.                     $$package{Maintainer} = $maintainer;
401.                 }
402.             }
403.             $$package{Priority} = $priority;
404.             $$package{Section} = $section;
405.         }
406.         $overridden{$p} = 1;
407.     }
408.  
409.     close($comp_file);
410. }
411.  
412. sub load_override_extra
413. {
414.     my $extra_override = shift;
415.     my $comp_file = Dpkg::Compression::FileHandle->new(filename => $extra_override);
416.  
417.     while (<$comp_file>) {
418.         s/\#.*//;
419.         s/\s+$//;
420.         next unless $_;
421.  
422.         my ($p, $field, $value) = split(/\s+/, $_, 3);
423.  
424.         next unless defined($packages{$p});
425.  
426.         for my $package (@{$packages{$p}}) {
427.             $$package{$field} = $value;
428.         }
429.     }
430.  
431.     close($comp_file);
432. }
433.  
434. {
435.     local $SIG{__WARN__} = sub { usageerr($_[0]) };
436.     GetOptions(\%options, @options_spec);
437. }
438.  
439. if (not (@ARGV >= 1 and @ARGV <= 3)) {
440.     usageerr(_g('one to three arguments expected'));
441. }
442.  
443. my $type = $options{type} // 'deb';
444. my $arch = $options{arch};
445. my %hash = map { $_ => 1 } split /,/, $options{hash} // '';
446.  
447. foreach my $alg (keys %hash) {
448.     if (not checksums_is_supported($alg)) {
449.         usageerr(_g('unsupported checksum \'%s\''), $alg);
450.     }
451. }
452.  
453. my @find_args;
454. if ($options{arch}) {
455.      @find_args = ('(', '-name', "*_all.$type", '-o',
456.                         '-name', "*_${arch}.$type", ')');
457. }
458. else {
459.      @find_args = ('-name', "*.$type");
460. }
461.  
462. my ($binarydir, $override, $pathprefix) = @ARGV;
463.  
464. if (not -d $binarydir) {
465.     error(_g('binary dir %s not found'), $binarydir);
466. }
467. if (defined $override and not -e $override) {
468.     error(_g('override file %s not found'), $override);
469. }
470.  
471. $pathprefix //= '';
472.  
473. my $find_h = IO::Handle->new();
474. open($find_h, '-|', 'find', '-L', "$binarydir/", @find_args, '-print')
475.      or syserr(_g("couldn't open %s for reading"), $binarydir);
476. FILE:
477.     while (my $fn = <$find_h>) {
478.         chomp $fn;
479.         my $output;
480.         my $pid = spawn(exec => [ 'dpkg-deb', '-I', $fn, 'control' ],
481.                         to_pipe => \$output);
482.         my $fields = Dpkg::Control->new(type => CTRL_INDEX_PKG);
483.         $fields->parse($output, $fn)
484.             or error(_g("couldn't parse control information from %s"), $fn);
485.         wait_child($pid, nocheck => 1);
486.         if ($?) {
487.             warning(_g("\`dpkg-deb -I %s control' exited with %d, skipping package"),
488.                     $fn, $?);
489.             next;
490.         }
491.  
492.         defined($fields->{'Package'})
493.             or error(_g('no Package field in control file of %s'), $fn);
494.         my $p = $fields->{'Package'};
495.  
496.         if (defined($packages{$p}) and not $options{multiversion}) {
497.             foreach my $pkg (@{$packages{$p}}) {
498.                 if (version_compare_relation($fields->{'Version'}, REL_GT,
499.                                              $pkg->{'Version'}))
500.                 {
501.                     warning(_g('package %s (filename %s) is repeat but newer version;'),
502.                             $p, $fn);
503.                     warning(_g('used that one and ignored data from %s!'),
504.                             $pkg->{Filename});
505.                     $packages{$p} = [];
506.                 } else {
507.                     warning(_g('package %s (filename %s) is repeat;'), $p, $fn);
508.                     warning(_g('ignored that one and using data from %s!'),
509.                             $pkg->{Filename});
510.                     next FILE;
511.                 }
512.             }
513.         }
514.         warning(_g('package %s (filename %s) has Filename field!'), $p, $fn)
515.             if defined($fields->{'Filename'});
516.  
517.         $fields->{'Filename'} = "$pathprefix$fn";
518.  
519.         my $sums = Dpkg::Checksums->new();
520.         $sums->add_from_file($fn);
521.         foreach my $alg (checksums_get_list()) {
522.             next if %hash and not $hash{$alg};
523.  
524.             if ($alg eq 'md5') {
525.                 $fields->{'MD5sum'} = $sums->get_checksum($fn, $alg);
526.             } else {
527.                 $fields->{$alg} = $sums->get_checksum($fn, $alg);
528.             }
529.         }
530.         $fields->{'Size'} = $sums->get_size($fn);
531.         $fields->{'X-Medium'} = $options{medium} if defined $options{medium};
532.  
533.         push @{$packages{$p}}, $fields;
534.     }
535. close($find_h);
536.  
537. load_override($override) if defined $override;
538. load_override_extra($options{'extra-override'}) if defined $options{'extra-override'};
539.  
540. my @missingover=();
541.  
542. my $records_written = 0;
543. for my $p (sort keys %packages) {
544.     if (defined($override) and not defined($overridden{$p})) {
545.         push @missingover, $p;
546.     }
547.     for my $package (@{$packages{$p}}) {
548.          print("$package\n") or syserr(_g('failed when writing stdout'));
549.          $records_written++;
550.     }
551. }
552. close(STDOUT) or syserr(_g("couldn't close stdout"));
553.  
554. if (@changedmaint) {
555.     warning(_g('Packages in override file with incorrect old maintainer value:'));
556.     warning($_) foreach (@changedmaint);
557. }
558. if (@samemaint) {
559.     warning(_g('Packages specifying same maintainer as override file:'));
560.     warning($_) foreach (@samemaint);
561. }
562. if (@missingover) {
563.     warning(_g('Packages in archive but missing from override file:'));
564.     warning('  %s', join(' ', @missingover));
565. }
566. if (@spuriousover) {
567.     warning(_g('Packages in override file but not in archive:'));
568.     warning('  %s', join(' ', @spuriousover));
569. }
570.  
571. info(_g('Wrote %s entries to output Packages file.'), $records_written);

Quellcode

Hier kannst du den Code kopieren und ihn in deinen bevorzugten Editor einfügen. PASTEBIN_DOWNLOAD_SNIPPET_EXPLAIN