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.

192 lines
4.9 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. # Architecture.
  47. my $debarch = `dpkg --print-architecture`;
  48. chomp $debarch;
  49. # Popcon release
  50. my $popconver=`dpkg-query --showformat='\${version}' --show popularity-contest`;
  51. # Vendor
  52. my $vendor="unknown";
  53. if (open(VENDOR, "<", $dpkg_origin))
  54. {
  55. while (<VENDOR>)
  56. {
  57. m/^Vendor: *(.*)/ and $vendor=$1;
  58. }
  59. close(VENDOR);
  60. }
  61. # Initialise time computations
  62. my $now = time;
  63. my $halfdaylen = 12 * 60 *60;
  64. my $daylen = 2 * $halfdaylen;
  65. my $monthlen = $daylen * 30;
  66. my $lastmonth = $now - $monthlen;
  67. sub trunc_time {
  68. return $halfdaylen * int($_[0] / $halfdaylen);
  69. }
  70. my %popcon=();
  71. # List all mapped files
  72. my %mapped;
  73. if (opendir(PROC, "/proc"))
  74. {
  75. my @procfiles = readdir(PROC);
  76. closedir(PROC);
  77. foreach (@procfiles)
  78. {
  79. -d "/proc/$_" or next;
  80. m{^[0-9]+$} or next;
  81. open MAPS, "/proc/$_/maps" or next;
  82. while (<MAPS>)
  83. {
  84. m{(/.*)} or next;
  85. $mapped{$1} = 1;
  86. }
  87. close MAPS;
  88. }
  89. }
  90. # List files diverted by dpkg
  91. my %diverted;
  92. if (open DIVERSIONS, "env LC_ALL=C dpkg-divert --list|")
  93. {
  94. while (<DIVERSIONS>)
  95. {
  96. next unless /^(?:local )?diversion of (\S+) to (?:\S+)(?: by (\S+))?\s*$/;
  97. $diverted{$1} = defined $2 ? $2 : ""
  98. }
  99. close DIVERSIONS;
  100. }
  101. # Read dpkg database of installed packages
  102. open PACKAGES, "dpkg-query --show --showformat='\${status} \${package}\\n'|";
  103. while (<PACKAGES>)
  104. {
  105. /^.*installed *(.+)$/ or next;
  106. my $pkg=$1;
  107. my $bestatime = undef;
  108. my $list;
  109. $popcon{$pkg}=[0,0,$pkg,"<NOFILES>"];
  110. foreach ("$dpkg_db/$pkg.list", glob("$dpkg_db/$pkg:*.list"))
  111. {
  112. open FILES, $_ or next;
  113. while (<FILES>)
  114. {
  115. chop;
  116. next unless (
  117. ( m{/bin/|/sbin/|/lib/.+/|^/usr/games/|\.[ah]$|\.pm$|\.php$|^/boot/System\.map-}
  118. && ! m{/lib/.+-.+-.+/} && ! m{^/usr/lib/mime/packages/}
  119. || defined $mapped{$_} )
  120. && -f $_);
  121. next if defined $diverted{$_} and $diverted{$_} ne $pkg;
  122. my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  123. $atime,$mtime,$ctime,$blksize,$blocks)
  124. = stat;
  125. if (defined $mapped{$_}) {
  126. # It's currently being accessed by a process
  127. $atime = time();
  128. }
  129. if (!defined($bestatime) || $atime >= $bestatime)
  130. {
  131. # Truncate time to reduce informaton leak.
  132. my $tatime = &trunc_time($atime);
  133. my $tctime = &trunc_time($ctime);
  134. $bestatime=$atime;
  135. if ($atime < $lastmonth)
  136. {
  137. # Not accessed since more than 30 days.
  138. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_,"<OLD>"];
  139. }
  140. elsif ($ctime > $lastmonth && $atime-$ctime < $daylen)
  141. {
  142. # Installed/upgraded less than a month ago and not used after
  143. # install/upgrade day.
  144. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_,"<RECENT-CTIME>"];
  145. }
  146. else
  147. {
  148. # Else we `vote' for the package.
  149. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_];
  150. }
  151. }
  152. }
  153. close FILES;
  154. }
  155. }
  156. close PACKAGES;
  157. # We're not done yet. Sort the output in reverse by atime, and
  158. # add a header/footer.
  159. print "POPULARITY-CONTEST-0 TIME:",time," ID:$HOSTID ".
  160. "ARCH:$debarch POPCONVER:$popconver VENDOR:$vendor\n";
  161. for (sort { $popcon{$b}[0] <=> $popcon{$a}[0] } keys %popcon)
  162. {
  163. print join(' ',@{$popcon{$_}}),"\n";
  164. }
  165. print "END-POPULARITY-CONTEST-0 TIME:",time,"\n";