Changeset 1418

Show
Ignore:
Timestamp:
04/02/08 15:57:18 (6 months ago)
Author:
kindlund
Message:

Initial version of light-weight Agent.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • honeyclient/branches/exp/kindlund-simpler_agent/lib/HoneyClient/LWA.pm

    r1319 r1418  
    11####################################################################### 
    2 # Created on:  May 11, 2006 
     2# Created on:  April 02, 2008 
    33# Package:     HoneyClient::Agent 
    44# File:        Agent.pm 
    …… 
    5858=cut 
    5959 
    60 package HoneyClient::Agent; 
    61  
    62 # XXX: Disabled version check, Honeywall does not have Perl v5.8 installed. 
    63 #use 5.008006; 
     60package HoneyClient::LWA; 
     61 
    6462use strict; 
    6563use warnings FATAL => 'all'; 
    6664use Config; 
    6765use Carp (); 
    68 # TODO: This can go away. 
    69 use POSIX qw(SIGALRM); 
    7066 
    7167####################################################################### 
    …… 
    10197    @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); 
    10298 
    103     # Check to make sure our OS is Windows-based. 
    104     # XXX: Fix this! 
    105     #if ($Config{osname} !~ /^MSWin32$/) { 
    106     #    Carp::croak "Error: " . __PACKAGE__ . " will only run on Win32 platforms!\n"; 
    107     #} 
    108  
     99    # TODO: Test this. 
     100    # Check to make sure our environment is Cygwin-based. 
     101    if ($Config{osname} !~ /^cygwin$/) { 
     102        Carp::croak "Error: " . __PACKAGE__ . " will only run on Win32 platforms!\n"; 
     103    } 
     104 
     105    # XXX: Not sure if this is still needed. 
    109106    # Check to see if ithreads are compiled into this version of Perl. 
    110     $Config{useithreads} or Carp::croak "Error: Recompile Perl with ithread support, in order to use this module.\n"; 
     107    #$Config{useithreads} or Carp::croak "Error: Recompile Perl with ithread support, in order to use this module.\n"; 
    111108 
    112109    $SIG{PIPE} = 'IGNORE'; # Do not exit on broken pipes. 
    …… 
    138135can_ok('HoneyClient::Util::Config', 'getVar'); 
    139136use HoneyClient::Util::Config qw(getVar); 
    140  
    141 # TODO: Include FF 
    142 # Make sure HoneyClient::Agent::Driver::Browser::IE loads. 
    143 BEGIN { use_ok('HoneyClient::Agent::Driver::Browser::IE') or diag("Can't load HoneyClient::Agent::Driver::Browser::IE package.  Check to make sure the package library is correctly listed within the path."); } 
    144 require_ok('HoneyClient::Agent::Driver::Browser::IE'); 
    145 # TODO: Update this list of function names. 
    146 can_ok('HoneyClient::Agent::Driver::Browser::IE', 'new'); 
    147 can_ok('HoneyClient::Agent::Driver::Browser::IE', 'drive'); 
    148 can_ok('HoneyClient::Agent::Driver::Browser::IE', 'getNextLink'); 
    149 can_ok('HoneyClient::Agent::Driver::Browser::IE', 'next'); 
    150 can_ok('HoneyClient::Agent::Driver::Browser::IE', 'isFinished'); 
    151 can_ok('HoneyClient::Agent::Driver::Browser::IE', 'status'); 
    152 use HoneyClient::Agent::Driver::Browser::IE; 
    153137 
    154138# Make sure Storable loads. 
    …… 
    168152use MIME::Base64 qw(encode_base64 decode_base64); 
    169153 
    170 #XXX: Check to see if the port number should be externalized. 
    171154# Global test variables. 
    172155our $PORT = getVar(name      => "port", 
    …… 
    188171 
    189172# Include Thread Libraries 
    190 use threads; 
    191 use threads::shared; 
    192 use Thread::Semaphore; 
    193 use Thread::Queue; 
     173#use threads; 
     174# TODO: Remove all ": shared" refs! 
     175#use threads::shared; 
     176#use Thread::Semaphore; 
     177#use Thread::Queue; 
    194178 
    195179# Include utility access to global configuration. 
    …… 
    207191use MIME::Base64 qw(encode_base64 decode_base64); 
    208192 
    209 # Include Data Differential Analysis Libraries 
    210 # TODO: Include corresponding unit tests. 
    211 # XXX: Do we need this? 
    212 #use Data::Diff; 
    213 # TODO: Include corresponding unit tests. 
    214 # XXX: Do we need this? 
    215 #use Data::Structure::Util qw(unbless); 
    216  
    217 # Include Data Differential Analysis Libraries 
    218 # TODO: Include corresponding unit tests. 
    219 use Data::Compare; 
    220  
    221193# Include Logging Library 
    222194use Log::Log4perl qw(:easy); 
    …… 
    244216# state of the VM -- ready to be checked against, at any time after 
    245217# initialization. 
    246 our $integrityData; 
     218#our $integrityData; 
    247219 
    248220# A globally shared, serialized hashtable, containing data per 
    …… 
    256228#       'next'      => undef; # Driver-specific connection information. 
    257229#   } 
    258 our $driverData     : shared = undef; 
     230#our $driverData     : shared = undef; 
    259231 
    260232# A global shared semaphore, designed to limit read/write 
    …… 
    263235# a scalar, the freeze/thaw operation is not atomic; thus, 
    264236# this semaphore ensures all operations remain atomic. 
    265 our $driverDataSemaphore     = Thread::Semaphore->new(1); 
     237#our $driverDataSemaphore     = Thread::Semaphore->new(1); 
    266238 
    267239# A globally shared hashtable, containing one "update queue" 
    …… 
    269241# receive asynchronous updates to their state information 
    270242# in a thread-safe manor. 
    271 our %driverUpdateQueues : shared = ( ); 
     243#our %driverUpdateQueues : shared = ( ); 
    272244 
    273245####################################################################### 
    …… 
    297269 B<$localPort> is an optional argument, specifying the TCP port for the SOAP server to listen on. 
    298270 
    299 Additionally optional, driver-specific arguments can be specified  
    300 as sub-hashtables, where the top-level key corresponds to the name of  
    301 the implemented driver and the value contains all the expected hash data 
    302 that can be fed to HoneyClient::Agent::Driver->new() instances. 
    303  
    304271 Here is an example set of arguments: 
    305272 
    …… 
    307274       address => '127.0.0.1', 
    308275       port    => 9000, 
    309        IE      => { 
    310            timeout => 30, 
    311            links_to_visit => { 
    312                'http://www.mitre.org/' => 1, 
    313            }, 
    314        }, 
    315276   ); 
    316277 
    …… 
    334295=cut 
    335296 
    336 # TODO: Update documentation to reflect hash-based args. 
    337297sub init { 
    338298    # Extract arguments. 
    …… 
    342302    my ($class, %args) = @_; 
    343303 
     304    # Log resolved arguments. 
     305    $LOG->debug(sub { 
     306        # Make Dumper format more terse. 
     307        $Data::Dumper::Terse = 1; 
     308        $Data::Dumper::Indent = 0; 
     309        Dumper(\%args); 
     310    }); 
     311 
    344312    # Sanity check.  Make sure the daemon isn't already running. 
    345313    if (defined($DAEMON_PID)) { 
    …… 
    355323 
    356324    # Acquire data lock. 
    357     _lock(); 
     325    #_lock(); 
    358326 
    359327    # Initialize the $driverData shared hashtable. 
    360     my $data = { }; 
    361     for my $driverName (@{$ALLOWED_DRIVERS}) { 
    362  
    363         eval "use $driverName"; 
    364         if ($@) { 
    365             $LOG->fatal($@); 
    366             Carp::croak $@; 
    367         } 
    368   
    369         $data->{$driverName} = {  
    370             'state'     => undef, 
    371             'thread_id' => undef, 
    372             'status'    => undef, 
    373             'next'      => undef, 
    374         }; 
    375  
    376         # Initialize the corresponding %driverUpdateQueues 
    377         $driverUpdateQueues{$driverName} = new Thread::Queue; 
    378     } 
    379  
    380     # Perform initial integrity baseline check. 
    381     if ($PERFORM_INTEGRITY_CHECKS) { 
    382         $integrityData = HoneyClient::Agent::Integrity->new(); 
    383         $integrityData->closeFiles(); 
    384     } 
    385  
    386     # Release data lock. 
    387     _unlock($data); 
     328#    my $data = { }; 
     329#    for my $driverName (@{$ALLOWED_DRIVERS}) { 
     330#     
     331#        eval "use $driverName"; 
     332#        if ($@) { 
     333#            $LOG->fatal($@); 
     334#            Carp::croak $@; 
     335#        } 
     336#  
     337#        $data->{$driverName} = {  
     338#            'state'     => undef, 
     339#            'thread_id' => undef, 
     340#            'status'    => undef, 
     341#            'next'      => undef, 
     342#        }; 
     343# 
     344#        # Initialize the corresponding %driverUpdateQueues 
     345#        $driverUpdateQueues{$driverName} = new Thread::Queue; 
     346#    } 
     347# 
     348#    # Perform initial integrity baseline check. 
     349#    if ($PERFORM_INTEGRITY_CHECKS) { 
     350#        $integrityData = HoneyClient::Agent::Integrity->new(); 
     351#        $integrityData->closeFiles(); 
     352#    } 
     353# 
     354#    # Release data lock. 
     355#    _unlock($data); 
    388356 
    389357    my $argsExist = scalar(%args); 
    …… 
    405373 
    406374    my $pid = undef; 
    407     if ($pid = fork) { 
     375    if ($pid = fork()) { 
    408376        # We use a local variable to get the pid, and then we set the global 
    409377        # DAEMON_PID variable after the fork().  This is intentional, because 
    …… 
    416384        # Make sure the fork was successful. 
    417385        if (!defined($pid)) { 
    418             $LOG->fatal("Error: Unable to fork child process.\n$!"); 
     386            $LOG->fatal("Error: Unable to fork child process. $!"); 
    419387            Carp::croak "Error: Unable to fork child process.\n$!"; 
    420388        } 
    421389 
    422         # Do not attempt to rejoin parent process tree, 
    423         # if any type of termination signal is received. 
    424         local $SIG{HUP} = sub { exit; }; 
    425         local $SIG{INT} = sub { exit; }; 
    426         local $SIG{QUIT} = sub { exit; }; 
    427         local $SIG{ABRT} = sub { exit; }; 
    428         local $SIG{PIPE} = sub { exit; }; 
    429         local $SIG{TERM} = sub { exit; }; 
    430  
    431390        my $daemon = getServerHandle(address => $args{'address'}, 
    432391                                     port    => $args{'port'}); 
    433392 
    434         # Populate our driver's object state with the remaining 
    435         # arguments. 
    436         delete($args{'address'}); 
    437         delete($args{'port'}); 
    438  
    439         # If this call fails, an exception is thrown or the process 
    440         # remains locked.  If the process locks, then external 
    441         # detection is used to catch for these types of failures. 
    442         updateState($class, encode_base64(nfreeze(\%args))); 
    443      
     393        # Unbind port, if we're shutting down. 
     394        sub shutdown { 
     395            $daemon->shutdown(2); 
     396            exit; 
     397        }; 
     398        $SIG{HUP}  = \&shutdown; 
     399        $SIG{INT}  = \&shutdown; 
     400        $SIG{QUIT} = \&shutdown; 
     401        $SIG{ABRT} = \&shutdown; 
     402        $SIG{TERM} = \&shutdown; 
     403 
    444404        for (;;) { 
    445405            $daemon->handle(); 
    446406        } 
     407 
     408#        # Populate our driver's object state with the remaining 
     409#        # arguments. 
     410#        delete($args{'address'}); 
     411#        delete($args{'port'}); 
     412# 
     413#        # If this call fails, an exception is thrown or the process 
     414#        # remains locked.  If the process locks, then external 
     415#        # detection is used to catch for these types of failures. 
     416#        updateState($class, encode_base64(nfreeze(\%args))); 
     417#     
     418#        for (;;) { 
     419#            $daemon->handle(); 
     420#        } 
    447421    } 
    448422} 
    …… 
    473447 
    474448sub destroy { 
     449 
     450    # Log resolved arguments. 
     451    $LOG->debug(sub { 
     452        # Make Dumper format more terse. 
     453        $Data::Dumper::Terse = 1; 
     454        $Data::Dumper::Indent = 0; 
     455        Dumper(); 
     456    }); 
     457 
    475458    my $ret = undef; 
    476459    # Make sure the PID is defined and not 
    477460    # the parent process... 
    478     if (defined($DAEMON_PID) && ($DAEMON_PID != 0)) { 
    479         $LOG->error("Killing PID = " . $DAEMON_PID); 
    480         print STDERR "Killing PID = " . $DAEMON_PID . "\n"; 
    481         # The Win32 version of kill() seems to only respond to SIGKILL(9). 
    482         # XXX: This doesn't work. 
    483         #$ret = kill(9, $DAEMON_PID); 
     461    if (defined($DAEMON_PID) && $DAEMON_PID) { 
     462        $LOG->info("Destroying Agent daemon at PID: " . $DAEMON_PID); 
    484463         
    485464        # TODO: Need unit tests. 
    …… 
    489468    } 
    490469    if ($ret) { 
    491         # Acquire data lock. 
    492         _lock(); 
    493  
    494         # Destroy all globally shared state data. 
    495         $URL                  = undef; 
    496         $URL_BASE             = undef; 
     470#        # Acquire data lock. 
     471#        _lock(); 
     472# 
     473#        # Destroy all globally shared state data. 
     474#        $URL                  = undef; 
     475#        $URL_BASE             = undef; 
    497476        $DAEMON_PID           = undef; 
    498         $driverData           = undef; 
    499         $driverDataSemaphore  = Thread::Semaphore->new(1); 
    500         %driverUpdateQueues   = ( ); 
    501  
    502         # Destroy all integrity data, if defined. 
    503         if (defined($integrityData)) { 
    504             $integrityData->destroy(); 
    505         } 
    506         $integrityData        = undef; 
    507          
    508         # Release data lock. 
    509         _unlock(); 
     477 
     478#        $driverData           = undef; 
     479#        $driverDataSemaphore  = Thread::Semaphore->new(1); 
     480#        %driverUpdateQueues   = ( ); 
     481# 
     482#        # Destroy all integrity data, if defined. 
     483#        if (defined($integrityData)) { 
     484#            $integrityData->destroy(); 
     485#        } 
     486#        $integrityData        = undef; 
     487#         
     488#        # Release data lock. 
     489#        _unlock(); 
    510490    } 
    511491    return $ret; 
    …… 
    533513# Input: None 
    534514# Output: driverData (deserialized) 
     515# XXX: DELETE 
    535516sub _lock { 
    536517    # Acquire lock on stored driver state. 
    …… 
    557538# Input: driverData (deserialized, optional) 
    558539# Output: None 
     540# XXX: DELETE 
    559541sub _unlock { 
    560542    my $data = shift; 
    …… 
    588570# Input: driver 
    589571# Output: driver (updated) 
     572# XXX: DELETE 
    590573sub _update { 
    591574    # Extract arguments. 
    …… 
    826809# to properly deal with exceptions/faults that occur within this 
    827810# thread. 
     811# XXX: DELETE 
    828812sub worker { 
    829813 
    …… 
    10531037# We must base64 encode the data, since SOAP doesn't like URLs 
    10541038# that contain amperstands. 
     1039# XXX: DELETE 
    10551040sub updateState { 
    10561041 
    …… 
    11561141 
    11571142# XXX: Document this. 
     1143# XXX: DELETE 
    11581144sub getState { 
    11591145    my $ret  = undef; 
    …… 
    11791165} 
    11801166 
     1167# XXX: DELETE 
    11811168# XXX: Document this. 
    11821169sub getStatus { 
    …… 
    11901177} 
    11911178 
     1179# XXX: DELETE 
    11921180# XXX: Document this. 
    11931181# XXX: Do we really need this? 
    …… 
    12071195} 
    12081196 
     1197# XXX: DELETE 
    12091198# XXX: Document this. 
    12101199# TODO: Make this more robust. 
    …… 
    12671256=head1 AUTHORS 
    12681257 
     1258Darien Kindlund, E<lt>kindlund@mitre.orgE<gt> 
     1259 
    12691260Kathy Wang, E<lt>knwang@mitre.orgE<gt> 
    1270  
    1271 Thanh Truong, E<lt>ttruong@mitre.orgE<gt> 
    1272  
    1273 Darien Kindlund, E<lt>kindlund@mitre.orgE<gt> 
    12741261 
    12751262=head1 COPYRIGHT & LICENSE