#!/usr/bin/perl

#
# kevin a. lenzo, based on original by Joshua Schachter
#
# to build the graph, get graphviz, and run this program.
# you can get graphviz from 
#
#      http://www.research.att.com/sw/tools/graphviz/index.html
#
# This has been heavily modified by W. Campbell
# wcampbel@botbay.net
#
# Incorporating code and ideas from zartik (dan@spot.org)
#

use Socket;
use POSIX qw(strftime);

# Adjust these for your system's paths
# It's best to use complete paths, as cron often does not
# include a complete set of paths
$neato = "/usr/local/bin/neato";
$dot = "/usr/local/bin/dot";

if ($ARGV[0])
{
  require $ARGV[0];
}
else
{
  print "Syntax:  net_map config.file\n";
  exit(1);
}

if ($PERSIST) {
	$pid = fork ();

	if ($pid == -1)
	{
	    exit (-1);
	}
	elsif ($pid == 0)
	{
	    # We're the child backgrounded process
	}
	else
	{
	    exit (0);
	}
}

$graph_file = "$map_root/current_graph";
$prior_time = strftime "%y%m%d%H%M", localtime ((stat $graph_file)[9]);
$save_graph = "$save_root/graph_$prior_time";
rename $graph_file, $save_graph;

$digraph_file = "$map_root/current_digraph";
$save_digraph = "$save_root/digraph_$prior_time";
rename $digraph_file, $save_digraph;

$nexttime = time(); # Now...

@colors = ("red", 
	   "PaleTurquoise", 
	   "DarkOrange", 
	   "DarkGreen",
	   "gold", 
	   "MidnightBlue", 
	   "DarkOrchid",

	   "black", "black", "black", "black",
	   "black", "black", "black", "black",
	   "black", "black", "black", "black",
	   "black", "black", "black", "black");

$| = 1 ;

$version    = "Network Mapper 3.0";

# $VERBOSE = 1;

$proto = getprotobyname('tcp');
socket(IRC, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";

if ($use_vhost) {
  $sockaddr = 'S n a4 x8';
  $this = pack($sockaddr, AF_INET,  0, inet_aton($vhost));
  bind(IRC, $this) || die "bind: $!";
}

$iaddr      = Socket::inet_aton($connect_to);
$paddr      = sockaddr_in ($port, $iaddr);

connect(IRC, $paddr) or die "connect: $!";

my $last = select IRC;
$| = 1;
select $last;

$login = getlogin || getpwuid($<) || "mapper";
$hostname = `hostname`;
chomp $hostname;

print IRC "USER $login $hostname $irc_server :research client\n";
print IRC "NICK $nickname\n";
sleep 1;

$i = 1;

while (<IRC>) {
    print STDERR $_ if $VERBOSE;

    if (/^PING :(.*)$/i) {
	print IRC "PONG :$1\n";
    } elsif ( /:$irc_server 001 \S* :(.*)$/i ) {
	# This handles the first connection
	print IRC "LINKS\n";
    } elsif (/^:$irc_server 364 $nickname (\S+) (\S+) (.*)/i) {
        $lserver{$1} = 1;
        $rserver{$2} = 1;
        $link{$1} = $2;
	$name = $1;
	$name2 = $2;
	$hops = $3;
	$hops =~ s/^:\s*//;
	$hops =~ s/\s+.*//;
	$hops{$name} = 0 + $hops;
	$maxhops = $hops if ($maxhops < $hops);
    } elsif (/^:$irc_server 365/i) {
	generate_graphs();
	if (! ($PERSIST)) {
		print IRC "QUIT :Mapping complete.\n";
		sleep(1);
		close(IRC);
		exit(0);
	}
    }

    # AFTER parsing, see if the nexttime has run out
    if (time() >= $nexttime) {
	print IRC "LINKS\n";
	$nexttime = time() + $timeval;
    }
}

sub generate_graphs
{
	@stars = grep /^\*/, keys %lserver;

	foreach $star (@stars) {
		($dom) = $star =~ /^\*\.(.*)$/i;
		@starmatch = grep /$dom$/, keys %rserver;
		if ((scalar @starmatch) == 1) {
                	$match = $starmatch[0];
                	$link{$match} = $link{$star};
                	delete $link{$star};
			$hops{$match} = $hops{$star};
			delete $hops{$star};
        	}
	}

	if ($graph_file) {
		open GRAPH, ">$graph_file" || die "can't make $graph_file: $!";
		print GRAPH "graph network {\n ";
		print GRAPH "\tnode [fontsize = 12];\n";

		foreach (sort { $hops{$a} <=> $hops{$b} } keys %hops) {
			print GRAPH "\t\"$_\" [color=$colors[$hops{$_}]];\n";
			print DIGRAPH "\t\"$_\" [color=$colors[$hops{$_}]];\n";
		}

		foreach (keys %link) {
			next unless $link{$_};
			next if $link{$_} eq $_;
			print GRAPH "\t\"$_\" -- \"$link{$_}\" [color=$colors[$hops{$_}]];\n";
		}

		print GRAPH "}\n";
		close GRAPH;

		if (-s $graph_file) {
			system "$neato -Tgif $graph_file > $graph_gif_file";

			if (-s $graph_gif_file) {
			    open GRAPH, ">$graph_html_file" or die "can't make $graph_html_file: $_\n";
			    print GRAPH "<HTML><HEAD>\n";
		    	    print GRAPH "<TITLE>$network Connection Graph</TITLE>\n";
			    print GRAPH "<META HTTP-EQUIV = \"Refresh\" CONTENT = \"3000; URL = $web_graph_html_file\">\n";
			    print GRAPH "</HEAD>\n";
			    print GRAPH "<BODY BGCOLOR=\"#FFFFFF\">\n";
			    print GRAPH "<h1>$network Connection Graph</h1>\n";
			    print GRAPH "Last updated ".scalar(localtime)." $timezone. \n";

			    print GRAPH "Plotted using <code>net_map</code> (in Perl) and  <a href=\"http://www.research.att.com/sw/tools/graphviz/index.html\">graphviz</a>\n";
			    print GRAPH "with \n";
			    my $g = $graph_file; $g =~ s|.*/||;
			    my $gg = $graph_gif_file; $gg =~ s|.*/||;
			    print GRAPH "<code>neato</code>.\n";

			    print GRAPH "<p>\n";
			    if ($digraph_file) {
				print GRAPH "See also the \n";
				print GRAPH "<a href = \"$web_digraph_html_file\">directed connection graph</a>.\n";
				print GRAPH "It is often more readable, as the nodes don't overlap, but can be larger.<br>\n";
			    }
			    print GRAPH "Colour indicates number of hops from $irc_server.\n";
			    print GRAPH "</p>\n";

			    print GRAPH "<hr>\n";
			    print GRAPH "<IMG SRC=\"$web_graph_gif_file\">\n";
			    print GRAPH "</BODY>\n"; 
			    print GRAPH "</HTML>\n";
			    close GRAPH;
			}
		}
	}

	if ($digraph_file) {
	    open DIGRAPH, ">$digraph_file" || die "can't make $digraph_file: $!";

	    print DIGRAPH "digraph network {\n ";
	    print DIGRAPH "\tnode [fontsize = 12];\n";

	    foreach (sort { $hops{$a} <=> $hops{$b} } keys %hops) {
		print DIGRAPH "\t\"$_\" [color=$colors[$hops{$_}]];\n";
	    }

	    foreach (keys %link) {
		next unless $link{$_};
		next if $link{$_} eq $_;
		print DIGRAPH "\t\"$link{$_}\" -> \"$_\" [color=$colors[$hops{$_}],dir = both];\n";
	    }
	    print DIGRAPH "}\n";
	    close DIGRAPH;

	    if (-s $digraph_file) {
		system "$dot -Tgif $digraph_file > $digraph_gif_file";

		if (-s $digraph_gif_file) {
		    open DIGRAPH, ">$digraph_html_file" or die "can't make $digraph_html_file: $_\n";
		    print DIGRAPH "<HEAD>\n";
		    print DIGRAPH "<TITLE>$network Connection Digraph</TITLE>\n";
		    print DIGRAPH "<META HTTP-EQUIV = \"Refresh\" CONTENT = \"3000; URL = $web_graph_html_file\">\n";
		    print DIGRAPH "</HEAD>\n";
		    print DIGRAPH "<BODY BGCOLOR=\"#FFFFFF\">\n";
		    print DIGRAPH "<h1>$network Connection Digraph</h1>\n";
		    print DIGRAPH "Last updated ".scalar(localtime)." $timezone. \n";

		    print DIGRAPH "Plotted using <code>net_map</code> (in Perl) and  <a href=\"http://www.research.att.com/sw/tools/graphviz/index.html\">graphviz</a>\n";
		    print DIGRAPH "with\n";
		    my $g = $digraph_file; $g =~ s|.*/||;
		    my $gg = $digraph_gif_file; $gg =~ s|.*/||;
		    print DIGRAPH "<code>dot</code>.\n";

		    print DIGRAPH "<p>\n";
		    if ($graph_file) {
			print DIGRAPH "See also the \n";
			print DIGRAPH "<a href = \"$web_graph_html_file\">undirected connection graph</a>.\n";
			print DIGRAPH "It is often more compact, but some nodes may overlap.<br>\n";
		    }
		    print DIGRAPH "Color indicates number of hops from $irc_server.\n";
		    print DIGRAPH "</p>\n";

		    print DIGRAPH "<hr>\n";
		    print DIGRAPH "<IMG SRC=\"$web_digraph_gif_file\">\n";
		    print DIGRAPH "</BODY>\n";
		    print DIGRAPH "</HTML>\n";
		    close DIGRAPH;
		}
	    }
	}
}

print IRC "QUIT :Mapping complete.\n";
exit(0);