2006年10月26日 20:30 [Edit]

perl - BSD::getloadavg

cpan
レポートを受け追記; BSD::Sysctlのことも追記

この部分がなんとも惜しいような気がしたので書きました。

Milano::Monolog: mod_rewriteでサーバーの負荷が高いときだけリダイレクトする
my ($ldavg1, $ldavg2, $ldavg3) = `uptime` =~ /load average:\s+([.0-9]+),\s+([.0-9]+),\s+([.0-9]+)/;
BSD::getloadavg
CPAN
http://www.dan.co.jp/~dankogai/cpan/BSD-getloadavg-0.01.tar.gz

これで当該部分は、

#!/usr/bin/perl
use strict;
use BSD::getloadavg;
$| = 1;

while (<STDIN>) {
    my ($ldavg1, $ldavg2, $ldavg3) = getloadavg(); # my $ldavg1 = getloadavg() でもOK
    print $ldavg1 "\n";
}

とすっきり書けますし、なんといってもfork()がないので、本当にcriticalな時も少し安心です。

BSD::getloadavgと名付けはしましたが、Linuxでも動くはずです。とりあえずPerl 5.6.2/5.8.8、Mac OS X 10.4.8/FreeBSD 6.1-Stableの組み合わせでは問題ないことを確認しています。他のarchの動作確認キヴォンヌ。

XS部分は以下のとおり極めてシンプルです。

getloadavg.xs
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <stdlib.h>

SV *
getloadavg_as_aref(){
    SV*        sva[3];
    double loadavg[3];
    if (getloadavg(loadavg, 3) == -1){
        return &PL_sv_undef;
    }else{
        sva[0]  = sv_2mortal(newSVnv(loadavg[0]));
        sva[1]  = sv_2mortal(newSVnv(loadavg[1]));
        sva[2]  = sv_2mortal(newSVnv(loadavg[2]));
        return newRV_noinc((SV *)av_make(3, sva));
    }
}

MODULE = BSD::getloadavg                PACKAGE = BSD::getloadavg

PROTOTYPES: ENABLE

SV *
xs_getloadavg()
CODE:
        RETVAL = getloadavg_as_aref();
OUTPUT:
        RETVAL

この手のものは、XSの書き方入門としても手頃な入口だと思います。

もっとも、上記のscriptそのものもCで簡単に置き換えられるというのも事実ではありますが、やはりここはglueとしてのPerlを楽しみたい所です。

Enjoy!

Dan the XS Monger

追記:

はてなブックマーク - 404 Blog Not Found:perl - BSD::getloadavg
miyagawa debianでうごいた

報告ありがとうございます。この関数、 4.3BSD-Reno からサポートされているのでBSD::としましたが、glibcにも入ってます。

Manpage of GETLOADAVG
getloadavg 関数は BSD 4.3 Reno で登場した。 この関数は glibc のバージョン 2.2 以降で利用可能である。

Benchmarkも取ってみました。

use strict;
use warnings;
use Benchmark qw/cmpthese timethese/;
use BSD::getloadavg;
cmpthese(
    timethese(
        0,
        {
            command => sub {
                my @loadavg =
                  ( qx(uptime) =~ /([\.\d]+)\s+([\.\d]+)\s+([\.\d]+)/ );
                return @loadavg;
            },
            XS => sub {
                my @loadavg = getloadavg();
                return @loadavg;
              }
        }
    )
);
MacBook Pro 2GHz, Mac OS X 10.4.8
Benchmark: running XS, command for at least 3 CPU seconds...
        XS:  3 wallclock secs ( 1.40 usr +  1.60 sys =  3.00 CPU) @ 69808.00/s (n=209424)
   command: 16 wallclock secs ( 0.58 usr  2.77 sys +  2.30 cusr  9.68 csys = 15.33 CPU) @ 1060.60/s (n=3553)
           Rate command      XS
command  1061/s      --    -98%
XS      69808/s   6482%      --
Dual Xeon 2.8GHz, FreeBSD 6-Stable
Benchmark: running XS, command for at least 3 CPU seconds...
        XS:  4 wallclock secs ( 2.49 usr +  0.58 sys =  3.07 CPU) @ 139022.98/s (n=426844)
   command: 11 wallclock secs ( 0.19 usr  2.98 sys +  2.34 cusr  7.12 csys = 12.62 CPU) @ 919.07/s (n=2908)
            Rate command      XS
command    919/s      --    -99%
XS      139023/s  15026%      --

赤く塗る以上に効果があるみたいです。

さらに追記:

naoyaグループ - naoyaの日記 - XS
弾さんの getloadavg() で無問題ですが、この手のものは、XSの書き方入門としても手頃な入口だと思います。 ということなので、XS 作成の練習も兼ねて sysinfo() に変えて作って XS とは何ぞやをちょっと覗いてみました。コードは弾さんのとほとんど一緒。

この手のものの最強そうなモジュールは、多分これかも。

BSD::Sysctl - Manipulate kernel sysctl variables on BSD-like systems - search.cpan.org
BSD::Sysctl offers a native Perl interface for fetching sysctl values that describe the kernel state of BSD-like operating systems. This is around 80 times faster than scraping the output of the sysctl(8) program.

ただし最強だけあって、FreeBSDのみOK。DarwinさえNG。なにせ

Makefile.PL
if ($Config{osname} ne 'freebsd') {
    die "$module_name does not support the ($Config{osname}) platform.\n";
}

ですから。今やsysctl(8)を持つPlatformは多いので、これPortableに出来ればいいのだけどねえ。SNMPでも同様のことは出来るし、実際MRTGやHotSaNICはおいしい情報はSNMP経由で取ってくるのが多いのだけど、直にアクセスできればsnmpdいらずになるわけで。なんとかならないかなあ....

追記2006.10.30

Clouder::Blogger: mod_loadaverage_actionリリース
先日作った mod_loadaverage_redirect にもう少し機能を追加して mod_loadaverage_action という名前でリリースします。名前が変ったのでディレクティブ名もLoadAverageRedirect***からLoadAverageAction***に変わっているので注意してください。

これではlinuxしか動かない。

static double get_load_average()
{
    struct sysinfo info;
    double av1, av2, av3;
    double shift = (1 << SI_LOAD_SHIFT);
    if (sysinfo(&info) == -1) {
        return (-1);
    }
    av1 = info.loads[0] / shift;
    av2 = info.loads[1] / shift;
    av3 = info.loads[2] / shift;
    return (av3);
}

getloadavg()を使った方がいい。

更に追記:

変更してくれたようです。

Before:
/usr/local/apache/bin/apxs -c    mod_loadaverage_action.c
gcc -O2 -DDEV_RANDOM=/dev/random -DMOD_SSL=208123  -DHAVE_DB -DMOD_PERL -DUSE_HSREGEX -DEAPI -DUSE_EXPAT -I../lib/expat-lite -fpic -DSHARED_MODULE -I/usr/local/apache/include  -c mod_loadaverage_action.c
In file included from mod_loadaverage_action.c:26:
mod_loadaverage_action.h:4:25: sys/sysinfo.h: No such file or directory
mod_loadaverage_action.c: In function `get_load_average':
mod_loadaverage_action.c:117: error: storage size of 'info' isn't known
mod_loadaverage_action.c:119: error: `SI_LOAD_SHIFT' undeclared (first use in this function)
mod_loadaverage_action.c:119: error: (Each undeclared identifier is reported only once
mod_loadaverage_action.c:119: error: for each function it appears in.)
apxs:Break: Command failed with rc=1
*** Error code 1

Stop in /home/work/mod_loadaverage_action-1.0.
After:
/usr/local/apache/bin/apxs -c    mod_loadaverage_action.c
gcc -O2 -DDEV_RANDOM=/dev/random -DMOD_SSL=208123  -DHAVE_DB -DMOD_PERL -DUSE_HSREGEX -DEAPI -DUSE_EXPAT -I../lib/expat-lite -fpic -DSHARED_MODULE -I/usr/local/apache/include  -c mod_loadaverage_action.c
gcc -shared -o mod_loadaverage_action.so mod_loadaverage_action.o 

ただし、そのままでは駄目。不要になった.h中の#include <sys/sysinfo>と、.c中のstruct sysinfo info;を消すこと。


この記事へのトラックバックURL

この記事へのトラックバック
perl - BSD::getloadavg dan さんのエントリーにロードア...
perl - BSD::getloadavg【Nix::WebLab】at 2006年10月27日 00:38
この記事へのコメント
(あたりまえと云や、あたりまえだけど)OpenBSDでも動きましたので。
OpenBSD3.9, perlv5.8.6です。
Posted by とほりすがり at 2006年10月26日 23:44