#!/usr/local/bin/perl
#
# $Id: MytoborIRC.pl,v 1.1 2007/05/01 13:56:17 rdilley Exp rdilley $
#
# author: ron dilley
#
# desc: this perl script is a false IRC server that uninstalls Mytobor.e
#
# Copyright (C) 2007  Ron A. Dilley
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; version 2
# of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# ron.dilley@uberadmin.com
#
############################################################################

#
# modules
#
use Getopt::Std;
use Sys::Syslog;
use Socket;
use POSIX "sys_wait_h";
use POSIX;
use FileHandle;
use Fcntl;
use Time::Local;

#
# pragmas
#
use strict;

#
# set environment
#
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin:/sbin:/usr/ucb";

#
# turn on autoflush
#
select STDERR; $| = 1;
select STDOUT; $| = 1;

#
# defines
#
$::TRUE = 1;
$::FALSE = 0;
$::FAILED = -1;

$::VERSION = '$Id: MytoborIRC.pl,v 1.1 2007/05/01 13:56:17 rdilley Exp rdilley $';
$::PROGNAME = "MytoborIRC.pl";

%::Config = ();
$::Config{'debug'} = $::FALSE;
$::Config{'srv_addr'} = "127.0.0.1";
$::Config{'srv_port'} = "6667";
$::Config{'protocol'} = getprotobyname( 'tcp' );
#
# main routine
#
if ( &main() != $::TRUE ) {
  exit( 1 );
}

exit( 0 );

############################################################################
#
# sub-routines
#

#
# main routine
#
sub main {
  my $arg;

  #
  # display script banner
  #
  &show_banner();

  #
  # parse command-line
  #
  &parse_command_line();

  # process args that are left
  if ( scalar( @::ARGV ) > 0 ) {
    while( $arg = shift( @::ARGV ) ) {
      # do something
    }
  }

  # get to work
  &listenForClients();

  # done
  return $::TRUE;
}

#
# display banner info
#
sub show_banner {
  print STDERR "$::VERSION\n";
  print STDERR "By: Ron Dilley\n";
  print STDERR "\n";
  print STDERR "$::PROGNAME comes with ABSOLUTELY NO WARRANTY.\n";
  print STDERR "This is free software, and you are welcome\n";
  print STDERR "to redistribute it under certain conditions;\n";
  print STDERR "See the GNU General Public License for details.\n";
  print STDERR "\n";

  return $::TRUE;
}

#
# display help info
#
sub show_help {
  print STDERR "Syntax:\n";
  print STDERR "\n";
  print STDERR "$::PROGNAME [options] {file} [{file} ...]\n";
  print STDERR "\n";
  print STDERR "-d {0-9}   Display debug information during program run\n";
  print STDERR "-p {num}   Override default IRC server port \($::Config{'srv_port'}\)\n";
  print STDERR "-n         Initiate a network scan (pending)\n";
  print STDERR "-s         Turn on the sniffer (pending)\n";
  print STDERR "-k         Turn on keylogger (pending)\n";
  print STDERR "\n";

  return $::TRUE;
}

#
# parse command-line arguments
#
sub parse_command_line {
  no strict 'vars';

  if ( getopts( 'd:p:snkv:' ) == $::FALSE ) {
    &show_help();
    return $::FAILED;
  }
  if ( defined $opt_d ) {
    if ( $opt_d > 0 ) {
      # set debug mode
      $::Config{'debug'} = $opt_d;
    }
  }
  if ( defined $opt_p ) {
    if ( $opt_p > 0 ) {
      # set port
      $::Config{'srv_port'} = $opt_p;
    }
  }
  if ( defined $opt_v ) {
    if ( length( $opt_v ) > 0 ) {
      # set port
      $::Config{'visitHttp'} = $opt_v;
    }
  }
  if ( defined $opt_n ) {
    # enable scanning
    $::Config{'scan'} = $opt_n;
  }
  if ( defined $opt_s ) {
    # enable sniffing
    $::Config{'sniff'} = $opt_s;
  }
  if ( defined $opt_k ) {
    # enable keylogger
    $::Config{'keylog'} = $opt_k;
  }

  return $::TRUE;
}


#
# listen for client connections
#
sub listenForClients {
  my $in_p_addr;
  my $line;
  my $child_pid;
  my $nick;
  my $channel;
  my $user;
  my $serverName;
  my $victimChannel;
  my $victimName;
  my $victimHttp;

  # socket file handles
  my $server_fh = new FileHandle;
  my $client_fh = new FileHandle;

  # create socket
  if ( socket( $server_fh, Socket::PF_INET, Socket::SOCK_STREAM, $::Config{'protocol'} ) != $::TRUE ) {
    &display( 'err', "Unable to open server socket" );
    return $::FAILED;
  }

  # set socket options
  if ( setsockopt( $server_fh, Socket::SOL_SOCKET, Socket::SO_REUSEADDR, pack( "l", 1 ) ) != $::TRUE ) {
    &display( 'err', "Unable to set socket options" );
    return $::FAILED;
  }

  # bind to socket
  if ( bind( $server_fh, Socket::sockaddr_in( $::Config{'srv_port'}, Socket::INADDR_ANY ) ) != $::TRUE ) {
    &display( 'err', "Unable to bind to socket" );
    return $::FAILED;
  }

  # allow reuse of addr
  if ( ! defined setsockopt( $server_fh, SOL_SOCKET, SO_REUSEADDR, 1 ) ) {
    &display( 'err', "Unable to set server socket options" );
    return $::FAILED;
  }

  # disable blocking
  if ( ! defined fcntl( $server_fh, F_SETFL(), O_NONBLOCK() ) ) {
    &display( 'err', "Unable to disable blocking on socket" );
    return $::FAILED;
  }

  # listen for new connections
  if ( listen( $server_fh, Socket::SOMAXCONN ) != $::TRUE ) {
    &display( 'err', "Unable to listen to new connections" );
    return $::FAILED;
  } else {
    &display( 'info', "Listening for new client connections" );
  }

  while( ! $::Config{'terminate'} ) {
    if ( defined ( $in_p_addr = accept( $client_fh, $server_fh ) ) ) {
      #
      # we have a new connection
      #

      #
      # lets fork and begin receiving data
      #

   FORK:

      if ( $child_pid = fork() ) {
	#
	# parent
	#

	# close the child side of the named pipe, we don't need it
	close( $client_fh );

	if ( $::Config{'debug'} >= 4 ) {
	  &display( 'debug', "My child is [$child_pid]" );
	}

      } elsif ( defined $child_pid ) {
	#
	# child
	#

	if ( $::Config{'debug'} >= 4 ) {
	  &display( 'debug', "I am a child" );
	}

	# close the server listener, we don't need it
	close( $server_fh );
	
	# disable blocking
	if ( ! defined fcntl( $client_fh, F_SETFL(), O_NONBLOCK() ) ) {
	  &display( 'err', "Unable to disable blocking on socket" );
	  return $::FAILED;
	}
	
	# force autoflush
	select $client_fh; $| = 1;
	select STDOUT;

	# get info about inbound connection
	my( $in_port, $in_i_addr ) = Socket::sockaddr_in( $in_p_addr );
	my $name = gethostbyaddr ( $in_i_addr, Socket::AF_INET );
	&display( 'info', "Connection from %s [%s] at port %d", $name, Socket::inet_ntoa( $in_i_addr ), $in_port );

	# do it
	while( ! $::Config{'terminate'} ) {
	  if ( $::Config{'debug'} >= 8 ) {
	    &display( 'debug', "About to read from socket" );
	  }
	  while( $line = readline( $client_fh ) ) {
	    $line =~ s/\r\n//g;
	    if ( $line =~ m/^NICK (.*)/ ) {
	      $nick = $1;
	      &display( 'info', "NICK ($nick)" );
	      print $client_fh "001\r\n";
	    } elsif ( $line =~ m/^USER (.*) \"(.*)\" \"(.*)\" \:(.*)/ ) {
	      $user = $1;
	      $serverName = $3;
	      &display( 'info', "Got USER ($user)" );
	      print $client_fh "005\r\n";
	      print $client_fh "422\r\n";
	      &display( 'info', "Sending PING" );
	      print $client_fh "PING $name-$in_port\r\n";
	    } elsif ( $line =~ m/^PING (.*)/ ) {
	      &display( 'info', "Got a PING" );
	      print $client_fh "PONG $1\r\n";
	    } elsif ( $line =~ m/^JOIN (.*)/ ) {
	      $channel = $1;
	      &display( 'info', "Got JOIN ($channel)" );
	      &display( 'info', "Sending topic" );
	      print $client_fh "332\r\n";
	      &display( 'info', "Sending message" );
	      print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG $channel :sysinfo\r\n";
	    } elsif ( $line =~ m/^PONG (.*)/ ) {
	      &display( 'info', "Got PONG ($1)" );
	    } elsif ( $line =~ m/^PRIVMSG (\#.*) \:\{SYSINFO\}\: UserName\: (.*)\, HTTP Serv\: (.*)/ ) {
	      $victimChannel = $1;
	      $victimName = $2;
	      $victimHttp = $3;
	      &display( 'info', "Got SYSINFO ($victimChannel, $victimName, $victimHttp)" );
	      if ( ( $::Config{'scan'} ) || ( $::Config{'sniff'} ) || ( $::Config{'keylog'} ) || ( $::Config{'visitHttp'} ) ) {
		if ( $::Config{'scan'} ) {
		  &display( 'info', "Sending scan command" );
		  print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG $channel :scan\r\n";
		}

		if ( $::Config{'sniff'} ) {
		  &display( 'info', "Sending sniff command" );
		  print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG $channel :join #sniff\r\n";
		  print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG #sniff :sniffer\r\n";
		}

		if ( $::Config{'keylog'} ) {
		  &display( 'info', "Sending keylog command" );
		  print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG $channel :keylog\r\n";
		}

		if ( $::Config{'visitHttp'} ) {
		  &display( 'info', "Telling bot to visit \($::Config{'visitHttp'}\)" );
		  print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG $channel :visit;$::Config{'visitHttp'}\r\n";
		}

	      } else {
		&display( 'info', "Sending remove command" );
		print $client_fh ":doppleganger!~perl\@fbi.gov PRIVMSG $channel :remove\r\n";
	      }
	    } elsif ( $line =~ m/^PRIVMSG $victimChannel \:removing....*/ ) {
	      &display( 'info', "Remove command accepted" );
	      &display( 'info', "Connection shutting down" );
	      shutdown( $client_fh, 1 );
	      &display( 'info', "Client exiting" );
	      exit( 1 );
	    } else {
	      &display( 'info', "$line" );
	    }
	  }
	}
	&display( 'info', "Connection shutting down" );
	shutdown( $client_fh, 2 );
	exit( 1 );
      } elsif ( $! =~ /No more process/ ) {
	# EAGAIN, supposedly recoverable fork error
	sleep 5;
	redo FORK;
      } else {
	# wierd fork error
	&display( 'err', "Can't fork: $!" );
	shutdown( $client_fh, 1 );
	return $::FAILED;
      }
    } else {
      # no inbound connections
    }
    # let the parent sleep
    sleep( 1 );
  }

  &display( 'info', "Server shutting down" );

  # cleanup
  close( $server_fh );

  return $::TRUE;
}

#
# send output to stdout or syslog
#
sub display {
  my ( $level, $formatting, @arguments ) = @_;

  if ( $::Config{'daemon'} ) {
    syslog( $level, $formatting, @arguments );
  } else {
    $level =~ tr/a-z/A-Z/;
    printf( "%s[%d] - " . $formatting . "\n", $level, $$, @arguments ); 
  }

  return $::TRUE;
}

