#!/usr/bin/perl

# storeclient
# 
# Monitor the incoming client stream and store the last-received message in
# separate files for each host/section. I recommend a tmpfs be used for this.
# 
# Note that empty sections will result in 0-byte files, however *missing*
# sections will result in existing files not being overwritten. When 
# forensically analyzying data, runing an "ls -l" in the host directory
# may be helpful.
# 
# You should clean stale files from the /var/lib/xymon/client/ tree
# regularly via cron: find -mtime +1 /var/lib/xymon/client/ -delete
# 
# 
# [storeclient]
#	ENVFILE /etc/xymon/xymonserver.cfg
#	NEEDS xymond
#	CMD xymond_channel --channel=client /path/to/storeclient
#	LOGFILE $XYMONSERVERLOGS/storeclient.log

#
# Copyright Japheth Cleaver <cleaver-xymon@terabithia.org>
# Licensed under GPLv2
# 

#######################################################################
use strict;
use warnings;
use Fcntl;

use constant {
	DEBUG => $ENV{DEBUG} || 0,
	ROOTDIR => '/var/lib/xymon/client/',
};



# Only needed in really HUGE installations (>200Mbps incoming client data)
# Requires patched perl-PerlIO-buffersize RPM 0.001-2 to work -jc
# See: https://github.com/Leont/perlio-buffersize/issues/1

# binmode(STDIN, ":buffersize(65536)");



#######################################################################

# Loop the loop -- not really needed in this script, but in others that
# are reading from channel messages and creating more messages, we try to
# combine the generated messages together into "combo" messages
COMBO: do {

 # Clear these variables every once in a while...
 my (@messageInfo, $statusLine, $messagePayload, $msgtype, $msgnum);	# before accepting
 my ($hostnameCommafied, $host, $logtime, $serverDir);			# at start of processing
 my ($sect, $data, $savechar);							# message data

# input separator is a newline here -- loop forever, we'll manually 'last' when our combo set is done

  MESSAGE: while (<STDIN>) {

    DEBUG > 1 and print('saw: ', $_);
    $_ eq "\n" ? next : index($_, '@@', 0) != 0 ? next : chomp;


  # First line is our metadata
    @messageInfo = split (m/\|/, $_);

  # Next line is the first raw message line the client sent
    $statusLine = <STDIN>;


  # Now, '@@' is our delimiter for the end of the message body
  # Keep accepting data until we get '@@' in it (it's possible we simply read
  # until the end of that buffer and there's more to come the next time we <STDIN>
    $messagePayload='';
    do {
        local $/="\n@@";
        chomp ($messagePayload = <STDIN>);
    };


  # This would be a great area to handle special commands (see xymond_sample.c source)
    die "** xymond_channel is going away, so we are too **\n" if index($messageInfo[0], '@@shutdown', 0) == 0;
    do { warn "Non-channel message seen\n"; next MESSAGE } unless index($messageInfo[0], '@@client', 0) == 0;

  # Sanity check, making sure the metadata was usefully parsed
    next MESSAGE unless ($host = $messageInfo[3]);

    DEBUG > 2 and print "* ",
	  "\n* Valid Message Found:\n", $statusLine, 
	  "\n==Message Payload Begins==\n", $messagePayload, 
	  "==Message Payload Ends==\n";


  # Make sure this host has a directory
    die "Unsafe hostname '$host' found; won't create server dir!\nFirst line:\n@messageInfo" unless (index ($host, '..') == -1 && $host =~ m/^[\w._-]+$/);

    $serverDir = ROOTDIR . $host . '/';
    -d $serverDir or
	do { system {'/bin/mkdir'} ('/bin/mkdir', '-p', $serverDir); -d $serverDir; } or
	die "Can't mkdir '$serverDir', so exiting: $!";

 

#########################################################################################
  # Handle each incoming client message
#########################################################################################

  # Add spurious '[' at the end and position ourselves at the start of
  # a client section name to make the following regex more efficient.
  $messagePayload .= "\n[";
  pos($messagePayload) = index($messagePayload, '[') + 1;

  # Search the string for each subsequent "section]" marker
  while ($messagePayload =~ m#\G(.+?)\]\s*?(.*?\n)\[#gms) {
    $sect = $1; $data = $2;

    # We don't need to do too much more sanity checking than this
    $sect =~ s#/#_#g;		
    die "Unsafe client section $sect found for $host" unless index ($sect, '..') == -1;

    # The regex catches the initial "\n" after the '[label]' if the section 
    # is blank. This is a feature not a bug because it allows us to capture 
    # empty sections:
    #	[sect1]
    #	[sect2]
    #	data....
    #
    # ...which otherwise would be wrongly parsed. The Problem is that now we 
    # start everything with a spurious newline. Use substr to efficiently 
    # "pre-chomp" the string. This will leave the data as the empty string 
    # if all it did consist of was that newline, but that's okay. 
    # At least we're writing the file out properly now.

    $savechar = substr($data, 0, 1, '');

    # If someone sent "[section]Foobar\n[section2]" then we just dropped data
    warn "Stripped a non-whitespace character prepend in $serverDir$sect: $savechar" unless $savechar eq "\n" || $savechar eq "\t";

    # Don't write files out in high debug
    DEBUG > 1 and print "$host would write $serverDir$sect\n" and next;

    # Don't buffer; we're just writing a single scalar variable
    # open (FILE, '>', $serverDir . $sect) or do {
    #    warn "Can't open $serverDir$sect: $!\n"; next MESSAGE; };
    # print FILE $data;

    sysopen (FILE, $serverDir . $sect, O_WRONLY | O_TRUNC | O_CREAT) or do {
        warn "Can't open $serverDir$sect: $!\n"; next MESSAGE; };
    syswrite FILE, $data;	# not print... that's buffered
    close FILE;
    DEBUG and print "Written to $serverDir$sect, ", length $data, " bytes\n";

  };


  }; # end MESSAGE loop

} while ! eof STDIN; #end ComboMessageLoop


print ">> STDIN closed; $0 quitting <<\n";
exit 0;