#!/usr/bin/perl
#
# ircmapS.pl - v2.0pre2
#
# Make a pretty image with tree of some IRC network
#
# This one will get dump of all links around whole IRC network from an IRC
# server and output them in format:
# M <mask> <root> [<note>]
# S <server> <sname>
# U <server> <local_usercount>
# A <server> <257>"""<258>"""<259>
# L <mask> <from> <to>
# X <key> <val>
#
# X is a hash - current valid keys are 'time.start' and 'time.end'
#
# (c) Petr Baudis <pasky@pasky.ji.cz> 2001, 2002
#
# Other authors: yanek <janek@isse.lipniknb.cz>
#        Thanks: ZZyZZ, jv, pht
#
# No warranty, and so on... distributed under GPL.
# Get it on http://pasky.ji.cz/~pasky/irc
#
# You need to have (as with a lot of my other scripts) IHash.pm
# (case-insensitive hash support) module also now. Please download it at
# http://pasky.ji.cz/~pasky/cp/IHash.pm.
#


###############################################################################
#
# Defaults:
#
## Connection
$remote = "pasky.ji.cz";
$port = "6667";

## Superverbose?
$v = 1;

## Oper'ed?
$opuser = "";
$oppass = "";

$ident = "mapper";

## Detailed? (U && A) (tested only when script is oper'ed)
$details = 1;

use lib "/home/pasky/ircmap";
	      # replace with the dir where you've IHash.pm (http://pasky.ji.cz/~pasky/cp/IHash.pm)

###############################################################################
#
# If you are not interested in code itself, you should stop here.
#
###############################################################################
#
# Details:
#
$ve="2.0pre3";
$ver="ircmapS-$ve";

use Socket;
use IO::Handle;
use IHash;

#
# Usage?
#

while ($switch = shift) {
  
  if ($switch eq '-s') {
    $remote = shift;
    
  } elsif ($switch eq '-p') {
    $port = shift;
    
  } elsif ($switch eq '-o') {
    $opuser = shift;
    $oppass = shift;

  } elsif ($switch eq '-d') {
    $details = 1;
    
  } elsif ($switch eq '-h') {
    print <<EOT;
$ver (c) Petr Baudis <pasky\@ji.cz> 2001,2002 - maps irc network
Usage: $0 [-s <server>] [-p <port>] [-o <user> <pass>] [-d] [-h]

-s	Name of the server to connect to
-p	Port of the server to connect to
-o	User/pass of operator, if you want to oper the script
-d	Details (lusers and admin)
-h	This help

Any comments or bug reports please send at <pasky\@ji.cz>.
EOT
    exit;
  }
}

#
# Socket magic
#

print STDERR "Casting 'connect' spell...\n" if ($v);

my $SOCK = IO::Handle->new();
$SOCK->autoflush(1);
$|=1;

$iaddr = inet_aton($remote) || die "Server not found: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');

socket($SOCK, PF_INET, SOCK_STREAM, $proto) || die "Cannot create socket: $!";
connect($SOCK, $paddr) || die "Cannoct connect: $!";

#
# Introduce us
#

print STDERR "Focusing magical energies to login...\n" if ($v);

rand_nick();

print $SOCK "USER $ident 0 0 :IRC network map generator\015\012";
print $SOCK "NICK $nick\015\012";

#
# Log in
#

while (defined($IN = <$SOCK>)) {
  chomp($IN);
  @input = split(/ /, $IN);
  
  # PING
  if ($input[0] eq "PING") {
    print $SOCK "PONG $input[1]\015\012";
    
  # NUMERIC
  } elsif ($input[1] =~ /^\d{3}$/) {
  
    # NICK ALREADY IN USE
    if ($input[1] == 433) {
      rand_nick();
      print $SOCK "NICK $nick\015\012";

    # END OF MOTD
    } elsif ($input[1] == 376) {
      print $SOCK "OPER $opuser $oppass\015\012" if ($opuser and $oppass);
      # print $SOCK "JOIN #debug\015\012";
      # print $SOCK "PRIVMSG #debug :map on ($ve:$remote/$port)\015\012";
      last;
    }
  }
}

#
# Start scanning
#

print STDERR "Draining mana reserves, starting scanning...\n" if ($v);

$X{"time.start"} = localtime();

#
# Walk thru the whole tree, unmask them all!
#

tie (%servername, "IHash");

@masks = qw(*);

for($msk = 0; $msk < @masks; $msk++) {
  $mask = $masks[$msk];

  print STDERR "Checking out mask $mask...\n" if ($v);
  
  $maps{$mask} = scan_links($mask);

  # have a rest
#  sleep(15);
}

#
# Check additional informations
#

if ($details) {
  tie (%admin, "IHash");
  tie (%users, "IHash");
  
  print STDERR "Checking out additional informations...\n" if ($v);
  
  foreach (keys %servername) {
    next if (/\*/);

    debugmsg("Check $_\n");
    
    print $SOCK "ADMIN $_\015\012";
    print $SOCK "LUSERS * $_\015\012";
 
#:irc.uhk.cz 257 `t :Fakulta Rizeni a Informacnich Technologii University Hradce Kralove
#:irc.uhk.cz 258 `t :Hradec Kralove, Czech Republic
#:irc.uhk.cz 259 `t :Administration team <irc@irc.uhk.cz>

#:irc.uhk.cz 251 `t :There are 101305 users and 7 services on 50 servers
#:irc.uhk.cz 252 `t 175 :operators online
#:irc.uhk.cz 253 `t 11 :unknown connections
#:irc.uhk.cz 254 `t 45227 :channels formed
#:irc.uhk.cz 255 `t :I have 363 users, 1 services and 1 servers
#:irc.uhk.cz 265 `t :Current local users: 363  Max: 634
#:irc.uhk.cz 266 `t :Current global users: 101305  Max: 112685
   
    while (defined($IN = <$SOCK>)) {
      chop($IN);
      chop($IN);
      
      @input = split(/ /, $IN);
      
      debugmsg("got input - @input");
      
      # PING
      if ($input[0] eq 'PING') {
	print $SOCK "PONG $input[1]\015\012";
	$tree->{"!note"} = "lagged";
	last;

      # ADMIN
      } elsif ($input[1] eq '257' or $input[1] eq '258' or $input[1] eq '259') {

	shift(@input);
	shift(@input);
	shift(@input);
	$input = join(' ', @input);
	$input =~ s/^://;
        $admin{$_} .= '"""' if ($admin{$_});
	$admin{$_} .= $input;
	debugmsg("Admin $admin{$_}\n");

      # LUSERS
      } elsif ($input[1] eq '255') {

	shift(@input);
	shift(@input);
	shift(@input);
	$input = join(' ', @input);
	$input =~ s/^://;
	$input =~ /^.*?(\d+) use.*$/;
	$input =~ /^.*?(\d+) cli.*$/ unless ($1);
	$users{$_} = $1;
	debugmsg("Users $input -> $1 -> $users{$_}\n");
	last;

      # NOT FOUND
      } elsif ($input[1] eq '402') {
	$tree->{"!note"} = "split";
	last;

      # TRY AGAIN
      } elsif ($input[1] eq '263') {
        sleep 1;#5;
	if ($admin{$_}) {
	  print $SOCK "LUSERS * $_\015\012";
	} else {
	  print $SOCK "ADMIN $_\015\012";
	}

      # eek?
      } else {
	debugmsg("got unknown from server - $IN");
      }
    }
  }
}

#
# Finalize our dialogue with server
#

$X{"time.end"} = localtime();

print STDERR "Telling Ta Ta to the server...\n" if ($v);

# print $SOCK "PRIVMSG #debug :map off ($time_start - $time_end)\015\012";
print $SOCK "QUIT :$ver\015\012";
close ($SOCK) || die "Cannot close socket: $!";

#
# Dump the results
#

print STDERR "Dumping the results...\n" if ($v);

foreach (keys %servername) {
  next if (/\*/);

  print "S ".$_." ".$servername{$_}."\n";
}

if ($details) {
  foreach (keys %admin) {
    print "A ".$_." ".$admin{$_}."\n";
  }

  foreach (keys %users) {
    print "U ".$_." ".$users{$_}."\n";
  }
}

foreach (@masks) {
  print "M ".$_." ".$maps{$_}->{"!root"}." ".$maps{$_}->{"!note"}."\n";

  $m = $_;
  
  foreach (%{$maps{$m}}) {
    next if (/!/);

    $s = $_;

    foreach (@{$maps{$m}->{$s}}) {
      print "L ".$m." ".$s." ".$_."\n";
    }
  }
}

foreach (keys %X) {
  print "X ".$_." ".$X{$_}."\n";
}

#
# Main program ends here
#
###############################################################################
#
# Now support functions follow
#

sub debugmsg {
  my($msg);

  print STDERR @_, "\n" if (0);
}

###############################################################################
#
# Generate a random nick
# @_: -nothing-
# uses (== writes to) the global variable $nick
#

sub rand_nick {
  $nick = 'q';
  for ($i = 1; $i < 9; $i++) { $nick .= chr(65 + rand(31)); }
}

###############################################################################
#
# Scan the server's links
# @_: -nothing-
# returns hash with tree as seen from given mask
#

sub scan_links {
  my (@input, $IN, $remask, $rm, $tree);

  tie (%{$tree}, "IHash");
  
  # XXX: undernet workaround
  if ($mask eq '*') {
    $lmask = "";
  } else {
    $lmask = $mask;
  }
  
  debugmsg("LINKS $lmask *");
  
  print $SOCK "LINKS $lmask *\015\012";
  
  while (defined($IN = <$SOCK>)) {
    chomp($IN);
    
    @input = split(/ /, $IN);
    
    debugmsg("got input - @input");
    
    # PING
    if ($input[0] eq 'PING') {
      print $SOCK "PONG $input[1]\015\012";
      $tree->{"!note"} = "lagged"; last;

    # LINKS
    } elsif ($input[1] eq '364') {
    
      if ($input[5] eq ":0") {
	$tree->{"!root"} = $input[3];

      } else {
	push(@masks, $input[3])
	  if ($input[3] =~ /\*\./ and !(member($input[3], @masks) + 1));
	
	push(@{$tree->{$input[4]}}, $input[3]);
      }

      $servername{$input[3]} = join(" ", splice(@input, 6));
      $servername{$input[3]} =~ s/\r//g;

    # TRY AGAIN
    } elsif ($input[1] eq '263') {
      sleep 15;
      print $SOCK "LINKS $mask *\015\012";

    # NOT FOUND
    } elsif ($input[1] eq '402') {
      $tree->{"!note"} = "split";
      last;

    # END OF LINKS
    } elsif ($input[1] eq '365') {
      last;

    # eek?
    } else {
      debugmsg("got unknown from server - $IN");
    }
  }

  return $tree;
}

###############################################################################
#
# member of an array?
#

sub member {
  my($pos, $f);
  $f=shift;
  
  for ($pos=0; $pos<@_; $pos++) {
    if (uc($_[$pos]) eq uc($f)) {
      return $pos;
    }
  }
  
  debugmsg("-- $f not a member of @_");
  
  return -1;
}

###############################################################################
#
# No more interesting stuff :-(r)
#