> Should I post the code here?

I guess it couldn't hurt to try. If you do I will see if I notice anything and if I can reproduce the problem.

Ok, here it goes...

#!/usr/local/bin/perl -w
my $img_server="daniel.dnd.com.pl";
my $pass="qmail";
use strict;
my $home;
my $folder;
my $kt;
my $ile;
my $ile_starych;
my $ktory;
my $fol_wzg;
my $fol_wzg_cel;
my $login;
my $domena;
my @du;
use Socket;
use Carp;
my $EOL = "\015\012";

sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
sub sep_par { print "\`\@\`"}

my $port = shift || 2345;
my $proto = getprotobyname('tcp');
$port = $1 if $port =~ /(\d+)/; # untaint port number
socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!
+";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1))   || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!
+";

logmsg "server started on port $port";

my $waitedpid = 0;
my $paddr;

sub REAPER {
        $waitedpid = wait;
        $SIG{CHLD} = \&REAPER;  # loathe sysV
        #logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}

$SIG{CHLD} = \&REAPER;

for ( $waitedpid = 0;
  ($paddr = accept(Client,Server)) || $waitedpid;
  $waitedpid = 0, close Client)
  {
        next if $waitedpid and not $paddr;
        my($port,$iaddr) = sockaddr_in($paddr);
        my $name = gethostbyaddr($iaddr,AF_INET);

        logmsg "connection from $name [",
                inet_ntoa($iaddr), "]
                at port $port";
        spawn sub {
                my $line = <STDIN>;
                chomp $line;
                my @param = split (/ /,$line);
                if ($param[0] eq "folders_stat") {
                        my $mail = $param[1];
                        ($login, $domena) = split ("@", $mail);
                        &folders_stat;
                        }
                else {print "error\'=\'UNKNOWN ERROR \;)"}
               };

           }

           sub spawn {
               my $coderef = shift;

               unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE')
+ {
                   confess "usage: spawn CODEREF";
               }

               my $pid;
               if (!defined($pid = fork)) {
                   logmsg "cannot fork: $!";
                   return;
               } elsif ($pid) {
                   #logmsg "begat $pid";
                   return; # I'm the parent
               }
               # else I'm the child -- go spawn

               open(STDIN,  "<&Client")   || die "can't dup client to 
+stdin";
               open(STDOUT, ">&Client")   || die "can't dup client to 
+stdout";
               ## open(STDERR, ">&STDOUT") || die "can't dup stdout to
+ stderr";
               exit &$coderef();
           }

sub folders_stat {
                $home = "/home/platna.dnd.com.pl/m/ms11";
                my $quota = 10000;
                &sep_par;
                $ktory = 4;
                open (FOL, "ls -1 $home|") || die "can't exec ls -1: $
+!";
                while ($fol_wzg = <FOL>) {
                        chomp $fol_wzg;
                        &napraw_fol_wzg;
                        if ($fol_wzg=~/Maildir/) { $kt = 1;&rob_folder
+;next;}
                        elsif ($fol_wzg=~/outbox/) { $kt = 2;&rob_fold
+er;next;}
                        elsif ($fol_wzg=~/kosz/) { $kt = 3;&rob_folder
+;next;}
                        else {$kt=$ktory;}
                        &rob_folder;
                        $ktory++;
                }
                close (FOL);
                print "koniec\`=\`koniec";
}

sub rob_folder {
        $ile=0;
        $ile_starych=0;
        $folder = $home . "/" . $fol_wzg; 
        open (LISTA, "find $folder -type f|") || die "can't exec find:
+ $!";
        while (my $lista = <LISTA>) {
                $ile++;
                if ($lista eq "") {print "Folder pusty\n";exit 6;}
                if ($lista =~ /S/) { $ile_starych++; }
        }
        close (LISTA);

        print "name_f",$kt,"\`=\`",$fol_wzg;
        &sep_par;
        print "all_mail",$kt,"\`=\`",$ile;
        &sep_par;
        print "new_mail",$kt,"\`=\`",$ile - $ile_starych;
        &sep_par;
        print "read_mail",$kt,"\`=\`",$ile_starych;
        &sep_par;
        $folder = $home . "/" . $fol_wzg;
 #       open (DU, "du -s $folder|") || die "can't exec du: $!";
        my $temp = `du -s $folder`;
#<DU>;
#        close (DU);
        @du = split (" ",$temp);
        print "size",$kt,"\`=\`",$du[0] - 16;
        &sep_par;
}
sub napraw_fol_wzg {
while ($fol_wzg =~ /<B6>/) {$fol_wzg =~ s/<B6>/%B6/;}
while ($fol_wzg =~ /<B1>/) {$fol_wzg =~ s/<B1>/%B1/;}
while ($fol_wzg =~ /<F3>/) {$fol_wzg =~ s/<F3>/%F3/;}
while ($fol_wzg =~ /<A6>/) {$fol_wzg =~ s/<A6>/%A6/;}
while ($fol_wzg =~ /<AC>/) {$fol_wzg =~ s/<AC>/%AC/;}
while ($fol_wzg =~ /<D3>/) {$fol_wzg =~ s/<D3>/%D3/;}
}

sub napraw_fol_wzg_cel {
while ($fol_wzg_cel =~ /<B6>/) {$fol_wzg_cel =~ s/<B6>/%B6/;}
while ($fol_wzg_cel =~ /<B1>/) {$fol_wzg_cel =~ s/<B1>/%B1/;}
while ($fol_wzg_cel =~ /<F3>/) {$fol_wzg_cel =~ s/<F3>/%F3/;}
while ($fol_wzg_cel =~ /<A6>/) {$fol_wzg_cel =~ s/<A6>/%A6/;}
while ($fol_wzg_cel =~ /<AC>/) {$fol_wzg_cel =~ s/<AC>/%AC/;}
while ($fol_wzg_cel =~ /<D3>/) {$fol_wzg_cel =~ s/<D3>/%D3/;}
}

-- 
Daniellek
[download]

Do you still get the "attempt to free unreferenced scalar" message if you comment out the line that says $SIG{CHLD} = \&REAPER;?

If so, you have probably found a real bug in Perl and you should prepare a bug report. Try trimming the code down some more by getting rid of some of the more peripheral subroutines. Use the perlbug program on your system to report the error, including the entire source code of the smallest version of the program you can find that still demonstrates the problem.

If commenting out the $SIG{CHLD} line makes the problem magically go away, then you've still found a bug in Perl, but it's a well-known bug that people don't know how to fix. In this case you can still solve your problem by avoiding signal handlers and using waitpid to reap the children. If you post about it I will help you fix the program to do this.

Thanks for taking so much time to investigate this.

Glad you got your problem fixed, though among other things I noticed that you could probably write this a little clearer:

while ($fol_wzg_cel =~ /<B6>/) {$fol_wzg_cel =~ s/<B6>/%B6/;}

# as:

$fol_wzg_cel =~ s/<B6>/%B6/g;
[download]

In addition, you could probably shrink all 6 of those lines into one regexp:

$fol_wzg_cel =~ /<(B6|B1|F3|A6|AC|D3)>/%$1/g;
[download]