Dienstag, 24. Februar 2009

Perl Memory Consumption: CollectD

CollectD: Perl


A really nice tool to graphically show system values (like disk free, running processes etc.) is CollectD (They self say: "collectd is a daemon which collects system performance statistics periodically and provides mechanisms to store the values in a variety of ways").

Measure Perl memory consumption


This is a bit tricky within Collectd, esp. when you want to see certain Perl processes. The next problem is the Collectd Perl plugin interface. This hurts really, when you are interested in a perl interpreter which has a small footprint and more: when you want to measure Perl. The Perl plugin interface of Collectd calls simply a Perl interpreter. That is not always wanted.

Perlmemory


(Yes I know, that form of publishing is not the best)

diff -urN collectd-4.5.2/configure.in collectd-4.5.2_a/configure.in
--- collectd-4.5.2/configure.in 2009-01-02 23:18:58.000000000 +0100
+++ collectd-4.5.2_a/configure.in       2009-02-11 09:28:33.000000000 +0100
@@ -2761,6 +2761,7 @@
 AC_PLUGIN([nut],         [$with_libupsclient], [Network UPS tools statistics])
 AC_PLUGIN([onewire],     [$with_libowcapi],    [OneWire sensor statistics])
 AC_PLUGIN([perl],        [$plugin_perl],       [Embed a Perl interpreter])
+AC_PLUGIN([perlmemory],  [yes],              [Perl memory consumption])
 AC_PLUGIN([ping],        [$with_liboping],     [Network latency statistics])
 AC_PLUGIN([postgresql],  [$with_libpq],        [PostgreSQL database statistics])
 AC_PLUGIN([powerdns],    [yes],                [PowerDNS statistics])
@@ -2929,6 +2930,7 @@
     nut . . . . . . . . . $enable_nut
     onewire . . . . . . . $enable_onewire
     perl  . . . . . . . . $enable_perl
+    perlmemory  . . . . . $enable_perlmemory
     ping  . . . . . . . . $enable_ping
     postgresql  . . . . . $enable_postgresql
     powerdns  . . . . . . $enable_powerdns
diff -urN collectd-4.5.2/contrib/collection.cgi collectd-4.5.2_a/contrib/collection.cgi
--- collectd-4.5.2/contrib/collection.cgi       2009-01-02 22:39:54.000000000 +0100
+++ collectd-4.5.2_a/contrib/collection.cgi     2009-02-11 14:24:10.000000000 +0100
@@ -1706,6 +1706,18 @@
     'GPRINT:max:MAX:%5.1lf%sbyte Max,',
     'GPRINT:avg:LAST:%5.1lf%sbyte Last\l'
     ],
+    perlmemory => ['-b', '1024', '-v', 'Bytes',
+    'DEF:avg={file}:value:AVERAGE',
+    'DEF:min={file}:value:MIN',
+    'DEF:max={file}:value:MAX',
+    "AREA:max#$HalfBlue",
+    "AREA:min#$Canvas",
+    "LINE1:avg#$FullBlue:Memory",
+    'GPRINT:min:MIN:%5.1lf%sbyte Min,',
+    'GPRINT:avg:AVERAGE:%5.1lf%sbyte Avg,',
+    'GPRINT:max:MAX:%5.1lf%sbyte Max,',
+    'GPRINT:avg:LAST:%5.1lf%sbyte Last\l'
+    ],
     old_memory => [
     'DEF:used_avg={file}:used:AVERAGE',
     'DEF:free_avg={file}:free:AVERAGE',
@@ -2626,6 +2638,7 @@
   $MetaGraphDefs->{'if_rx_errors'} = \&meta_graph_if_rx_errors;
   $MetaGraphDefs->{'if_tx_errors'} = \&meta_graph_if_rx_errors;
   $MetaGraphDefs->{'memory'} = \&meta_graph_memory;
+  $MetaGraphDefs->{'perlmemory'} = \&meta_graph_perlmemory;
   $MetaGraphDefs->{'nfs_procedure'} = \&meta_graph_nfs_procedure;
   $MetaGraphDefs->{'ps_state'} = \&meta_graph_ps_state;
   $MetaGraphDefs->{'swap'} = \&meta_graph_swap;
@@ -2913,6 +2926,61 @@
   return (meta_graph_generic_stack ($opts, $sources));
 } # meta_graph_memory
+sub meta_graph_perlmemory
+{
+  confess ("Wrong number of arguments") if (@_ != 5);
+
+  my $host = shift;
+  my $plugin = shift;
+  my $plugin_instance = shift;
+  my $type = shift;
+  my $type_instances = shift;
+
+  my $opts = {};
+  my $sources = [];
+
+  $opts->{'title'} = "$host/$plugin"
+  . (defined ($plugin_instance) ? "-$plugin_instance" : '') . "/$type";
+  $opts->{'number_format'} = '%5.1lf%s';
+
+  $opts->{'rrd_opts'} = ['-b', '1024', '-v', 'Bytes'];
+
+  my @files = ();
+
+  $opts->{'colors'} =
+  {
+    'Perl processes'     => '00e000',
+#    'Sum VSZ'   => '0000ff',
+    'Sum RSS' => 'ffb000'
+  };
+
+  for (@$type_instances)
+  {
+    my $inst = $_;
+    my $file = '';
+    my $title = $opts->{'title'};
+
+    for (@DataDirs)
+    {
+      if (-e "$_/$title-$inst.rrd")
+      {
+       $file = "$_/$title-$inst.rrd";
+       last;
+      }
+    }
+    confess ("No file found for $title") if ($file eq '');
+
+    push (@$sources,
+      {
+       name => $inst,
+       file => $file
+      }
+    );
+  } # for (@$type_instances)
+
+  return (meta_graph_generic_stack ($opts, $sources));
+} # meta_graph_perlmemory
+
 sub meta_graph_if_rx_errors
 {
   confess ("Wrong number of arguments") if (@_ != 5);
diff -urN collectd-4.5.2/src/Makefile.am collectd-4.5.2_a/src/Makefile.am
--- collectd-4.5.2/src/Makefile.am      2009-01-02 22:39:55.000000000 +0100
+++ collectd-4.5.2_a/src/Makefile.am    2009-02-11 09:28:33.000000000 +0100
@@ -779,6 +779,14 @@
 collectd_DEPENDENCIES += xmms.la
 endif

+if BUILD_PLUGIN_PERLMEMORY
+pkglib_LTLIBRARIES += perlmemory.la
+perlmemory_la_SOURCES = perlmemory.c
+perlmemory_la_LDFLAGS = -module -avoid-version
+collectd_LDADD += "-dlopen" perlmemory.la
+collectd_DEPENDENCIES += perlmemory.la
+endif
+

 dist_man_MANS = collectd.1 collectd-nagios.1 collectd.conf.5 \
                collectd-email.5 collectd-exec.5 collectd-perl.5 \
diff -urN collectd-4.5.2/src/perlmemory.c collectd-4.5.2_a/src/perlmemory.c
--- collectd-4.5.2/src/perlmemory.c     1970-01-01 01:00:00.000000000 +0100
+++ collectd-4.5.2_a/src/perlmemory.c   2009-02-11 14:24:49.000000000 +0100
@@ -0,0 +1,105 @@
+/**
+ * collectd - Perl memory consumption
+ * Copyright (C) 2005-2007  Patrick Kirsch
+ *
+ * This program is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; only version 2 of the License is applicable.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+ *
+ * Authors:
+ *     Patrick Kirsch 
+ **/
+
+#include "collectd.h"
+#include "common.h"
+#include "plugin.h"
+
+#include 
+#include 
+#include 
+
+
+#ifdef HAVE_SYS_SYSCTL_H
+# include 
+#endif
+
+int splitter(char *buf) {
+        int i;
+        for(i=0;i<=sizeof(buf);i++){
+                if(buf[i] == ' ')
+                       break;
+        }
+       return i;
+}
+
+static void perl_memory_submit (const char *type_instance, gauge_t value)
+{
+       value_t values[1];
+       value_list_t vl = VALUE_LIST_INIT;
+
+       values[0].gauge = value * 1024;
+
+       vl.values = values;
+       vl.values_len = 1;
+       vl.time = time (NULL);
+       sstrncpy (vl.host, hostname_g, sizeof (vl.host));
+       sstrncpy (vl.plugin, "perlmemory", sizeof (vl.plugin));
+       sstrncpy (vl.type, "perlmemory", sizeof (vl.type));
+       sstrncpy (vl.type_instance, type_instance, sizeof (vl.type_instance));
+
+       plugin_dispatch_values (&vl);
+}
+
+static int perl_memory_read (void)
+{
+       int how_many_perl_process = 0;
+
+        long sum_vsz = 0;
+        long sum_rss = 0;
+        int sep_stelle = 0;
+        int i;
+        FILE *pipe;
+
+        pipe = popen("ps -o vsz,rss,cmd -A | grep -i perl | grep -v grep | tr -s ' ' | sed 's/^ //' | cut  -d ' ' -f 1,2;","r");
+        fflush(pipe); /* Weil gepuffert, per default */
+        char buf[128];
+    while(!feof(pipe) ) {
+        if( fgets( buf, 128, pipe ) != NULL ) {
+                how_many_perl_process++;
+                    /*printf("%s<\n", buf );*/
+                sep_stelle = splitter(buf);
+                char tmp[128];
+                strncpy(tmp,buf,sep_stelle);
+                sum_vsz += atol(tmp);
+                for(i=0;i+                        buf[i]=buf[i+sep_stelle];       /* Impliziere das VSZ > RSS (immer!) */
+
+                strcpy(tmp,buf);
+                sum_rss += atol(tmp);
+                /*printf("Erg: %ld %ld\n",sum_vsz, sum_rss);*/
+        }
+    }
+        pclose(pipe);
+
+       if (how_many_perl_process > 0)
+       {
+               perl_memory_submit ("Perl processes",    how_many_perl_process);
+/*             perl_memory_submit ("Sum VSZ", sum_vsz);*/
+               perl_memory_submit ("Sum RSS", sum_rss);
+       }
+       return 0;
+}
+
+void module_register (void)
+{
+       plugin_register_read ("perlmemory", perl_memory_read);
+} /* void module_register */
diff -urN collectd-4.5.2/src/types.db collectd-4.5.2_a/src/types.db
--- collectd-4.5.2/src/types.db 2009-01-02 22:39:55.000000000 +0100
+++ collectd-4.5.2_a/src/types.db       2009-02-11 09:28:33.000000000 +0100
@@ -55,6 +55,7 @@
 memcached_octets       rx:COUNTER:0:4294967295, tx:COUNTER:0:4294967295
 memcached_ops          value:COUNTER:0:134217728
 memory                 value:GAUGE:0:281474976710656
+perlmemory             value:GAUGE:0:281474976710656
 multimeter             value:GAUGE:U:U
 mysql_commands         value:COUNTER:0:U
 mysql_handler          value:COUNTER:0:U


The interesting line is 


pipe = popen("ps -o vsz,rss,cmd -A | grep -i perl | grep -v grep | tr -s ' ' | sed 's/^ //' | cut  -d ' ' -f 1,2;","r");

Here you can add your service to track.(Of course, I do understand, that a fork within a library should be circumvented. Nonetheless is that a working example for easily tracking the memory consumption of a Perl process).

Some hints
I hope it makes some sence to you.

Links


CollectD

Update:
Perlmemory plugin for collectd
Posted by Patrick Kirsch at 11:32 0 comments
Labels: ,

Perl Memory Consumption

Perl Memory, the Perl Garbage Collector


A small proposal to early free some Memory allocated in Perl:

Garbage Collector: automatic undef on scope closure



iff -urN perl-5.8.8/scope.c perl-5.8.8_/scope.c
--- perl-5.8.8/scope.c  2005-09-30 15:56:51.000000000 +0200
+++ perl-5.8.8_/scope.c 2009-02-23 16:23:40.000000000 +0100
@@ -946,14 +946,26 @@
                        SvREFCNT_dec(AvARYLEN(sv));
                        AvARYLEN(sv) = 0;
                    }
+                   av_undef((AV*)sv);
                    break;
                case SVt_PVHV:
                    hv_clear((HV*)sv);
+                   hv_undef((HV*)sv);
                    break;
                case SVt_PVCV:
                    Perl_croak(aTHX_ "panic: leave_scope pad code");
                default:
                    SvOK_off(sv);
+               const U32 padflags
+                 = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
+               switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
+               case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
+               case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
+               default:        *(SV**)ptr = NEWSV(0,0);        break;
+               }
+               SvREFCNT_dec(sv);       /* Cast current value to the winds. */
+               SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
+
                    break;
                }
            }


So yes, I have patched the file scope.c. Because a lot of the (existing) code does not use a explicit undef on a scope exit (of course, does this imply a variable declared with 'my').
At least it helps me to free some malloced space on a scope close (see below).
After applying this patch you can do such thing:


print "Start: >".$$."<\n";<>;
{
        my @arr;
        $arr[$_]=$_ foreach(1 .. 1000000);
        print "How Many?\n";<>;
#       undef @arr;
}
print "Done, how many?\n";<>;

And you recognize, that there is now a automatic undefining on scope closure.

References: Perlmonks


A discussion on Perlmonks about the Perl Garbage Collector

References


Votrag: Perl Speicherverbrauch
Posted by Patrick Kirsch at 11:24 0 comments
Abonnieren Posts (Atom)