redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # use strict; use warnings; use Getopt::Long; # Declaration of important/main variables. my $quiet = 0; my $sparse = 0; my $help = 0; my $explain = 1; my $debug = 0; my $reasondir = '/usr/share/vrms/reasons/'; my %reason = (); # # Auxiliary functions section (FIXME: put them in a file by themselves). # # sub usage: # Input: nothing. # Output: Messages to stdout telling the usage of the program. sub usage() { print <<EOF; Usage: vrms [OPTIONS] ... --quiet, -q Do nothing if there are no non-free packages installed. --explain, -e Give a brief explanation of why a package is non-free, if available. --sparse, -s Just list non-free packages, nothing else. --reason-dir=DIR Use DIR as the reason directory. --help, -h Display this help. --debug, -d Generate debugging information. All options can be prefixed with "no" (eg: --noexplain) to turn them off. EOF } # sub parse_reason_file: # Input: the name of a reason file and the global hash %reason # Output: the hash %reason filled with reasons from the input file # (FIXME: %reason shouldn't be global) sub parse_reason_file { my $file = shift; print "Parsing reason file $file\n" if $debug >= 1; open(REASON, "<", $file) or die "Can't open FILE [$file]: $!\n"; while (my $line = <REASON>) { chomp $line; # Grab a line of the form 'package: reason', skip if we don't match my ($pkg, $reason) = ($line =~ /^(\S+):\s+(.*)\s*$/) or next; print "'$pkg' because '$reason'\n" if ($debug >= 1); # If this is _our_ master file, then prefer anything # else (so that package maintainers can override) next if exists $reason{$pkg} and $file =~ /\/vrms$/; $reason{$pkg} = $reason; } close REASON or die "Can't close FILE [$file]: $!\n"; } # # Main program starts here. # GetOptions('q|quiet' => \$quiet, 's|sparse' => \$sparse, 'e|explain!' => \$explain, 'reason-dir=s' => \$reasondir, 'd|debug+' => \$debug, 'h|help' => \$help); if ($help) { usage(); exit 0; } opendir(REASONDIR, $reasondir) or die "Can't open DIR [$reasondir]: $!\n"; # Parse all the reason files in $reasondir except those beginning with # a . or ending with a ~ parse_reason_file("$reasondir/$_") foreach (grep {!/~$/ && !/^\./} readdir(REASONDIR)); closedir REASONDIR or die "Can't close DIR [$reasondir]: $!\n"; my $statusfile = '/var/lib/dpkg/status'; my $is_nonfree = 0; ### preset none found, yet my %nonfree = (); my $is_other_nonfree = 0; ### preset none found, yet my %other_nonfree = (); my $is_contrib = 0; ### preset none found, yet my %contrib = (); my $is_other_contrib = 0; ### preset none found, yet my %other_contrib = (); my %pkg_status = (); my $pkgcnt = 0; my $clumpcnt = 0; my $dontcarelines = 5; ### no. of lines a non-installed entry may have in the statusfile my $sysname = ""; chop($sysname = `uname -n`); open(PKG_SOURCE, "< $statusfile") or die "Can't open FILE [$statusfile]: $!\n"; $/ = ""; ### snarf a paragraph at a time while(<PKG_SOURCE>) { my $clump = $_; $clumpcnt++; my (@pkglines) = split(/\n/, $clump); ### iff more than $dontcarelines lines, package is installed, so process it ### (speed-up by skipping don't-care entries) if (@pkglines > $dontcarelines) { my $pkg = ""; ### name of this package my $pkgstatus = ""; ### status my $plan = ""; ### install plan (hold, deinstall, purge, install, etc.) my $state = ""; ### state (ok or ???) my $status = ""; ### status (installed, not-installed, etc.) my $section = ""; ### section this is where non-free is marked my $shortdescr = ""; ### one-liner description of pkg my $linenbr = 0; ### current line number of this pkackag's info my $label = ""; ### junk field (not used, except to catch split values) my $has_pkg = 0; ### reset the markers my $has_status = 0; my $has_section = 0; foreach (@pkglines) { chomp; $linenbr++; if (/^Package:/) { ($label, $pkg) = split(/:\s+/,$_,2); $pkgcnt++; printf "pkg(%4.4d) pkg=[%s]\n",$pkgcnt,$pkg if $debug >= 1; $has_pkg = 1; ### we have necessary section next; } if (/^Status:/) { my $label = ""; ($label, $pkgstatus) = split(/:\s+/,$_,2); print "\tpkgstatus=[$pkgstatus]\n" if $debug >= 1; $pkg_status{$pkg} = $pkgstatus; ($plan, $state, $status) = split(/\s+/,$pkgstatus); print "\t\tplan=[$plan]\n" if $debug >= 1; print "\t\tstate=[$state]\n" if $debug >= 1; print "\t\tstatus=[$status]\n" if $debug >= 1; $has_status = 1; ### we have necessary section next; } if (/^Section:/) { my $label = ""; ($label, $section) = split(/:\s+/,$_,2); print "\tsection=[$section]\n" if $debug >= 1; $has_section = 1; ### we have necessary section if ($section =~ /contrib|non-free|restricted|multiverse/) { ### read thru rest of array to find descr instead of waiting for it my $found_descr =0; while (! $found_descr) { if ($linenbr > $#pkglines) { ### iff badly formed entry ensure blank description print "\tEEEE shortdescr=[$shortdescr]\n" if $debug >= 1; last; } my $dline = $pkglines[$linenbr++]; if($dline =~ /^Description:/) { ($label, $shortdescr) = split(/:\s+/,$dline,2); print "\tshortdescr=[$shortdescr]\n" if $debug >= 1; $found_descr = 1; } } if ($section =~ /contrib/) { if (lc $status eq 'installed') { $is_contrib = 1; $contrib{$pkg} = $shortdescr; } else { $is_other_contrib = 1; $other_contrib{$pkg} = $shortdescr; } } else { if (lc $status eq 'installed') { $is_nonfree = 1; $nonfree{$pkg} = $shortdescr; } else { $is_other_nonfree = 1; $other_nonfree{$pkg} = $shortdescr; } } } last; ### this is last desriptor of package we care about so end loop } else { ### un-processed lines from package info if($debug >= 1) { print "\t\t--- $_\n"; } } } if (!$has_status or !$has_pkg) { print STDERR "vrms: ERROR- Badly formed dpkg-status entry #$clumpcnt!\n"; print STDERR " pkg=[$pkg], pkgstatus=[$pkgstatus], section=[$section] \n"; } source code
fmarier
andpad
doradora09
macloud
hsugita
rinchsan
recruitengineers
usaito
hirotomotaguchi
yu4u
kaz29
poteboy
mh4gf
eileencodes
philnash
tanoku
chrislema
searls
geeforr
edds
bluesmoon
paulrobertlloyd
hannesfritz
erikaheidi
chriscoyier
![@fmarier [email protected] Questions?](https://files.speakerdeck.com/presentations/4f574a34d31bbb0022013889/slide_86.jpg){kind=link}
