# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-02 11:06 (EST)
# Function: misc code
#
# $Id: misc.pl,v 1.4 2005/02/06 21:05:13 jaw Exp $

use Socket;
BEGIN{ eval{ require Socket6; import Socket6; $HAVE_S6 = 1; }}
use Fcntl qw(:flock);

# My lord the emperor, resolve me this:
#  -- Shakespeare, Titus Andronicus
# memoized gethostbyname
my %resolve = ();
sub resolve {
    my $a = shift;
    my( $opt, $ip, @o );

    # skip DNS lookups if only checking the config file (-t)
    # but do the lookup under more checking (-T)
    return "addr" if $::opt_t && !$::opt_T;
    $a =~ s/\s+/ /g;
    
    # since we often monitor several things per host, we tend to lookup
    # each host many times, we use a cache to speed things up
    return $resolve{$a} if( $resolve{$a} );

    # undocumented feature: '-4 www.example.com', '-6 www.example.com'
    if( $a =~ /^-(\S+)\s(.*)/ ){
	$opt = $1;
	$a   = $2;
    }
    $opt ||= '46';
    
    if( $a =~ /^\d+\.\d+\.\d+\.\d+$/ ){
	$ip = inet_aton( $a );
    }elsif( $a =~ /^[a-f\d:]+$/i && $HAVE_S6 ){
	$ip = inet_pton(AF_INET6, $a);
    }elsif( $HAVE_S6 ){
	for (0 .. 1){
	    # 1st look for a v6 addr, then v4
	    $ip   = gethostbyname2($a, AF_INET6) if $opt =~ /6/;
	    $ip ||= gethostbyname2($a, AF_INET)  if $opt =~ /4/;
	    last if length($ip) != 0;
	    sleep 1;
	}
    }else{
	for (0 .. 1){
	    $ip = gethostbyname($a);
	    last if length($ip) != 0;
	    # if the lookup fails, we briefly pause and try again
	    # this takes care of slow DNS servers or transient errors
            sleep 1;
        }
    }

    $resolve{$a} = $ip;
    $ip;
}

sub xxx_inet_ntoa {
    my $n = shift;

    return inet_ntoa($n) if length($n) == 4;
    return undef unless $HAVE_S6;
    return inet_ntop(AF_INET6, $n) if length($n) == 16;
    
    "X.X.X.X";
}

sub ckbool {
    my $v = shift;

    ($v =~ /yes|true|on|1/i) ? 1 : 0;
}


# And these does she apply for warnings, and portents,
# And evils imminent; and on her knee
#  -- Shakespeare, Julius Ceasar
sub warning {
    my $msg = shift;

    loggit( $msg, 1 );
}

sub xxx_openlog {

    return if $opt_t;
    
    if( $Conf::Config{syslog} ){

	$ENV{ARGUS_SYSLOG} = $Conf::Config{syslog};
	# ver 3 (5.8.0) will iterate @connectmethods
	if( $Sys::Syslog::VERSION < 0.03 ){
	    eval {
		setlogsock( 'unix' );
	    };
	}
	eval {
	    # this is broken in 5.6.0, at least on Linux
	    openlog( $NAME, 'pid ndelay', $Conf::Config{syslog} );
	    loggit( "syslog configured: $Conf::Config{syslog}" );
	};
	if( $@ ){
	    if( $] == 5.006 ){
		loggit( "syslog open failed - due to bug in perl 5.6.0", 1 );
	    }else{
		loggit( "syslog open failed - $@", 1 );
	    }
	}
    }
}

# And there was found at Achmetha, in the palace that is in the province
# of the Medes, a roll, and therein was a record thus written:
#   -- ezra 6:2
sub loggit {
    my $msg = shift;
    my $lfp = shift;	# also put in datadir/log
    my( $date, @d );

    # When they had thrown down their great logs of wood over the whole ground
    #   -- Homer, Iliad
    @d = localtime;
    $date = sprintf "%d/%d/%d %d:%0.2d:%0.2d",
        $d[5]+1900, $d[4]+1, $d[3], $d[2], $d[1], $d[0];

    eval {
	syslog( 'info', $msg )  if $Conf::Config{syslog};
    };
    print STDERR "[$date] $msg\n" if $opt_f;
    
    Control::console( $msg );
    if( $lfp && $datadir && !$Conf::Config{_test_mode} ){
	if( open  LOG, ">> $datadir/log" ){
	    print LOG "[$date] [$$] $msg\n";
	    close LOG;
	}else{
	    loggit( "open log failed: $!", 0 );
	}
    }

    undef;
}

# It is a good shrubbery.  I like the laurels particularly.
# But there is one small problem--
#   -- Monty Python, Holy Grail
sub sysproblem {
    my $msg = shift;

    warning( $msg );
}

# The greatest efforts of the race have always been traceable to the love
# of praise, as its greatest catastrophes to the love of pleasure.
#   -- John Ruskin, Sesame and Lilies
sub trace {

    for my $i (0..6){
	print STDERR "trace: ", join(", ", caller($i)), "\n" if caller($i);
    }
    print STDERR "----\n";
}

# Once upon a weekend weary, while I pondered, beat and bleary,
# Over many a faintly printed hexadecimal dump of core --
# While I nodded, nearly napping, suddenly there came a tapping,
# As of some Source user chatting, chatting of some Mavenlore.
# "Just a power glitch," I muttered, "printing out an underscore --
# 		  Just a glitch and nothing more."
#   -- the Dragon, The Maven
sub hexdump {
    my $b = shift;
    my( $l, $t );

    while( $b ){
	$t = $l = substr($b, 0, 16);
	substr($b, 0, 15) = '';
	$l =~ s/(.)/sprintf('%0.2X ',ord($1))/ges;
	$t =~ s/\W/./gs;
	print STDERR "    $l\n";
    }
}

sub hexstr {
    my $b = shift;

    $b =~ s/(.)/sprintf('%0.2X ',ord($1))/ges;
    $b;
}


1;
