#!@PERL@ # Copyright (C) 2002 Stanislav Sinyagin # # 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; either version 2 of the License, or # (at your option) any later version. # # 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. # $Id: rrddir2xml.in,v 1.1 2010-12-27 00:04:01 ivan Exp $ # Stanislav Sinyagin # Generate Torrus XML configuration from a directory containing RRD files # BEGIN { require '@devdiscover_config_pl@'; } use strict; use Getopt::Long; use IO::Dir; use Fcntl qw(:mode); use RRDs; use Torrus::ConfigBuilder; use Torrus::Log; my $creator = "Torrus version @VERSION@\n" . "This file was generated by command:\n" . $0 . " \\\n"; foreach my $arg ( @ARGV ) { if( $arg =~ /^--/ ) { $creator .= ' ' . $arg . ' '; } else { $creator .= "\'" . $arg . "\'\\\n"; } } $creator .= "\nOn " . scalar(localtime(time)); my $indir; my $recursive = 0; my $filter = '.*'; my $outfile = 'rrddir.xml'; my $topsubtree = '/'; my $splitexpr = '_+'; my $levels = 2; my $hwpredict = 0; my $comment; my $debug = 0; my $verbose = 0; my $ok = GetOptions( 'dir=s' => \$indir, 'recursive' => \$recursive, 'filter=s' => \$filter, 'out=s' => \$outfile, 'subtree=s' => \$topsubtree, 'split=s' => \$splitexpr, 'levels=i' => \$levels, 'comment=s' => \$comment, 'holtwinters' => \$hwpredict, 'verbose' => \$verbose, 'debug' => \$debug ); if( not $ok or not $indir or scalar( @ARGV ) > 0 ) { print STDERR "Generate Torrus XML configuration from a directory with RRD files\n"; print STDERR "Usage: $0 --dir=path options...\n", "Options:\n", " --dir=path directory to read RRD files from\n", " --recursive read the directories recursively\n", " --filter=re filter RE for file and directory names\n", " --out=filename output file [".$outfile."]\n", " --subtree=subtree XML config subtree [".$topsubtree."]\n", " --split=regexp regexp to split file names [".$splitexpr."]\n", " --levels=integer no. of subtree levels [".$levels."]\n", " --comment=text top subtree comment\n", " --holtwinters enable Holt-Winters boundaries diaplay\n", " --verbose print extra information\n", " --debug print debugging information\n"; exit 1; } if( $debug ) { Torrus::Log::setLevel('debug'); } elsif( $verbose ) { Torrus::Log::setLevel('verbose'); } if( not -d $indir ) { Error('No such directory: ' . $indir); exit 1; } if( $indir !~ /^\// ) { Error('Input directory must be an absolute path: ' . $indir); exit 1; } # remove trailing slash from $indir $indir =~ s/\/$//; if( $topsubtree !~ /^\/[0-9A-Za-z_\-\.\/]*$/ or $topsubtree =~ /\.\./ ) { Error("Invalid format for subtree name: " . $topsubtree); exit 1; } if( $outfile !~ /^\// ) { $outfile = $Torrus::Global::siteXmlDir . '/' . $outfile; } my %rrdinfos; read_rrd_dir( \%rrdinfos, $indir, $filter, $recursive ); Verbose(sprintf('Found %d RRD files', scalar( keys( %rrdinfos ) ) )); my $cb = new Torrus::ConfigBuilder; $cb->addCreatorInfo( $creator ); # Chop the first and last slashes my $path = $topsubtree; $path =~ s/^\///; $path =~ s/\/$//; # generate subtree path XML my $topSubtreeNode = undef; foreach my $subtreeName ( split( '/', $path ) ) { $topSubtreeNode = $cb->addSubtree( $topSubtreeNode, $subtreeName ); } if( length( $comment ) > 0 ) { $cb->addParam( $topSubtreeNode, 'comment', $comment ); } foreach my $rrdfile ( sort keys %rrdinfos ) { my @nameparts = split( $splitexpr, $rrdfile, $levels ); my $subtreeNode = $topSubtreeNode; foreach my $subtreeName ( @nameparts ) { $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName ); } my $info = $rrdinfos{$rrdfile}; my $legend = 'Directory:' . $info->{'dir'} . ';' . 'File:' . $rrdfile . ';'; $cb->addParam( $subtreeNode, 'legend', $legend ); my %dsnames; my $this_rrd_hwpredict = 0; foreach my $prop ( keys %{$info->{'rrdinfo'}} ) { if( $prop =~ /^ds\[(\S+)\]\./o ) { $dsnames{$1} = 1; } else { if( $prop =~ /^rra\[\d+\]\.cf/o and $info->{'rrdinfo'}->{$prop} eq 'FAILURES' ) { $this_rrd_hwpredict = 1; } } } if( not $hwpredict ) { $this_rrd_hwpredict = 0; } foreach my $dsname ( sort keys %dsnames ) { my $dslegend = $legend . 'DS:' . $dsname . ';Type:' . $info->{'rrdinfo'}->{'ds['.$dsname.'].type'}; my $params = { 'legend' => $dslegend, 'ds-type' => 'rrd-file', 'leaf-type' => 'rrd-def', 'rrd-cf' => 'AVERAGE', 'data-file' => $rrdfile, 'data-dir' => $info->{'dir'}, 'rrd-ds' => $dsname, 'rrd-hwpredict' => ($this_rrd_hwpredict ? 'enabled':'disabled') }; $cb->addLeaf( $subtreeNode, $dsname, $params ); } } my $ok = $cb->toFile( $outfile ); if( $ok ) { Verbose('Wrote ' . $outfile); } else { Error('Cannot write ' . $outfile . ': ' . $!); } exit( $ok ? 0:1); sub read_rrd_dir { my $infos = shift; my $indir = shift; my $filter = shift; my $recursive = shift; Debug('Reading directory: ' . $indir); my @subdirs; my %dir; tie( %dir, 'IO::Dir', $indir ); foreach my $file ( keys %dir ) { if( $file =~ /^\./ or $file !~ $filter ) { Debug('Skipping ' . $file); next; } my $mode = $dir{$file}->mode(); if( S_ISDIR( $mode ) ) { Debug($file . ' is a directory'); push( @subdirs, $file ); } elsif( S_ISREG( $mode ) ) { Debug($file . ' is a regular file'); if( defined( $infos->{$file} ) ) { Warn("Duplicate file name: $file"); } else { my $fullname = $indir . '/' . $file; my $rrdinfo = RRDs::info( $fullname ); my $err = RRDs::error(); if( $err ) { Verbose($fullname . ' is not an RRD file'); } else { Debug('Found RRD file: ' . $file); $infos->{$file}->{'fullname'} = $fullname; $infos->{$file}->{'dir'} = $indir; $infos->{$file}->{'rrdinfo'} = $rrdinfo; } } } } untie %dir; if( $recursive and scalar( @subdirs ) > 0 ) { foreach my $subdir ( @subdirs ) { read_rrd_dir( $infos, $indir . '/' . $subdir, $filter, $recursive ); } } } # Local Variables: # mode: perl # indent-tabs-mode: nil # perl-indent-level: 4 # End: