diff options
| author | Paul Buetow <paul@buetow.org> | 2015-01-02 14:00:56 +0100 |
|---|---|---|
| committer | Paul Buetow <paul@buetow.org> | 2015-01-02 14:00:56 +0100 |
| commit | 4f27f3ea59baa6cfca0ac1df96b1dfedbd83706c (patch) | |
| tree | 79754e3c49216f80cb3ad5579851fca0bf1a31c9 /lib/MON | |
initial
Diffstat (limited to 'lib/MON')
| -rw-r--r-- | lib/MON/Cache.pm | 55 | ||||
| -rw-r--r-- | lib/MON/Config.pm | 176 | ||||
| -rw-r--r-- | lib/MON/Display.pm | 360 | ||||
| -rw-r--r-- | lib/MON/Filter.pm | 166 | ||||
| -rw-r--r-- | lib/MON/JSON.pm | 51 | ||||
| -rw-r--r-- | lib/MON/Options.pm | 163 | ||||
| -rw-r--r-- | lib/MON/Query.pm | 557 | ||||
| -rw-r--r-- | lib/MON/QueryBase.pm | 232 | ||||
| -rw-r--r-- | lib/MON/RESTlos.pm | 471 | ||||
| -rw-r--r-- | lib/MON/Syslogger.pm | 77 | ||||
| -rw-r--r-- | lib/MON/Utils.pm | 80 |
11 files changed, 2388 insertions, 0 deletions
diff --git a/lib/MON/Cache.pm b/lib/MON/Cache.pm new file mode 100644 index 0000000..21b59f5 --- /dev/null +++ b/lib/MON/Cache.pm @@ -0,0 +1,55 @@ +package MON::Cache; + +use strict; +use warnings; +use v5.10; +use autodie; + +use Data::Dumper; + +use MON::Display; +use MON::Config; +use MON::Utils; + +our @ISA = ('MON::Display'); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + + return $self; +} + +sub init { + my ($self) = @_; + + $self->clear(); + + return undef; +} + +sub clear { + my ($self) = @_; + + $self->{cache} = {}; + + return undef; +} + +sub magic { + my ( $self, $key, $sub ) = @_; + + my $cache = $self->{cache}; + + if ( exists $cache->{$key} ) { + $self->verbose("Delivering '$key' from cache"); + return $cache->{$key}; + } + + return $cache->{$key} = $sub->(); +} + +1; diff --git a/lib/MON/Config.pm b/lib/MON/Config.pm new file mode 100644 index 0000000..dc83911 --- /dev/null +++ b/lib/MON/Config.pm @@ -0,0 +1,176 @@ +package MON::Config; + +use strict; +use warnings; +use v5.10; +use autodie; + +use IO::File; +use Data::Dumper; + +use MON::Display; +use MON::Utils; + +#use MON::Options; + +use MIME::Base64 qw( decode_base64 ); + +our @ISA = ('MON::Display'); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + my $options = $self->{options}; + + $options->store_first($self); + + $self->SUPER::init(%opts); + + for ( @{ $options->{unknown} } ) { + $self->error("Unknown option: $_"); + } + + if ( $self->{'config'} ne '' ) { + $self->read_config( $self->{'config'} ); + + } + elsif ( exists $ENV{MON_CONFIG} ) { + $self->read_config( $ENV{MON_CONFIG} ); + + } + else { + $self->read_config('/etc/mon.conf'); + $self->read_config($_) for sort glob("/etc/mon.d/*.conf"); + + $self->read_config("$ENV{HOME}/.mon.conf"); + $self->read_config($_) for sort glob("$ENV{HOME}/.mon.d/*.conf"); + } + + $options->store_after($self); + + unless ( exists $self->{config_was_read} ) { + $self->verbose("No config file found, but this might be OK"); + } + + $self->_set_defaults(); + + return $self; +} + +sub _set_defaults { + my ($self) = @_; + + my $set_default = sub { + my ( $key, $val ) = @_; + + unless ( exists $self->{$key} ) { + $self->{$key} = $val; + $self->verbose( + "Since $key is not specified setting its default value to $val"); + } + }; + + $set_default->( 'backups.dir' => "$ENV{HOME}/.mon" ); + $set_default->( 'backups.disable' => 1 ); + $set_default->( 'backups.keep.days' => 7 ); + $set_default->( 'restlos.api.port' => '443' ); + $set_default->( 'restlos.api.protocol' => 'https' ); + $set_default->( 'restlos.auth.realm' => 'Login Required' ); + $set_default->( 'restlos.auth.username' => $ENV{USER} ); +} + +sub read_config { + my ( $self, $config_file ) = @_; + + return undef if not defined $config_file or not -f $config_file; + + my $fh = IO::File->new( $config_file, 'r' ); + $self->error("Could not open file $config_file") unless defined $fh; + + $self->verbose("Reading config $config_file"); + + while ( my $line = $fh->getline() ) { + next if $line =~ /^#/; + + # Ignore comments + $line =~ s/(.*);.*/$1/; + + # Parse only matching lines + if ( $line =~ /^(.*):(.*)/ ) { + my ( $key, $val ) = ( lc trim $1, trim $2); + $self->verbose("Reading conf value $key"); + + # Handle ~ + $val =~ s/~/$ENV{HOME}/g; + $self->set( $key, $val ); + } + } + + $fh->close(); + $self->{config_was_read} = 1; + + return undef; +} + +sub get { + my ( $self, $key ) = @_; + $key = lc $key; + + $self->{$key} //= do { + my $key = uc $key; + $key =~ s/\./_/g; + + exists $ENV{$key} ? $ENV{$key} : undef; + }; + + if ( not exists $self->{$key} + or not defined $self->{$key} + or $self->{$key} eq '' ) + { + $self->error("$key not configured"); + } + + return $self->{$key}; +} + +sub get_maybe_encoded { + my ( $self, $key ) = @_; + + return $self->get($key) if exists $self->{$key}; + + $self->error("$key or $key.enc not configured") + unless exists $self->{"$key.enc"}; + + my $enc = $self->get("$key.enc"); + + return decode_base64($enc); +} + +sub bool { + my ( $self, $key ) = @_; + + my $val = $self->get($key); + + return $val != 0; +} + +sub array { + my ( $self, $key ) = @_; + + my $val = $self->get($key); + + return map { trim $_ } split ',', $val; +} + +sub set { + my ( $self, $key, $val ) = @_; + $key = lc $key; + + $self->verbose("$key already configured, overwriting it with its new value") + if exists $self->{$key}; + + return $self->{$key} = $val; +} + +1; diff --git a/lib/MON/Display.pm b/lib/MON/Display.pm new file mode 100644 index 0000000..9bf8115 --- /dev/null +++ b/lib/MON/Display.pm @@ -0,0 +1,360 @@ +package MON::Display; + +use strict; +use warnings; +use v5.10; +use autodie; + +use Data::Dumper; +use Term::ANSIColor; + +use MON::Config; +use MON::JSON; +use MON::Utils; + +our $VERBOSE = 0; +our $DEBUG = 0; +our $COLORFUL = 0; +our $QUIET = 0; +our $LOGGER = undef; +our $INTERACTIVE = undef; + +sub init { + my ( $self, %opts ) = @_; + + $VERBOSE = $self->{'verbose'} == 1; + $DEBUG = $self->{'debug'} == 1; + $QUIET = $self->{'quiet'} == 1; + $LOGGER = $opts{logger}; + $INTERACTIVE = $opts{interactive}; + + $self->{logglevel} = 'info'; + + if ( $self->{'nocolor'} == 1 ) { + $COLORFUL = 0; + } + else { + $COLORFUL = $ENV{MON_COLORFUL} // 1; + } + + $VERBOSE = $DEBUG = $COLORFUL = 0 if $QUIET == 1; + + return undef; +} + +sub is_verbose { + my ($self) = @_; + + return $VERBOSE == 1; +} + +sub is_debug { + my ($self) = @_; + + return $DEBUG == 1; +} + +sub is_quiet { + my ($self) = @_; + + return $QUIET == 1; +} + +sub _display { + my ( $self, $msg, $fh, $level ) = @_; + + return undef unless defined $msg; + + $LOGGER->logg( $self->{logglevel}, $msg ) if defined $LOGGER; + + return undef if $QUIET; + + $fh = *STDERR unless defined $fh; + + print $fh $msg; + + return undef; +} + +sub info_no_nl { + my ( $self, $msg ) = @_; + + print STDERR color 'bold blue' if $COLORFUL; + $self->_display($msg); + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub out_json { + my ( $self, $out ) = @_; + + return undef unless defined $out; + my $config = $self->{config}; + + local $, = "\n"; + + my $json = MON::JSON->new()->decode($out); + my $num_results = ref $json eq 'ARRAY' ? @$json : undef; + + # Don't _display meta aka custom variables unless -m or --meta is specified + unless ( $config->{'meta'} ) { + if ( ref $json eq 'ARRAY' ) { + @$json = map { + if ( ref $_ eq 'HASH' ) + { + my $h = $_; + delete $h->{$_} for grep /^_/, keys %$h; + $h; + } + else { + $_; + } + } @$json; + } + } + + # Sort and pretty print all the JSON pretty pretty please + unless ( defined $config->{outfile} ) { + print MON::JSON->new()->encode_canonical($json) unless $QUIET; + } + else { + my $outfile = $config->{outfile}; + print $outfile MON::JSON->new()->encode_canonical($json); + print STDERR color 'bold green' if $COLORFUL; + $self->_display("Wrote JSON to file\n"); + print STDERR color 'reset' if $COLORFUL; + } + + $LOGGER->logg( 'info', JSON->new()->encode($json) ) if defined $LOGGER; + + print STDERR color 'bold green' if $COLORFUL; + $self->_display("Found $num_results entries\n") if defined $num_results; + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub out_format { + my ( $self, $format, $out ) = @_; + + return undef unless defined $out; + + my $config = $self->{config}; + my $options = $self->{options}; + my $json = MON::JSON->new()->decode($out); + my $num_results = ref $json eq 'ARRAY' ? @$json : undef; + + $self->error("Expected an JSON Array") if ref $json ne 'ARRAY'; + + my @vars1 = $format =~ /\$(\w+)/g; + my @vars2 = $format =~ /\$\{(\w+)\}/g; + my @vars3 = $format =~ /\@(\w+)/g; + my @vars4 = $format =~ /\@\{(\w+)\}/g; + + my %vars; + $vars{$_} = '' for @vars1, @vars2, @vars3, @vars4; + my @out; + my %empty; + + for my $obj (@$json) { + my %obj_vars = %vars; + my $obj_format = $format; + + for my $var ( keys %obj_vars ) { + if ( $var eq 'HOSTNAME' ) { + my $val = exists $obj->{host_name} ? $obj->{host_name} : ''; + + if ( $val eq '' ) { + $empty{$var} = 1; + } + else { + $val =~ s/\..*//; + } + + $obj_format =~ s/\$$var/$val/g; + + } + else { + my $val = exists $obj->{$var} ? $obj->{$var} : ''; + $empty{$var} = 1 if $val eq ''; + + $obj_format =~ s/\$$var/$val/g; + $obj_format =~ s/\$\{$var\}/$val/g; + $obj_format =~ s/\@$var/$val/g; + $obj_format =~ s/\@\{$var\}/$val/g; + } + } + + push @out, $obj_format if $obj_format =~ /^.*\w+.*$/; + } + + if (@out) { + + if ( $config->{'unique'} ) { + my %lines; + @out = grep { exists $lines{$_} ? 0 : ( $lines{$_} = 1 ) } sort @out; + $num_results = @out; + } + else { + @out = sort @out; + } + + if ( $QUIET == 0 ) { + local $, = "\n"; + print @out; + say ''; + } + elsif ( defined $LOGGER ) { + $LOGGER->logg( 'info', $_ ) for @out; + } + } + + $self->warning( "Some objects dont have such a field or have empty strings: " + . join( ' ', sort keys %empty ) ) + if keys %empty; + + print STDERR color 'bold green' if $COLORFUL; + $self->_display("Found $num_results entries\n") if defined $num_results; + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub info { + my ( $self, $msg ) = @_; + + my $str = "$msg\n"; + $self->{logglevel} = 'info'; + + print STDERR color 'bold blue' if $COLORFUL; + $self->_display($str); + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub nl { + my ($self) = @_; + + $self->_display("\n"); + + return undef; +} + +sub error { + my ( $self, $msg ) = @_; + + $self->error_no_exit($msg); + + exit 3 unless $INTERACTIVE; +} + +sub error_no_exit { + my ( $self, $msg ) = @_; + + $self->{logglevel} = 'warning'; + print STDERR color 'bold red' if $COLORFUL; + $self->_display( "! ERROR: $msg\n", *STDERR ); + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub possible { + my ( $self, @params ) = @_; + + my $config = $self->{config}; + my $options = $self->{options}; + + push @params, $options->get_keys() + if $config->{'help'}; + + my $msg = ''; + + if (@params) { + for ( grep !/^V_ALIAS/, @params ) { + if ( ref $_ eq 'ARRAY' ) { + $msg .= join "\n", @$_; + $msg .= "\n"; + } + else { + $msg .= "$_\n"; + } + } + } + else { + $msg .= "\n"; + } + + $self->{logglevel} = 'info'; + $self->_display($msg); + + exit 0 unless $INTERACTIVE; +} + +sub warning { + my ( $self, $msg ) = @_; + + my $str = "! $msg\n"; + + print STDERR color 'red' if $COLORFUL; + $self->_display( $str, *STDERR ); + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub verbose { + my ( $self, @msgs ) = @_; + + print STDERR color 'cyan' if $COLORFUL; + $self->{logglevel} = 'info'; + + if ( $self->is_verbose() ) { + for my $msg (@msgs) { + if ( $self->is_debug() ) { + my @caller = caller; + $self->_display("@caller: $msg\n"); + } + else { + $self->_display("$msg\n"); + } + } + } + + print STDERR color 'reset' if $COLORFUL; + + return undef; +} + +sub dump { + my ( $self, $msg ) = @_; + + $self->{logglevel} = 'warning'; + $self->_display( Dumper $msg ); + + return undef; +} + +sub debug { + my ( $self, @msgs ) = @_; + + my @caller = caller; + + if ( $self->is_debug() ) { + for my $msg (@msgs) { + $msg = Dumper $msg if ref $msg ne ''; + + my $str = "@caller: $msg\n"; + + $self->{logglevel} = 'debug'; + $self->_display($str); + } + } + + return undef; +} + +1; + diff --git a/lib/MON/Filter.pm b/lib/MON/Filter.pm new file mode 100644 index 0000000..d16d1c5 --- /dev/null +++ b/lib/MON/Filter.pm @@ -0,0 +1,166 @@ +package MON::Filter; + +use strict; +use warnings; +use v5.10; +use autodie; + +use Data::Dumper; + +use MON::Display; +use MON::Config; +use MON::Utils; + +our @ISA = ('MON::Display'); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + + return $self; +} + +sub init { + my ($self) = @_; + + $self->{query_string} = ''; + $self->{filters} = {}; + $self->{num_filters} = 0; + $self->{is_computed} = 0; + $self->{or} = []; + + return undef; +} + +# Create filters with params +sub compute { + my ( $self, $params ) = @_; + + $self->debug( 'Computing filter using', $params ); + return undef if $self->{is_computed}; + + my %likes; + + if ( defined $params and ref $params eq 'ARRAY' ) { + while (@$params) { + my $op_token = pop @$params; + given ($op_token) { + when (/^OP_LIKE$/) { + my $arg2 = pop @$params; + my $arg1 = pop @$params; + + if ( exists $likes{$arg1} ) { + $self->error( +"Can not run multiple 'like's on '$arg1', since it is used for the API query_string" + ); + } + else { + $likes{$arg1} = "$arg1=$arg2"; + } + + } + when (/^OP_/) { + $self->{filters}{$_} = [] unless exists $self->{filters}{$_}; + my $arg2 = pop @$params; + my $arg1 = pop @$params; + push @{ $self->{filters}{$_} }, [ $arg1, $arg2 ]; + $self->{num_filters}++; + } + default { + $self->error("Inernal error: Operator expected instead of $_"); + } + } + } + } + + $self->{query_string} = '?' . join( '&', values %likes ); + $self->{is_computed} = 1; + + $self->debug( 'Computed filter:', $self->{filters} ); + $self->verbose( "Computed query string is: " . $self->{query_string} ); + + return undef; +} + +sub filter { + my ( $self, $objects ) = @_; + + my $config = $self->{config}; + my $json = $self->{json}; + + return $objects unless $self->{num_filters}; + + my $num = sub { + my $str = shift; + $str =~ s/\D//g; + $str = 0 if $str eq ''; + return int $str; + }; + + while ( my ( $op, $vals ) = each %{ $self->{filters} } ) { + for my $val (@$vals) { + my ( $key, $val ) = @$val; + + @$objects = grep { + my $object = $_; + + if ( exists $object->{$key} ) { + if ( $op eq 'OP_MATCHES' and $object->{$key} =~ /$val/ ) { + 1; + + } + elsif ( $op eq 'OP_NMATCHES' and $object->{$key} !~ /$val/ ) { + 1; + + } + elsif ( $op eq 'OP_EQ' and $object->{$key} eq $val ) { + 1; + + } + elsif ( $op eq 'OP_NE' and $object->{$key} ne $val ) { + 1; + + } + elsif ( $op eq 'OP_LT' + and $num->( $object->{$key} ) < $num->($val) ) + { + 1; + + } + elsif ( $op eq 'OP_LE' + and $num->( $object->{$key} ) <= $num->($val) ) + { + 1; + + } + elsif ( $op eq 'OP_GT' + and $num->( $object->{$key} ) > $num->($val) ) + { + 1; + + } + elsif ( $op eq 'OP_GE' + and $num->( $object->{$key} ) >= $num->($val) ) + { + 1; + + } + else { + 0; + } + } + else { + 0; + } + } @$objects; + } + } + + return $objects; +} + +1; + diff --git a/lib/MON/JSON.pm b/lib/MON/JSON.pm new file mode 100644 index 0000000..e12b1ce --- /dev/null +++ b/lib/MON/JSON.pm @@ -0,0 +1,51 @@ +package MON::JSON; + +use strict; +use warnings; +use v5.10; +use autodie; + +use JSON; + +use MON::Display; +use MON::Utils; + +our @ISA = ('MON::Display'); + +our $JSON_XS = JSON::XS->new(); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + + return $self; +} + +sub init { + my ($self) = @_; + + return undef; +} + +sub decode { + my ( $self, $json ) = @_; + + return $JSON_XS->allow_nonref()->decode($json); +} + +sub encode { + my ( $self, $vals ) = @_; + + return $JSON_XS->pretty()->encode($vals); +} + +sub encode_canonical { + my ( $self, $vals ) = @_; + + return $JSON_XS->canonical()->pretty()->encode($vals); +} + +1; diff --git a/lib/MON/Options.pm b/lib/MON/Options.pm new file mode 100644 index 0000000..b798f56 --- /dev/null +++ b/lib/MON/Options.pm @@ -0,0 +1,163 @@ +package MON::Options; + +use strict; +use warnings; +use v5.10; +use autodie; + +use Data::Dumper; +use Scalar::Util qw(looks_like_number); + +use MON::Utils; + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + $self->parse(); + + return $self; +} + +sub init { + my ($self) = @_; + + my %opts = ( + opts => { + config => '', + debug => 0, + dry => 0, + help => 0, + interactive => 0, + meta => 0, + nocolor => 0, + quiet => 0, + syslog => 0, + unique => 0, + verbose => 0, + version => 0, + errfile => '', + }, + opts_short => { + c => 'config', + D => 'debug', + d => 'dry', + i => 'interactive', + h => 'help', + m => 'meta', + n => 'nocolor', + q => 'quiet', + s => 'syslog', + u => 'unique', + v => 'verbose', + V => 'version', + R => 'errfile', + }, + unknown => [], + ); + + $self->{$_} = $opts{$_} for keys %opts; + + return undef; +} + +sub parse { + my ($self) = @_; + + my $opts_passed = $self->{opts_passed}; + + for my $opt (@$opts_passed) { + my ( $k, $v ) = split /=/, $opt; + + # Longopt + if ( $k =~ s/^--// && isin $k, keys %{ $self->{opts} } ) { + if ( defined $v ) { + $self->{opts}{$k} = $v; + } + else { + $self->{opts}{$k} = 1; + } + } + + # Shortopt + elsif ( $k =~ s/^-// && isin $k, keys %{ $self->{opts_short} } ) { + if ( defined $v ) { + $self->{opts}{ $self->{opts_short}{$k} } = $v; + } + else { + $self->{opts}{ $self->{opts_short}{$k} } = 1; + } + + } + elsif ( $k !~ /\./ ) { + + # If key is not separated by dot, it is unknown + push @{ $self->{unknown} }, $opt; + + } + else { + + # Otherise it might overwrite a value of mon.conf + $self->{opts}{$k} = $v; + } + } + + # Help implies dry mode + $self->{opts}{dry} = 1 if $self->{opts}{help}; + + # Debug implies verbose mode + $self->{opts}{verbose} = 1 if $self->{opts}{debug}; + + return undef; +} + +sub get_keys { + my ($self) = @_; + my @keys; + + while ( my ( $k, $v ) = each %{ $self->{opts_short} } ) { + if ( looks_like_number( $self->{opts}{$v} ) ) { + push @keys, "--$v -$k"; + } + else { + push @keys, "--$v=VAL -$k=VAL"; + } + } + + return @keys; +} + +sub store { + my ( $self, $config ) = @_; + + $self->store_first($config); + $self->store_after($config); + + return undef; +} + +# Only store values which are not separated by dots +sub store_first { + my ( $self, $config ) = @_; + + for ( grep !/\./, keys %{ $self->{opts} } ) { + $config->{$_} = $self->{opts}{$_}; + } + + return undef; +} + +# Only store values which are separated by dots +sub store_after { + my ( $self, $config ) = @_; + + for ( grep /\./, keys %{ $self->{opts} } ) { + $config->{$_} = $self->{opts}{$_}; + } + + return undef; +} + +1; diff --git a/lib/MON/Query.pm b/lib/MON/Query.pm new file mode 100644 index 0000000..d7e223b --- /dev/null +++ b/lib/MON/Query.pm @@ -0,0 +1,557 @@ +package MON::Query; + +use strict; +use warnings; +use v5.10; + +use Data::Dumper; + +use MON::Display; +use MON::Config; +use MON::Utils; +use MON::QueryBase; + +our @ISA = ('MON::QueryBase'); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + + return $self; +} + +sub init { + my ($self) = @_; + + $self->{querystack} = []; + $self->{args} = [ map { s/^V_/:V_/; $_ } @{ $self->{args} } ]; + + return undef; +} + +sub tree { + my ($self) = @_; + + my $api = $self->{api}; + my $paths = $api->get_possible_paths(); + + my ( $s, $r ) = ( $self, $api ); + + my $arr = sub { + my ( $keys, $vals ) = @_; + map { $_ => shift @$vals } @$keys; + }; + +# _ => By default to run anonymous sub if no other key is specified in command line +# __ => Always to run anonymous sub in the beginning of the current recursion +# ___ => Always to run anonymous sub before next recursion +# __DO => Process recursion right away, only do __ if exists +# V_FOO => Declare variable FOO + + my $where = { + _ => sub { + my $d = shift; + $s->possible( $r->get_path_params( $d->{V_PATH} ) ); + }, + V_KEY => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_KEY}, $r->get_path_params( $d->{V_PATH} ) ); + }, + like => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_LIKE') } + }, + matches => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_MATCHES') } + }, + nmatches => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_NMATCHES') } + }, + eq => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_EQ') } + }, + ne => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_NE') } + }, + lt => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_LT') } + }, + le => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_LE') } + }, + gt => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_GT') } + }, + ge => { + V_VAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + $s->out_json( $d->{where_action}($path) ); + }, + }, + ___ => sub { $s->push_querystack('OP_GE') } + }, + }, + }; + + for my $op ( sort qw(like matches nmatches eq ne lt le gt ge) ) { + $where->{V_KEY}{$op}{V_VAL}{and}{__DO} = $where; + $where->{V_KEY}{$op}{V_VAL}{'V_ALIAS:a'} = $where->{V_KEY}{$op}{V_VAL}{and}; + } + + $where->{V_KEY}{'V_ALIAS:l'} = $where->{V_KEY}{like}; + $where->{V_KEY}{'V_ALIAS:~'} = $where->{V_KEY}{like}; + $where->{V_KEY}{'V_ALIAS:=='} = $where->{V_KEY}{eq}; + $where->{V_KEY}{'V_ALIAS:!='} = $where->{V_KEY}{ne}; + $where->{V_KEY}{'V_ALIAS:=~'} = $where->{V_KEY}{matches}; + $where->{V_KEY}{'V_ALIAS:!~'} = $where->{V_KEY}{nmatches}; + + my $set_where = { + _ => sub { + my $d = shift; + $s->possible( $r->get_path_params( $d->{V_PATH} ) ); + }, + V_SETKEY => { + '=' => { + V_SETVAL => { + __ => sub { + my $d = shift; + $d->{where_action} = $d->{set_action}; + }, + where => $where, + }, + }, + }, + }; + $set_where->{V_SETKEY}{'='}{V_SETVAL}{and} = $set_where; + $set_where->{V_SETKEY}{'='}{V_SETVAL}{'V_ALIAS::'} = + $set_where->{V_SETKEY}{'='}{V_SETVAL}{where}; + $set_where->{V_SETKEY}{'='}{V_SETVAL}{'V_ALIAS:a'} = + $set_where->{V_SETKEY}{'='}{V_SETVAL}{and}; + + my $set = { + _ => sub { + my $d = shift; + $s->possible( $r->get_path_params( $d->{V_PATH} ) ); + }, + V_SETKEY => { + '=' => { + V_SETVAL => { + _ => sub { + my $d = shift; + my $path = $d->{V_PATH}; + + $s->out_json( $d->{set_action}($path) ); + }, + }, + }, + }, + }; + $set->{V_SETKEY}{'='}{V_SETVAL}{and} = $set; + $set->{V_SETKEY}{'='}{V_SETVAL}{'V_ALIAS:a'} = + $set->{V_SETKEY}{'='}{V_SETVAL}{and}; + + my $remove = { + _ => sub { + my $d = shift; + $s->possible( $r->get_path_params( $d->{V_PATH} ) ); + }, + V_REMOVEKEY => { + __ => sub { + my $d = shift; + $d->{where_action} = $d->{remove_action}; + }, + where => $where, + }, + }; + $remove->{V_REMOVEKEY}{and} = $remove; + $remove->{V_REMOVEKEY}{'V_ALIAS:a'} = $remove->{V_REMOVEKEY}{and}; + + my $tree = { + get => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{where_action} = sub { + my ($path) = @_; + $r->fetch_path_json( $path, $s->get_querystack() ); + }; + }, + _ => sub { + my $d = shift; + $s->out_json( + $r->fetch_path_json( $d->{V_PATH}, $s->get_querystack() ) ); + }, + where => $where, + }, + }, + getfmt => { + V_FORMAT => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{where_action} = sub { + my ($path) = @_; + $s->out_format( $d->{V_FORMAT}, + $r->fetch_path_json( $path, $s->get_querystack() ) ); + }; + }, + _ => sub { + my $d = shift; + $s->out_format( $d->{V_FORMAT}, + $r->fetch_path_json( $d->{V_PATH}, $s->get_querystack() ) ); + }, + where => $where, + }, + }, + }, + edit => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{where_action} = sub { + my ($path) = @_; + $s->edit_path_data( $path, + $r->fetch_path_json( $path, $s->get_querystack() ) ); + }; + }, + _ => sub { + my $d = shift; + $s->edit_path_data( $d->{V_PATH}, + $r->fetch_path_json( $d->{V_PATH} ) ); + }, + where => $where, + }, + }, + view => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{where_action} = sub { + my ($path) = @_; + $s->view_data( $path, + $r->fetch_path_json( $path, $s->get_querystack() ) ); + }; + }, + _ => sub { + my $d = shift; + $s->view_data( $d->{V_PATH}, $r->fetch_path_json( $d->{V_PATH} ) ); + }, + where => $where, + }, + }, + delete => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{where_action} = sub { + my ($path) = @_; + $s->out_json( $r->delete_path_json( $path, $s->get_querystack() ) ); + }; + }, + _ => sub { + my $d = shift; + $s->out_json( $r->fetch_path_json( $d->{V_PATH} ) ); + }, + where => $where, + }, + }, + update => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{set_action} = sub { + my ($path) = @_; + my %set = $arr->( $d->{ALL_V_SETKEY}, $d->{ALL_V_SETVAL} ); + $s->out_json( + $r->update_path_json( $path, $s->get_querystack(), \%set ) ); + }; + $d->{remove_action} = sub { + my ($path) = @_; + my $remove = $d->{ALL_V_REMOVEKEY}; + $s->out_json( + $r->update_remove_path_json( + $path, $s->get_querystack(), $remove + ) + ); + }; + }, + set => $set_where, + 'delete' => $remove, + }, + }, + insert => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + $d->{set_action} = sub { + my ($path) = @_; + my %set = $arr->( $d->{ALL_V_SETKEY}, $d->{ALL_V_SETVAL} ); + $s->out_json( $self->insert_data( $path, \%set ) ); + }; + }, + set => $set, + }, + }, + post => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + }, + _ => sub { + my $d = shift; + $s->send_data( $d->{V_PATH}, 'POST' ); + }, + from => { + V_FILEPATH => { + _ => sub { + my $d = shift; + $s->send_data( $d->{V_PATH}, 'POST', $d->{V_FILEPATH} ); + } + } + } + }, + }, + put => { + _ => sub { $s->possible(@$paths) }, + V_PATH => { + __ => sub { + my $d = shift; + $s->check_has( $d->{V_PATH}, $paths ); + }, + _ => sub { + my $d = shift; + $s->send_data( $d->{V_PATH}, 'PUT' ); + }, + from => { + V_FILEPATH => { + _ => sub { + my $d = shift; + $s->send_data( $d->{V_PATH}, 'PUT', $d->{V_FILEPATH} ); + } + } + } + }, + }, + verify => sub { $s->verify() }, + restart => sub { $s->restart() }, + reload => sub { $s->restart() }, + 'V_ALIAS:y' => sub { $s->verify() }, + 'V_ALIAS:r' => sub { $s->restart() }, + }; + + $tree->{delete}{V_PATH}{'V_ALIAS::'} = $tree->{delete}{V_PATH}{where}; + $tree->{'V_ALIAS:d'} = $tree->{delete}; + + $tree->{edit}{V_PATH}{'V_ALIAS::'} = $tree->{edit}{V_PATH}{where}; + $tree->{'V_ALIAS:e'} = $tree->{edit}; + + $tree->{get}{V_PATH}{'V_ALIAS::'} = $tree->{get}{V_PATH}{where}; + $tree->{'V_ALIAS:g'} = $tree->{get}; + + $tree->{getfmt}{V_FORMAT}{V_PATH}{'V_ALIAS::'} = + $tree->{getfmt}{V_FORMAT}{V_PATH}{where}; + $tree->{'V_ALIAS:f'} = $tree->{getfmt}; + + $tree->{insert}{V_PATH}{'V_ALIAS:s'} = $tree->{insert}{V_PATH}{set}; + $tree->{'V_ALIAS:i'} = $tree->{insert}; + + $tree->{'V_ALIAS:p'} = $tree->{post}; + + $tree->{'V_ALIAS:t'} = $tree->{put}; + + $tree->{update}{V_PATH}{'V_ALIAS:d'} = $tree->{update}{V_PATH}{delete}; + $tree->{update}{V_PATH}{'V_ALIAS:s'} = $tree->{update}{V_PATH}{set}; + $tree->{'V_ALIAS:u'} = $tree->{update}; + + $tree->{view}{V_PATH}{'V_ALIAS::'} = $tree->{view}{V_PATH}{where}; + $tree->{'V_ALIAS:v'} = $tree->{view}; + + $self->debug( 'Abstract syntax tree:', $tree ); + + return $tree; +} + +sub parse { + my ($self) = @_; + + my $config = $self->{config}; + my $args = $self->{args}; + + # Get > and < operators (only needed by interactive mode) + $config->{outfile} = $config->{infile} = undef; + if ( defined $args->[-2] ) { + given ( $args->[-2] ) { + when ('>') { + my ( undef, $file ) = splice @$args, -2, 2; + open $config->{outfile}, '>', $file or $self->warning("$file: $!"); + } + when ('<') { + my ( undef, $file ) = splice @$args, -2, 2; + open $config->{infile}, '<', $file or $self->warning("$file: $!"); + } + } + } + + my $ret = $self->traverse( $args, $self->tree(), {} ); + + close $config->{infile} if defined $config->{infile}; + close $config->{outfile} if defined $config->{outfile}; + + return $ret; +} + +sub traverse { + my ( $self, $args, $tree, $data ) = @_; + + $self->debug( 'Traversing args: ' . Dumper $args); + $self->debug( 'Traversing data: ' . Dumper $data); + + if ( ref $tree eq 'CODE' ) { + $tree->($data); + return undef; + } + + $tree->{__}->($data) if exists $tree->{__}; + + if ( exists $tree->{__DO} ) { + $self->traverse( $args, $tree->{__DO}, $data ); + return undef; + } + + my @possible = grep !/^__?$/, sort keys %$tree; + my $token = $possible[0]; + + unless (@$args) { + if ( exists $tree->{_} ) { + $tree->{_}->($data); + } + else { + $self->possible(@possible); + } + } + else { + my $arg = shift @$args; + + if ( exists $tree->{$arg} ) { + $tree->{___}->($data) if exists $tree->{___}; + $self->traverse( $args, $tree->{$arg}, $data ); + } + elsif ( exists $tree->{"V_ALIAS:$arg"} ) { + $tree->{___}->($data) if exists $tree->{___}; + $self->traverse( $args, $tree->{"V_ALIAS:$arg"}, $data ); + } + elsif ( defined $token && $token =~ /^V_/ && $token !~ /^V_ALIAS:/ ) { + $data->{$token} = $arg; + $self->push_querystack($arg) if $token =~ /^V_(?:KEY|VAL)/; + + unless ( exists $data->{"ALL_$token"} ) { + $data->{"ALL_$token"} = [$arg]; + } + else { + push @{ $data->{"ALL_$token"} }, $arg; + } + + $tree->{___}->($data) if exists $tree->{___}; + $self->traverse( $args, $tree->{$token}, $data ); + } + else { + $self->error("'$arg' unexpected here"); + } + } + + return undef; +} + +sub push_querystack { + my ( $self, $token ) = @_; + + $self->debug("Pushing token '$token' to querystack"); + push @{ $self->{querystack} }, $token; + + return undef; +} + +sub get_querystack { + my ($self) = @_; + + return $self->{querystack}; +} + +1; diff --git a/lib/MON/QueryBase.pm b/lib/MON/QueryBase.pm new file mode 100644 index 0000000..6ddfb99 --- /dev/null +++ b/lib/MON/QueryBase.pm @@ -0,0 +1,232 @@ +package MON::QueryBase; + +use strict; +use warnings; +use v5.10; + +use File::Temp qw/:mktemp/; +use Data::Dumper; +use Digest::SHA; + +use MON::Display; +use MON::Config; +use MON::Utils; + +our @ISA = ('MON::Display'); + +sub check_has { + my ( $self, $key, $in ) = @_; + + if ( ref $in eq 'HASH' && exists $in->{$key} ) { + return 1; + + } + else { + for (@$in) { + return 1 if $_ eq $key; + } + } + + my @possible = sort ( ref $in eq 'HASH' ? keys %$in : @$in ); + $self->error("'$key' not expected here. Possible: @possible"); +} + +sub edit_path_file_send { + my ( $self, $path, $filename ) = @_; + + my $api = $self->{api}; + + open my $fh, $filename or die "$filename: $!"; + my @data = <$fh>; + close $fh; + + $self->info("Saving data to API into $path from file $filename"); + $self->out_json( + $api->send_path_json( $path, join( '', @data ), undef, 'PUT' ) ); + + return undef; +} + +sub get_sha_of_file { + my ( $self, $filename ) = @_; + + my $sha = Digest::SHA->new(); + open my $sha_fh, $filename or die "$!\n"; + $sha->addfile($sha_fh); + $sha = $sha->b64digest(); + close $sha_fh; + + return $sha; +} + +sub edit_path_file { + my ( $self, $path, $filename ) = @_; + + my $config = $self->{config}; + my $api = $self->{api}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + my $editor = $ENV{EDITOR} // 'vim'; + + my $sha_before = $self->get_sha_of_file($filename); + $self->verbose("Checksum of $filename before edit: $sha_before"); + + for ( ; ; ) { + system("$editor $filename"); + my $sha_after = $self->get_sha_of_file($filename); + $self->verbose("Checksum of $filename after edit: $sha_after"); + + if ( $sha_before eq $sha_after ) { + $self->info( + "Dude, no changes were made. I am not sending data back to the API!"); + last; + } + + $self->edit_path_file_send( $path, $filename ); + if ( $api->{has_error} ) { + $self->info('An error has occured, press any key to re-edit'); + <STDIN>; + } + else { + last; + } + } + + for ( glob("/tmp/mon*.json") ) { + $self->verbose("Cleaning up tempfile $_"); + unlink $_; + } + + return undef; +} + +sub edit_path_data { + my ( $self, $path, $data ) = @_; + + my $config = $self->{config}; + my $api = $self->{api}; + my $json = $api->{json}; + + my ( $fh, $filename ) = mkstemps( "/tmp/monXXXXXX", '.json' ); + + # Sort the json + my $vals = $json->decode($data); + print $fh $json->encode_canonical($vals); + close $fh; + + $self->edit_path_file( $path, $filename ); + + return undef; +} + +sub view_data { + my ( $self, $path, $data ) = @_; + + my $config = $self->{config}; + my $api = $self->{api}; + my $json = $api->{json}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + my ( $fh, $filename ) = mkstemps( "/tmp/monXXXXXX", '.json' ); + + # Sort the json + my $vals = $json->decode($data); + print $fh $json->encode_canonical($vals); + close $fh; + + my $editor = $ENV{PAGER} // 'view'; + system("$editor $filename"); + + unlink $filename; + return undef; +} + +sub insert_data { + my ( $self, $path, $set ) = @_; + + my $config = $self->{config}; + my $api = $self->{api}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + return $api->send_path_json( $path, $api->{json}->encode($set) ); +} + +sub send_data { + my ( $self, $path, $method, $fromfile ) = @_; + + my $config = $self->{config}; + my $api = $self->{api}; + my @send_data; + + if ( defined $config->{infile} ) { + my $infile = $config->{infile}; + + # Slurp it, it's not gonna be >1mb anyway + @send_data = <$infile>; + } + elsif ( defined $fromfile ) { + open my $fh, $fromfile or do { + $self->error("Can not open file $fromfile: $!"); + return undef; + }; + + # Slurp it, it's not gonna be >1mb anyway + @send_data = <$fh>; + close $fh; + } + else { + + # Slurp it, it's not gonna be >1mb anyway + @send_data = <STDIN>; + } + + unless (@send_data) { + $self->error( +"No post data found. Use 'from datafile' or pipes to set post or put data." + ); + return undef; + } + + my $send_data = join '', @send_data; + + my $json = $api->{json}->decode($send_data); + + if ( ref $json eq 'ARRAY' && @$json && ref $json->[0] ne 'HASH' ) { + $self->verbose('Transforming array style JSON into an hash style one'); + my %json = @$json; + $json = \%json; + } + + $self->out_json( + $api->send_path_json( $path, $api->{json}->encode($json), undef, $method ) + ); + + return undef; +} + +sub verify { + my ($self) = @_; + my $api = $self->{api}; + + $self->out_json( $api->post_verify_json() ); +} + +sub restart { + my ($self) = @_; + my $api = $self->{api}; + + $self->out_json( $api->post_restart_json() ); +} + +1; diff --git a/lib/MON/RESTlos.pm b/lib/MON/RESTlos.pm new file mode 100644 index 0000000..d13ecce --- /dev/null +++ b/lib/MON/RESTlos.pm @@ -0,0 +1,471 @@ +package MON::RESTlos; + +use strict; +use warnings; +use v5.10; +use autodie; + +use POSIX 'strftime'; +use IO::File; +use IO::Dir; +use HTTP::Headers; +use LWP::UserAgent; +use Data::Dumper; + +use MON::Cache; +use MON::Config; +use MON::Display; +use MON::Filter; +use MON::Utils; +use MON::JSON; + +our @ISA = ('MON::Display'); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + + return $self; +} + +sub init { + my ($self) = @_; + + my $config = $self->{config}; + + my $host = $config->get('restlos.api.host'); + my $port = $config->get('restlos.api.port'); + my $protocol = $config->get('restlos.api.protocol'); + + $self->{url_base} = "$protocol://$host:$port/"; + $self->{cache} = MON::Cache->new( config => $config ); + $self->{filter} = MON::Filter->new( config => $config ); + $self->{json} = MON::JSON->new( config => $config ); + $self->{has_error} = 0; + $self->{had_error} = 0; + + my $url = $self->{url_base}; + my $vals = $self->{json}->decode( $self->fetch_json($url) ); + + my $all = $self->{all} = $vals->{endpoints}; + my @top; + push @top, $_ for sort keys %$all; + $self->{all_possible_paths} = \@top; + + return undef; +} + +# Easy getter methods +sub get_possible_paths { + my ($self) = @_; + + return $self->{all_possible_paths}; +} + +sub get_path_params { + my ( $self, $path ) = @_; + + return $self->{all}{$path}; +} + +# Helper methods +sub set_credentials { + my ( $self, $ua ) = @_; + + my $config = $self->{config}; + + my $host = $config->get('restlos.api.host'); + my $port = $config->get('restlos.api.port'); + my $protocol = $config->get('restlos.api.protocol'); + my $password = $config->get_maybe_encoded('restlos.auth.password'); + my $realm = $config->get('restlos.auth.realm'); + my $username = $config->get('restlos.auth.username'); + + $ua->credentials( "$host:$port", $realm, $username, $password ); + + return undef; +} + +sub create_request { + my ( $self, $method, $url ) = @_; + + my $req = HTTP::Request->new( $method, $url ); + $req->header( 'Accept', 'application/json' ); + $req->header( 'Content-Type', 'application/json' ); + + return $req; +} + +sub handle_http_error_if { + my ( $self, $response ) = @_; + + my $config = $self->{config}; + + unless ( $response->is_success() ) { + + #$self->out_json( $response->decoded_content() ); + $self->warning( $response->status_line() . ' ==> switching to dry mode' ); + $self->{has_error} = 1; + $self->{had_error} = 1; + } + else { + $self->{has_error} = 0; + } + + return undef; +} + +# Fetch methods +sub fetch_json { + my ( $self, $url ) = @_; + + my $config = $self->{config}; + my $cache = $self->{cache}; + + my $response = $cache->magic( + $url, + sub { + $self->verbose("Requesting '$url' via GET"); + + my $req = $self->create_request( 'GET', $url ); + + my $ua = LWP::UserAgent->new(); + $self->set_credentials($ua); + + my $response = $ua->request($req); + $self->handle_http_error_if($response); + + return $response; + } + ); + + return $response->decoded_content(); +} + +sub fetch_path_json { + my ( $self, $path, $params ) = @_; + + my $config = $self->{config}; + my $filter = $self->{filter}; + $filter->compute($params); + + my $content = + $self->fetch_json( $self->{url_base} . $path . $filter->{query_string} ); + + return $self->{json} + ->encode( $filter->filter( $self->{json}->decode($content) ) ); +} + +# Delete methods +sub delete_json { + my ( $self, $url ) = @_; + + my $config = $self->{config}; + my $filter = $self->{filter}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + $self->verbose("Requesting '$url' via DELETE"); + my $req = $self->create_request( 'DELETE', $url ); + + my $ua = LWP::UserAgent->new(); + $self->set_credentials($ua); + + my $response = $ua->request($req); + $self->handle_http_error_if($response); + + return $response->decoded_content(); +} + +sub delete_path_json { + my ( $self, $path, $params, $no_backup ) = @_; + + my $config = $self->{config}; + my $filter = $self->{filter}; + my $json = $self->{json}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + $filter->compute($params); + $self->backup_path_json( $path, $params ) unless defined $no_backup; + + if ( $filter->{num_filters} > 0 ) { + my $jsonstr = $self->fetch_path_json( $path, $params ); + my $data = $json->decode($jsonstr); + my @ret; + + for my $obj (@$data) { + my $url = $self->{url_base} . $path . "?name.eq=$obj->{name}"; + push @ret, $json->decode( $self->delete_json($url) ); + } + + return $json->encode( \@ret ); + + } + else { + my $url = $self->{url_base} . $path . $filter->{query_string}; + return $self->delete_json($url); + } +} + +# Post methods +sub send_json { + my ( $self, $url, $send_data, $method ) = @_; + + $method //= 'POST'; + + my $config = $self->{config}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + $send_data = '' unless defined $send_data; + + $self->verbose("Using URL $url and $method data:\n$send_data"); + + my $req = $self->create_request( $method, $url ); + $req->content($send_data); + + my $ua = LWP::UserAgent->new(); + $self->set_credentials($ua); + + my $response = $ua->request($req); + $self->handle_http_error_if($response); + + return $response->decoded_content(); +} + +sub send_path_json { + my ( $self, $path, $send_data, $no_backup, $method ) = @_; + + # If $method == undef, then $method = 'POST' + + my $config = $self->{config}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + my $url = $self->{url_base} . $path; + $self->backup_path_json($path) unless defined $no_backup; + + return $self->send_json( $url, $send_data, $method ); +} + +# Post methods +sub post_verify_json { + my ($self) = @_; + + my $config = $self->{config}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + $self->info("Verifying configuration."); + return $self->send_json( $self->{url_base} . 'control?verify' ); +} + +sub post_restart_json { + my ($self) = @_; + + my $config = $self->{config}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + $self->info("Restarting monitoring core."); + return $self->send_json( $self->{url_base} . 'control?restart=true' ); +} + +# Allow variables like this: +# m -v update host set __FOO = '$host_name $name' where host_name like paul +sub vars { + my ( $self, $elem, $v ) = @_; + + $v =~ s/\\\$/:ESCAPE_DOLLAR/g; + $v =~ s/\\@/:ESCAPE_AT/g; + $v =~ s/\@(\w+)/\$$1/g; + $v =~ s/\@(\{\w+\})/\$$1/g; + + my @vars1 = $v =~ /\$(\w+)/g; + my @vars2 = $v =~ /\$\{(\w+)\}/g; + + $v =~ s/\$\{(\w+)\}/\$$1/g; + $v =~ s/\\\$/\$/g; + + for ( @vars1, @vars2 ) { + unless ( exists $elem->{$_} ) { + my @possible = map { "\$$_" } keys %$elem; + $self->error( + "Variable \$$_ (aka \@$_) does not exist. Possible: @possible"); + } + + $self->verbose("Evaluating variable '\$$_' to '$elem->{$_}'"); + $v =~ s/\$$_/$elem->{$_}/; + } + + $v =~ s/:ESCAPE_DOLLAR/\$/g; + $v =~ s/:ESCAPE_AT/\@/g; + + return $v; +} + +# Update methods +sub update_path_json { + my ( $self, $path, $params, $set ) = @_; + + my $config = $self->{config}; + my $filter = $self->{filter}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + $filter->compute($params); + my $url = $self->{url_base} . $path . $filter->{query_string}; + + my $json = $self->fetch_path_json( $path, $params ); + + $self->backup_path_json( $path, $params, $json ); + my $vals = $self->{json}->decode($json); + + for my $elem (@$vals) { + while ( my ( $k, $v ) = each %$set ) { + $elem->{$k} = $self->vars( $elem, $v ); + } + } + + $json = $self->{json}->encode($vals); + + return $self->send_path_json( $path, $json, 1 ); +} + +sub update_remove_path_json { + my ( $self, $path, $params, $remove ) = @_; + + my $config = $self->{config}; + + if ( $config->{'dry'} ) { + $self->verbose("Dry mode, don't modify anything via API."); + return undef; + } + + my $json = $self->fetch_path_json( $path, $params ); + + $self->backup_path_json( $path, $params, $json ); + my $vals = $self->{json}->decode($json); + + for my $removekey (@$remove) { + my $flag = 0; + + for my $elem (@$vals) { + if ( exists $elem->{$removekey} ) { + delete $elem->{$removekey}; + $flag = 1; + } + } + + $self->warning("No key '$removekey' to remove found.") unless $flag; + } + + $json = $self->{json}->encode($vals); + return $self->send_path_json( $path, $json, 1, 'PUT' ); +} + +# Backup methods +sub backup_cleanup { + my ( $self, $path, $params ) = @_; + + my $config = $self->{config}; + my $location = $config->get('backups.dir'); + + if ( $config->{'dry'} ) { + $self->verbose( + "Dry mode, don't modify anything via API, backup irrelevant."); + return undef; + } + + my $dir = IO::Dir->new($location); + + if ( defined $dir ) { + my $days = $config->get('backups.keep.days'); + + while ( defined( $_ = $dir->read() ) ) { + my $backfile = "$location/$_"; + my $age = -M $backfile; + + #$self->verbose("'$backfile' has age $age"); + if ( $backfile =~ /backup_.*\.json/ && $days <= $age ) { + $self->verbose("Deleting '$backfile', it's older than $days days"); + unlink $backfile; + } + } + + $dir->close(); + } + + return undef; +} + +sub backup_path_json { + my ( $self, $path, $params, $json ) = @_; + + my $config = $self->{config}; + + if ( $config->{'dry'} ) { + $self->verbose( + "Dry mode, don't modify anything via API, backup irrelevant."); + return undef; + } + + return undef if $config->bool('backups.disable'); + + my $days = $config->get('backups.keep.days'); + my $location = $config->get('backups.dir'); + + unless ( -d $location ) { + $self->info("Creating '$location' for backups"); + $self->info("Backups older than $days days will be automatically deleted"); + mkdir $location; + } + + my $backfile = + $location . strftime( "/backup_%Y%m%d_%H%M%S_$path.json", localtime ); + + #$self->info("To rollback run: $0 post $path < $backfile"); + + my $fh = IO::File->new( $backfile, 'w' ); + $self->error("Could not open file $backfile for writing a backup") + unless defined $fh; + + unless ( defined $json ) { + $self->verbose("Retrieving data for backup"); + $json = $self->fetch_path_json( $path, $params ); + } + + print $fh $json; + + $fh->close(); + $self->backup_cleanup(); + + return undef; +} + +1; diff --git a/lib/MON/Syslogger.pm b/lib/MON/Syslogger.pm new file mode 100644 index 0000000..9292085 --- /dev/null +++ b/lib/MON/Syslogger.pm @@ -0,0 +1,77 @@ +package MON::Syslogger; + +use strict; +use warnings; +use v5.10; +use autodie; + +use Unix::Syslog qw(:macros :subs); +use Scalar::Util qw(looks_like_number); + +sub new { + my ( $class, %opts ) = @_; + + my $self = bless \%opts, $class; + + $self->init(); + + return $self; +} + +sub init { + my ($self) = @_; + + my $options = $self->{options}; + $options->store($self); + + if ( exists $self->{syslog} && $self->{syslog} ne '0' ) { + $self->{enable} = 1; + + } + elsif ( exists $ENV{MON_SYSLOG} && $ENV{MON_SYSLOG} ne '0' ) { + $self->{enable} = 1; + + } + else { + $self->{enable} = 0; + } + + return undef; +} + +sub logg { + my ( $self, $level, @msgs ) = @_; + + return undef unless $self->{enable}; + + openlog $0, LOG_PID, LOG_LOCAL0; + + s/\n/ /g for @msgs; + + given ($level) { + when ('debug') { + syslog LOG_DEBUG, $_ for @msgs; + } + when ('warning') { + syslog LOG_WARNING, $_ for @msgs; + } + when ('error') { + syslog LOG_ERR, $_ for @msgs; + } + when ('notice') { + syslog LOG_NOTICE, $_ for @msgs; + } + when ('info') { + syslog LOG_INFO, $_ for @msgs; + } + default { + $self->logg( 'info', @msgs ) + } + } + + closelog + + return undef; +} + +1; diff --git a/lib/MON/Utils.pm b/lib/MON/Utils.pm new file mode 100644 index 0000000..791af8e --- /dev/null +++ b/lib/MON/Utils.pm @@ -0,0 +1,80 @@ +package MON::Utils; + +use strict; +use warnings; +use v5.10; +use autodie; + +use Data::Dumper; +use Exporter; + +use base 'Exporter'; + +our @EXPORT = qw ( + d + dumper + get_version + isin + newline + notnull + null + remove_spaces + say + sum + trim +); + +sub say (@) { print "$_\n" for @_; return undef } +sub newline () { say ''; return undef } +sub sum (@) { my $sum = 0; $sum += $_ for @_; return $sum } +sub null ($) { defined $_[0] ? $_[0] : 0 } +sub notnull ($) { $_[0] != 0 ? $_[0] : 1 } +sub dumper (@) { die Dumper @_ } +sub d (@) { dumper @_ } + +sub isin ($@) { + my ( $elem, @list ) = @_; + + for (@list) { + return 1 if $_ eq $elem; + } + + return 0; +} + +sub trim ($) { + my $trimit = shift; + + $trimit =~ s/^[\s\t]+//; + $trimit =~ s/[\s\t]+$//; + + return $trimit; +} + +sub remove_spaces ($) { + my $str = shift; + + $str =~ s/[\s\t]//g; + + return $str; +} + +sub get_version () { + my $versionfile = do { + if ( -f '.version' ) { + '.version'; + } + else { + '/usr/share/mon/version'; + } + }; + + open my $fh, $versionfile or error("$!: $versionfile"); + my $version = <$fh>; + close $fh; + + chomp $version; + return $version; +} + +1; |
