Bug#337792: Memory leak in Debbugs::MIME::parse

[Martin Michlmayr]

Package: debbugs
Version: 2.4.1
Severity: normal

There's a memory leak in Debbugs::MIME::parse() as you can see by
running the attached script for a while.

 6536 tbm       24   0  9344 6696 4056 R 46.8  1.7   0:26.79 test-mem-leak.p
 6536 tbm       24   0 50116  46m 4056 R 42.6 12.3  10:20.87 test-mem-leak.p


Tested with CVS as the end of ~2003 and with current CVS.



-- System Information:
Debian Release: testing/unstable
  APT prefers unstable
  APT policy: (500, 'unstable')
Architecture: i386 (i686)
Shell:  /bin/sh linked to /bin/bash
Kernel: Linux 2.6.12-1-686
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)

-- 
Martin Michlmayr
http://www.cyrius.com/

#!/usr/bin/perl -w

use strict;
use Debbugs::Log;
use Debbugs::MIME;

my $spool = "/org/bugs.debian.org/spool";

sub read_log($) {
    my $log_filename = shift;
    open LOG, "< $log_filename" or die "Can't open $log_filename: $!";
    my @records = Debbugs::Log::read_log_records(*LOG);
    close LOG;

    for my $record (@records) {
        if ($record->{type} eq "incoming-recv") {
            my $decoded = Debbugs::MIME::parse($record->{text});
        }
    }
}


sub process_dir($) {
    my $db = shift;

    opendir DB, $db or die "Can't opendir $db: $!";
    while (defined(my $dir = readdir DB)) {
        next if $dir =~ /^\.\.?$/ or not -d "$db/$dir";
        opendir HASH, "$db/$dir" or die "Can't opendir $db/$dir: $!";
        print "Processing dir $dir ...\n";
        while (defined(my $file = readdir HASH)) {
            next unless $file =~ /\.log$/;
            my $bug = $file;
            $bug =~ s/\.log$//;
            my $log = "$db/$dir/$file";
            next if -z $log;
            read_log($log);
        }
        closedir HASH;
    }
    closedir DB;
}

for my $db ("archive", "db-h") {
    process_dir("$spool/$db");
}


# vim: ts=4:expandtab:shiftwidth=4: