torrus/bin/rrddir2xml.in

   1 #!@PERL@
   2 #  Copyright (C) 2002  Stanislav Sinyagin
   3 #
   4 #  This program is free software; you can redistribute it and/or modify
   5 #  it under the terms of the GNU General Public License as published by
   6 #  the Free Software Foundation; either version 2 of the License, or
   7 #  (at your option) any later version.
   8 #
   9 #  This program is distributed in the hope that it will be useful,
  10 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #  GNU General Public License for more details.
  13 #
  14 #  You should have received a copy of the GNU General Public License
  15 #  along with this program; if not, write to the Free Software
  16 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  17
  18 # $Id: rrddir2xml.in,v 1.1 2010-12-27 00:04:01 ivan Exp $
  19 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  20
  21 # Generate Torrus XML configuration from a directory containing RRD files
  22 #
  23
  24 BEGIN { require '@devdiscover_config_pl@'; }
  25
  26 use strict;
  27 use Getopt::Long;
  28 use IO::Dir;
  29 use Fcntl qw(:mode);
  30 use RRDs;
  31
  32 use Torrus::ConfigBuilder;
  33 use Torrus::Log;
  34
  35
  36 my $creator = "Torrus version @VERSION@\n" .
  37     "This file was generated by command:\n" .
  38     $0 . " \\\n";
  39 foreach my $arg ( @ARGV )
  40 {
  41     if( $arg =~ /^--/ )
  42     {
  43         $creator .= ' ' . $arg . ' ';
  44     }
  45     else
  46     {
  47         $creator .= "\'" . $arg . "\'\\\n";
  48     }
  49 }
  50 $creator .= "\nOn " . scalar(localtime(time));
  51
  52
  53 my $indir;
  54 my $recursive = 0;
  55 my $filter = '.*';
  56 my $outfile = 'rrddir.xml';
  57 my $topsubtree = '/';
  58 my $splitexpr = '_+';
  59 my $levels = 2;
  60 my $hwpredict = 0;
  61 my $comment;
  62 my $debug = 0;
  63 my $verbose = 0;
  64
  65
  66 my $ok = GetOptions(
  67                     'dir=s'       => \$indir,
  68                     'recursive'   => \$recursive,
  69                     'filter=s'    => \$filter,
  70                     'out=s'       => \$outfile,
  71                     'subtree=s'   => \$topsubtree,
  72                     'split=s'     => \$splitexpr,
  73                     'levels=i'    => \$levels,
  74                     'comment=s'   => \$comment,
  75                     'holtwinters' => \$hwpredict,
  76                     'verbose'     => \$verbose,
  77                     'debug'       => \$debug
  78                     );
  79
  80 if( not $ok or not $indir or scalar( @ARGV ) > 0 )
  81 {
  82     print STDERR
  83         "Generate Torrus XML configuration from a directory with RRD files\n";
  84
  85     print STDERR "Usage: $0 --dir=path options...\n",
  86     "Options:\n",
  87     " --dir=path              directory to read RRD files from\n",
  88     " --recursive             read the directories recursively\n",
  89     " --filter=re             filter RE for file and directory names\n",
  90     " --out=filename          output file             [".$outfile."]\n",
  91     " --subtree=subtree       XML config subtree      [".$topsubtree."]\n",
  92     " --split=regexp          regexp to split file names [".$splitexpr."]\n",
  93     " --levels=integer        no. of subtree levels  [".$levels."]\n",
  94     " --comment=text          top subtree comment\n",
  95     " --holtwinters           enable Holt-Winters boundaries diaplay\n",
  96     " --verbose               print extra information\n",
  97     " --debug                 print debugging information\n";
  98
  99     exit 1;
 100 }
 101
 102 if( $debug )
 103 {
 104     Torrus::Log::setLevel('debug');
 105 }
 106 elsif( $verbose )
 107 {
 108     Torrus::Log::setLevel('verbose');
 109 }
 110
 111 if( not -d $indir )
 112 {
 113     Error('No such directory: ' . $indir);
 114     exit 1;
 115 }
 116
 117 if( $indir !~ /^\// )
 118 {
 119     Error('Input directory must be an absolute path: ' . $indir);
 120     exit 1;
 121 }
 122
 123 # remove trailing slash from $indir
 124 $indir =~ s/\/$//;
 125
 126 if( $topsubtree !~ /^\/[0-9A-Za-z_\-\.\/]*$/ or
 127     $topsubtree =~ /\.\./ )
 128 {
 129     Error("Invalid format for subtree name: " . $topsubtree);
 130     exit 1;
 131 }
 132
 133
 134 if( $outfile !~ /^\// )
 135 {
 136     $outfile = $Torrus::Global::siteXmlDir . '/' . $outfile;
 137 }
 138
 139 my %rrdinfos;
 140 read_rrd_dir( \%rrdinfos, $indir, $filter, $recursive );
 141
 142 Verbose(sprintf('Found %d RRD files', scalar( keys( %rrdinfos ) ) ));
 143
 144 my $cb = new Torrus::ConfigBuilder;
 145 $cb->addCreatorInfo( $creator );
 146
 147 # Chop the first and last slashes
 148 my $path = $topsubtree;
 149 $path =~ s/^\///;
 150 $path =~ s/\/$//;
 151
 152 # generate subtree path XML
 153 my $topSubtreeNode = undef;
 154 foreach my $subtreeName ( split( '/', $path ) )
 155 {
 156     $topSubtreeNode = $cb->addSubtree( $topSubtreeNode, $subtreeName );
 157 }
 158
 159 if( length( $comment ) > 0 )
 160 {
 161     $cb->addParam( $topSubtreeNode, 'comment', $comment );
 162 }
 163
 164 foreach my $rrdfile ( sort keys %rrdinfos )
 165 {
 166     my @nameparts = split( $splitexpr, $rrdfile, $levels );
 167
 168     my $subtreeNode = $topSubtreeNode;
 169     foreach my $subtreeName ( @nameparts )
 170     {
 171         $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName );
 172     }
 173
 174     my $info = $rrdinfos{$rrdfile};
 175
 176     my $legend =
 177         'Directory:' . $info->{'dir'} . ';' .
 178         'File:' . $rrdfile . ';';
 179
 180     $cb->addParam( $subtreeNode, 'legend', $legend );
 181
 182     my %dsnames;
 183     my $this_rrd_hwpredict = 0;
 184
 185     foreach my $prop ( keys %{$info->{'rrdinfo'}} )
 186     {
 187         if( $prop =~ /^ds\[(\S+)\]\./o )
 188         {
 189             $dsnames{$1} = 1;
 190         }
 191         else
 192         {
 193             if( $prop =~ /^rra\[\d+\]\.cf/o and
 194                 $info->{'rrdinfo'}->{$prop} eq 'FAILURES' )
 195             {
 196                 $this_rrd_hwpredict = 1;
 197             }
 198         }
 199     }
 200
 201     if( not $hwpredict )
 202     {
 203         $this_rrd_hwpredict = 0;
 204     }
 205
 206     foreach my $dsname ( sort keys %dsnames )
 207     {
 208         my $dslegend = $legend . 'DS:' . $dsname . ';Type:' .
 209             $info->{'rrdinfo'}->{'ds['.$dsname.'].type'};
 210
 211         my $params = {
 212             'legend'        => $dslegend,
 213             'ds-type'       => 'rrd-file',
 214             'leaf-type'     => 'rrd-def',
 215             'rrd-cf'        => 'AVERAGE',
 216             'data-file'     => $rrdfile,
 217             'data-dir'      => $info->{'dir'},
 218             'rrd-ds'        => $dsname,
 219             'rrd-hwpredict' => ($this_rrd_hwpredict ? 'enabled':'disabled')
 220             };
 221
 222         $cb->addLeaf( $subtreeNode, $dsname, $params );
 223     }
 224 }
 225
 226 my $ok = $cb->toFile( $outfile );
 227 if( $ok )
 228 {
 229     Verbose('Wrote ' . $outfile);
 230 }
 231 else
 232 {
 233     Error('Cannot write ' . $outfile . ': ' . $!);
 234 }
 235
 236 exit( $ok ? 0:1);
 237
 238
 239
 240 sub read_rrd_dir
 241 {
 242     my $infos = shift;
 243     my $indir = shift;
 244     my $filter = shift;
 245     my $recursive = shift;
 246
 247     Debug('Reading directory: ' . $indir);
 248
 249     my @subdirs;
 250
 251     my %dir;
 252     tie( %dir, 'IO::Dir', $indir );
 253
 254     foreach my $file ( keys %dir )
 255     {
 256         if( $file =~ /^\./ or $file !~ $filter )
 257         {
 258             Debug('Skipping ' . $file);
 259             next;
 260         }
 261
 262         my $mode = $dir{$file}->mode();
 263         if( S_ISDIR( $mode ) )
 264         {
 265             Debug($file . ' is a directory');
 266             push( @subdirs, $file );
 267         }
 268         elsif( S_ISREG( $mode ) )
 269         {
 270             Debug($file . ' is a regular file');
 271             if( defined( $infos->{$file} ) )
 272             {
 273                 Warn("Duplicate file name: $file");
 274             }
 275             else
 276             {
 277                 my $fullname = $indir . '/' . $file;
 278                 my $rrdinfo = RRDs::info( $fullname );
 279                 my $err = RRDs::error();
 280                 if( $err )
 281                 {
 282                     Verbose($fullname . ' is not an RRD file');
 283                 }
 284                 else
 285                 {
 286                     Debug('Found RRD file: ' . $file);
 287                     $infos->{$file}->{'fullname'} = $fullname;
 288                     $infos->{$file}->{'dir'} = $indir;
 289                     $infos->{$file}->{'rrdinfo'} = $rrdinfo;
 290                 }
 291             }
 292         }
 293     }
 294
 295     untie %dir;
 296
 297     if( $recursive and scalar( @subdirs ) > 0 )
 298     {
 299         foreach my $subdir ( @subdirs )
 300         {
 301             read_rrd_dir( $infos, $indir . '/' . $subdir,
 302                           $filter, $recursive );
 303         }
 304     }
 305 }
 306
 307 # Local Variables:
 308 # mode: perl
 309 # indent-tabs-mode: nil
 310 # perl-indent-level: 4
 311 # End: