Bug#545519: perl: memory leak

[Vincent Lefevre]

Package: perl
Version: 5.10.0-25
Severity: important

There seems to be a memory leak in perl. After 6 days, the attached
script takes 50 MB RES memory. This problem seems to be quite recent
(a few weeks?) and is reproducible: I rebooted the machine on Sep 1
after 7 weeks for the same reason.

-- System Information:
Debian Release: squeeze/sid
  APT prefers testing
  APT policy: (900, 'testing'), (900, 'stable'), (500, 'oldstable'), (200, 
'unstable')
Architecture: powerpc (ppc)

Kernel: Linux 2.6.26-1-powerpc
Locale: LANG=POSIX, LC_CTYPE=en_US.ISO8859-1 (charmap=ISO-8859-1)
Shell: /bin/sh linked to /bin/bash

Versions of packages perl depends on:
ii  libc6                  2.9-25            GNU C Library: Shared libraries
ii  libdb4.7               4.7.25-7          Berkeley v4.7 Database Libraries [
ii  libgdbm3               1.8.3-6+b1        GNU dbm database routines (runtime
ii  perl-base              5.10.0-25         minimal Perl system
ii  perl-modules           5.10.0-25         Core Perl modules
ii  zlib1g                 1:1.2.3.3.dfsg-15 compression library - runtime

Versions of packages perl recommends:
ii  make                          3.81-6     An utility for Directing compilati
ii  netbase                       4.37       Basic TCP/IP networking system

Versions of packages perl suggests:
ii  libterm-readline-gnu-perl     1.19-1     Perl extension for the GNU Readlin
ii  libterm-readline-perl-perl    1.0302-1   Perl implementation of Readline li
ii  perl-doc                      5.10.0-25  Perl documentation

-- no debconf information

#!/usr/bin/env perl

use strict;
use Filesys::DiskSpace;
use RRDs;

my $RCSID = '$Id: disk-update 2770 2004-03-17 22:39:32Z lefevre $';
my ($proc) = $RCSID =~ /^.Id: (\S+) / or die;

@ARGV or die "Usage: $proc <rrdfile> [ <webdir> ]\n";

my $file = shift;
-f $file or die "$proc: RRDtool file isn't a plain file\n";
-r $file or die "$proc: RRDtool file isn't readable\n";
-w $file or die "$proc: RRDtool file isn't writable\n";

my $wdir = shift;
if (defined $wdir)
  { -d $wdir or die "$proc: $wdir isn't a directory\n"; }

my %t = (
  'day'   => 1,
  'week'  => 6,
  'month' => 24,
  'year'  => 288);

for(;;)
  {
    my $time = time;
    my $root = (df '/')[2];
    my $home = (df '/home')[2];
    time - $time < 3
      and RRDs::update ($file, "$time:$root:$home");
    &rrdgraph('root', '/dev/hda4');
    &rrdgraph('home', '/dev/hda5');
    sleep 60;
  }

sub rrdgraph
  {
    defined $wdir or return;
    my ($name,$fs) = @_;
    foreach (qw/day week month year/)
      {
        RRDs::graph ("$wdir/$name-$_.png", '-a', 'PNG',
          '-h', 200, '-v', $fs, '-b', 1024,
          '--start', -120000*$t{$_},
          "DEF:kavg=$file:$name:AVERAGE", "CDEF:avg=kavg,1024,*",
          "DEF:kmax=$file:$name:MAX",     "CDEF:max=kmax,1024,*",
          "AREA:avg#00ff00", "LINE1:max#ff0000");
      }
  }