package Smokeping::probes::passwordchecker; =head1 301 Moved Permanently This is a Smokeping probe module. Please use the command C to view the documentation or the command C to generate the POD document. =cut use strict; use Smokeping::probes::basefork; use base qw(Smokeping::probes::basefork); use Carp; my $e = "="; sub pod_hash { return { name => < < < method, that needs the corresponding host and username as arguments. ${e}head2 Password file format The password file format is simply one line for each triplet of host, username and password, separated from each other by colons (:). Comment lines, starting with the `#' sign, are ignored, as well as empty lines. DOC authors => <<'DOC', Niko Tyni DOC bugs => < <, L, L DOC } } sub ProbeDesc { return "probe that can fork, knows about passwords and doesn't override the ProbeDesc method"; } sub probevars { my $class = shift; return $class->_makevars($class->SUPER::probevars, { passwordfile => { _doc => "Location of the file containing usernames and passwords.", _example => '/some/place/secret', _sub => sub { my $val = shift; -r $val or $ENV{SERVER_SOFTWARE} or return "ERROR: password file $val is not readable."; return undef; }, }, }); } sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new(@_); # no need for this if we run as a cgi unless ($ENV{SERVER_SOFTWARE}) { if (defined $self->{properties}{passwordfile}) { my @stat = stat($self->{properties}{passwordfile}); my $mode = $stat[2]; carp("Warning: password file $self->{properties}{passwordfile} is world-readable\n") if defined $mode and $mode & 04; open(P, "<$self->{properties}{passwordfile}") or croak("Error opening specified password file $self->{properties}{passwordfile}: $!"); while (

) { chomp; next unless /\S/; next if /^\s*#/; my ($host, $username, $password) = split(/:/); carp("Line $. in $self->{properties}{passwordfile} is invalid"), next unless defined $host and defined $username and defined $password; $self->password($host, $username, $password); } close P; } } return $self; } sub password { my $self = shift; my $host = shift; my $username = shift; my $newval = shift; $self->{password}{$host}{$username} = $newval if defined $newval; return $self->{password}{$host}{$username}; } 1;