开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > SNMP编程 > 查看源码
mrtglib.pod
资源名称：mrtg-2.13.2.zip　[点击查看]
上传用户：shbosideng
上传日期：2013-05-04
资源大小：1555k
文件大小：72k
源码类别：

SNMP编程

开发平台：

C/C++

mrtglib.pod：源码内容
  1. # -*- mode: Perl -*-
  2. package MRTG_lib;
  4. ###################################################################
  5. # MRTG 2.13.2  Support library MRTG_lib.pm
  6. ###################################################################
  7. # Created by Tobias Oetiker <oetiker@ee.ethz.ch>
  8. #            and Dave Rand <dlr@bungi.com>
  9. #
  10. # For individual Contributers check the CHANGES file
  11. #
  12. ###################################################################
  13. #
  14. # Distributed under the GNU General Public License
  15. #
  16. ###################################################################
  18. require 5.005;
  19. use strict;
  20. use vars qw($OS $SL $PS @EXPORT @ISA $VERSION %timestrpospattern);
  21. if (eval { require Net_SNMP_util} ) {
  22. import Net_SNMP_util;
  23. }
  24. else {
  25. require SNMP_util; import SNMP_util;
  26. }
  27. my %mrtgrules;
  29. BEGIN {
  30.     # Automatic OS detection ... do NOT touch
  31.     if ( $^O =~ /^(?:(ms)?(dos|win(32|nt)?))/i ) {
  32.         $OS = 'NT';
  33.         $SL = '\';
  34.         $PS = ';';
  35.     } elsif ( $^O =~ /^NetWare$/i ) {
  36. $OS = 'NW';
  37. $SL = '/';
  38. $PS = ';';
  39.     } elsif ( $^O =~ /^VMS$/i ) {
  40.         $OS = 'VMS';
  41.         $SL = '.';
  42.         $PS = ':';
  43.     } elsif ( $^O =~ /^os2$/i ) {
  44. $OS = 'OS2';
  45. $SL = '/';
  46. $PS = ';';
  47.     }  else {
  48.         $OS = 'UNIX';
  49.         $SL = '/';
  50.         $PS = ':';
  51.     }
  52. }
  54. require Exporter;
  55. @ISA = qw(Exporter);
  56. @EXPORT = qw(readcfg cfgcheck setup_loghandlers 
  57.      datestr expistr ensureSL timestamp
  58.              create_pid demonize_me debug log2rrd storeincache readfromcache clearfromcache cleanhostkey
  59.      populateconfcache readconfcache writeconfcache
  60.      v4onlyifnecessary);
  62. $VERSION = 2.100015;
  64. %timestrpospattern =
  65.       (
  66.        'NO' => 0,
  67.        'LU' => 1,
  68.        'RU' => 2,
  69.        'LL' => 3,
  70.        'RL' => 4
  71.       );
  73. %mrtgrules =
  74.       (                         # General CFG
  75.        'workdir' => 
  76.        [sub{$_[0] && (-d $_[0])}, sub{"Working directory $_[0] does not exist"}],
  78.        'htmldir' =>
  79.        [sub{$_[0] && (-d $_[0])}, sub{"Html directory $_[0] does not exist"}],
  81.        'imagedir' =>
  82.        [sub{$_[0] && (-d $_[0])}, sub{"Image directory $_[0] does not exist"}],
  84.        'logdir' =>
  85.        [sub{$_[0] && (-d $_[0] )}, sub{"Log directory $_[0] does not exist"}],
  87.        'forks' =>
  88.        [sub{$_[0] && (int($_[0]) > 0 and $MRTG_lib::OS eq 'UNIX')},
  89.         sub{"Less than 1 fork or not running on Unix/Linux"}],
  91.        'refresh' => 
  92.        [sub{int($_[0]) >= 300}, sub{"$_[0] should be 300 seconds or more"}],
  94.        'enablesnmpv3' =>
  95.        [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}],
  97.        'enableipv6' =>
  98.        [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}],
  100.        'interval' => 
  101.        [sub{int($_[0]) >= 1 and int($_[0]) <= 60}, sub{"$_[0] should be at least 1 Minute and no more than 60 Minutes"}], 
  103.        'writeexpires' =>  
  104.        [sub{1}, sub{"Internal Error"}],
  106.        'nomib2' => 
  107.        [sub{1}, sub{"Internal Error"}],
  109.        'singlerequest' => 
  110.        [sub{1}, sub{"Internal Error"}],
  112.        'icondir' =>
  113.        [sub{$_[0]}, sub{"Directory argument missing"}],
  115.        'language' =>
  116.        [sub{1}, sub{"Mrtg not localized for $_[0] - defaulting to english"}],
  118.        'loadmibs' =>
  119.        [sub{$_[0]}, sub{"No MIB Files specified"}],
  121.        'userrdtool' =>
  122.        [sub{0}, sub{"UseRRDtool is not valid any more. Use LogFormat, PathAdd and LibAdd instead"}],
  124.        'userrdtool[]' =>
  125.        [sub{0}, sub{"UseRRDtool[] is not valid any more. Check the new xyz*bla[] syntax for passing parameters to tool xyz who reads the mrtg.cfg"}],
  126.        
  127.        'logformat' =>
  128.        [sub{$_[0] =~ /^(rateup|rrdtool)$/}, sub{"Invalid Logformat '$_[0]'"}],
  130.        'pathadd' =>
  131.        [sub{-d $_[0]}, sub{"$_[0] is not the name of a directory"}],
  133.        'libadd' =>
  134.        [sub{-d $_[0]}, sub{"$_[0] is not the name of a directory"}],
  135.        
  136.        'runasdaemon' =>
  137.        [sub{1}, sub{"Internal Error"}],
  139.        'nodetach' =>
  140.        [sub{1}, sub{"Internal Error"}],
  142.        'maxage' =>
  143.        [sub{(($_[0] =~ /^[0-9]+$/) and ($_[0] > 0)) },
  144.         sub{"$_[0] must be a Number bigger than 0"}],
  146.        'nospacechar' =>
  147.        [sub{length($_[0]) == 1}, sub{"$_[0] must be one character long"}],
  149.        'snmpoptions' =>
  150.        [sub{ eval( '{'.$_[0].'}' ); return not $@},
  151.         sub{"Must have the format "OptA => Number, OptB => 'String', ... ""}],
  153.        'conversioncode' =>
  154.        [sub{-r $_[0]}, sub{"Cannot read conversion code file $_[0]"}],
  156.        # Per Router CFG
  157.        'target[]' => 
  158.        [sub{1}, sub{"Internal Error"}], #will test this later
  160.        'snmpoptions[]' =>
  161.        [sub{ eval( '{'.$_[0].'}' ); return not $@},
  162.         sub{"Must have the format "OptA => Number, OptB => 'String', ... ""}],
  164.        'routeruptime[]' => 
  165.        [sub{1}, sub{"Internal Error"}], #will test this later
  167.        'routername[]' => 
  168.        [sub{1}, sub{"Internal Error"}], #will test this later
  170.        'maxbytes[]' => 
  171.        [sub{(($_[0] =~ /^[0-9]+$/) && ($_[0] > 0)) },
  172.         sub{"$_[0] must be a Number bigger than 0"}],
  174.        'maxbytes1[]' =>
  175.        [sub{(($_[0] =~ /^[0-9]+$/) && ($_[0] > 0))},
  176.         sub{"$_[0] must be numerical and larger than 0"}],
  178.        'maxbytes2[]' =>
  179.        [sub{(($_[0] =~ /^[0-9]+$/) && ($_[0] > 0))},
  180.         sub{"$_[0] must a number bigger than 0"}],
  182.        'ipv4only[]' =>
  183.        [sub{((lc($_[0])) eq 'yes' or (lc($_[0])) eq 'no')}, sub{"$_[0] must be yes or no"}],
  185.        'absmax[]' => 
  186.        [sub{($_[0] =~ /^[0-9]+$/)}, sub{"$_[0] must be a Number"}],
  188.        'title[]' => 
  189.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  191.        'directory[]' => 
  192.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  194.        'pagetop[]' => 
  195.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  197.        'bodytag[]' => 
  198.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  200.        'pagefoot[]' => 
  201.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  203.        'addhead[]' => 
  204.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  206.        'rrdrowcount[]' => 
  207.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  209.        'extension[]' =>
  210.        [sub{1}, sub{"Internal Error"}], #what ever the user chooses.
  212.        'unscaled[]' => 
  213.        [sub{$_[0] =~ /[ndwmy]+/i}, sub{"Must be a string of [n]one, [d]ay, [w]eek, [m]onth, [y]ear"}],
  215.        'weekformat[]' => 
  216.        [sub{$_[0] =~ /[UVW]/}, sub{"Must be either W, V, or U"}],
  218.        'withpeak[]' =>
  219.        [sub{$_[0] =~ /[ndwmy]+/i}, sub{"Must be a string of [n]one, [d]ay, [w]eek, [m]onth, [y]ear"}],
  221.        'suppress[]' =>
  222.        [sub{$_[0] =~ /[ndwmy]+/i}, sub{"Must be a string of [n]one, [d]ay, [w]eek, [m]onth, [y]ear"}],
  224.        'xsize[]' =>
  225.        [sub{((int($_[0]) >= 30) && (int($_[0]) <= 600))}, sub{"$_[0] must be between 30 and 600 pixels"}],
  227.        'ysize[]' =>
  228.        [sub{(int($_[0]) >= 30)}, sub{"Must be >= 30 pixels"}],
  230.        'ytics[]' =>
  231.        [sub{(int($_[0]) >= 1) }, sub{"Must be >= 1"}],
  233.        'yticsfactor[]' =>
  234.        [sub{$_[0] =~ /[-+0-9.efg]+/}, sub{"Should be a numerical value"}],
  236.        'factor[]' =>
  237.        [sub{$_[0] =~ /[-+0-9.efg]+/}, sub{"Should be a numerical value"}],
  239.        'step[]'  =>
  240.        [sub{(int($_[0]) >= 0)}, sub{"$_[0] must be > 0"}],
  242.        'timezone[]' =>
  243.        [sub{1}, sub{"Internal Error"}],
  245.        'options[]' =>
  246.        [sub{1}, sub{"Internal Error"}],
  248.        'colours[]' =>
  249.        [sub{1}, sub{"Internal Error"}],
  251.        'background[]' =>
  252.        [sub{1}, sub{"Internal Error"}],
  254.        'kilo[]' => 
  255.        [sub{($_[0] =~ /^[0-9]+$/)}, sub{"$_[0] must be a Integer Number"}],
  256.        #define whatever k should be (1000, 1024, ???)
  258.        'kmg[]' =>
  259.        [sub{1}, sub{"Internal Error"}],
  261.        'pngtitle[]' =>
  262.        [sub{1}, sub{"Internal Error"}],
  264.        'ylegend[]' =>
  265.        [sub{1}, sub{"Internal Error"}],
  267.        'shortlegend[]' =>
  268.        [sub{1}, sub{"Internal Error"}],
  270.        'legend1[]' =>
  271.        [sub{1}, sub{"Internal Error"}],
  273.        'legend2[]' =>
  274.        [sub{1}, sub{"Internal Error"}],
  276.        'legend3[]' =>
  277.        [sub{1}, sub{"Internal Error"}],
  279.        'legend4[]' =>
  280.        [sub{1}, sub{"Internal Error"}],
  282.        'legend5[]' =>
  283.        [sub{1}, sub{"Internal Error"}],
  285.        'legendi[]' =>
  286.        [sub{1}, sub{"Internal Error"}],
  288.        'legendo[]' =>
  289.        [sub{1}, sub{"Internal Error"}],
  291.        'setenv[]' => 
  292.        [sub{$_[0] =~ /^(?:[-w]+="[^"]*"(?:s+|$))+$/},
  293.         sub{"$_[0] must be XY="dddd" AASD="kjlkj" ... "}],
  295.        'xzoom[]' =>
  296.        [sub{($_[0] =~ /^[0-9]+(?:.[0-9]+)?$/)},
  297.         sub{"$_[0] must be a Number xxx.xxx"}],
  299.        'yzoom[]' =>
  300.        [sub{($_[0] =~ /^[0-9]+(?:.[0-9]+)?$/)},
  301.         sub{"$_[0] must be a Number xxx.xxx"}],
  303.        'xscale[]' =>
  304.        [sub{($_[0] =~ /^[0-9]+(?:.[0-9]+)?$/)},
  305.         sub{"$_[0] must be a Number xxx.xxx"}],
  307.        'yscale[]' =>
  308.        [sub{($_[0] =~ /^[0-9]+(?:.[0-9]+)?$/)},
  309.         sub{"$_[0] must be a Number xxx.xxx"}],
  311.        'threshdir' =>
  312.        [sub{$_[0] && (-d $_[0])}, sub{"Threshold directory $_[0] does not exist"}],
  314.        'threshmini[]' =>
  315.        [sub{1}, sub{"Internal Threshold Config Error"}],
  317.        'threshmino[]' =>
  318.        [sub{1}, sub{"Internal Threshold Config Error"}],
  320.        'threshmaxi[]' =>
  321.        [sub{1}, sub{"Internal Threshold Config Error"}],
  323.        'threshmaxo[]' =>
  324.        [sub{1}, sub{"Internal Threshold Config Error"}],
  326.        'threshdesc[]' =>
  327.        [sub{1}, sub{"Internal Threshold Config Error"}],
  329.        'threshprogi[]' =>
  330.        [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}],
  332.        'threshprogo[]' =>
  333.        [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}],
  335.        'threshprogoki[]' =>
  336.        [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}],
  338.        'threshprogoko[]' =>
  339.        [sub{$_[0] && (-e $_[0])}, sub{"Threshold program $_[0] cannot be executed"}],
  341.        'timestrpos[]' => 
  342.        [sub{$_[0] =~ /^(no|[lr][ul])$/i}, sub{"Must be a string of NO, LU, RU, LL, RL"}],
  344.        'timestrfmt[]' => 
  345.        [sub{1}, sub{"Internal Error"}] #what ever the user chooses.
  346. );
  349. # config file reading
  351. sub readcfg ($$$$;$$) {
  352.     my $cfgfile = shift;
  353.     my $routers = shift;
  354.     my $cfg = shift;
  355.     my $rcfg = shift;
  356.     my $extprefix = shift || '';
  357.     my $extrules = shift;
  358.     my ($first,$second,$key,$userules);
  359.     my (%seen);
  360.     my (%pre,%post,%deflt,%defaulted);
  361.     unless ($cfgfile) {
  362.         die "ERROR: readfg: no configfile specifiedn";
  363.     }
  364.     unless (ref($routers) eq 'ARRAY' and ref($cfg) eq 'HASH'
  365.             and ref($rcfg) eq 'HASH') {
  366.         die "ERROR: readcfg called with wrong argumentsn";
  367.     }
  368.     if ($extprefix and ref($extrules) ne 'HASH') {
  369.         die "ERROR: readcfg called with wrong args for mrtg extensionn";
  370.     }
  371.     my $hand;
  372.     my $file;
  373.     my @filestack;
  374.     local *CFG;
  375.     if ($cfgfile eq '-'){$cfgfile = '<&STDIN'};
  376.     open (CFG, $cfgfile) || die "ERROR: unable to open config file: $cfgfilen";
  377.     $hand = *CFG;
  378.     my @handstack;
  379.     my $nextfile = $cfgfile;
  380.     my %routerhash;
  381.     while (1) {        
  382.         if (eof $hand || not defined ($_ = <$hand>) ) {
  383.                 close $hand;
  384.                 if (scalar @handstack){
  385.                         $hand = pop @handstack;
  386.                         $nextfile = pop @filestack;
  387.                         next;
  388.                 } else {
  389.                         last;
  390.                 }
  391.         }
  392.         $file=$nextfile;
  393.         chomp;
  394.         my $line = $.;
  395.         if (/^include:s*(.*?S)s*$/i){
  396.                 push @filestack, $file;
  397.                 push @handstack, $hand;
  398.                 $nextfile = $1;
  399.                 local *FH;
  400.                 open (FH, $nextfile)
  401.                  || open (FH, ($cfgfile =~ m#(.+)${MRTG_lib::SL}[^${MRTG_lib::SL}]+$#)[0] . ${MRTG_lib::SL} . $nextfile)
  402.                  || do { die "ERROR: unable to open include file: $nextfilen"};
  403.                 $hand = *FH;
  404.                 next;
  405.         }
  407.         debug('cfg',"$file[$.]: $_");
  408.                 
  409.         s/t/ /g;               #replace tab by space
  410.         s/r$//;                # kill dos newlines ...
  411.         s/ +$//g;               #remove space at the end of the line
  412.         next if /^ *#/;       #ignore comment lines
  413.         next if /^ *$/;        #ignore empty lines
  414.         # oops spelling error
  415.         s/^supress/suppress/gi;
  417.                 
  418.         # the line we got starts with white space so it is to be appended to what ever
  419.         # was on the previous line.
  421.         if (defined $first && /^s+(.*S)s*$/) {
  422.             if (defined $second) {
  423.                $second eq '^' && do { $pre{$first} .= "n".$1; next};
  424.                $second eq '$' && do { $post{$first} .= "n".$1; next};
  425.                $second eq '_' && do { $deflt{$first} .= "n".$1; next};
  426.                $$rcfg{$first}{$second} .= " ".$1;
  427.             } else {
  428.                $$cfg{$first} .= "n".$1;
  429.             }
  430.             next;
  431.         }
  432.     
  433.         if (defined $first && defined $second && defined $post{$first} && ($second !~ /^[$^_]$/)) {
  434.             if (defined $defaulted{$first}{$second}) {
  435.                 $$rcfg{$first}{$second} = $post{$first};
  436.                 delete $defaulted{$first}{$second};
  437.             } else {
  438.                 $$rcfg{$first}{$second} .= ( defined $$cfg{nospacechar} and $post{$first} =~ /(.*)Q$$cfg{nospacechar}E$/) ? $1 : " ".$post{$first} ;
  439.             }
  440.         }
  442.         if (defined $first and $first =~ m/^([^*]+)*(.+)$/) {
  443.             $userules = ($1 eq $extprefix ? $extrules : '');
  444.         } else {
  445.             $userules = %mrtgrules;
  446.         }
  448.         if ($first && defined $deflt{$first} && ($second eq '_')) {
  449.             quickcheck($first,$second,$deflt{$first},$file,$line,$userules)
  450.         } elsif ($first && $second && ($second !~ /^[$^_]$/)) {
  451.             quickcheck($first,$second,$$rcfg{$first}{$second},$file,$line,$userules)
  452.         } elsif ($first && not $second) {
  453.             quickcheck($first,0,$$cfg{$first},$file, $line,$userules)
  454.         }
  456.         if (/^([A-Za-z0-9*]+)[(S+)]s*:s*(.*S?)s*$/) {
  457.             $first = lc($1);
  458.             $second = lc($2);
  459.             # For us spelling-handicapped Americans. ;)
  460.             # James Overbeck, grendel@gmo.jp, 2003/01/19
  461.             if ($first eq 'colors') { $first = 'colours' };
  462.             if ($second eq '^') {
  463.                 if ($3 ne '') {
  464.                     $pre{$first}=$3;
  465.                 } else {
  466.                     delete $pre{$first};
  467.                 }
  468.                 next;
  469.             }
  470.             if ($second eq '$') {
  471.                 if ($3 ne '') {
  472.                     $post{$first}=$3;
  473.                 } else {
  474.                     delete $post{$first};
  475.                 }
  476.                 next;
  477.             }
  478.             if ($second eq '_') {
  479.                 if ($3 ne '') {
  480.                     $deflt{$first}=$3;
  481.                 } else {
  482.                     delete $deflt{$first};
  483.                 }
  484.                 next;
  485.             }
  487.             if (not defined $routerhash{$second}) {
  488.                     push (@{$routers}, $second);
  489.                     $routerhash{$second} = 1;
  490.             }
  491.       
  492.             # make sure that default tags spring into existance upon first 
  493.             # call of a router
  495.             foreach $key (keys %deflt) {
  496.                 if (! defined $$rcfg{$key}{$second}) {
  497.                     $$rcfg{$key}{$second} = $deflt{$key};
  498.                     $defaulted{$key}{$second} = 1;
  499.                 }
  500.             }
  502.             # make sure that prefix-only tags spring into existance upon first 
  503.             # call of a router
  505.             foreach $key (keys %pre) {
  506.                 if (! defined $$rcfg{$key}{$second}) {
  507.                     delete $defaulted{$key}{$second} if $defaulted{$key}{$second};
  508.                     $$rcfg{$key}{$second} = ( defined $$cfg{nospacechar} && $pre{$key} =~ m/(.*)Q$$cfg{nospacechar}E$/ ) ? $1 : $pre{$key}." ";
  509.                 }
  510.             }
  512.             if ($seen{$first}{$second}) {
  513.                 die ("ERROR: Line $line ($_) in CFG file ($file)n".
  514.                      "contains a duplicate definition for $first[$second].n".
  515.                      "First definition is on line $seen{$first}{$second}n")
  516.             } else {
  517.                 $seen{$first}{$second} = $line;
  518.             }
  520.             if ($defaulted{$first}{$second}) {
  521.                 $$rcfg{$first}{$second} = '';
  522.                 delete $defaulted{$first}{$second};
  523.             }
  524.             $$rcfg{$first}{$second} .= $3;
  526.             next;
  528.         }
  529.         if (/^(S+):s*(.*S)s*$/) {
  530.             $first = lc($1);    
  531.             $$cfg{$first} = $2;
  532.             $second = '';
  533.             next;
  534.         }
  535.         die "ERROR: Line $line ($_) in CFG file ($file)  does not make sensen";
  536.     }
  538.     # append $ stuff to the very last tag in cfg file if necessary 
  539.     if (defined $first && defined $second && defined $post{$first} && ($second !~ /^[$^_]$/)) {
  540.         if ($defaulted{$first}{$second}) {
  541.             $$rcfg{$first}{$second} = $post{$first};
  542.             delete $defaulted{$first}{$second};
  543.         } else {
  544.             $$rcfg{$first}{$second} .= 
  545.       ( defined $$cfg{'nospacechar'} && $post{$first} =~ /(.*)Q$$cfg{nospacechar}E$/ ) ? $1 : " ".$post{$first} ;      
  546.         }
  547.     }
  548.   
  549.     #check the last input line
  550.     if ($first =~ m/^([^*]+)*(.+)$/) {
  551.         $userules = ($1 eq $extprefix ? $extrules : '');
  552.     } else {
  553.         $userules = %mrtgrules;
  554.     }
  555.     if ($first && defined $deflt{$first} && ($second eq '_')) {
  556.         quickcheck($first,$second,$deflt{$first},$file,$.,$userules)
  557.     } elsif ($first && $second && ($second !~ /^[$^_]$/)) {
  558.         quickcheck($first,$second,$$rcfg{$first}{$second},$file,$.,$userules)
  559.     } elsif ($first && not $second) {
  560.         quickcheck($first,0,$$cfg{$first},$file,$.,$userules)
  561.     }
  563.     close (CFG);
  564. }
  566. # quick checks
  568. sub quickcheck ($$$$$$) {
  569.     my ($first,$second,$arg,$file,$line,$rules) = @_;
  570.     return unless ref($rules) eq 'HASH';
  571.     my $braces = $second ? '[]':'';
  572.     if (exists $rules->{$first.$braces}) {
  573.         if (&{$rules->{$first.$braces}[0]}($arg)) {
  574.             return 1;
  575.         } else {
  576.             if ($second) {
  577.                 die "ERROR: CFG Error in "$first[$second]", line $line: ".
  578.                   &{$rules->{$first.$braces}[1]}($arg)."nn"; 
  579.             } else {
  580.                 die "ERROR: CFG Error in "$first", line $line: ".
  581.                   &{$rules->{$first.$braces}[1]}($arg)."nn"; 
  582.             } 
  583.         }
  584.     }
  585.     die "ERROR: CFG Error Unknown Option "$first" on line $line or above.n".
  586.       "           Check doc/reference.txt for Helpnn";
  587. }
  589. # complex config checks
  591. sub mkdirhier ($){
  592.     my @dirs = split /Q${MRTG_lib::SL}E+/, shift;
  593.     my $path = "";
  594.     while (@dirs){
  595. $path .= shift @dirs;
  596. $path .= ${MRTG_lib::SL};
  597. if (! -d $path){
  598.                 warn ("WARNING: $path did not exist I will create it nown");
  599. mkdir $path, 0777  or die ("ERROR: mkdir $path: $!n");
  600. }
  601.     }
  602. }
  604. sub cfgcheck ($$$$) {
  605.     my ($routers, $cfg, $rcfg, $target) = @_;
  606.     my ($rou, $confname, $one_option);
  607.     # Target index hash. Keys are "int:community@router" target definition
  608.     # strings and values are indices of the @$target array. Used to avoid
  609.     # duplicate entries in @$target.
  610.     my $targIndex = { };
  611.     my $error="no";
  612.     my(@known_options) = qw(growright bits noinfo absolute gauge nopercent avgpeak derive
  613.     integer perhour perminute transparent dorelpercent 
  614.     unknaszero withzeroes noborder noarrow noi noo
  615.     nobanner nolegend logscale secondmean pngdate printrouter);
  617.     snmpmapOID('hrSystemUptime' => '1.3.6.1.2.1.25.1.1');
  619.     if (defined $$cfg{workdir}) {
  620.         die ("ERROR: WorkDir must not contain spaces when running on Windows. (Yeat another reason to get Linux)n")
  621.                 if ($OS eq 'NT' or $OS eq 'OS2') and $$cfg{workdir} =~ /s/;
  622.         ensureSL($$cfg{workdir});
  623.         $$cfg{logdir}=$$cfg{htmldir}=$$cfg{imagedir}=$$cfg{workdir};
  624.         mkdirhier "$$cfg{workdir}";
  625.         
  626.     } elsif ( not (defined $$cfg{logdir} or defined $$cfg{htmldir} or defined $$cfg{imagedir})) {
  627.           die ("ERROR: "WorkDir" not specified in mrtg config filen");
  628.   $error = "yes";
  629.     } else {
  630.         if (! defined $$cfg{logdir}) {
  631.             warn ("WARNING: "LogDir" not specifiedn");
  632.             $error = "yes";
  633.         } else {
  634.           ensureSL($$cfg{logdir});
  635.           mkdirhier $$cfg{logdir};
  636.         }
  637.         if (! defined $$cfg{htmldir}) {
  638.             warn ("WARNING: "HtmlDir" not specifiedn");
  639.             $error = "yes";
  640.         } else {
  641.           ensureSL($$cfg{htmldir});
  642.           mkdirhier $$cfg{htmldir};
  643.         }
  644.         if (! defined $$cfg{imagedir}) {
  645.             warn ("WARNING: "ImageDir" not specifiedn");
  646.             $error = "yes";
  647.         } else {
  648.           ensureSL($$cfg{imagedir});
  649.           mkdirhier $$cfg{imagedir};
  650.         }
  651.     }
  652.     # build relativ path from htmldir to image dir.
  653.     my @htmldir = split /Q${MRTG_lib::SL}E+/, $$cfg{htmldir};
  654.     my @imagedir =  split /Q${MRTG_lib::SL}E+/, $$cfg{imagedir};
  655.     while (scalar @htmldir > 0 and $htmldir[0] eq $imagedir[0]) {
  656.      shift @htmldir; shift @imagedir;
  657.     }
  658.     # this is for the webpages so we use / path separator always
  659.     $$cfg{imagehtml} = "";
  660.     foreach my $dir ( @htmldir ) {
  661.         $$cfg{imagehtml} .= "../" if $dir;
  662.     }
  663.     map {$$cfg{imagehtml} .= "$_/" } @imagedir;
  664.     # relative path is built
  665.     debug('dir', "imagehtml = $$cfg{imagehtml}");
  667.     $SNMP_util::CacheFile = "$$cfg{'logdir'}oid-mib-cache.txt";
  669.     if (defined $$cfg{loadmibs}) {
  670.         my($mibFile);
  671.         foreach $mibFile (split /[,s]+/, $$cfg{loadmibs}) {
  672.             snmpQueue_MIB_File($mibFile);
  673.         }
  674.     }
  675.     if(defined $$cfg{pathadd}){
  676.         ensureSL($$cfg{pathadd});        
  677.         $ENV{PATH} = "$$cfg{pathadd}${MRTG_lib::PS}$ENV{PATH}";
  678.     }
  679.     if(defined $$cfg{libadd}){
  680.         ensureSL($$cfg{libadd});
  681.         eval "use lib qw($$cfg{libadd})";
  682. my @match;
  683. foreach my $dir (@INC){
  684. push @match, $dir if -f "$dir/RRDs.pm";
  685. }
  686. warn "WARN: found several copies of RRDs.pm in your path: ".
  687.         (join ", ", @match)." I will be using $match[0]. This could ".
  688. "be a problem if this is an old copy and you think I would be using a newer one!n"
  689. if $#match > 0;
  690.     }
  691.     $$cfg{logformat} = 'rateup' unless defined $$cfg{logformat};
  693.     if($$cfg{logformat} eq 'rrdtool') {
  694.         my ($name);
  695.         if ($MRTG_lib::OS eq 'NT' or $MRTG_lib::OS eq 'OS2'){
  696.             $name = "rrdtool.exe";
  697.         } elsif ($MRTG_lib::OS eq 'NW'){
  698.             $name = "rrdtool.nlm";
  699.         } else {
  700.             $name = "rrdtool";
  701.         }
  702.         foreach my $path (split /Q${MRTG_lib::PS}E/, $ENV{PATH}) {
  703.             ensureSL($path);
  704.             -f "$path$name" && do { 
  705.                 $$cfg{'rrdtool'} = "$path$name";
  706.                 last;}
  707.         };
  708.         die "ERROR: could not find $name. Use PathAdd: in mrtg.cfg to help mrtg find rrdtooln" 
  709.                 unless defined $$cfg{rrdtool};
  710.         debug ('rrd',"found rrdtool in $$cfg{rrdtool}");
  711.         my $found;
  712.         foreach my $path (@INC) {
  713.             ensureSL($path);
  714.             -f "${path}RRDs.pm" && do { 
  715.                 $found=1;
  716.                 last;}
  717.         };
  718.         die "ERROR: could not find RRDs.pm. Use LibAdd: in mrtg.cfg to help mrtg find RRDs.pmn" 
  719.                 unless defined $found;
  720.     }
  721.     if (defined $$cfg{snmpoptions}) {
  722.            $cfg->{snmpoptions} = eval('{'.$cfg->{snmpoptions}.'}');
  723.     }
  725.     # default interval is 5 minutes
  726.     $$cfg{interval} = 5 unless defined $$cfg{interval};
  727.     unless ($$cfg{logformat} eq 'rrdtool') {
  728.         # interval has to be 5 minutes at least without userrdtool
  729.         if ($$cfg{interval} < 5) {
  730.             die "ERROR: CFG Error in "Interval": should be at least 5 Minutes (unless you use rrdtool)";
  731.         }
  732.     }
  734.     # Check for a Conversion Code file and evaluate its contents, which
  735.     # should consist of one or more subroutine definitions. The code goes
  736.     # into the MRTGConversion name space.
  737.     if( exists $cfg->{ conversioncode } ) {
  738.         open CONV, $cfg->{ conversioncode }
  739.             or die "ERROR: Can't open file $cfg->{ conversioncode }n";
  740.         my $code = "package MRTGConversion;n". join( '', <CONV> ) . "1;n";
  741.         close CONV;
  742.         die "ERROR: File $cfg->{ conversioncode } conversion code evaluation failedn$@n"
  743.             unless eval $code;
  744.     }
  746.     foreach $rou (@$routers) {
  747.         # and now for the testing
  749. if (! defined $rcfg->{snmpoptions}{$rou}) {
  750. $rcfg->{snmpoptions}{$rou} = {%{$cfg->{snmpoptions}}}
  751.   if defined $cfg->{snmpoptions};
  752.      } else {
  753.              $rcfg->{snmpoptions}{$rou} = eval('{'.$rcfg->{snmpoptions}{$rou}.'}');
  754.         }
  755.         $rcfg->{snmpoptions}{$rou}{avoid_negative_request_ids} = 1;
  756.         # $rcfg->{snmpoptions}{$rou}{domain} = 'udp';
  757.         
  758.         if (! defined $$rcfg{"title"}{$rou}) {
  759.             warn ("WARNING: "Title[$rou]" not specifiedn");
  760.             $error = "yes";
  761.         }
  762.         if (defined $$rcfg{'directory'}{$rou} and $$rcfg{'directory'}{$rou} ne "") {
  763.             # They specified a directory for this router.  Append the
  764.             # pathname seperator to it (so that it can either be present or
  765.             # absent, and the rules for including it are the same).
  766.     ensureSL($$rcfg{'directory'}{$rou});
  767.             for my $x (qw(imagedir logdir htmldir)) {
  768.                 mkdirhier $$cfg{$x}.$$rcfg{directory}{$rou};
  769.             }                   
  770.             $$rcfg{'directory_web'}{$rou} = $$rcfg{'directory'}{$rou};
  771.     $$rcfg{'directory_web'}{$rou} =~ s/Q${MRTG_lib::SL}E+///g;
  772.             debug('dir', "directory for $rou '$$rcfg{'directory_web'}{$rou}'");
  773.         } else {
  774.                 $$rcfg{'directory'}{$rou}="";
  775.                 $$rcfg{'directory_web'}{$rou}="";
  776.         }
  778.       if (defined $$rcfg{"pagetop"}{$rou}) {
  779.             $$rcfg{"pagetop"}{$rou} =~ s/\n/n/g;
  780.         }
  783.         if (defined $$rcfg{"pagefoot"}{$rou}) {
  784.             # allow for linebreaks
  785.             $$rcfg{"pagefoot"}{$rou} =~ s/\n/n/g;
  786.         }
  787.  
  788.         $$rcfg{"maxbytes1"}{$rou} = $$rcfg{"maxbytes"}{$rou} unless defined $$rcfg{"maxbytes1"}{$rou};
  789.         $$rcfg{"maxbytes2"}{$rou} = $$rcfg{"maxbytes"}{$rou} unless defined $$rcfg{"maxbytes2"}{$rou};
  791.         if (    not defined $$rcfg{"maxbytes"}{$rou} 
  792.             and not defined $$rcfg{"maxbytes1"}{$rou} 
  793.             and not defined $$rcfg{"maxbytes2"}{$rou}) {
  794.             warn ("WARNING: "MaxBytes[$rou]" not specifiedn");
  795.             $error = "yes";
  796.         } else {
  798.         if (not defined $$rcfg{"maxbytes1"}{$rou}) {
  799.             warn ("WARNING: "MaxBytes1[$rou]" not specifiedn");
  800.             $error = "yes";
  801.         }
  802.         if (not defined $$rcfg{"maxbytes2"}{$rou}) {
  803.             warn ("WARNING: "MaxBytes2[$rou]" not specifiedn");
  804.             $error = "yes";
  805.         }
  806.         }
  807.         # set default extension
  808.         if (! defined $$rcfg{"extension"}{$rou}) {
  809.             $$rcfg{"extension"}{$rou}="html";
  810.         }
  812.         # set default size 
  813.         if (! defined $$rcfg{"xsize"}{$rou}) {
  814.             $$rcfg{"xsize"}{$rou}=400;
  815.         } 
  816.         if (! defined $$rcfg{"ysize"}{$rou}) {
  817.             $$rcfg{"ysize"}{$rou}=100;
  818.         }
  819.         if (! defined $$rcfg{"ytics"}{$rou}) {
  820.             $$rcfg{"ytics"}{$rou}=4;
  821.         }
  822.         if (! defined $$rcfg{"yticsfactor"}{$rou}) {
  823.             $$rcfg{"yticsfactor"}{$rou}=1;
  824.         }
  825.         if (! defined $$rcfg{"factor"}{$rou}) {
  826.             $$rcfg{"factor"}{$rou}=1;
  827.         }
  828.     
  829.         if (defined $$rcfg{"options"}{$rou}) {      
  830.             my $opttemp = lc($$rcfg{"options"}{$rou});          
  831.             delete $$rcfg{"options"}{$rou};
  832.             foreach $one_option (split /[,s]+/, $opttemp) {
  833.                 if (grep {$one_option eq $_} @known_options) {
  834.                     $$rcfg{'options'}{$one_option}{$rou} = 1;
  835.                 } else {
  836.                     warn ("WARNING: Option[$rou]: "$one_option" is unknownn");
  837.                     $error="yes";
  838.                 }
  839.             }
  840.     if ($rcfg->{'options'}{derive}{$rou} and not $cfg->{logformat} eq 'rrdtool'){
  841.     warn ("WARNING: Option[$rou]: "derive" works only with rrdtool logformatn");
  842.     $error="yes";
  843.     }
  844.         }
  845.         #
  846.         # Check out routeruptime definition
  847.         #
  848.         if (defined $$rcfg{"routeruptime"}{$rou}) {
  849.             ($$rcfg{"community"}{$rou},$$rcfg{"router"}{$rou}) =
  850.               split(/@/,$$rcfg{"routeruptime"}{$rou});
  851.         }
  852.         #
  853.         # Check out target definition
  854.         #
  855.         if (defined $$rcfg{"target"}{$rou}) {
  856.             $$rcfg{targorig}{$rou} = $$rcfg{target}{$rou};
  857.     debug ('tarp',"Starting $rou -> $$rcfg{target}{$rou}");
  858.             # Decide whether to turn on IPv6 support for this target.
  859.             # IPv6 support is turned on only if the EnableIPv6 global
  860.             # setting is yes and the IPv4Only per-target setting is no.
  861.             # If IPv6 is disabled, we set IPv4Only to true for all
  862.             # targets, thus disabling all IPv6-related code.
  863.             my $ipv4only = 1;
  864.             if ($$cfg{enableipv6} and $$cfg{enableipv6} eq 'yes') {
  865.                 # IPv4Only is off by default
  866.                 $ipv4only = 0
  867.                   unless (defined $$rcfg{ipv4only}{$rou}) && (lc($$rcfg{ipv4only}{$rou}) eq 'yes');
  868.             }
  869.     ( $$rcfg{target}{$rou}, $$rcfg{uniqueTarget}{$rou} ) =
  870. targparser( $$rcfg{target}{$rou}, $target, $targIndex, $ipv4only, $rcfg->{snmpoptions}{$rou} );
  871.         } else {
  872.             warn ("WARNING: I can't find a "target[$rou]" definitionn");
  873.             $error = "yes";
  874.         }
  876.         # colors format: name#hexcol,
  877.         if (defined $$rcfg{"colours"}{$rou}) {
  878.             if ($$rcfg{'options'}{'dorelpercent'}{$rou}) {
  879.                 if ($$rcfg{"colours"}{$rou} =~  
  880.                     /^([^#]+)(#[0-9a-f]{6})s*,s*
  881.                      ([^#]+)(#[0-9a-f]{6})s*,s*
  882.                      ([^#]+)(#[0-9a-f]{6})s*,s*
  883.                      ([^#]+)(#[0-9a-f]{6})s*,s*
  884.                      ([^#]+)(#[0-9a-f]{6})/ix) {
  885.                     ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou},
  886.                      $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou},
  887.                      $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou},
  888.                      $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou},
  889.                      $$rcfg{'col5'}{$rou}, $$rcfg{'rgb5'}{$rou}) = 
  890.                        ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10);
  891.                 } else {
  892.                     warn ("WARNING: "colours[$rou]" for colour definitionn".
  893.                           "       use the format: Name#hexcolour, Name#Hexcolour,...n",
  894.                           "       note, that dorelpercent requires 5 colours");
  895.                     $error="yes";
  896.                 }
  897.             } else {            
  898.                 if ($$rcfg{"colours"}{$rou} =~  
  899.                     /^([^#]+)(#[0-9a-f]{6})s*,s*
  900.                      ([^#]+)(#[0-9a-f]{6})s*,s*
  901.                      ([^#]+)(#[0-9a-f]{6})s*,s*
  902.                      ([^#]+)(#[0-9a-f]{6})/ix) {
  903.                     ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou},
  904.                      $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou},
  905.                      $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou},
  906.                      $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}) =
  907.                        ($1, $2, $3, $4, $5, $6, $7, $8);
  908.                 } else {
  909.                     warn "WARNING: "colours[$rou]" for colour definitionn".
  910.                           "       use the format: Name#hexcolour, Name#Hexcolour,...n";
  911.                     $error="yes";
  912.                 }
  913.             }
  914.         } else {            
  915.             if (defined $$rcfg{'options'}{'dorelpercent'}{$rou}) {
  916.                 ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou},
  917.                  $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou},
  918.                  $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou},
  919.                  $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou},
  920.                  $$rcfg{'col5'}{$rou}, $$rcfg{'rgb5'}{$rou}) = 
  921.                    ("GREEN","#00cc00",
  922.                     "BLUE","#0000ff",
  923.                     "DARK GREEN","#006600",
  924.                     "MAGENTA","#ff00ff",
  925.                     "AMBER","#ef9f4f");
  926.             } else {            
  927.                 ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou},
  928.                  $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou},
  929.                  $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou},
  930.                  $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}) =
  931.                    ("GREEN","#00cc00",
  932.                     "BLUE","#0000ff",
  933.                     "DARK GREEN","#006600",
  934.                     "MAGENTA","#ff00ff");
  935.             }
  936.         }
  937.         # Background color, format: #rrggbb
  938.         if (! defined $$rcfg{'background'}{$rou}) {
  939.             $$rcfg{'background'}{$rou} = "#ffffff";
  940.         }
  941.         if ($$rcfg{'background'}{$rou} =~ /^(#[0-9a-f]{6})/i) {
  942.             $$rcfg{'backgc'}{$rou} = "$1";
  943.         } else {
  944.             warn "WARNING: "background[$rou]: ".
  945.                   "$$rcfg{'background'}{$rou}" for colour definitionn".
  946.                   "       use the format: #rrggbbn";
  947.             $error="yes";
  948.         }
  950.         if (! defined  $$rcfg{'kilo'}{$rou}) {
  951.             $$rcfg{'kilo'}{$rou} = 1000;
  952.         }
  953.         if (defined $$rcfg{'kmg'}{$rou}) {
  954.             $$rcfg{'kmg'}{$rou} =~ s/s+//g;
  955.         }
  957.         if (! defined $$rcfg{'xzoom'}{$rou}) {
  958.             $$rcfg{'xzoom'}{$rou} = 1.0;
  959.         }
  960.         if (! defined $$rcfg{'yzoom'}{$rou}) {
  961.             $$rcfg{'yzoom'}{$rou} = 1.0;
  962.         }
  963.         if (! defined $$rcfg{'xscale'}{$rou}) {
  964.             $$rcfg{'xscale'}{$rou} = 1.0;
  965.         }
  966.         if (! defined $$rcfg{'yscale'}{$rou}) {
  967.             $$rcfg{'yscale'}{$rou} = 1.0;
  968.         }
  969.         if (! defined $$rcfg{'timestrpos'}{$rou}) {
  970.             $$rcfg{'timestrpos'}{$rou} = 'NO';
  971.         }
  972.         if (! defined $$rcfg{'timestrfmt'}{$rou}) {
  973.             $$rcfg{'timestrfmt'}{$rou} = "%Y-%m-%d %H:%M";
  974.         }
  975.         if ($error eq "yes") {        
  976.             die "ERROR: Please fix the error(s) in your config filen";
  977.         }
  978.     }
  979. }
  981. # make sure string ends with a slash.
  982. sub ensureSL($) {
  983. #  return;
  984.   my $ref = shift;
  985.   return if $$ref eq "";
  986.   debug('dir',"ensure path IN:  '$$ref'");
  987.   if (${MRTG_lib::SL} eq '\'){
  988.      # two slashes at the start of the string are OK
  989.      $$ref =~ s/(.)Q${MRTG_lib::SL}E+/$1${MRTG_lib::SL}/g;
  990.   } else {
  991.      $$ref =~ s/Q${MRTG_lib::SL}E+/${MRTG_lib::SL}/g;
  992.   }
  993.   $$ref =~ s/Q${MRTG_lib::SL}E*$/${MRTG_lib::SL}/;
  994.   debug('dir',"ensure path OUT: '$$ref'");
  995. }
  997. # convert current supplied time into a nice date string
  999. sub datestr ($) {
  1000.     my ($time) = shift || return 0;
  1001.     my ($wday) = ('Sunday','Monday','Tuesday','Wednesday',
  1002.                   'Thursday','Friday','Saturday')[(localtime($time))[6]];
  1003.     my ($month) = ('January','February' ,'March' ,'April' ,
  1004.                    'May' , 'June' , 'July' , 'August' , 'September' , 
  1005.                    'October' ,
  1006.                    'November' , 'December' )[(localtime($time))[4]];
  1007.     my ($mday,$year,$hour,$min) = (localtime($time))[3,5,2,1];
  1008.     if ($min<10) {
  1009.         $min = "0$min";
  1010.     }
  1011.     return "$wday, $mday $month ".($year+1900)." at $hour:$min";
  1012. }
  1015. # create expire date for expiery in ARG Minutes
  1017. sub expistr ($) {
  1018.     my ($time) = time+$_[0]*60+5;
  1019.     my ($wday) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[(gmtime($time))[6]];
  1020.     my ($month) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', 
  1021.                    'Oct','Nov','Dec')[(gmtime($time))[4]];
  1022.     my ($mday,$year,$hour,$min,$sec) = (gmtime($time))[3,5,2,1,0];
  1023.     if ($mday<10) {
  1024.         $mday = "0$mday";
  1025.     }
  1026.     ;
  1027.     if ($hour<10) {
  1028.         $hour = "0$hour";
  1029.     }
  1030.     ;
  1031.     if ($min<10) {
  1032.         $min = "0$min";
  1033.     }
  1034.     if ($sec<10) {
  1035.         $sec = "0$sec";
  1036.     }
  1037.     return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT";
  1038. }
  1040. sub create_pid ($) {
  1041.     my $pidfile = shift;
  1042.     return if ($OS eq 'NT' );
  1043.     return if -e $pidfile;
  1044.     if ( open(PIDFILE,">$pidfile")) {
  1045.          close PIDFILE;
  1046.     } else {
  1047.          warn "cannot write to $pidfile: $!n";
  1048.     }
  1049. }
  1051. sub demonize_me ($) {
  1052.     my $pidfile = shift;
  1053.     my $cfgfile = shift;
  1054.     print "Daemonizing MRTG ...n";
  1055.     if ( $OS eq 'NT' ) {
  1056.         print "Do Not close this window. Or MRTG will dien";
  1057. #            require Win32::Console;
  1058. #            my $CONSOLE = new Win32::Console;
  1059.         #    detach process from Console
  1060. #            $CONSOLE->Flush();
  1061. #            $CONSOLE->Free();
  1062. #            $CONSOLE->Alloc();
  1063. #            $CONSOLE->Mode()
  1064.     }
  1065.     elsif( $OS eq 'OS2')
  1066.     {
  1067.      require OS2::Process;
  1068.      if (my_type() eq 'VIO'){
  1069.         $main::Cleanfile3 = $pidfile;
  1071.         print "MRTG detached. PID=".system(P_DETACH,$^X." ".$0." ".$cfgfile);
  1072.         exit;
  1073.      }
  1074.     } else {
  1075.            # Check out if there is another mrtg running before forking
  1076.            if (defined $pidfile && open(READPID, "<$pidfile")){
  1077.                if (not eof READPID) {
  1078.                    chomp(my $input = <READPID>);    # read process id in pidfile
  1079.                    if ($input && kill 0 => $input) {# oops - the pid actually exists
  1080.                         die "ERROR: I Quit! Another copy of mrtg seems to be running. Check $pidfilen";
  1081.                    }
  1082.                }
  1083.                close READPID;
  1084.            }
  1086.            defined (my $pid = fork) or die "Can't fork: $!";
  1087.            if ($pid) {
  1088.               exit;
  1089.             } else {
  1090.                 if (defined $pidfile){
  1091.                    $main::Cleanfile3 = $pidfile;
  1092.                    if (open(PIDFILE,">$pidfile")) {
  1093.                         print PIDFILE "$$n";
  1094.                         close PIDFILE;
  1095.                    } else {
  1096.                         warn "cannot write to $pidfile: $!n";
  1097.                    }
  1098.               }
  1099.               require 'POSIX.pm';
  1100.               POSIX::setsid() or die "Can't start a new session: $!";
  1101.               open STDOUT,'>/dev/null' or die "ERROR: Redirecting STDOUT to /dev/null: $!";
  1102.               open STDIN, '</dev/null' or die "ERROR: Redirecting STDIN from /dev/null: $!";
  1103.       }
  1104.    }
  1105. }
  1107. # Create a new SNMP target entry for the @$target array and return a
  1108. # reference to it
  1109. sub newSnmpTarg( $$ ) {
  1110. my $t = shift; # target string
  1111. my $if = shift; # interface match strings
  1112. my $targ = { }; # New target closure
  1113. $targ->{ Methode } = 'SNMP';
  1114. $targ->{ Community } = $if->{ComStr};
  1115. $targ->{ Host } = ( defined $if->{HostIPv6} ) ? $if->{HostIPv6} : $if->{HostName};
  1116. $targ->{ SnmpOpt } = $if->{SnmpInfo};
  1117. $targ->{ snmpoptions}  = $if->{snmpoptions};
  1118. $targ->{ Conversion } = ( defined $if->{ConvSub} ) ? $if->{ConvSub} : '';
  1119. for my $i( 0..1 ) {
  1120. die 'ERROR: Malformed ', $i ? 'output ' : 'input ', "ifSpec in '$t'n"
  1121. if not defined $if->{OID}[$i] and not defined $if->{Alt}[$i];
  1122. $targ->{OID}[$i] = $if->{OID}[$i];
  1123. if( defined $if->{Alt}[$i] ) {
  1124. if( defined $if->{Num}[$i] ) {
  1125. $targ->{IfSel}[$i] = 'If';
  1126. $targ->{Key}[$i] = $if->{Num}[$i];
  1127. } elsif( defined $if->{IP}[$i] ) {
  1128. $targ->{IfSel}[$i] = 'Ip';
  1129. $targ->{Key}[$i] = $if->{IP}[$i];
  1130. } elsif( defined $if->{Desc}[$i] ) {
  1131. $targ->{IfSel}[$i] = 'Descr';
  1132. $targ->{Key}[$i] = $if->{Desc}[$i];
  1133. } elsif( defined $if->{Name}[$i] ) {
  1134. $targ->{IfSel}[$i] = 'Name';
  1135. $targ->{Key}[$i] = $if->{Name}[$i];
  1136. } elsif( defined $if->{Eth}[$i] ) {
  1137. $targ->{IfSel}[$i] = 'Eth';
  1138. $targ->{Key}[$i] = join( '-', map( { sprintf '%02x', hex $_ } split( /-/, $if->{Eth}[$i] ) ) );
  1139. } elsif( defined $if->{Type}[$i] ) {
  1140. $targ->{IfSel}[$i] = 'Type';
  1141. $targ->{Key}[$i] = $if->{Type}[$i];
  1142. } else {
  1143. die "ERROR: Internal error parsing ifSpec in '$t'n";
  1144. }
  1145. } else {
  1146. $targ->{IfSel}[$i] = 'None';
  1147. $targ->{Key}[$i] = '';
  1148. }
  1149. # Remove escaped characters and trailing space from Descr or Name Key
  1150. $targ->{Key}[$i] =~ s/\([s:&@])/$1/g
  1151. if $targ->{IfSel}[$i] eq 'Descr' or $targ->{IfSel}[$i] eq 'Name';
  1152. $targ->{Key}[$i] =~ s/[- ]+$//;
  1153. }
  1154. # Remove escaped characters from community
  1155. $targ->{ Community } =~ s/\([ @])/$1/g;
  1156. return $targ; # Return new target closure
  1157. }
  1159. # ( $string, $unique ) = targparser( $string, $target, $targIndex, $ipv4only )
  1160. # Walk amd analyze the target string $string. $target is a reference to the
  1161. # array of targets being built. $targIndex is a reference to a hash of targets
  1162. # previously encountered indexed by target string. When $ipv4only is nonzero,
  1163. # only IPv4 is in use. Returns the modifed target string and the index of the
  1164. # @$target array to which the target refers if that index is unique. If the
  1165. # index is not unique, i.e. the target definition is a calculation involving
  1166. # two or more different targets, then the value -1 is returned for $unique.
  1167. # Targparser updates the target array avoiding duplicate targets. The goal is
  1168. # to substitute all target definitions with strings of the form
  1169. # "$t1$thisTarg$t2", where $thisTarg is the target index, and $t1 and $t2 are
  1170. # as defined below. The intended result is a target string that can be eval'ed
  1171. # in its entirety later on when monitoring data has been collected. This
  1172. # evaluation occurs in sub getcurrent in the main mrtg script.
  1174. # Note: In the regular expressions in &targparser, we have avoided m/.../i
  1175. # and the variables &`, $&, and $'. Use of these makes regex processing less
  1176. # efficient. See Friedl, J.E.F. Mastering Regular Expressions. O'Reilly.
  1177. # p. 273
  1179. sub targparser( $$$$$ ) {
  1180. # Target string (int:community@router, etc.)
  1181. my $string = shift;
  1182. # Reference to target array
  1183. my $target = shift;
  1184. # Reference to target index hash
  1185. my $targIndex = shift;
  1186. # Nonzero if only IPv4 is in use
  1187. my $ipv4only = shift;
  1188. # options passed per target.
  1189. my $snmpoptions = shift;
  1191. # Next available index in the @$target array
  1192. my $idx = @$target;
  1193. # Common match strings: pre-target, target, post-target
  1194. my( $pre, $t, $post );
  1195. # Portion of string already parsed
  1196. my $parsed = '';
  1197. # Initialize $unique to undefined. It will take on the $targIndex value
  1198. # of the first target encountered. $otherTargCount will count the
  1199. # number of other targets (targets with different values of $targIndex)
  1200. # encountered during the parse. $unique will be returned as undef
  1201. # unless $otherTargCount remains 0.
  1202. my $unique = -1;
  1203. my $otherTargCount = 0;
  1205. # Components of the target expression that are substituted into the
  1206. # target string each time a target is identified. The substitution
  1207. # string is the interpolated value of "$t1$targIndex$t2". At present
  1208. # $t1 and $t2 are set to create a new BigFloat object.
  1209. # my $t1 = ' Math::BigFloat->new($target->[';
  1210. # my $t2 = ']{$mode}) ';
  1211.         # this gives problems with perl 5.005 so bigfloat is introduces in mrtg itself
  1212. my $t1 = ' $target->[';
  1213. my $t2 = ']{$mode} ';
  1215. # Find and substitute all external program targets
  1216. while( ( $pre, $t, $post ) = $string =~ m<
  1217. ^(.*?) # capture pre-target string
  1218. ` # beginning of program target
  1219. ((?:\`|[^`])+) # capture target contents (` allowed)
  1220. ` # end of program target
  1221. (.*)$ # capture post-target string
  1222. >x ) { # Total of 3 captures
  1223. my $thisTarg;
  1224. if( exists $targIndex->{ $t } ) {
  1225. # This program target has been encountered previously
  1226. $thisTarg = $targIndex->{ $t };
  1227. debug( 'tarp', "Existing program target [$thisTarg]" );
  1228. } else {
  1229. # A new program target is needed
  1230. my $targ = { };
  1231. $targ->{ Methode } = 'EXEC';
  1232. $targ->{ Command } = $t;
  1233. # Remove escaped backticks
  1234. $targ->{ Command } =~ s/\`/`/g;
  1235. $target->[ $idx ] = $targ;
  1236. $thisTarg = $idx++;
  1237. $targIndex->{ $t } = $thisTarg;
  1238. debug( 'tarp', "New program target [$thisTarg] '$t'" );
  1239. }
  1240. $parsed .= "$pre$t1$thisTarg$t2";
  1241. $string = $post;
  1242. if( $unique < 0 ) {
  1243. $unique = $thisTarg;
  1244. } else {
  1245. $otherTargCount++ unless $thisTarg == $unique;
  1246. }
  1247. };
  1248. # Reset $string for new target type search
  1249. $string = $parsed . $string;
  1250. $parsed = '';
  1251. debug( 'tarp', "&targparser external done: '$string'" );
  1253. # Common interface specification regex components
  1255. # Simple interface specification regex component. Matches interface
  1256. # specification by IPv4 address, description, name, Ethernet address, or
  1257. # type.
  1258. my $ifSimple =
  1259. '       (d+)|' . # by number ($if->{Num})
  1260. '  /    (d+(?:.d+)+)|' . # by IPv4 address ($if->{IP})
  1261. '  \\ ((?:\\[s:&@]|[^s:&@])+)|' . # by description (allow   : & @) ($if->{Desc})
  1262. '  #   ((?:\\[s:&@]|[^s:&@])+)|' . # by name (allow   : & @) ($if->{Name})
  1263. '  !    ([a-fA-F0-9]+(?:-[a-fA-F0-9]+)+)|' . # by Ethernet address ($if->{Eth})
  1264. '  %    (d+)';  # by type ($if->{Type})
  1266. # Complex interface specification regex component. Note that a null string
  1267. # will match. Therefore the match must be postprocessed to check that
  1268. # $ifOID and $ifAlt are not both null.
  1269. my $ifComplex =
  1270. '([a-zA-Z0-9]*(?:.d+)*?)' . # OID possibly starting with a MIB name ($if->{OID})
  1271. '(' . # Interface specification alternatives: ($if->{Alt})
  1272. '.' . #  separator
  1273. $ifSimple . #  simple alternatives (6 variables)
  1274. ')?'; #  maybe none of the above
  1276. # Community-host interface specification regex component.
  1277. my $ifComHost =
  1278. '((?:\\[@ ]|[^s@])+)' . # community string ('@' and ' ' allowed) ($if->{ComStr})
  1279. '@' . # separator
  1280. '(?:([[a-fA-F0-9:]*])|' . # hostname as IPv6 address ($if->{HostIPv6})
  1281. '([-w]+(?:.[-w]+)*))' . # or DNS name ($if->{HostName})
  1282. '((?::[d.!]*)*)' . # SNMP session configuration ($if->{SnmpInfo})
  1283. '(?:|([a-zA-Z_][w]*))?'; # numeric conversion subroutine ($if->{ConvSub})
  1285. # Match strings for simple and complex interface specifications. Entries
  1286. # are of the form $if->{k1}[i], where k1 is OID, Alt, Num, IP, Desc,
  1287. # Name, Eth, or Type, and i is 0 or 1 (input or output). Entries may also
  1288. # have the form $if->{k1}, where k1 is Rev, ComStr, HostIPv6, HostName,
  1289. # SnmpInfo, or ConvSub, with no [i] in these cases.
  1290. my $if;
  1292. # Find and substitute all complex OID targets
  1294. while( ( $pre, $t, $if->{OID}[0], $if->{Alt}[0], $if->{Num}[0],
  1295. $if->{IP}[0], $if->{Desc}[0], $if->{Name}[0], $if->{Eth}[0],
  1296. $if->{Type}[0], $if->{OID}[1], $if->{Alt}[1], $if->{Num}[1],
  1297. $if->{IP}[1], $if->{Desc}[1], $if->{Name}[1], $if->{Eth}[1],
  1298. $if->{Type}[1], $if->{ComStr}, $if->{HostIPv6}, $if->{HostName},
  1299. $if->{SnmpInfo}, $if->{ConvSub}, $post ) = $string =~ m<
  1300. ^(.*?) # capture pre-target string
  1301. ( # capture entire target
  1302. ${ifComplex} # input interface specification (8 captures)
  1303. & # separator
  1304. ${ifComplex} # output interface specification (8 captures)
  1305. : # separator
  1306. ${ifComHost} # community-host specification (5 captures)
  1307. ) # end of entire target capture
  1308. (.*)$ # capture post-target string
  1309. >x ) { # Total of 24 captures
  1310. my $thisTarg;
  1311. # Exception: skip and try to parse later as a simple target if
  1312. # $if->{Desc}[0], $if->{Name}[0], $if->{Desc}[1], or $if->{Name}[1]
  1313. # ends with a backslash character
  1314. if( ( defined $if->{Desc}[0] and $if->{Desc}[0] =~ m<\$> ) or
  1315. ( defined $if->{Name}[0] and $if->{Name}[0] =~ m<\$> ) or
  1316. ( defined $if->{Desc}[1] and $if->{Desc}[1] =~ m<\$> ) or
  1317. ( defined $if->{Name}[1] and $if->{Name}[1] =~ m<\$> ) ) {
  1318. $parsed .= "$pre$t";
  1319. $string = $post;
  1320. next;
  1321. }
  1322. if( exists $targIndex->{ $t } ) {
  1323. # This complex target has been encountered previously
  1324. $thisTarg = $targIndex->{ $t };
  1325. debug( 'tarp', "Existing complex target [$thisTarg]" );
  1326. } else {
  1327. # A new complex target is needed
  1328. my $targ = newSnmpTarg( $t, $if );
  1329. $targ->{ ipv4only } = $ipv4only;
  1330. $targ->{ snmpoptions } = $snmpoptions;
  1331. $target->[ $idx ] = $targ;
  1332. $thisTarg = $idx++;
  1333. $targIndex->{ $t } = $thisTarg;
  1334. debug( 'tarp', "New complex target [$thisTarg] '$t':n" .
  1335. "  Comu:  $targ->{Community}, Host: $targ->{Host}n" .
  1336. "  Opt:   $targ->{SnmpOpt}, IPv4: $targ->{ipv4only}n" .
  1337. "  Conv:  $targ->{Conversion}n" .
  1338. "  OID:   $targ->{OID}[0], $targ->{OID}[1]n" .
  1339. "  IfSel: $targ->{IfSel}[0], $targ->{IfSel}[1]n" .
  1340. "  Key:   $targ->{Key}[0], $targ->{Key}[1]" );
  1341. }
  1342. $parsed .= "$pre$t1$thisTarg$t2";
  1343. $string = $post;
  1344. if( $unique < 0 ) {
  1345. $unique = $thisTarg;
  1346. } else {
  1347. $otherTargCount++ unless $thisTarg == $unique;
  1348. }
  1349. }
  1350. # Reset $string and $parsedfor new target type search
  1351. $string = $parsed . $string;
  1352. $parsed = '';
  1353. debug( 'tarp', "&targparser complex done: '$string'" );
  1355. # Find and substitute all simple targets
  1357. while( ( $pre, $t, $if->{Rev}, $if->{Num}[0], $if->{IP}[0],
  1358. $if->{Desc}[0], $if->{Name}[0], $if->{Eth}[0], $if->{Type}[0],
  1359. $if->{ComStr}, $if->{HostIPv6}, $if->{HostName}, $if->{SnmpInfo},
  1360. $if->{ConvSub}, $post ) = $string =~ m<
  1361. ^(.*?) # capture pre-target string
  1362. ( # capture entire target
  1363. (-)? # capture direction reversal
  1364. (?: ${ifSimple} ) # simple interface specification (6 captures)
  1365. : # separator
  1366. ${ifComHost} # community-host specification (5 captures)
  1367. ) # end of entire target capture
  1368. (.*)$ # capture post-target string
  1369. >x ) { # Total of 15 captures
  1370. my $thisTarg;
  1371. if( exists $targIndex->{ $t } ) {
  1372. # This simple target has been encountered previously
  1373. $thisTarg = $targIndex->{ $t };
  1374. debug( 'tarp', "Existing simple target [$thisTarg]" );
  1375. } else {
  1376. # A new simple target is needed
  1377. # Reverse interface directions if indicated by $if->{Rev}.
  1378. # The sense of $d1 and $d2 is 0 for input and 1 for output
  1379. my $d1 = ( defined $if->{Rev} and $if->{Rev} eq '-' ) ? 1 : 0;
  1380. my $d2 = 1 - $d1;
  1381. # Set the OIDs depending on whether SNMPv2 has been specified
  1382. # and on the direction
  1383. if( $if->{SnmpInfo} =~ m/(?::[^:]*){4}:[32][Cc]?/ ) {
  1384. $if->{OID}[$d1] = 'ifHCInOctets';
  1385. $if->{OID}[$d2] = 'ifHCOutOctets';
  1386. } else {
  1387. $if->{OID}[$d1] = 'ifInOctets';
  1388. $if->{OID}[$d2] = 'ifOutOctets';
  1389. }
  1390. # Give $if->{Alt}[i] an arbitrary defined value so that
  1391. # &newSnmpTarg works correctly
  1392. $if->{Alt}[0] = 1;
  1393. $if->{Alt}[1] = 1;
  1394. # Copy input specification to output
  1395. $if->{Num}[1] = $if->{Num}[0];
  1396. $if->{IP}[1] = $if->{IP}[0];
  1397. $if->{Desc}[1] = $if->{Desc}[0];
  1398. $if->{Name}[1] = $if->{Name}[0];
  1399. $if->{Eth}[1] = $if->{Eth}[0];
  1400. $if->{Type}[1] = $if->{Type}[0];
  1401. my $targ = newSnmpTarg( $t, $if );
  1402. $targ->{ snmpoptions} = $snmpoptions;
  1403. $targ->{ ipv4only } = $ipv4only;
  1404. $target->[ $idx ] = $targ;
  1405. $thisTarg = $idx++;
  1406. $targIndex->{ $t } = $thisTarg;
  1407. debug( 'tarp', "New simple target [$thisTarg] '$t':n" .
  1408. "  Comu:  $targ->{Community}, Host: $targ->{Host}n" .
  1409. "  Opt:   $targ->{SnmpOpt}, IPv4: $targ->{ipv4only}n" .
  1410. "  Conv:  $targ->{Conversion}n" .
  1411. "  OID:   $targ->{OID}[0], $targ->{OID}[1]n" .
  1412. "  IfSel: $targ->{IfSel}[0], $targ->{IfSel}[1]n" .
  1413. "  Key:   $targ->{Key}[0], $targ->{Key}[1]" );
  1414. }
  1415. $parsed .= "$pre$t1$thisTarg$t2";
  1416. $string = $post;
  1417. if( $unique < 0 ) {
  1418. $unique = $thisTarg;
  1419. } else {
  1420. $otherTargCount++ unless $thisTarg == $unique;
  1421. }
  1422. }
  1423. # Assemble string to be returned
  1424. $string = $parsed . $string;
  1425. # Set $unique undefined if more than one target is referred to in the
  1426. # target string
  1427. $unique = -1 if $otherTargCount;
  1428. debug( 'tarp', "&targparser simple done: '$string'" );
  1429. debug( 'tarp', "&targparser returning: unique = $unique" );
  1430. return ( $string, $unique );
  1431. }
  1433. # Display of &targparser intermediate values for debugging purposes. Call as
  1434. # showMatch( $string, $pre, $t, $post, $if ) from within &targparser.
  1435. sub showMatch( $$$$$ ) {
  1436. my( $string, $pre, $t, $post, $if ) = @_;
  1437. warn "# Matching on string '$string'n";
  1438. warn "# Prematch:  '$pre'n";
  1439. warn "# Target:    '$t'n";
  1440. warn "# Postmatch: '$post'n";
  1441. warn "# Captured:n";
  1442. foreach my $k( keys %$if ) {
  1443. if( ref( $if->{$k} ) eq 'ARRAY' ) {
  1444. warn "#  $if->{$k}[0,1]: '",
  1445. ( defined $if->{$k}[0] ) ? $if->{$k}[0] : 'undef', "', '",
  1446. ( defined $if->{$k}[1] ) ? $if->{$k}[1] : 'undef', "'n";
  1447. } else {
  1448. warn "#  $if->{$k}:      '",
  1449. ( defined $if->{$k} ) ? $if->{$k} : 'undef', "'n";
  1450. }
  1451. }
  1452. }
  1454. sub readconfcache ($) {
  1455.     my $cfgfile = shift;
  1456.     my %confcache;
  1457.     if (open (CFGOK,"<$cfgfile")) {
  1458.         while (<CFGOK>) {
  1459.             chomp;
  1460.             next unless /t/; #ignore odd lines
  1461.     next if /^S+:/; #ignore legacy lines
  1462.             my ($host,$method,$key,$if) = split (/t/, $_);
  1463.             $key =~ s/[- ]+$//; # no trailing whitespace in keys realy !
  1464.             $key =~ s/[- ]/ /g; # all else becomes a normal space ... get a life
  1465.             $confcache{$host}{$method}{$key} = $if;
  1466.         }
  1467.         close CFGOK;
  1468.     }
  1469.     return %confcache;
  1470. }
  1472. sub writeconfcache ($$) {
  1473.     my $confcache = shift;
  1474.     my $cfgfile = shift;
  1475.     if ($cfgfile ne '&STDOUT'){
  1476.       open (CFGOK,">$cfgfile") or die "ERROR: writing $cfgfile.ok: $!";
  1477.     }
  1478.     my @hosts;
  1479.     if (defined $$confcache{___updated}) {
  1480.         @hosts = @{$$confcache{___updated}} ;
  1481.         delete $$confcache{___updated};
  1482.     } else {
  1483.         @hosts = grep !/^___/, keys %{$confcache}
  1484.     }
  1485.     foreach my $host (sort @hosts) {
  1486.         foreach my $method (sort keys %{$$confcache{$host}}) {
  1487.             foreach my $key (sort keys %{$$confcache{$host}{$method}}) {
  1488.                 if ($cfgfile ne '&STDOUT'){
  1489.                         print CFGOK "$hostt$methodt$keyt".
  1490.                             $$confcache{$host}{$method}{$key},"n";
  1491.                 } else {
  1492.                          print "$hostt$methodt$keyt".
  1493.                             $$confcache{$host}{$method}{$key},"n";
  1494.                 }
  1495.             }
  1496.         }
  1497.     }
  1498.     close CFGOK;
  1499. }
  1501. sub cleanhostkey ($){
  1502.     my $host = shift;
  1503.     return undef unless defined $host;
  1504.     $host =~ s/(:d*)(?:(:d*)(?:(:d*)(?:(:d*)(?:(:d*)))))$/$1$5/
  1505.         or
  1506.     $host =~ s/(:d*)(?:(:d*)(?:(:d*)(?:(:d*)?)?)?)$/$1/;
  1507.     $host =~ s/:/_/g; # make sure that double invocations do not kill us
  1508.     return $host;
  1509. }
  1511. sub storeincache ($$$$$){
  1512.     my($confcache,$host,$method,$key,$value) = @_;
  1513.     $host = cleanhostkey $host;
  1514.     if (not defined $value ){
  1515.  $$confcache{$host}{$method}{$key} = undef;
  1516.  return;
  1517.     }
  1518.     $value =~ s/[- ]/ /g; # all else becomes a normal space ... get a life
  1519.     $value =~ s/ +$//; # no trailing spaces
  1520.     if (defined $$confcache{$host}{$method}{$key} and 
  1521. $$confcache{$host}{$method}{$key} ne $value) {
  1522.         $$confcache{$host}{$method}{$key} = "Dup";
  1523. debug('coca',"store in confcache $host $method $key --> $value (duplicate)");
  1524.     } else {
  1525.         $$confcache{$host}{$method}{$key} = $value;
  1526. debug('coca',"store in confcache $host $method $key --> $value");
  1527.     }
  1529. }
  1531. sub readfromcache ($$$$){
  1532.     my($confcache,$host,$method,$key) = @_;
  1533.     $host = cleanhostkey $host;
  1534.     return $$confcache{$host}{$method}{$key};
  1535. }
  1538. sub clearfromcache ($$){
  1539.     my($confcache,$host) = @_;
  1540.     $host = cleanhostkey $host;
  1541.     delete $$confcache{$host};
  1542.     debug('coca',"clear confcache $host");
  1543. }
  1546. sub populateconfcache ($$$$$) {
  1547.     my $confcache = shift;
  1548.     my $host = shift;
  1549.     my $ipv4only = shift;
  1550.     my $reread = shift;
  1551.     my $snmpoptions = shift || {};
  1552.     my $hostkey = cleanhostkey $host;    
  1553.     return if defined $$confcache{$hostkey} and not $reread;
  1554.     my $snmp_errlevel = $SNMP_Session::suppress_warnings;
  1555.     $SNMP_Session::suppress_warnings = 3;    
  1556.     debug('coca',"populate confcache $host");
  1558.     # clear confcache for host;
  1559.     delete $$confcache{$hostkey};
  1561.     my @ret;
  1562.     my %tables = ( ifDescr => 'Descr',
  1563.    ifName  => 'Name',
  1564.    ifType  => 'Type',
  1565.    ipAdEntIfIndex => 'Ip' );
  1566.     my @nodes = qw (ifName ifDescr ifType ipAdEntIfIndex);
  1567.     # it seems that some devices only give back sensible data if their tables
  1568.     # are walked in the right ordere ....
  1569.     foreach my $node (@nodes) {
  1570. next if $confcache->{___deadhosts}{$hostkey} and time - $confcache->{___deadhosts}{$hostkey} < 300;
  1571. $SNMP_Session::errmsg = undef;
  1572. @ret = snmpwalk(v4onlyifnecessary($host, $ipv4only), $snmpoptions, $node);
  1573. unless ( $SNMP_Session::errmsg){
  1574.     foreach my $ret (@ret)
  1575.       {
  1576.   my ($oid, $desc) = split(':', $ret, 2);
  1577.   if ($tables{$node} eq 'Ip') {
  1578.       storeincache($confcache,$host,$tables{$node},$oid,$desc);
  1579.   } else {
  1580.                       $desc =~ s/[- ]+$//; #trailing whitespace is too sick for us
  1581.                       $desc =~ s/[- ]/ /g; #whitespace is just whitespace
  1582.       storeincache($confcache,$host,$tables{$node},$desc,$oid);
  1583.   }
  1584.       };
  1585. } else {
  1586.        $confcache->{___deadhosts}{$hostkey} = time
  1587. if $SNMP_Session::errmsg =~ /no response received/;
  1588.     debug('coca',"Skipping $node scanning because $host does not seem to support it");
  1589. }
  1590.     }
  1591.     if ($confcache->{___deadhosts}{$hostkey} and time - $confcache->{___deadhosts}{$hostkey} < 300){
  1592. $SNMP_Session::suppress_warnings = $snmp_errlevel;
  1593. return;
  1594.     }
  1595.     $SNMP_Session::errmsg = undef;
  1596.     @ret = snmpwalk(v4onlyifnecessary($host, $ipv4only), $snmpoptions, "ifPhysAddress");
  1597.     unless ( $SNMP_Session::errmsg){
  1598. foreach my $ret (@ret)
  1599.   {
  1600.       my ($oid, $bin) = split(':', $ret, 2);
  1601.       my $eth = unpack 'H*', $bin; 
  1602.         my @eth;
  1603.       while ($eth =~ s/^..//){
  1604.         push @eth, $&;
  1605.       }
  1606.       my $phys=join '-', @eth;
  1607.       storeincache($confcache,$host,"Eth",$phys,$oid);
  1608.            }
  1609.      } else {
  1610.             debug('coca',"Skipping ifPhysAddress scanning because $host does not seem to support it");
  1611.      }
  1613.      if (ref $$confcache{___updated} ne 'ARRAY') {
  1614.         $$confcache{___updated} = []; #init to empty array
  1615.      }
  1616.      push @{$$confcache{___updated}}, $hostkey;
  1618.     $SNMP_Session::suppress_warnings = $snmp_errlevel;    
  1619. }
  1621. sub log2rrd ($$$) {
  1622.     my $router = shift;
  1623.     my $cfg = shift;
  1624.     my $rcfg = shift;
  1625.     my %mark;
  1626.     my %incomp;
  1627.     my %elapsed_time;
  1628.     my %rate;
  1629.     my %store;
  1630.     my %first_step;
  1631.     my %cur;
  1632.     my %next;
  1633.     my $rrd;    
  1634.     my @steps = qw(300 1800 7200 86400);
  1635.     my %sizes = ( 300 => 600, 1800 => 700, 7200 => 775, 86400 => 797);
  1637.     open R, "<$$cfg{logdir}$$rcfg{'directory'}{$router}$router.log" or 
  1638. die "ERROR: opening $$cfg{logdir}$$rcfg{'directory'}{$router}$router.log: $!";
  1639.     debug('rrd',"converting $$cfg{logdir}$$rcfg{'directory'}{$router}$router.log");
  1640.     my $latest_timestamp;
  1641.     my %latest_counter;
  1642.     chomp($_ = <R>);
  1643.     my $time;
  1644.     my $next_time;
  1645.     ($latest_timestamp,$latest_counter{in},$latest_counter{out}) = split /s+/;
  1646.     chomp($_ = <R>);  
  1647.     ($time,$cur{in},$cur{out},$cur{maxin},$cur{maxout}) = split /s+/;
  1649.     foreach my $s (@steps) {
  1650. $mark{$s} = $latest_timestamp - ($latest_timestamp % $s) + $s;
  1651. $first_step{$s} = $latest_timestamp - ($mark{$s} - $s);
  1652. $elapsed_time{$s} = $s - $first_step{$s};
  1653. $rate{in}{$s}=$cur{in};
  1654. $rate{out}{$s}=$cur{out};
  1655. $rate{maxin}{$s}=$cur{maxin};
  1656. $rate{maxout}{$s}=$cur{maxout};
  1657.     }
  1659.     while(<R>){
  1660. chomp;
  1661. ($next_time,$next{in},$next{out},$next{maxin},$next{maxout}) =
  1662.     split /s+/;
  1663.         foreach my $s (@steps) {
  1664.     # bail if we have enough entries
  1665.     next if ref $store{in}{$s} and
  1666. scalar @{$store{in}{$s}} > $sizes{$s};
  1667.    
  1668.     # ok we are still here. If next mark is before the next time
  1669.             # we take a short step, else we gobble up
  1670.     my $next_stop;
  1671.     do {
  1672. if ($elapsed_time{$s} + $time - $next_time > $s) {
  1673.     $next_stop = $mark{$s}-$s;
  1674. } else {
  1675.     $next_stop = $next_time;
  1676. }
  1677. my $time_diff = $time-$next_stop;
  1678. foreach my $d (qw(in out)) {     
  1679.     $rate{$d}{$s} = ($rate{$d}{$s} * $elapsed_time{$s}
  1680.      + $cur{$d} * $time_diff) /
  1681.        ($elapsed_time{$s} + $time_diff);
  1682. }
  1683. foreach my $d (qw(maxin maxout)){
  1684.     $rate{$d}{$s} = $cur{$d} if $rate{$d}{$s} < $cur{$d};
  1685. }
  1686. $elapsed_time{$s} += $time_diff;
  1687. # print "$time $next_stopn" if $s == 300;
  1688. if ($next_stop == $mark{$s}-$s) {
  1689.     foreach my $t (qw(in out maxin maxout)){
  1690.                        $rate{$t}{$s}/=3600
  1691.                            if (defined $$rcfg{'options'}{'perhour'}{$router});    
  1692.                        $rate{$t}{$s}/=60
  1693.                            if (defined $$rcfg{'options'}{'perminute'}{$router});
  1694.             push @{$store{$t}{$s}}, int($rate{$t}{$s});
  1695.     }
  1696.     $mark{$s} -= $s;
  1697.     $rate{maxin}{$s} = 0;
  1698.     $rate{maxout}{$s} = 0;
  1699.     $elapsed_time{$s} = 0;
  1700. }
  1701.             } while ($next_stop > $next_time );
  1702. }
  1703.         ($time,$cur{in},$cur{out},$cur{maxin},$cur{maxout}) = 
  1704.     ($next_time,$next{in},$next{out},$next{maxin},$next{maxout});
  1705.     }
  1706.     close R;
  1707.     # lets see if we have rrdtool 1.2 at our hands
  1708.     my $VERSION = '0001';
  1709.     if ($RRDs::VERSION >= 1.2){
  1710. $VERSION = '0003';
  1711.     }
  1712.     my $DST;
  1713.     my $pdprepin = (shift @{$store{in}{300}})*($first_step{300});
  1714.     my $pdprepout = (shift @{$store{out}{300}})*($first_step{300});
  1716.     if (defined $$rcfg{'options'}{'absolute'}{$router}) {
  1717. $DST = 'ABSOLUTE'
  1718.     } elsif (defined $$rcfg{'options'}{'gauge'}{$router}) {
  1719. $DST = 'GAUGE'
  1720.     } else {
  1721. $DST = 'COUNTER'
  1722.     }
  1724.     my $MHB = $$cfg{interval} * 60 * 2;
  1726.     my $MAX1 =
  1727.       $$rcfg{'absmax'}{$router}
  1728. || $$rcfg{'maxbytes1'}{$router} 
  1729.   || 'U';
  1731.     my $MAX2 =
  1732.       $$rcfg{'absmax'}{$router}
  1733. || $$rcfg{'maxbytes2'}{$router} 
  1734.   || 'U';
  1735.     
  1736.     $rrd = <<RRD;
  1737. <!-- MRTG Log converted to RRD -->
  1738. <rrd>
  1739. <version> $VERSION </version>
  1740. <step> 300 </step>
  1741. <lastupdate> $latest_timestamp </lastupdate>
  1743. <ds>
  1744. <name> ds0 </name>
  1745. <type> $DST </type>
  1746. <minimal_heartbeat> $MHB </minimal_heartbeat>
  1747. <min> 0 </min>
  1748. <max> $MAX1 </max>
  1750. <!-- PDP Status -->
  1751. <last_ds> $latest_counter{in} </last_ds>
  1752. <value> $pdprepin </value>
  1753. <unknown_sec> 0 </unknown_sec>
  1754. </ds>
  1756. <ds>
  1757. <name> ds1 </name>
  1758. <type> $DST </type>
  1759. <minimal_heartbeat> $MHB </minimal_heartbeat>
  1760. <min> 0 </min>
  1761. <max> $MAX2 </max>
  1763. <!-- PDP Status -->
  1764. <last_ds> $latest_counter{out} </last_ds>
  1765. <value> $pdprepout </value>
  1766. <unknown_sec> 0 </unknown_sec>
  1767. </ds>
  1768. RRD
  1769.     $first_step{300} = 0; # invalidate
  1770.     addarch(1,'AVERAGE','in','out',%store,%first_step,$rrd);
  1771.     addarch(6,'AVERAGE','in','out',%store,%first_step,$rrd);
  1772.     addarch(24,'AVERAGE','in','out',%store,%first_step,$rrd);
  1773.     addarch(288,'AVERAGE','in','out',%store,%first_step,$rrd);
  1774.     addarch(1,'MAX','maxin','maxout',%store,%first_step,$rrd);
  1775.     addarch(6,'MAX','maxin','maxout',%store,%first_step,$rrd);
  1776.     addarch(24,'MAX','maxin','maxout',%store,%first_step,$rrd);
  1777.     addarch(288,'MAX','maxin','maxout',%store,%first_step,$rrd);
  1778.     $rrd .= <<RRD;
  1779. </rrd>
  1780. RRD
  1781.         
  1782.     if ( $OS eq 'NT'  or $OS eq 'OS2') {
  1783.        open (R, "|$$cfg{rrdtool} restore - $$cfg{logdir}$$rcfg{'directory'}{$router}$router.rrd");
  1784.     } else {
  1785.        open (R, "|-") or exec "$$cfg{rrdtool}","restore","-","$$cfg{logdir}$$rcfg{'directory'}{$router}$router.rrd";
  1786.     }
  1787.     print R $rrd;
  1788.     close R;
  1789. }
  1792. sub addarch($$$$$$$){
  1793.     my $steps = shift;
  1794.     my $cons = shift;
  1795.     my $in = shift;
  1796.     my $out = shift;
  1797.     my $store = shift;
  1798.     my $first_step = shift;
  1799.     my $rrd = shift;
  1800.     my $cdpin = 'NaN';
  1801.     my $cdpout = 'NaN';
  1803.     my $param_start = '';
  1804.     my $param_end = '';
  1805.     my $extra_ds = '';
  1806.     if ($RRDs::VERSION >= 1.2){
  1807.         $param_start = '<params>';
  1808.         $param_end = '</params>';
  1809.         $extra_ds = '<primary_value> 0.0000000000e+00 </primary_value> <secondary_value> 0.0000000000e+00 </secondary_value>';
  1810.     }
  1812.     if ($steps != 300) {
  1813. $cdpin = shift @{$$store{$in}{300*$steps}};
  1814. $cdpout = shift @{$$store{$out}{300*$steps}};
  1815.     };
  1816.     $$rrd .= <<RRD;
  1817. <!-- Round Robin Archive -->
  1818. <rra>
  1819. <cf> $cons </cf>
  1820. <pdp_per_row> $steps </pdp_per_row>
  1821. $param_start <xff> 0.5 </xff> $param_end
  1822. <cdp_prep>
  1823. <ds>$extra_ds <value> $cdpin </value>  <unknown_datapoints> 0 </unknown_datapoints></ds>
  1824. <ds>$extra_ds <value> $cdpout </value>  <unknown_datapoints> 0 </unknown_datapoints></ds>
  1825. </cdp_prep>
  1827. <database>
  1828. RRD
  1829.     while (@{$$store{$in}{$steps*300}}){
  1830.         # we take zero as UNKNOWN
  1831. my $inr = pop @{$$store{$in}{$steps*300}} || 'NaN';
  1832. my $outr = pop @{$$store{$out}{$steps*300}} || 'NaN';
  1833. $$rrd .= <<RRD;
  1834.              <row><v> $inr </v><v> $outr </v></row>
  1835. RRD
  1836.     }
  1837.     $$rrd .= <<RRD;
  1838. </database>
  1839. </rra>
  1840. RRD
  1841. }
  1846. # debug if the relevant debug tag is active print the debug message
  1847. sub debug ($$) {
  1848.     return unless scalar @main::DEBUG;
  1849.     my $tag = shift;
  1850.     my $msg = shift;
  1851.     return unless grep {$_ eq $tag} @main::DEBUG;
  1852.     warn "--",$tag,": ",$msg,"n";
  1853.     return;
  1854. }
  1856. # timestamp
  1857. sub timestamp () {
  1858.     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  1859.                                                 localtime(time);
  1860.     $year += 1900;
  1861.     $mon += 1;
  1862.     return sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year,$mon,$mday,$hour,$min,$sec;
  1863. }
  1865. # configure __DIE__ and __WARN__
  1866.        
  1867. sub setup_loghandlers ($){
  1868.     $::global_logfile = $_[0];
  1869.     for($_[0]){
  1870. /^eventlog$/i && do {
  1871.     require Win32::EventLog;
  1872.     $SIG{__WARN__} = sub {
  1873. my $EventLog = Win32::EventLog->new('MRTG');
  1874. my $Type = ($_[0] =~ /warning/) ? 
  1875.   &Win32::EventLog::EVENTLOG_WARNING_TYPE : 
  1876.   &Win32::EventLog::EVENTLOG_INFORMATION_TYPE;
  1877. my $Msg = $_[0];
  1878. $Msg =~ s/n/rn/g;
  1879.                 $Msg =~ s/[nr]$//g;
  1880. $EventLog->Report({
  1881.         EventID => 1000,
  1882.                       Category => "WARN",
  1883.       EventType => $Type,
  1884.                       Data => '',                       
  1885.       Strings => $Msg });
  1886. $EventLog->Close;
  1887.     };
  1888.     $SIG{__DIE__} = sub {
  1889. my $EventLog = Win32::EventLog->new('MRTG');
  1890. my $Msg = $_[0];
  1891. $Msg =~ s/n/rn/g;
  1892.                 $Msg =~ s/[nr]$//g;
  1893. $EventLog->Report({
  1894.       EventID => 1000,
  1895.                       Category => "ERROR",
  1896.       EventType => &Win32::EventLog::EVENTLOG_ERROR_TYPE,
  1897.                       Data => '',
  1898.       Strings => $Msg });
  1899. $EventLog->Close;
  1900. exit 1;
  1901.     };
  1902.     last;
  1903. };
  1904. $SIG{__WARN__} = sub {
  1905.     
  1906.     if (open DEB, ">>$::global_logfile") {
  1907. print DEB timestamp." -- $_[0]";
  1908. close DEB;
  1909.     } else {
  1910. print STDERR timestamp." -- $_[0]" 
  1911.     }
  1912. };
  1915. $SIG{__DIE__} = sub {
  1916.     
  1917.     if ( open DEB, ">>$::global_logfile") {
  1918. print DEB timestamp." -- $_[0]";
  1919. close DEB;
  1920.     } else {
  1921. print STDERR timestamp." -- $_[0]" 
  1922.     }
  1923.     exit 1
  1924. };
  1926.     }
  1927. }    
  1929. # Adds the v4only attribute to a target if the caller requests it.
  1930. # (this includes targets specified using numeric IPv6 addresses...)
  1931. sub v4onlyifnecessary ($$) {
  1932.     my $target = shift;
  1933.     my $add = shift;
  1934.     my ($v6addr, $temptarget);
  1936.     if($add) {
  1937. # Catch numeric IPv6 addresses
  1938. if ( $target =~ /([[w:]*])(.*)/) {
  1939.     ($v6addr, $temptarget) = ($1,$2);
  1940. } else {
  1941.     $temptarget = $target;
  1942. }
  1943. return $target.(":" x (5 - ($temptarget =~ tr/://))).":v4only";
  1944.     } else {
  1945. return $target;
  1946.     }
  1947. }
  1948. __END__
  1950. =pod
  1952. =head1 NAME
  1954. MRTG_lib.pm - Library for MRTG and support scripts
  1956. =head1 SYNOPSIS
  1958.  use MRTG_lib;
  1959.  my ($configfile, @target_names, %globalcfg, %targetcfg);
  1960.  readcfg($configfile, @target_names, %globalcfg, %targetcfg);
  1961.  my (@parsed_targets);
  1962.  cfgcheck(@target_names, %globalcfg, %targetcfg, @parsed_targets);
  1964. =head1 DESCRIPTION
  1966. MRTG_lib is part of MRTG, the Multi Router Traffic Grapher. It was separated
  1967. from MRTG to allow other programs to easily use the same config files. The
  1968. main part of MRTG_lib is the config file parser but some other funcions are
  1969. there too.
  1971. =over 4
  1973. =item C<$MRTG_lib::OS>
  1975. Type of OS: WIN, UNIX, VMS
  1977. =item C<$MRTG_lib::SL>
  1979. I<Slash> in the current OS.
  1981. =item C<$MRTG_lib::PS>
  1983. Path separator in PATH variable
  1985. =item C<readcfg>
  1987. C<readcfg($file, @targets, %globalcfg, %targetcfg [, $prefix, %extrules])>
  1989. Reads a config file, parses it and fills some arrays and hashes. The
  1990. mandatory arguments are: the name of the config file, a ref to an array which
  1991. will be filled with a list of the target names, a hashref for the global
  1992. configuration, a hashref for the target configuration.
  1994. The configuration file syntax is:
  1996.  globaloption: value
  1997.  targetoption[targetname]: value
  1998.  aprefix*extglobal: value
  1999.  aprefix*exttarget[target2]: value
  2001. E.g.
  2003.  workdir: /var/stat/mrtg
  2004.  target[router1]: 2:public@router1.local.net
  2005.  14all*columns: 2
  2007. The global config hash has the structure
  2009.  $globalcfg{configoption} = 'value'
  2011. The target config hash has the structure
  2013.  $targetcfg{configoption}{targetname} = 'value'
  2015. See L<mrtg-reference> for more information about the MRTG configuration syntax.
  2017. C<readcfg> can take two additional arguments to extend the config file
  2018. syntax. This allows programs to put their configuration into the mrtg config
  2019. file. The fifth argument is the prefix of the extension, the sixth argument
  2020. is a hash with the checkrules for these extension settings. E.g. if the
  2021. prefix is "14all" C<readcfg> will check config lines that begin with
  2022. "14all*", i.e. all lines like
  2024.  14all*columns: 2
  2025.  14all*graphsize[target3]: 500 200
  2027. against the rules in %extrules. The format of this hash is:
  2029.  $extrules{option} = [sub{$_[0] =~ m/^d+$/}, sub{"Error message for $_[0]"}]
  2030.      i.e.
  2031.  $extrules{option}[0] -> a test expression
  2032.  $extrules{option}[1] -> error message if test fails
  2034. The first part of the array is a perl expression to test the value of the
  2035. option. The test can access this value in the variable "$arg". The second
  2036. part of the array is an error message to display when the test fails. The
  2037. failed value can be integrated by using the variable "$arg".
  2039. Config settings with an different prefix than the one given in the C<readcfg>
  2040. call are not checked but inserted into I<%globalcfg> and I<%targetcfg>.
  2041. Prefixed settings keep their prefix in the config hashes:
  2043.  $targetcfg{'14all*graphsize'}{'target3'} = '500 200'
  2045. =item C<cfgcheck>
  2047. C<cfgcheck(@target_names, %globalcfg, %targetcfg, @parsed_targets)>
  2049. Checks the configuration read by C<readcfg>. Checks the values in the config
  2050. for syntactical and/or semantical errors. Sets defaults for some options.
  2051. Parses the "target[...]" options and filles the array @parsed_targets ready
  2052. for mrtg functions.
  2054. The first three arguments are the same as for C<readcfg>. The fourth argument
  2055. is an arrayref which will be filled with the parsed target defs.
  2057. C<cfgcheck> converts the values of target settings I<options>, e.g.
  2059.  options[router1]: bits, growright
  2061. to a hash:
  2063.  $targetcfg{'option'}{'bits'}{'router1'} = 1
  2064.  $targetcfg{'option'}{'growright'}{'router1'} = 1
  2066. This is not done by C<readcfg> so if you don't use C<cfgcheck> you have to
  2067. check the scalar variable I<$targetcfg{'option'}{'router1'}> (MRTG allows
  2068. options to be separated by space or ',').
  2070. =item C<ensureSL>
  2072. C<ensureSL($pathname)>
  2074. Checks that the I<pathname> does not contain double path separators and ends
  2075. with a path separator. It uses $MRTG_lib::SL as path separator which will be /
  2076. or  depending on the OS.
  2078. =item C<log2rrd>
  2080. C<log2rrd ($router,%globalcfg,%targetcfg)>
  2082. Convert log file to rrd format. Needs rrdtool.
  2084. =item C<datestr>
  2086. C<datestr(time)>
  2088. Returns the time given in the argument as a nicely formated date string.
  2089. The argument has to be in UNIX time format (seconds since 1970-1-1).
  2091. =item C<timestamp>
  2093. C<timestamp()>
  2095. Return a string representing the current time.
  2097. =item C<setup_loghandlers>
  2099. C<setup_loghandlers(filename)>
  2101. Install signalhandlers for __DIE__ and __WARN__ making the errors
  2102. go the the specified destination. If filename is 'eventlog'
  2103. mrtg will log to the windows event logger.
  2105. =item C<expistr>
  2107. C<expistr(time)>
  2109. Returns the time given in the argument formatted suitable for HTTP
  2110. Expire-Headers.
  2112. =item C<create_pid> 
  2114. C<create_pid()> 
  2116. Creates a pid file for the mrtg daemon       
  2118. =item C<demonize_me>
  2120. C<demonize_me()>
  2122. Puts the running program into background, detaching it from the terminal.
  2124. =item C<populatecache>
  2126. C<populatecache(%confcache, $host, $reread, $snmpoptshash)>
  2128. Reads the SNMP variables I<ifDescr>, I<ipAdEntIfIndex>, I<ifPhysAddress>, I<ifName> from
  2129. the I<host> and stores the values in I<%confcache> as follows:
  2131.  $confcache{$host}{'Descr'}{ifDescr}{oid} = (ifDescr or 'Dup')
  2132.  $confcache{$host}{'IP'}{ipAdEntIfIndex}{oid} = (ipAdEntIfIndex or 'Dup')
  2133.  $confcache{$host}{'Eth'}{ifPhysAddress}{oid} = (ifPhysAddress or 'Dup')
  2134.  $confcache{$host}{'Name'}{ifName}{oid} = (ifName or 'Dup')
  2135.  $confcache{$host}{'Type'}{ifType}{oid} = (ifType or 'Dup')
  2137. The value (at the right side of =) is 'Dup' if a value was retrieved
  2138. muliple times, the retrieved value else.
  2140. =item C<readconfcache>
  2142. C<my $confcache = readconfcache($file)>
  2144. Preload the confcache from a file.
  2146. =item C<readfromconfcache>
  2148. C<writeconfcache($confcache,$file)>
  2150. Store the current confcache into a file.
  2152. =item C<writeconfcache>
  2154. C<writeconfcache($confcache,$file)>
  2156. Store the current confcache into a file.
  2158. =item C<storeincache>
  2160. C<storeincache($confcache,$host,$method,$key,$value)>
  2162. =item C<readfromcache>
  2164. C<readfromcache($confcache,$host,$method,$key)>
  2166. =item C<clearfromcache>
  2168. C<clearfromcache($confcache,$host)>
  2170. =item C<debug>
  2172. C<debug($type, $message)>
  2174. Prints the I<message> on STDERR if debugging is enabled for type I<type>.
  2175. A debug type is enabled if I<type> is in array @main::DEBUG.
  2177. =back
  2179. =head1 AUTHORS
  2181. Rainer Bawidamann E<lt>Rainer.Bawidamann@rz.uni-ulm.deE<gt>
  2183. (This Manpage)
  2185. =cut