You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

219 lines
5.5 KiB

  1. #!/usr/bin/perl -w
  2. #
  3. # Copyright (C) 2003 by Bill Allombert <ballombe@debian.org>
  4. # This program is free software; you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation; either version 2 of the License, or
  7. # (at your option) any later version.
  8. #
  9. # This program is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. # GNU General Public License for more details.
  13. #
  14. # You should have received a copy of the GNU General Public License
  15. # along with this program; if not, write to the Free Software
  16. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  17. # based on a design and a bash/gawk script
  18. #
  19. # Copyright (C) 1998,2000 by Avery Pennarun, for the Debian Project.
  20. # Use, modify, and redistribute modified or unmodified versions in any
  21. # way you wish.
  22. use strict;
  23. use 5.6.0;
  24. my $dpkg_db="/var/lib/dpkg/info";
  25. my $dpkg_origin="/etc/dpkg/origins/default";
  26. my $popcon_conf="/etc/popularity-contest.conf";
  27. # $popcon_conf is in shell-script format
  28. my $HOSTID = qx(unset MY_HOSTID; . $popcon_conf; echo \$MY_HOSTID );
  29. chomp $HOSTID;
  30. if ( $HOSTID eq "")
  31. {
  32. print STDERR "You must set MY_HOSTID in $popcon_conf!\n";
  33. exit 1;
  34. }
  35. if ( $HOSTID eq "d41d8cd98f00b204e9800998ecf8427e")
  36. {
  37. print STDERR "Warning: MY_HOSTID is the md5sum of the empty file!\n";
  38. print STDERR "Please change it to the md5sum of a random file in $popcon_conf!\n";
  39. }
  40. if ( $HOSTID !~ /^([a-f0-9]{32})$/)
  41. {
  42. print STDERR "Error: MY_HOSTID does not match ^([a-f0-9]{32})\$\n";
  43. print STDERR "Please edit $popcon_conf to use a valid md5sum value\n";
  44. exit 1;
  45. }
  46. # List all mapped files
  47. my %mapped;
  48. if (opendir(PROC, "/proc"))
  49. {
  50. my @procfiles = readdir(PROC);
  51. closedir(PROC);
  52. foreach (@procfiles)
  53. {
  54. -d "/proc/$_" or next;
  55. m{^[0-9]+$} or next;
  56. open MAPS, "/proc/$_/maps" or next;
  57. while (<MAPS>)
  58. {
  59. m{(/.*)} or next;
  60. $mapped{$1} = 1;
  61. }
  62. close MAPS;
  63. }
  64. }
  65. if (defined($ARGV[0]) && $ARGV[0] eq "--su-nobody")
  66. {
  67. my $user="nobody";
  68. my ($uid, $gid, $home, $shell) = (getpwnam($user))[2,3,7,8];
  69. $( = $) = $gid;
  70. $< = $> = $uid;
  71. $ENV{USER} = $user;
  72. $ENV{LOGNAME} = $user;
  73. $ENV{HOME} = $home;
  74. $ENV{SHELL} = $shell;
  75. }
  76. # Architecture.
  77. my $debarch = `dpkg --print-architecture`;
  78. chomp $debarch;
  79. # Popcon release
  80. my $popconver=`dpkg-query --showformat='\${version}' --show popularity-contest`;
  81. # Vendor
  82. my $vendor="unknown";
  83. if (open(VENDOR, "<", $dpkg_origin))
  84. {
  85. while (<VENDOR>)
  86. {
  87. m/^Vendor: *(.*)/ and $vendor=$1;
  88. }
  89. close(VENDOR);
  90. }
  91. # Initialise time computations
  92. my $now = time;
  93. my $halfdaylen = 12 * 60 *60;
  94. my $daylen = 2 * $halfdaylen;
  95. my $monthlen = $daylen * 30;
  96. my $lastmonth = $now - $monthlen;
  97. sub trunc_time {
  98. return $halfdaylen * int($_[0] / $halfdaylen);
  99. }
  100. my %popcon=();
  101. # List files diverted by dpkg
  102. my %diverted;
  103. if (open DIVERSIONS, "env LC_ALL=C dpkg-divert --list|")
  104. {
  105. while (<DIVERSIONS>)
  106. {
  107. next unless /^(?:local )?diversion of (\S+) to (?:\S+)(?: by (\S+))?\s*$/;
  108. $diverted{$1} = defined $2 ? $2 : ""
  109. }
  110. close DIVERSIONS;
  111. }
  112. my %pkgs_files = ();
  113. if (opendir(my $DPKG_DB, $dpkg_db))
  114. {
  115. for my $e (readdir($DPKG_DB)) {
  116. if ($e =~ m/^([^:]+) .*? \. list$/x) {
  117. $pkgs_files{$1} ||= [];
  118. push @{$pkgs_files{$1}}, "$dpkg_db/$e";
  119. }
  120. }
  121. closedir($DPKG_DB);
  122. }
  123. # Read dpkg database of installed packages
  124. open PACKAGES, "dpkg-query --show --showformat='\${status} \${package}\\n'|";
  125. while (<PACKAGES>)
  126. {
  127. /^.*installed *(.+)$/ or next;
  128. my $pkg=$1;
  129. my $bestatime = undef;
  130. my $list;
  131. # dpkg-query reports multiple times the same package for diff archs
  132. next if $popcon{$pkg};
  133. $popcon{$pkg}=[0,0,$pkg,"<NOFILES>"];
  134. foreach (@{$pkgs_files{$pkg}})
  135. {
  136. open FILES, $_ or next;
  137. while (<FILES>)
  138. {
  139. chop;
  140. next unless (
  141. ( m{/bin/|/sbin/|/lib/.+/|^/usr/games/|\.[ah]$|\.pm$|\.php$|^/boot/System\.map-}
  142. && ! m{/lib/.+-.+-.+/} && ! m{^/usr/lib/mime/packages/}
  143. || defined $mapped{$_} )
  144. && -f $_);
  145. next if defined $diverted{$_} and $diverted{$_} ne $pkg;
  146. my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  147. $atime,$mtime,$ctime,$blksize,$blocks)
  148. = stat;
  149. if (defined $mapped{$_}) {
  150. # It's currently being accessed by a process
  151. $atime = time();
  152. }
  153. if (!defined($bestatime) || $atime >= $bestatime)
  154. {
  155. # Truncate time to reduce informaton leak.
  156. my $tatime = &trunc_time($atime);
  157. my $tctime = &trunc_time($ctime);
  158. $bestatime=$atime;
  159. if ($atime < $lastmonth)
  160. {
  161. # Not accessed since more than 30 days.
  162. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_,"<OLD>"];
  163. }
  164. elsif ($ctime > $lastmonth && $atime-$ctime < $daylen)
  165. {
  166. # Installed/upgraded less than a month ago and not used after
  167. # install/upgrade day.
  168. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_,"<RECENT-CTIME>"];
  169. }
  170. else
  171. {
  172. # Else we `vote' for the package.
  173. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_];
  174. }
  175. }
  176. }
  177. close FILES;
  178. }
  179. }
  180. close PACKAGES;
  181. # We're not done yet. Sort the output in reverse by atime, and
  182. # add a header/footer.
  183. print "POPULARITY-CONTEST-0 TIME:",time," ID:$HOSTID ".
  184. "ARCH:$debarch POPCONVER:$popconver VENDOR:$vendor\n";
  185. for (sort { $popcon{$b}[0] <=> $popcon{$a}[0] } keys %popcon)
  186. {
  187. print join(' ',@{$popcon{$_}}),"\n";
  188. }
  189. print "END-POPULARITY-CONTEST-0 TIME:",time,"\n";