#!/usr/perl5/bin/perl -w
#
# Copyright 2002 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident	"@(#)autodiscover.pl	1.16	02/11/12 SMI"
#
# Transport autodiscovery code

require 5.005;
use strict;
use Socket;
use IO::Handle;
use Sys::Hostname;
use Fcntl;
use POSIX;

if ($#ARGV < 0) {
    print STDERR "usage: autodiscover.pl port\n";
    exit 1;
}

my (@interfaces);
my ($ifconf, $public) = (1, 2); # Flags

my (%ifinfo, %ifflags, %snoophandle);

&do_autodiscover();

# Fork a process to do autodiscovery; the parent just returns
# Nothing happens if autodiscovery is already running
sub do_autodiscover {
    if (-e "/usr/cluster/bin" && ! -e "/tmp/test_autodiscover") {
	# Clustering already installed
	# To test autodiscover,  create test_autodiscover to force run

	# Clean up autodiscover file if created during install
	unlink "/var/cluster/spm/autodiscover";
	return 1;
    }

    if (-e "/var/cluster/spm/autodiscover") {
	# Already have autodiscovery information
	return 1;
    }

    my ($pid) = fork;
    if ($pid) {
	wait;
	# Parent
	return 1;
    }

    # Close all file descriptors so we don't confuse caller
    for (my $i = 0; $i < 255; $i++) {
	POSIX::close($i);
    }

    # Set up fds 0, 1, 2 so forked snoops won't hit SIGPIPE
    open(IN, "</dev/null"); # fd 0
    open(OUT, ">/dev/console"); # fd 1
    open(ERR, ">/dev/console"); # fd 2

    # Create output file
    system("mkdir -p /var/cluster/spm");
    open(OUTFILE, ">/var/cluster/spm/autodiscover");
    system("/bin/chown spmadmin /var/cluster/spm/autodiscover");

    setpgrp(0, $$); # Disassociate from parent's group
    $pid = fork;
    if ($pid) {
	# Child
	CORE::exit; # Avoid zombies
    } else {
	$pid = fork;
	if ($pid) {
	    # Grandchild
	    &check_ifaces();
	    CORE::exit;
	} else {
	    # Great-grandchild
	    &udploop();
	    CORE::exit;
	}
    }
    # Unexecuted, avoid variable used only once warning.
    close(IN);
    close(OUT);
    close(ERR);
}

# Check the interfaces to see which are public
sub check_ifaces {
    close(STDERR);
    open(STDERR, ">/dev/null");

    my ($iaddr, $proto, $paddr);

    $SIG{INT} = \&catch_int;

    my ($hostname) = `hostname`;
    chop $hostname;

    my ($hostip, $rin, $if);
    $hostip = inet_ntoa(inet_aton($hostname));

    @interfaces = &get_interfaces();
    foreach my $i (@interfaces) {
	$ifflags{$i} = 0;
    }

    &parseifconfig(\%ifflags);

    $rin = '';
    my (%ifaddr);

    foreach $if (@interfaces) {
	$snoophandle{$if} = &opensnoop($if);

	vec($rin, fileno($snoophandle{$if}), 1) = 1;
    }

    my ($starttime) = time;

    while ((time - $starttime) < 8) {
	my ($rout, $eout);

	if (select($rout = $rin, undef, $eout = $rin, 1) > 0) {
	    my $if;
	    foreach $if (keys %snoophandle) {
		if (vec($eout, fileno($snoophandle{$if}), 1)) {
		    print STDERR "Error from snoop $if\n";
		}
		if (vec($rout, fileno($snoophandle{$if}), 1)) {
		    &readsnoop($if);
		}
	    }
	}
    }

    &dumpifinfo();

    &closechildren();

    close(OUTFILE);
}

# Return all interfaces
sub get_interfaces {
    my (@interfaces);

    @interfaces = `awk '{print \$3 \$2}' /etc/path_to_inst | tr -d \\" | egrep -e 'hme|qfe|ge|eri|ce|bge'`;

    for (my $i=0; $i<=$#interfaces; $i++) {
	chomp $interfaces[$i];
    }

    return sort @interfaces;
}

# Open snoop on the specified interface
sub opensnoop {
    my ($if) = @_;
    my ($socket) = IO::Handle->new();
    open($socket, "snoop -d $if |") || die "snoop";
    my ($old_fh) = select($socket); $| = 1; select($old_fh);
    return $socket
}

# Parse output of ifconfig -a
# Set the hash ifflags->{if} to $ifconf
sub parseifconfig {
    my ($ifflags) = @_;
    my ($if) ="";
    open(IN, "ifconfig -a|") || die "ifconfig -a";
    while (<IN>) {
	if (/^\s+/) {
	} elsif (/([a-z0-9]*:\d+):.*\bUP\b/) {
	    $if = $1;
	    $ifflags->{$if} |= $ifconf;
	    print STDERR "ifconfig found $if\n";
	} elsif (/([a-z0-9]*):\s+.*\bUP\b/) {
	    $if = $1;
	    $ifflags->{$if} |= $ifconf;
	    print STDERR "ifconfig found $if\n";
	}
    }
}

# Read input lines from snoop
sub readsnoop {
    my ($if) = @_;
    my ($addr, $buf);
    $addr = sysread($snoophandle{$if}, $buf, 10000);
    my ($port) = 0;
    while (defined $buf) {
	my ($line);
	($line, $buf) = split(/\n/, $buf, 2);
	if ( (!(defined $line)) ||
		($line eq "" && (defined $buf) && $buf eq "")) {
	    last;
	}
	if ($line =~ /^\s*(\S+) -> (\S+)\s+([^\(]*)/) { #)
	    # sender -> recipient type msg
	    my ($src, $dst, $type) = ($1, $2, $3);
	    $type =~ s/\s+$//;
	    $ifflags{$if} |= $public;
	    print STDERR "Snoop found $line for $if\n";
	}
    }
}

sub dumpifinfo {
    my ($if);
    foreach $if (@interfaces) {
	print OUTFILE "$if $ifflags{$if}\n";
    }
}

# Close the snoop children
sub closechildren {
    my ($if);

    # Kill the snoop children
    system("/usr/bin/pkill -KILL -g 0 snoop");

    foreach $if (keys %snoophandle) {
	close($snoophandle{$if});
    }
}

sub catch_int {
    &closechildren();
    die "Signal received";
}

1;

# Loop for udp requests for our name
sub udploop {
    my ($port) = $ARGV[0];
    my ($addr) = INADDR_ANY;
    my $buf;
    my ($hostname) = `hostname`;
    chop $hostname;

    socket(S, PF_INET, SOCK_DGRAM, getprotobyname('udp')) || die("socket $!");
    my ($sin);
    $sin = sockaddr_in($port, inet_aton($addr));
    bind(S, $sin) || CORE::exit; # If error, probably already running
    while (1) {
	my ($recvaddr);
	$recvaddr = recv(S, $buf, 1000, 0) || die("Recv $!");
	my ($recvport, $addr) = sockaddr_in($recvaddr);
	$addr = inet_ntoa($addr);
	send(S, $hostname, 0, $recvaddr) || die("send $!");
    }
}
