Changeset f51cc7c864024ce120ec1eeaba4ba1bed38241e1

Show
Ignore:
Timestamp:
03/18/10 21:06:39 (3 years ago)
Author:
Mark Harrison <mark@omniti.com>
git-committer:
Mark Harrison <mark@omniti.com> 1268946399 +0000
git-parent:

[62a01cb2337137135b88275f9ab151e1efcef77d]

git-author:
Mark Harrison <mark@omniti.com> 1268946399 +0000
Message:

Indentation/formatting fixes (4 spaces per OmniTI coding style)

git-svn-id: https://labs.omniti.com/resmon/trunk@261 8c0face9-b7db-6ec6-c4b3-d5f7145c7d55

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • lib/Resmon/Config.pm

    rd5d5b49 rf51cc7c  
    44 
    55sub new { 
    6   my $class = shift; 
    7   my $filename = shift; 
    8   my $self = bless { 
    9     configfile => $filename, 
    10     modstatus => '', 
    11     # Defaults 
    12     timeout => 10 
    13   }, $class; 
    14   open(CONF, "<$filename") || return undef; 
     6    my $class = shift; 
     7    my $filename = shift; 
     8    my $self = bless { 
     9        configfile => $filename, 
     10        modstatus => '', 
     11        # Defaults 
     12        timeout => 10 
     13    }, $class; 
     14    open(CONF, "<$filename") || return undef; 
    1515 
    16   my $current; 
    17   my $line = 0; 
    18   while(<CONF>) { 
    19     $line++; 
    20     next if /^\s*#/; 
    21     next if /^\s*$/; 
    22     if($current) { 
    23       if(/^\s*([^:\s](?:[^:]*[^:\s])?)\s*:\s*(.+)\s*$/) { 
    24         my %kvs; 
    25         $kvs{'type'} = $current; 
    26         $kvs{'object'} = $1; 
    27         my @params = split(/,/, $2); 
    28         grep { $kvs{$1} = $2 if /^\s*(\S+)\s*=>\s*(\S(?:.*\S)?)\s*$/ } @params; 
    29         my $object = bless \%kvs, "Resmon::Module::$current"; 
    30         push(@{$self->{Module}->{$current}}, $object); 
     16    my $current; 
     17    my $line = 0; 
     18    while(<CONF>) { 
     19        $line++; 
     20        next if /^\s*#/; 
     21        next if /^\s*$/; 
     22        if($current) { 
     23            if(/^\s*([^:\s](?:[^:]*[^:\s])?)\s*:\s*(.+)\s*$/) { 
     24                my %kvs; 
     25                $kvs{'type'} = $current; 
     26                $kvs{'object'} = $1; 
     27                my @params = split(/,/, $2); 
     28                grep { $kvs{$1} = $2 if /^\s*(\S+)\s*=>\s*(\S(?:.*\S)?)\s*$/ } 
     29                    @params; 
     30                my $object = bless \%kvs, "Resmon::Module::$current"; 
     31                push(@{$self->{Module}->{$current}}, $object); 
    3132 
    32         # Test to make sure the module actually works 
    33         my $coderef; 
    34         eval { $coderef = Resmon::Module::fetch_monitor($current); }; 
    35         if (!$coderef) { 
    36             # Try to execute the config_as_hash method. If it fails, then 
    37             # the module didn't load properly (e.g. syntax error). 
    38             eval { $object->config_as_hash; }; 
    39             if ($@) { 
    40                 # Module failed to load, print error and add to failed 
    41                 # modules list. 
    42                 print STDERR "Problem loading module $current\n"; 
    43                 print STDERR "This module will not be available\n"; 
    44                 $self->{'modstatus'} .= "$current "; 
     33                # Test to make sure the module actually works 
     34                my $coderef; 
     35                eval { $coderef = Resmon::Module::fetch_monitor($current); }; 
     36                if (!$coderef) { 
     37                    # Try to execute the config_as_hash method. If it fails, 
     38                    # then the module didn't load properly (e.g. syntax 
     39                    # error). 
     40                    eval { $object->config_as_hash; }; 
     41                    if ($@) { 
     42                        # Module failed to load, print error and add to failed 
     43                        # modules list. 
     44                        print STDERR "Problem loading module $current\n"; 
     45                        print STDERR "This module will not be available\n"; 
     46                        $self->{'modstatus'} .= "$current "; 
     47                    } 
     48                } 
     49 
     50            } elsif (/^\s*\}\s*$/) { 
     51                $current = undef; 
     52            } else { 
     53                die "Syntax Error on line $line\n"; 
     54            } 
     55        } else { 
     56            if(/\s*(\S+)\s*\{/) { 
     57                $current = $1; 
     58                $self->{Module}->{$current} = []; 
     59                next; 
     60            } 
     61            elsif(/\S*LIB\s+(\S+)\s*;\s*/) { 
     62                eval "use lib '$1';"; 
     63                next; 
     64            } 
     65            elsif(/\S*PORT\s+(\d+)\s*;\s*/) { 
     66                $self->{port} = $1; 
     67                next; 
     68            } 
     69            elsif(/\S*INTERFACE\s+(\S+)\s*;\s*/) { 
     70                $self->{interface} = $1; 
     71                next; 
     72            } 
     73            elsif(/\s*INTERVAL\s+(\d+)\s*;\s*/) { 
     74                $self->{interval} = $1; 
     75                next; 
     76            } 
     77            elsif(/\s*STATUSFILE\s+(\S+)\s*;\s*/) { 
     78                $self->{statusfile} = $1; 
     79                next; 
     80            } 
     81            elsif(/\s*TIMEOUT\s+(\d+)\s*;\s*/) { 
     82                $self->{timeout} = $1; 
     83                next; 
     84            } 
     85            elsif(/\S*AUTHUSER\s+(\S+)\s*;\s*/) { 
     86                $self->{authuser} = $1; 
     87                next; 
     88            } 
     89            elsif(/\S*AUTHPASS\s+(\S+)\s*;\s*/) { 
     90                $self->{authpass} = $1; 
     91                next; 
     92            } 
     93            else { 
     94                die "Syntax Error on line $line\n"; 
    4595            } 
    4696        } 
    47  
    48       } elsif (/^\s*\}\s*$/) { 
    49         $current = undef; 
    50       } else { 
    51         die "Syntax Error on line $line\n"; 
    52       } 
    53     } else { 
    54       if(/\s*(\S+)\s*\{/) { 
    55         $current = $1; 
    56         $self->{Module}->{$current} = []; 
    57         next; 
    58       } 
    59       elsif(/\S*LIB\s+(\S+)\s*;\s*/) { 
    60         eval "use lib '$1';"; 
    61         next; 
    62       } 
    63       elsif(/\S*PORT\s+(\d+)\s*;\s*/) { 
    64         $self->{port} = $1; 
    65         next; 
    66       } 
    67       elsif(/\S*INTERFACE\s+(\S+)\s*;\s*/) { 
    68         $self->{interface} = $1; 
    69         next; 
    70       } 
    71       elsif(/\s*INTERVAL\s+(\d+)\s*;\s*/) { 
    72         $self->{interval} = $1; 
    73         next; 
    74       } 
    75       elsif(/\s*STATUSFILE\s+(\S+)\s*;\s*/) { 
    76         $self->{statusfile} = $1; 
    77         next; 
    78       } 
    79       elsif(/\s*TIMEOUT\s+(\d+)\s*;\s*/) { 
    80         $self->{timeout} = $1; 
    81         next; 
    82       } 
    83       elsif(/\S*AUTHUSER\s+(\S+)\s*;\s*/) { 
    84         $self->{authuser} = $1; 
    85         next; 
    86       } 
    87       elsif(/\S*AUTHPASS\s+(\S+)\s*;\s*/) { 
    88         $self->{authpass} = $1; 
    89         next; 
    90       } 
    91       else { 
    92         die "Syntax Error on line $line\n"; 
    93       } 
    9497    } 
    95   } 
    96   if($current) { 
    97     die "unclosed stanza\n"; 
    98   } 
    99   return $self; 
     98    if($current) { 
     99        die "unclosed stanza\n"; 
     100    } 
     101    return $self; 
    100102} 
    101103 

  • lib/Resmon/ExtComm.pm

    rf0705dd rf51cc7c  
    1313 
    1414sub cache_command($$;$) { 
    15   my ($command, $expiry, $timeout) = @_; 
    16   $timeout ||= $expiry; 
     15    my ($command, $expiry, $timeout) = @_; 
     16    $timeout ||= $expiry; 
    1717 
    18   my $now = time; 
    19   if($commhist{$command}>$now) { 
     18    my $now = time; 
     19    if($commhist{$command}>$now) { 
     20        return $commcache{$command}; 
     21    } 
     22    # TODO: timeouts 
     23    $commcache{$command} = run_cmd($command); 
     24    $commhist{$command} = $now + $expiry; 
    2025    return $commcache{$command}; 
    21   } 
    22   # TODO: timeouts 
    23   $commcache{$command} = run_cmd($command); 
    24   $commhist{$command} = $now + $expiry; 
    25   return $commcache{$command}; 
    2626} 
    2727 

  • lib/Resmon/Module.pm

    rcbbf0ac rf51cc7c  
    1010 
    1111sub fetch_monitor { 
    12   my $type = shift; 
    13   my $coderef = $coderefs{$type}; 
    14   return $coderef if ($coderef); 
     12    my $type = shift; 
     13    my $coderef = $coderefs{$type}; 
     14    return $coderef if ($coderef); 
    1515 
    16   # First if the monitor name is raw and looks right: 
    17   #   is a subclass of Resmon::Module and can 'handler' 
    18   # then we will promote it into the Resmon::Module namespace 
    19   # and use this one. 
    20   eval "use $type;"; 
    21   if($type->isa(__PACKAGE__) && $type->can('handler')) { 
    22     eval "  
    23       package Resmon::Module::$type; 
    24       use vars qw/\@ISA/; 
    25       \@ISA = qw($type); 
    26       1; 
    27     "; 
    28     if($@) { 
    29       die "Could not repackage $type as Resmon::Module::$type\n"; 
     16    # First if the monitor name is raw and looks right: 
     17    #   is a subclass of Resmon::Module and can 'handler' 
     18    # then we will promote it into the Resmon::Module namespace 
     19    # and use this one. 
     20    eval "use $type;"; 
     21    if($type->isa(__PACKAGE__) && $type->can('handler')) { 
     22        eval "  
     23        package Resmon::Module::$type; 
     24        use vars qw/\@ISA/; 
     25        \@ISA = qw($type); 
     26        1; 
     27        "; 
     28        if($@) { 
     29            die "Could not repackage $type as Resmon::Module::$type\n"; 
     30        } 
     31        return undef; 
    3032    } 
     33    eval "use Resmon::Module::$type;"; 
    3134    return undef; 
    32   } 
    33   eval "use Resmon::Module::$type;"; 
    34   return undef; 
    3535} 
    3636 
    3737sub register_monitor { 
    38   my ($type, $ref) = @_; 
    39   if(ref $ref eq 'CODE') { 
    40     $coderefs{$type} = $ref; 
    41   } 
    42   print STDERR "$rmloading $type monitor\n"; 
     38    my ($type, $ref) = @_; 
     39    if(ref $ref eq 'CODE') { 
     40        $coderefs{$type} = $ref; 
     41    } 
     42    print STDERR "$rmloading $type monitor\n"; 
    4343} 
    4444 
    4545sub fresh_status { 
    46   my $arg = shift; 
    47   print STDERR $arg->{type} . ": Warning: fresh_status() is deprecated, and no longer required.\n"; 
    48   return undef; 
     46    my $arg = shift; 
     47    print STDERR $arg->{type} . 
     48        ": Warning: fresh_status() is deprecated, and no longer required.\n"; 
     49    return undef; 
    4950} 
    5051 
    5152sub fresh_status_msg { 
    52   # Deal with result caching if an 'interval' entry is placed in the config 
    53   # for that module 
    54   my $arg = shift; 
    55   return undef unless $arg->{interval}; 
    56   my $now = time; 
    57   if(($arg->{lastupdate} + $arg->{interval}) >= $now) { 
    58     return $arg->{laststatus}, $arg->{lastmessage}; 
    59   } 
    60   return undef; 
     53    # Deal with result caching if an 'interval' entry is placed in the config 
     54    # for that module 
     55    my $arg = shift; 
     56    return undef unless $arg->{interval}; 
     57    my $now = time; 
     58    if(($arg->{lastupdate} + $arg->{interval}) >= $now) { 
     59        return $arg->{laststatus}, $arg->{lastmessage}; 
     60    } 
     61    return undef; 
    6162} 
    6263 
    6364sub set_status { 
    64   my $arg = shift; 
    65   $arg->{laststatus} = shift; 
    66   $arg->{lastmessage} = shift; 
    67   $arg->{lastupdate} = time; 
    68   if($arg->{laststatus} =~ /^([A-Z]+)\((.*)\)$/s) { 
    69     # This handles old-style modules that return just set status as 
    70     #     STATE(message) 
    71     $arg->{laststatus} = $1; 
    72     $arg->{lastmessage} = $2; 
    73   } 
    74   return ($arg->{laststatus}, $arg->{lastmessage}); 
     65    my $arg = shift; 
     66    $arg->{laststatus} = shift; 
     67    $arg->{lastmessage} = shift; 
     68    $arg->{lastupdate} = time; 
     69    if($arg->{laststatus} =~ /^([A-Z]+)\((.*)\)$/s) { 
     70        # This handles old-style modules that return just set status as 
     71        #     STATE(message) 
     72        $arg->{laststatus} = $1; 
     73        $arg->{lastmessage} = $2; 
     74    } 
     75    return ($arg->{laststatus}, $arg->{lastmessage}); 
    7576} 
    7677sub config_as_hash { 
    77   my $self = shift; 
    78   my $conf = {}; 
    79   while(my ($key, $value) = each %$self) { 
    80     if(! ref $value) { 
    81       # only stash scalars here. 
    82       $conf->{$key} = $value; 
     78    my $self = shift; 
     79    my $conf = {}; 
     80    while(my ($key, $value) = each %$self) { 
     81        if(! ref $value) { 
     82            # only stash scalars here. 
     83            $conf->{$key} = $value; 
     84        } 
    8385    } 
    84   } 
    85   return $conf; 
     86    return $conf; 
    8687} 
    8788 

  • lib/Resmon/Status.pm

    r02e91af rf51cc7c  
    1515my $REQUEST_TIMEOUT = 60; 
    1616sub new { 
    17   my $class = shift; 
    18   my $file = shift; 
    19   return bless { 
    20     file => $file 
    21   }, $class; 
     17    my $class = shift; 
     18    my $file = shift; 
     19    return bless { 
     20        file => $file 
     21    }, $class; 
    2222} 
    2323sub get_shared_state { 
    24   my $self = shift; 
    25   my $blob; 
    26   my $len; 
    27   return unless(defined($self->{shared_state})); 
    28   # Lock shared segment 
    29   # Read in 
    30   shmread($self->{shared_state}, $len, 0, length(pack('i', 0))); 
    31   $len = unpack('i', $len); 
    32   shmread($self->{shared_state}, $blob, length(pack('i', 0)), $len); 
    33   # unlock 
    34   my $VAR1; 
    35   eval $blob; 
    36   die $@ if ($@); 
    37   $self->{store} = $VAR1; 
    38   return $self->{store}; 
     24    my $self = shift; 
     25    my $blob; 
     26    my $len; 
     27    return unless(defined($self->{shared_state})); 
     28    # Lock shared segment 
     29    # Read in 
     30    shmread($self->{shared_state}, $len, 0, length(pack('i', 0))); 
     31    $len = unpack('i', $len); 
     32    shmread($self->{shared_state}, $blob, length(pack('i', 0)), $len); 
     33    # unlock 
     34    my $VAR1; 
     35    eval $blob; 
     36    die $@ if ($@); 
     37    $self->{store} = $VAR1; 
     38    return $self->{store}; 
    3939} 
    4040sub store_shared_state { 
    41   my $self = shift; 
    42   return unless(defined($self->{shared_state})); 
    43   my $blob = Dumper($self->{store}); 
    44  
    45   # Lock shared segment 
    46   # Write state and flush 
    47   shmwrite($self->{shared_state}, pack('i', length($blob)), 
    48            0, length(pack('i', 0))) || die "$!"; 
    49   shmwrite($self->{shared_state}, $blob, length(pack('i', 0)), 
    50            length($blob)) || die "$!"; 
    51   # unlock 
     41    my $self = shift; 
     42    return unless(defined($self->{shared_state})); 
     43    my $blob = Dumper($self->{store}); 
     44 
     45    # Lock shared segment 
     46    # Write state and flush 
     47    shmwrite($self->{shared_state}, pack('i', length($blob)), 
     48        0, length(pack('i', 0))) || die "$!"; 
     49    shmwrite($self->{shared_state}, $blob, length(pack('i', 0)), 
     50        length($blob)) || die "$!"; 
     51    # unlock 
    5252} 
    5353sub xml_kv_dump { 
    54   my $info = shift; 
    55   my $indent = shift || 0; 
    56   my $rv = ''; 
    57   while(my ($key, $value) = each %$info) { 
    58     if(ref $value eq 'HASH') { 
    59       while (my ($k, $v) = each %$value) { 
    60         $rv .= " " x $indent; 
    61         $rv .= "<$key name=\"$k\""; 
    62         if (ref($v) eq 'ARRAY') { 
    63           # A value/type pair 
    64           my $type = $v->[1]; 
    65           if ($type !~ /^[0iIlLns]$/) { 
    66               $type = "0"; 
    67           } 
    68           $rv .= " type=\"$type\""; 
    69           $v = $v->[0]; 
    70         } 
    71         $v = xml_escape($v); 
    72         $rv .= ">$v</$key>\n"; 
    73       } 
    74     } else { 
    75       $rv .= " " x $indent; 
    76       $value = xml_escape($value); 
    77       $rv .= "<$key>$value</$key>\n"; 
    78     } 
    79   } 
    80   return $rv; 
     54    my $info = shift; 
     55    my $indent = shift || 0; 
     56    my $rv = ''; 
     57    while(my ($key, $value) = each %$info) { 
     58        if(ref $value eq 'HASH') { 
     59            while (my ($k, $v) = each %$value) { 
     60                $rv .= " " x $indent; 
     61                $rv .= "<$key name=\"$k\""; 
     62                if (ref($v) eq 'ARRAY') { 
     63                    # A value/type pair 
     64                    my $type = $v->[1]; 
     65                    if ($type !~ /^[0iIlLns]$/) { 
     66                        $type = "0"; 
     67                    } 
     68                    $rv .= " type=\"$type\""; 
     69                    $v = $v->[0]; 
     70                } 
     71                $v = xml_escape($v); 
     72                $rv .= ">$v</$key>\n"; 
     73            } 
     74        } else { 
     75            $rv .= " " x $indent; 
     76            $value = xml_escape($value); 
     77            $rv .= "<$key>$value</$key>\n"; 
     78        } 
     79    } 
     80    return $rv; 
    8181} 
    8282sub xml_info { 
    83   my ($module, $service, $info) = @_; 
    84   my $rv = ''; 
    85   $rv .= "  <ResmonResult module=\"$module\" service=\"$service\">\n"; 
    86   $rv .= xml_kv_dump($info, 4); 
    87   $rv .= "  </ResmonResult>\n"; 
    88   return $rv; 
     83    my ($module, $service, $info) = @_; 
     84    my $rv = ''; 
     85    $rv .= "  <ResmonResult module=\"$module\" service=\"$service\">\n"; 
     86    $rv .= xml_kv_dump($info, 4); 
     87    $rv .= "  </ResmonResult>\n"; 
     88    return $rv; 
    8989} 
    9090sub xml_escape { 
    91   my $v = shift; 
    92   $v =~ s/&/&amp;/g; 
    93   $v =~ s/</&lt;/g; 
    94   $v =~ s/>/&gt;/g; 
    95   $v =~ s/'/&apos;/g; 
    96   return $v; 
     91    my $v = shift; 
     92    $v =~ s/&/&amp;/g; 
     93    $v =~ s/</&lt;/g; 
     94    $v =~ s/>/&gt;/g; 
     95    $v =~ s/'/&apos;/g; 
     96    return $v; 
    9797} 
    9898sub dump_generic { 
    99   my $self = shift; 
    100   my $dumper = shift; 
    101   my $rv = ''; 
    102   while(my ($module, $services) = each %{$self->{store}}) { 
     99    my $self = shift; 
     100    my $dumper = shift; 
     101    my $rv = ''; 
     102    while(my ($module, $services) = each %{$self->{store}}) { 
     103        while(my ($service, $info) = each %$services) { 
     104            $rv .= $dumper->($module,$service,$info); 
     105        } 
     106    } 
     107    return $rv; 
     108} 
     109sub dump_generic_module { 
     110    # Dumps a single module rather than all checks 
     111    my $self = shift; 
     112    my $dumper = shift; 
     113    my $module = shift; 
     114    my $rv = ''; 
     115    my $services = $self->{store}->{$module}; 
    103116    while(my ($service, $info) = each %$services) { 
    104       $rv .= $dumper->($module,$service,$info); 
    105     } 
    106   } 
    107   return $rv; 
    108 } 
    109 sub dump_generic_module { 
    110   # Dumps a single module rather than all checks 
    111   my $self = shift; 
    112   my $dumper = shift; 
    113   my $module = shift; 
    114   my $rv = ''; 
    115   my $services = $self->{store}->{$module}; 
    116   while(my ($service, $info) = each %$services) { 
    117     $rv .= $dumper->($module,$service,$info); 
    118   } 
    119   return $rv; 
     117        $rv .= $dumper->($module,$service,$info); 
     118    } 
     119    return $rv; 
    120120} 
    121121sub dump_generic_state { 
    122   # Dumps only checks with a specific state 
    123   my $self = shift; 
    124   my $dumper = shift; 
    125   my $state = shift; 
    126   my $rv = ''; 
    127   while(my ($module, $services) = each %{$self->{store}}) { 
    128     while(my ($service, $info) = each %$services) { 
    129       if ($info->{state} eq $state) { 
    130         $rv .= $dumper->($module,$service,$info); 
    131       } 
    132     } 
    133   } 
    134   return $rv; 
     122    # Dumps only checks with a specific state 
     123    my $self = shift; 
     124    my $dumper = shift; 
     125    my $state = shift; 
     126    my $rv = ''; 
     127    while(my ($module, $services) = each %{$self->{store}}) { 
     128        while(my ($service, $info) = each %$services) { 
     129            if ($info->{state} eq $state) { 
     130                $rv .= $dumper->($module,$service,$info); 
     131            } 
     132        } 
     133    } 
     134    return $rv; 
    135135} 
    136136sub dump_oldstyle { 
    137   my $self = shift; 
    138   my $response = $self->dump_generic(sub { 
    139     my($module,$service,$info) = @_; 
    140     my $message = $info->{metric}->{message}; 
    141     if (ref $message eq "ARRAY") { 
    142         $message = $message->[0]; 
    143     } 
    144     return "$service($module) :: $info->{state}($message)\n"; 
    145   }); 
    146   return $response; 
     137    my $self = shift; 
     138    my $response = $self->dump_generic(sub { 
     139            my($module,$service,$info) = @_; 
     140            my $message = $info->{metric}->{message}; 
     141            if (ref $message eq "ARRAY") { 
     142                $message = $message->[0]; 
     143            } 
     144            return "$service($module) :: $info->{state}($message)\n"; 
     145        }); 
     146    return $response; 
    147147} 
    148148sub dump_xml { 
    149   my $self = shift; 
    150   my $response = <<EOF 
     149    my $self = shift; 
     150    my $response = <<EOF 
    151151<?xml version="1.0" encoding="UTF-8"?> 
    152152<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?> 
    153153<ResmonResults> 
    154154EOF 
    155   ;  
    156   $response .= $self->dump_generic(\&xml_info); 
    157   $response .= "</ResmonResults>\n"; 
    158   return $response; 
     155    ;  
     156    $response .= $self->dump_generic(\&xml_info); 
     157    $response .= "</ResmonResults>\n"; 
     158    return $response; 
    159159} 
    160160sub get_xsl() { 
    161   my $response = <<EOF 
     161    my $response = <<EOF 
    162162<?xml version="1.0" encoding="ISO-8859-1"?> 
    163163<xsl:stylesheet version="1.0" 
    …… 
    225225</xsl:stylesheet> 
    226226EOF 
    227   ; 
    228   return $response; 
     227    ; 
     228    return $response; 
    229229} 
    230230sub get_css() { 
    231   my $response=<<EOF 
     231    my $response=<<EOF 
    232232body { 
    233233    font-family: Verdana, Arial, helvetica, sans-serif; 
    …… 
    329329} 
    330330EOF 
    331   ; 
    332   return $response; 
     331    ; 
     332    return $response; 
    333333} 
    334334sub service { 
    335   my $self = shift; 
    336   my ($client, $req, $proto, $snip, $authuser, $authpass) = @_; 
    337   my $state = $self->get_shared_state(); 
    338   if ($self->{authuser} ne "" && 
     335    my $self = shift; 
     336    my ($client, $req, $proto, $snip, $authuser, $authpass) = @_; 
     337    my $state = $self->get_shared_state(); 
     338    if ($self->{authuser} ne "" && 
    339339        ($authuser ne $self->{authuser} || $authpass ne $self->{authpass})) { 
    340       my $response = "<html><head><title>Password required</title></head>" . 
     340        my $response = "<html><head><title>Password required</title></head>" . 
    341341        "<body><h1>Password required</h1></body></html>"; 
    342       $client->print(http_header(401, length($response), 'text/html', $snip, 
    343           "WWW-Authenticate: Basic realm=\"Resmon\"\n")); 
    344       $client->print($response . "\r\n"); 
    345       return; 
    346   } elsif($req eq '/' or $req eq '/status') { 
    347     my $response .= $self->dump_xml(); 
    348     $client->print(http_header(200, length($response), 'text/xml', $snip)); 
    349     $client->print($response . "\r\n"); 
    350     return; 
    351   } elsif($req eq '/status.txt') { 
    352     my $response = $self->dump_oldstyle(); 
    353     $client->print(http_header(200, length($response), 'text/plain', $snip)); 
    354     $client->print($response . "\r\n"); 
    355     return; 
    356   } elsif($req eq '/resmon.xsl') { 
    357     my $response = $self->get_xsl(); 
    358     $client->print(http_header(200, length($response), 'text/xml', $snip)); 
    359     $client->print($response . "\r\n"); 
    360     return; 
    361   } elsif($req eq '/resmon.css') { 
    362     my $response = $self->get_css(); 
    363     $client->print(http_header(200, length($response), 'text/css', $snip)); 
    364     $client->print($response . "\r\n"); 
    365     return; 
    366   } elsif($req =~ /^\/([^\/]+)\/(.+)$/) { 
    367     if(exists($self->{store}->{$1}) && 
    368         exists($self->{store}->{$1}->{$2})) { 
    369     my $info = $self->{store}->{$1}->{$2}; 
    370     my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^; 
    371     my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^; 
    372     $response .= "<ResmonResults>\n". 
    373                     xml_info($1,$2,$info). 
    374                     "</ResmonResults>\n"; 
    375     $client->print(http_header(200, length($response), 'text/xml', $snip)); 
    376     $client->print( $response . "\r\n"); 
    377     return; 
    378     } 
    379   } elsif($req =~ /^\/([^\/]+)$/) { 
    380     if ($1 eq "BAD" || $1 eq "OK" || $1 eq "WARNING") { 
    381       my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^; 
    382       my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^; 
    383       $response .= "<ResmonResults>\n". 
    384                       $self->dump_generic_state(\&xml_info,$1) . 
    385                       "</ResmonResults>\n"; 
    386       $client->print(http_header(200, length($response), 'text/xml', $snip)); 
    387       $client->print( $response . "\r\n"); 
    388       return; 
    389     } elsif(exists($self->{store}->{$1})) { 
    390       my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^; 
    391       my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^; 
    392       $response .= "<ResmonResults>\n". 
    393                       $self->dump_generic_module(\&xml_info,$1) . 
    394                       "</ResmonResults>\n"; 
    395       $client->print(http_header(200, length($response), 'text/xml', $snip)); 
    396       $client->print( $response . "\r\n"); 
    397       return; 
    398     } 
    399   } 
    400   die "Request not understood\n"; 
     342        $client->print(http_header(401, length($response), 'text/html', $snip, 
     343                "WWW-Authenticate: Basic realm=\"Resmon\"\n")); 
     344        $client->print($response . "\r\n"); 
     345        return; 
     346    } elsif($req eq '/' or $req eq '/status') { 
     347        my $response .= $self->dump_xml(); 
     348        $client->print(http_header(200, length($response), 'text/xml', $snip)); 
     349        $client->print($response . "\r\n"); 
     350        return; 
     351    } elsif($req eq '/status.txt') { 
     352        my $response = $self->dump_oldstyle(); 
     353        $client->print(http_header(200, length($response), 'text/plain', $snip)); 
     354        $client->print($response . "\r\n"); 
     355        return; 
     356    } elsif($req eq '/resmon.xsl') { 
     357        my $response = $self->get_xsl(); 
     358        $client->print(http_header(200, length($response), 'text/xml', $snip)); 
     359        $client->print($response . "\r\n"); 
     360        return; 
     361    } elsif($req eq '/resmon.css') { 
     362        my $response = $self->get_css(); 
     363        $client->print(http_header(200, length($response), 'text/css', $snip)); 
     364        $client->print($response . "\r\n"); 
     365        return; 
     366    } elsif($req =~ /^\/([^\/]+)\/(.+)$/) { 
     367        if(exists($self->{store}->{$1}) && 
     368            exists($self->{store}->{$1}->{$2})) { 
     369            my $info = $self->{store}->{$1}->{$2}; 
     370            my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^; 
     371            my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^; 
     372            $response .= "<ResmonResults>\n". 
     373            xml_info($1,$2,$info). 
     374            "</ResmonResults>\n"; 
     375            $client->print(http_header(200, length($response), 'text/xml', $snip)); 
     376            $client->print( $response . "\r\n"); 
     377            return; 
     378        } 
     379    } elsif($req =~ /^\/([^\/]+)$/) { 
     380        if ($1 eq "BAD" || $1 eq "OK" || $1 eq "WARNING") { 
     381            my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^; 
     382            my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^; 
     383            $response .= "<ResmonResults>\n". 
     384            $self->dump_generic_state(\&xml_info,$1) . 
     385            "</ResmonResults>\n"; 
     386            $client->print(http_header(200, length($response), 'text/xml', $snip)); 
     387            $client->print( $response . "\r\n"); 
     388            return; 
     389        } elsif(exists($self->{store}->{$1})) { 
     390            my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^; 
     391            my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^; 
     392            $response .= "<ResmonResults>\n". 
     393            $self->dump_generic_module(\&xml_info,$1) . 
     394            "</ResmonResults>\n"; 
     395            $client->print(http_header(200, length($response), 'text/xml', $snip)); 
     396            $client->print( $response . "\r\n"); 
     397            return; 
     398        } 
     399    } 
     400    die "Request not understood\n"; 
    401401} 
    402402sub http_header { 
    403   my $code = shift; 
    404   my $len = shift; 
    405   my $type = shift || 'text/xml'; 
    406   my $close_connection = shift || 1; 
    407   my $extra_headers = shift; 
    408   return qq^HTTP/1.0 $code OK 
    409 Server: resmon 
    410 ^ . (defined($len) ? "Content-length: $len\n" : "") . 
     403    my $code = shift; 
     404    my $len = shift; 
     405    my $type = shift || 'text/xml'; 
     406    my $close_connection = shift || 1; 
     407    my $extra_headers = shift; 
     408    return "HTTP/1.0 $code OK\nServer: resmon\n" . 
     409        (defined($len) ? "Content-length: $len\n" : "") . 
    411410    (($close_connection || !$len) ? "Connection: close\n" : "") . 
    412 qq^Content-Type: $type; charset=utf-8 
    413 ^ . $extra_headers . qq^ 
    414 ^; 
     411    "Content-Type: $type; charset=utf-8\n" . $extra_headers . "\n"; 
    415412} 
    416413sub base64_decode($) { 
    …… 
    422419    $enc =~ tr#A-Za-z0-9+/=##cd; # Ignore any invalid characters 
    423420    $enc =~ tr#A-Za-z0-9+/=# -_#d; # Convert base64 to uuencode alphabet and 
    424                                    # strip padding 
     421    # strip padding 
    425422    if (length($enc) > 63) { return "" }; # Only support up to 63 chars 
    426                                           # (one uuencoded line) 
     423    # (one uuencoded line) 
    427424    my $len = chr(32 + length($enc)*3/4); # uuencode has a length byte at the 
    428                                           # beginning 
     425    # beginning 
    429426    return unpack("u", $len.$enc); 
    430427} 
    431428sub serve_http_on { 
    432   my $self = shift; 
    433   my $ip = shift; 
    434   my $port = shift; 
    435   $self->{authuser} = shift; 
    436   $self->{authpass} = shift; 
    437   $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*'); 
    438   $port ||= 81; 
    439  
    440   my $handle = IO::Socket->new(); 
    441   socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp')) 
     429    my $self = shift; 
     430    my $ip = shift; 
     431    my $port = shift; 
     432    $self->{authuser} = shift; 
     433    $self->{authpass} = shift; 
     434    $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*'); 
     435    $port ||= 81; 
     436 
     437    my $handle = IO::Socket->new(); 
     438    socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp')) 
    442439    || die "socket: $!"; 
    443   setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) 
     440    setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) 
    444441    || die "setsockopt: $!"; 
    445   bind($handle, sockaddr_in($port, $ip)) 
     442    bind($handle, sockaddr_in($port, $ip)) 
    446443    || die "bind: $!"; 
    447   listen($handle,SOMAXCONN); 
    448  
    449   $self->{zindex} = 0; 
    450   if (-x "/usr/sbin/zoneadm") { 
    451     open(Z, "/usr/sbin/zoneadm list -p |"); 
    452     my $firstline = <Z>; 
    453     close(Z); 
    454     ($self->{zindex}) = split /:/, $firstline, 2; 
    455   } 
    456   $self->{http_port} = $port; 
    457   $self->{http_ip} = $ip; 
    458   $self->{ftok_number} = $port * (1 + $self->{zindex}); 
    459  
    460   $self->{child} = fork(); 
    461   if($self->{child} == 0) { 
    462     eval { 
    463       $SIG{'HUP'} = 'IGNORE'; 
    464       $SIG{'PIPE'} = 'IGNORE'; 
    465       while(my $client = $handle->accept) { 
    466         my $req; 
    467         my $proto; 
    468         my $close_connection; 
    469         my $authuser; 
    470         my $authpass; 
    471         local $SIG{ALRM} = sub { die "timeout\n" }; 
     444    listen($handle,SOMAXCONN); 
     445 
     446    $self->{zindex} = 0; 
     447    if (-x "/usr/sbin/zoneadm") { 
     448        open(Z, "/usr/sbin/zoneadm list -p |"); 
     449        my $firstline = <Z>; 
     450        close(Z); 
     451        ($self->{zindex}) = split /:/, $firstline, 2; 
     452    } 
     453    $self->{http_port} = $port; 
     454    $self->{http_ip} = $ip; 
     455    $self->{ftok_number} = $port * (1 + $self->{zindex}); 
     456 
     457    $self->{child} = fork(); 
     458    if($self->{child} == 0) { 
    472459        eval { 
    473           alarm($KEEPALIVE_TIMEOUT); 
    474           while(<$client>) { 
    475             alarm($REQUEST_TIMEOUT); 
    476             eval { 
    477               s/\r\n/\n/g; 
    478               chomp; 
    479               if(!$req) { 
    480                 if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) { 
    481                   $req = $1; 
    482                   $proto = $2; 
    483                   # Protocol 1.1 and high are keep-alive by default 
    484                   $close_connection = ($proto <= 1.0)?1:0; 
    485                 } 
    486                 elsif(/./) { 
    487                   die "protocol deviations.\n"; 
    488                 } 
    489               } 
    490               else { 
    491                 if(/^$/) { 
    492                   $self->service($client, $req, $proto, $close_connection, 
    493                     $authuser, $authpass); 
    494                   last if ($close_connection); 
    495                   alarm($KEEPALIVE_TIMEOUT); 
    496                   $req = undef; 
    497                   $proto = undef; 
    498                 } 
    499                 elsif(/^\S+\s*:\s*.{1,4096}$/) { 
    500                   # Valid request header... noop 
    501                   if(/^Connection: (\S+)/) { 
    502                     if(($proto <= 1.0 && lc($2) eq 'keep-alive') || 
    503                        ($proto == 1.1 && lc($2) ne 'close')) { 
    504                       $close_connection = 0; 
     460            $SIG{'HUP'} = 'IGNORE'; 
     461            $SIG{'PIPE'} = 'IGNORE'; 
     462            while(my $client = $handle->accept) { 
     463                my $req; 
     464                my $proto; 
     465                my $close_connection; 
     466                my $authuser; 
     467                my $authpass; 
     468                local $SIG{ALRM} = sub { die "timeout\n" }; 
     469                eval { 
     470                    alarm($KEEPALIVE_TIMEOUT); 
     471                    while(<$client>) { 
     472                        alarm($REQUEST_TIMEOUT); 
     473                        eval { 
     474                            s/\r\n/\n/g; 
     475                            chomp; 
     476                            if(!$req) { 
     477                                if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) { 
     478                                    $req = $1; 
     479                                    $proto = $2; 
     480                                    # Protocol 1.1 and high are keep-alive by 
     481                                    # default 
     482                                    $close_connection = ($proto <= 1.0)?1:0; 
     483                                } 
     484                                elsif(/./) { 
     485                                    die "protocol deviations.\n"; 
     486                                } 
     487                            } 
     488                            else { 
     489                                if(/^$/) { 
     490                                    $self->service($client, $req, $proto, $close_connection, 
     491                                        $authuser, $authpass); 
     492                                    last if ($close_connection); 
     493                                    alarm($KEEPALIVE_TIMEOUT); 
     494                                    $req = undef; 
     495                                    $proto = undef; 
     496                                } 
     497                                elsif(/^\S+\s*:\s*.{1,4096}$/) { 
     498                                    # Valid request header... noop 
     499                                    if(/^Connection: (\S+)/) { 
     500                                        if(($proto <= 1.0 && lc($2) eq 'keep-alive') || 
     501                                            ($proto == 1.1 && lc($2) ne 'close')) { 
     502                                            $close_connection = 0; 
     503                                        } 
     504                                    } 
     505                                    if(/^Authorization: Basic (\S+)/) { 
     506                                        my $dec = base64_decode($1); 
     507                                        ($authuser, $authpass) = split /:/, $dec, 2 
     508                                    } 
     509                                } 
     510                                else { 
     511                                    die "protocol deviations.\n"; 
     512                                } 
     513                            } 
     514                        }; 
     515                        if($@) { 
     516                            print $client http_header(500, 0, 'text/plain', 1); 
     517                            print $client "$@\r\n"; 
     518                            last; 
     519                        } 
    505520                    } 
    506                   } 
    507                   if(/^Authorization: Basic (\S+)/) { 
    508                       my $dec = base64_decode($1); 
    509                       ($authuser, $authpass) = split /:/, $dec, 2 
    510                   } 
    511                 } 
    512                 else { 
    513                   die "protocol deviations.\n"; 
    514                 } 
    515               } 
    516             }; 
    517             if($@) { 
    518               print $client http_header(500, 0, 'text/plain', 1); 
    519               print $client "$@\r\n"; 
    520               last; 
     521                    alarm(0); 
     522                }; 
     523                alarm(0) if($@); 
     524                $client->close(); 
    521525            } 
    522           } 
    523           alarm(0); 
    524526        }; 
    525         alarm(0) if($@); 
    526         $client->close(); 
    527       } 
    528     }; 
    529     if($@) { 
    530       print STDERR "Error in listener: $@\n"; 
    531     } 
    532     exit(0); 
    533   } 
    534   close($handle); 
    535   return; 
     527        if($@) { 
     528            print STDERR "Error in listener: $@\n"; 
     529        } 
     530        exit(0); 
     531    } 
     532    close($handle); 
     533    return; 
    536534} 
    537535sub open { 
    538   my $self = shift; 
    539   return 0 unless(ref $self); 
    540   return 1 if($self->{handle});  # Alread open 
    541   if($self->{file} eq '-' || !defined($self->{file})) { 
    542     $self->{handle_is_stdout} = 1; 
    543     $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w"); 
     536    my $self = shift; 
     537    return 0 unless(ref $self); 
     538    return 1 if($self->{handle});  # Alread open 
     539    if($self->{file} eq '-' || !defined($self->{file})) { 
     540        $self->{handle_is_stdout} = 1; 
     541        $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w"); 
     542        return 1; 
     543    } 
     544    $self->{handle} = IO::File->new("> $self->{file}.swap"); 
     545    die "open $self->{file}.swap failed: $!\n" unless($self->{handle}); 
     546    $self->{swap_on_close} = 1; # move this to a non .swap version on close 
     547    chmod 0644, "$self->{file}.swap"; 
     548 
     549    unless(defined($self->{shared_state})) { 
     550        $self->{shared_state} = shmget(IPC_PRIVATE, $SEGSIZE, 
     551            IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO); 
     552        die "$0: $!" if($self->{shared_state} == -1); 
     553    } 
    544554    return 1; 
    545   } 
    546   $self->{handle} = IO::File->new("> $self->{file}.swap"); 
    547   die "open $self->{file}.swap failed: $!\n" unless($self->{handle}); 
    548   $self->{swap_on_close} = 1; # move this to a non .swap version on close 
    549   chmod 0644, "$self->{file}.swap"; 
    550  
    551   unless(defined($self->{shared_state})) { 
    552     $self->{shared_state} = shmget(IPC_PRIVATE, $SEGSIZE, 
    553                                    IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO); 
    554     die "$0: $!" if($self->{shared_state} == -1); 
    555   } 
    556   return 1; 
    557555} 
    558556sub store { 
    559   my ($self, $type, $name, $info) = @_; 
    560   %{$self->{store}->{$type}->{$name}} = %$info; 
    561   $self->{store}->{$type}->{$name}->{last_update} = time; 
    562   $self->store_shared_state(); 
    563   my $message = $info->{metric}->{message}; 
    564   if (ref $message eq "ARRAY") { 
    565     $message = $message->[0]; 
    566   } 
    567   if($self->{handle}) { 
    568     $self->{handle}->print("$name($type) :: $info->{state}($message)\n"); 
    569   } else { 
    570     print "$name($type) :: $info->{state}($message)\n"; 
    571   } 
     557    my ($self, $type, $name, $info) = @_; 
     558    %{$self->{store}->{$type}->{$name}} = %$info; 
     559    $self->{store}->{$type}->{$name}->{last_update} = time; 
     560    $self->store_shared_state(); 
     561    my $message = $info->{metric}->{message}; 
     562    if (ref $message eq "ARRAY") { 
     563        $message = $message->[0]; 
     564    } 
     565    if($self->{handle}) { 
     566        $self->{handle}->print("$name($type) :: $info->{state}($message)\n"); 
     567    } else { 
     568        print "$name($type) :: $info->{state}($message)\n"; 
     569    } 
    572570} 
    573571sub purge { 
    …… 
    608606} 
    609607sub close { 
    610   my $self = shift; 
    611   return if($self->{handle_is_stdout}); 
    612   $self->{handle}->close() if($self->{handle}); 
    613   $self->{handle} = undef; 
    614   if($self->{swap_on_close}) { 
    615     unlink("$self->{file}"); 
    616     link("$self->{file}.swap", $self->{file}); 
    617     unlink("$self->{file}.swap"); 
    618     delete($self->{swap_on_close}); 
    619   } 
     608    my $self = shift; 
     609    return if($self->{handle_is_stdout}); 
     610    $self->{handle}->close() if($self->{handle}); 
     611    $self->{handle} = undef; 
     612    if($self->{swap_on_close}) { 
     613        unlink("$self->{file}"); 
     614        link("$self->{file}.swap", $self->{file}); 
     615        unlink("$self->{file}.swap"); 
     616        delete($self->{swap_on_close}); 
     617    } 
    620618} 
    621619sub DESTROY { 
    622   my $self = shift; 
    623   my $child = $self->{child}; 
    624   if($child) { 
    625     kill 15, $child; 
    626     sleep 1; 
    627     kill 9, $child if(kill 0, $child); 
    628     waitpid(-1,WNOHANG); 
    629   } 
    630   if(defined($self->{shared_state})) { 
    631     shmctl($self->{shared_state}, IPC_RMID, 0); 
    632   } 
     620    my $self = shift; 
     621    my $child = $self->{child}; 
     622    if($child) { 
     623        kill 15, $child; 
     624        sleep 1; 
     625        kill 9, $child if(kill 0, $child); 
     626        waitpid(-1,WNOHANG); 
     627    } 
     628    if(defined($self->{shared_state})) { 
     629        shmctl($self->{shared_state}, IPC_RMID, 0); 
     630    } 
    633631} 
    6346321; 

  • lib/Resmon/Updater.pm

    r021df69 rf51cc7c  
    102102    my $host = "127.0.0.1"; 
    103103    my $handle = IO::Socket::INET->new(Proto     => "tcp", 
    104                                     PeerAddr  => $host, 
    105                                     PeerPort  => $port); 
     104        PeerAddr  => $host, 
     105        PeerPort  => $port); 
    106106    if (!$handle) { 
    107107        print STDERR "can't connect to port $port on $host: $!"; 
    …… 
    161161 
    162162sub track_mod_times { 
    163   my $mtime = (stat $_)[9]; 
    164   return unless -f $_; 
    165   return if /\/\.svn$/ || /\/\.svn\//; 
    166   if($assess == 0) { 
    167     $times{$_} = $mtime; 
    168   } else { 
    169     $newfiles++ unless(exists($times{$_})); 
    170     $changedfiles++ if(exists($times{$_}) and ($times{$_} != $mtime)); 
    171   } 
     163    my $mtime = (stat $_)[9]; 
     164    return unless -f $_; 
     165    return if /\/\.svn$/ || /\/\.svn\//; 
     166    if($assess == 0) { 
     167        $times{$_} = $mtime; 
     168    } else { 
     169        $newfiles++ unless(exists($times{$_})); 
     170        $changedfiles++ if(exists($times{$_}) and ($times{$_} != $mtime)); 
     171    } 
    172172} 
    173173 

  • resmon

    r2253d8b rf51cc7c  
    22 
    33BEGIN { 
    4   (my $dir = $0) =~ s/\/?[^\/]+$//; 
    5   eval "use lib '$dir/lib';"; 
    6   die $@ if($@); 
     4    (my $dir = $0) =~ s/\/?[^\/]+$//; 
     5    eval "use lib '$dir/lib';"; 
     6    die $@ if($@); 
    77}; 
    88 
    …… 
    1313use Data::Dumper; 
    1414use vars qw($config_file $debug $status_file $interface $port $config 
    15             $status $update); 
     15$status $update); 
    1616 
    1717use Resmon::Config; 
    …… 
    2121 
    2222GetOptions( 
    23   "i=s" => \$interface, 
    24   "p=i" => \$port, 
    25   "c=s" => \$config_file, 
    26   "d"   => \$debug, 
    27   "f=s" => \$status_file, 
    28   "u"   => \$update, 
     23    "i=s" => \$interface, 
     24    "p=i" => \$port, 
     25    "c=s" => \$config_file, 
     26    "d"   => \$debug, 
     27    "f=s" => \$status_file, 
     28    "u"   => \$update, 
    2929); 
    3030 
    …… 
    3939 
    4040sub configure { 
    41   $config = Resmon::Config->new($config_file); 
    42   $config->{statusfile} = $status_file if($status_file); 
    43   $config->{port} = $port if($port); 
    44   $config->{interface} = $interface if($interface); 
     41    $config = Resmon::Config->new($config_file); 
     42    $config->{statusfile} = $status_file if($status_file); 
     43    $config->{port} = $port if($port); 
     44    $config->{interface} = $interface if($interface); 
    4545} 
    4646 
    …… 
    9191my $rmlast = undef; 
    9292sub wait_interval { 
    93   $rmlast = [gettimeofday] unless defined($rmlast); 
    94   my $elapsed = $config->{interval} - tv_interval($rmlast); 
    95   if($elapsed > 0) { 
    96     sleep($elapsed); 
    97   } 
    98   $rmlast = [gettimeofday]; 
     93    $rmlast = [gettimeofday] unless defined($rmlast); 
     94    my $elapsed = $config->{interval} - tv_interval($rmlast); 
     95    if($elapsed > 0) { 
     96        sleep($elapsed); 
     97    } 
     98    $rmlast = [gettimeofday]; 
    9999} 
    100100 
    …… 
    107107 
    108108unless($debug) { 
    109   fork && exit; 
    110   setsid; 
    111   open(STDIN, "</dev/null"); 
    112   open(STDOUT, ">/dev/null"); 
    113   open(STDERR, ">/dev/null"); 
    114   fork && exit; 
     109    fork && exit; 
     110    setsid; 
     111    open(STDIN, "</dev/null"); 
     112    open(STDOUT, ">/dev/null"); 
     113    open(STDERR, ">/dev/null"); 
     114    fork && exit; 
    115115} 
    116116 
    …… 
    119119$status->open(); 
    120120$status->serve_http_on($config->{interface}, $config->{port}, 
    121                        $config->{authuser}, $config->{authpass}) 
    122   if($config->{port}); 
     121    $config->{authuser}, $config->{authpass}) 
     122if($config->{port}); 
    123123 
    124124while(1) { 
    125   while(my($module_name, $mod_configs) = each %{$config->{Module}}) { 
    126     my $coderef = undef; 
    127     eval { $coderef = Resmon::Module::fetch_monitor($module_name); }; 
    128     foreach my $monobj (@$mod_configs) { 
    129       my $check_rv = 'BAD', 
    130       my $check_metric = 'no data'; 
    131       my $starttime = [gettimeofday]; 
    132       # Get old status if it hasn't expired 
    133       my ($check_rv, $check_metric) = Resmon::Module::fresh_status_msg($monobj); 
    134       # Otherwise, run the check 
    135       if (!$check_rv) { 
    136         my $timeout = $monobj->{'check_timeout'} || $config->{'timeout'}; 
    137         alarm($timeout); 
    138         eval { 
    139           local $SIG{ALRM} = sub { die "alarm\n" }; 
    140           if($coderef) { 
    141             ($check_rv, $check_metric) = $coderef->($monobj); 
    142           } else { 
    143             ($check_rv, $check_metric) = $monobj->handler(); 
    144           } 
    145         }; 
    146         alarm 0; 
    147         # Store the last status for use by fresh_status_msg later 
    148         # Also converts old style status messages 
    149         ($check_rv, $check_metric) = 
    150           Resmon::Module::set_status($monobj, $check_rv, $check_metric); 
    151       } 
    152       my $checkstat = $@; 
    153       my $confighash = {}; 
    154       eval { $confighash = $monobj->config_as_hash(); }; 
    155       my $results = { 
    156         #configuration => $confighash, 
    157         last_runtime_seconds => sprintf("%.6f", tv_interval($starttime)), 
    158       }; 
    159       if($checkstat) { 
    160         $results->{state} = 'BAD'; 
    161         $results->{metric} = { "message" => 
    162             "Bad module or problem running handler code."}; 
    163         if ($checkstat eq "alarm\n") { 
    164           $results->{metric} = { "message" => 
    165               "Check timeout"}; 
    166           Resmon::ExtComm::clean_up; 
     125    while(my($module_name, $mod_configs) = each %{$config->{Module}}) { 
     126        my $coderef = undef; 
     127        eval { $coderef = Resmon::Module::fetch_monitor($module_name); }; 
     128        foreach my $monobj (@$mod_configs) { 
     129            my $check_rv = 'BAD', 
     130            my $check_metric = 'no data'; 
     131            my $starttime = [gettimeofday]; 
     132            # Get old status if it hasn't expired 
     133            my ($check_rv, $check_metric) = Resmon::Module::fresh_status_msg( 
     134                $monobj); 
     135            # Otherwise, run the check 
     136            if (!$check_rv) { 
     137                my $timeout = $monobj->{'check_timeout'} || 
     138                    $config->{'timeout'}; 
     139                alarm($timeout); 
     140                eval { 
     141                    local $SIG{ALRM} = sub { die "alarm\n" }; 
     142                    if($coderef) { 
     143                        ($check_rv, $check_metric) = $coderef->($monobj); 
     144                    } else { 
     145                        ($check_rv, $check_metric) = $monobj->handler(); 
     146                    } 
     147                }; 
     148                alarm 0; 
     149                # Store the last status for use by fresh_status_msg later 
     150                # Also converts old style status messages 
     151                ($check_rv, $check_metric) = 
     152                Resmon::Module::set_status($monobj, $check_rv, $check_metric); 
     153            } 
     154            my $checkstat = $@; 
     155            my $confighash = {}; 
     156            eval { $confighash = $monobj->config_as_hash(); }; 
     157            my $results = { 
     158                #configuration => $confighash, 
     159                last_runtime_seconds => sprintf("%.6f", tv_interval($starttime)) 
     160            }; 
     161            if($checkstat) { 
     162                $results->{state} = 'BAD'; 
     163                $results->{metric} = { "message" => 
     164                    "Bad module or problem running handler code."}; 
     165                if ($checkstat eq "alarm\n") { 
     166                    $results->{metric} = { "message" => 
     167                        "Check timeout"}; 
     168                    Resmon::ExtComm::clean_up; 
     169                } 
     170            } else { 
     171                $results->{state} = $check_rv; 
     172                if (ref($check_metric) eq "HASH") { 
     173                    my $metric = {}; 
     174                    while(my ($k, $v) = each %$check_metric) { 
     175                        $metric->{$k} = $v; 
     176                    } 
     177                    $results->{metric} = $metric; 
     178                } else { 
     179                    $results->{metric} = { "message" => $check_metric }; 
     180                } 
     181            } 
     182            $status->store($module_name,$monobj->{'object'}, $results); 
     183            printf("%s: %s\n%s\n", $module_name, $monobj->{'object'}, 
     184                Dumper($results)) if $debug; 
    167185        } 
    168       } else { 
    169         $results->{state} = $check_rv; 
    170         if (ref($check_metric) eq "HASH") { 
    171             my $metric = {}; 
    172             while(my ($k, $v) = each %$check_metric) { 
    173                 $metric->{$k} = $v; 
    174             } 
    175             $results->{metric} = $metric; 
    176         } else { 
    177             $results->{metric} = { "message" => $check_metric }; 
    178         } 
    179       } 
    180       $status->store($module_name,$monobj->{'object'}, $results); 
    181       printf("%s: %s\n%s\n", $module_name, $monobj->{'object'}, Dumper($results)) if $debug; 
    182     } 
    183   } 
    184   $status->close(); 
    185   die "Exiting.\n" if($sigint); 
    186   if ($sighup) { 
    187     $sighup = 0; 
    188     reconfigure(); 
    189   } else { 
    190     reap_zombies(); 
    191     wait_interval(); 
    192     reap_zombies(); 
    193   } 
    194   die "Exiting.\n" if($sigint); 
    195   print "\n---- ".localtime(time)."----------\n" 
    196    unless $status->open(); 
    197 } 
    198  
     186    } 
     187    $status->close(); 
     188    die "Exiting.\n" if($sigint); 
     189    if ($sighup) { 
     190        $sighup = 0; 
     191        reconfigure(); 
     192    } else { 
     193        reap_zombies(); 
     194        wait_interval(); 
     195        reap_zombies(); 
     196    } 
     197    die "Exiting.\n" if($sigint); 
     198    print "\n---- ".localtime(time)."----------\n" 
     199    unless $status->open(); 
     200}