#!/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 # 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); } $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; @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 2.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 () { print STDERR $_ if $VERBOSE; if (/^PING :(.*)$/i) { print IRC "PONG :$1\n"; } elsif ( /:$irc_server 001 \S* :(.*)$/i ) { 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); } last if (/^:$irc_server 365/i); } @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 = 10];\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 "\n"; print GRAPH "$network Connection Graph\n"; print GRAPH "\n"; print GRAPH "\n"; print GRAPH "\n"; print GRAPH "

$network Connection Graph

\n"; print GRAPH "Last updated ".scalar(localtime)." $timezone. \n"; print GRAPH "Plotted using net_map (in Perl) and graphviz\n"; print GRAPH "with \n"; my $g = $graph_file; $g =~ s|.*/||; my $gg = $graph_gif_file; $gg =~ s|.*/||; print GRAPH "neato.\n"; print GRAPH "

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

\n"; print GRAPH "

\n"; print GRAPH "\n"; print GRAPH "\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 = 10];\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 "\n"; print DIGRAPH "$network Connection Digraph\n"; print DIGRAPH "\n"; print DIGRAPH "\n"; print DIGRAPH "\n"; print DIGRAPH "

$network Connection Digraph

\n"; print DIGRAPH "Last updated ".scalar(localtime)." $timezone. \n"; print DIGRAPH "Plotted using net_map (in Perl) and graphviz\n"; print DIGRAPH "with\n"; my $g = $digraph_file; $g =~ s|.*/||; my $gg = $digraph_gif_file; $gg =~ s|.*/||; print DIGRAPH "dot.\n"; print DIGRAPH "

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

\n"; print DIGRAPH "

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