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.

179 lines
4.6 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. # Read dpkg database of installed packages
  91. open PACKAGES, "dpkg-query --show --showformat='\${status} \${package}\\n'|";
  92. while (<PACKAGES>)
  93. {
  94. /^.*installed *(.+)$/ or next;
  95. my $pkg=$1;
  96. my $bestatime = undef;
  97. my $list;
  98. $popcon{$pkg}=[0,0,$pkg,"<NOFILES>"];
  99. foreach ("$dpkg_db/$pkg.list", glob("$dpkg_db/$pkg:*.list"))
  100. {
  101. open FILES, $_ or next;
  102. while (<FILES>)
  103. {
  104. chop;
  105. next unless (
  106. ( m{/bin/|/sbin/|/lib/.+/|^/usr/games/|\.[ah]$|\.pm$|\.php$|^/boot/System\.map-}
  107. && ! m{/lib/.+-.+-.+/}
  108. || defined $mapped{$_} )
  109. && -f $_);
  110. my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  111. $atime,$mtime,$ctime,$blksize,$blocks)
  112. = stat;
  113. if (defined $mapped{$_}) {
  114. # It's currently being accessed by a process
  115. $atime = time();
  116. }
  117. if (!defined($bestatime) || $atime >= $bestatime)
  118. {
  119. # Truncate time to reduce informaton leak.
  120. my $tatime = &trunc_time($atime);
  121. my $tctime = &trunc_time($ctime);
  122. $bestatime=$atime;
  123. if ($atime < $lastmonth)
  124. {
  125. # Not accessed since more than 30 days.
  126. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_,"<OLD>"];
  127. }
  128. elsif ($ctime > $lastmonth && $atime-$ctime < $daylen)
  129. {
  130. # Installed/upgraded less than a month ago and not used after
  131. # install/upgrade day.
  132. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_,"<RECENT-CTIME>"];
  133. }
  134. else
  135. {
  136. # Else we `vote' for the package.
  137. $popcon{$pkg}=[$tatime,$tctime,$pkg,$_];
  138. }
  139. }
  140. }
  141. close FILES;
  142. }
  143. }
  144. close PACKAGES;
  145. # We're not done yet. Sort the output in reverse by atime, and
  146. # add a header/footer.
  147. print "POPULARITY-CONTEST-0 TIME:",time," ID:$HOSTID ".
  148. "ARCH:$debarch POPCONVER:$popconver VENDOR:$vendor\n";
  149. for (sort { $popcon{$b}[0] <=> $popcon{$a}[0] } keys %popcon)
  150. {
  151. print join(' ',@{$popcon{$_}}),"\n";
  152. }
  153. print "END-POPULARITY-CONTEST-0 TIME:",time,"\n";