File Coverage

blib/lib/Metabrik/Forensic/Sysmon.pm
Criterion Covered Total %
statement 9 465 1.9
branch 0 140 0.0
condition 0 123 0.0
subroutine 3 45 6.6
pod 1 38 2.6
total 13 811 1.6


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # forensic::sysmon Brik
5             #
6             package Metabrik::Forensic::Sysmon;
7 1     1   818 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         1  
  1         28  
9              
10 1     1   5 use base qw(Metabrik::Client::Elasticsearch::Query);
  1         4  
  1         565  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             nodes => [ qw(node_list) ], # Inherited
20             index => [ qw(index) ], # Inherited
21             type => [ qw(type) ], # Inherited
22             filter_user => [ qw(user) ],
23             filter_session => [ qw(session) ],
24             filter_computer_name => [ qw(name) ],
25             use_regex_match => [ qw(0|1) ],
26             },
27             attributes_default => {
28             index => 'winlogbeat-*',
29             type => 'wineventlog',
30             use_regex_match => 0,
31             },
32             commands => {
33             create_client => [ ],
34             reset_client => [ ],
35             query => [ qw(query index|OPTIONAL type|OPTIONAL) ],
36             get_event_id => [ qw(event_id index|OPTIONAL type|OPTIONAL) ],
37             get_process_create => [ ],
38             get_file_creation_time_changed => [ ],
39             get_network_connection_detected => [ ],
40             get_sysmon_service_state_changed => [ ],
41             get_process_terminated => [ ],
42             get_driver_loaded => [ ],
43             get_image_loaded => [ ],
44             get_create_remote_thread => [ ],
45             get_raw_access_read_detected => [ ],
46             get_process_accessed => [ ],
47             get_file_created => [ ],
48             get_registry_object_added_or_deleted => [ ],
49             get_registry_value_set => [ ],
50             get_sysmon_config_state_changed => [ ],
51             list_file_created_processes => [ ],
52             ps => [ ],
53             ps_image_loaded => [ ],
54             ps_driver_loaded => [ ],
55             ps_parent_image => [ ],
56             ps_target_filename_created => [ ],
57             ps_target_filename_changed => [ ],
58             ps_target_image => [ ],
59             ps_network_connections => [ ],
60             ps_registry_object_added_or_deleted => [ ],
61             ps_registry_value_set => [ ],
62             ps_target_process_accessed => [ ],
63             list_users => [ ],
64             list_sessions => [ ],
65             list_computer_names => [ ],
66             list_domains => [ ],
67             build_list => [ qw(ps_data) ],
68             write_list => [ qw(list_data output_csv) ],
69             read_list => [ qw(input_csv) ],
70             clean_ps_from_list => [ qw(ps_data input_csv sources|OPTIONAL) ],
71             save_state => [ qw(ps_type|OPTIONAL) ],
72             diff_current_state => [ qw(ps_type|OPTIONAL sources|OPTIONAL) ],
73             },
74             require_modules => {
75             'Metabrik::File::Csv' => [ ],
76             },
77             require_binaries => {
78             },
79             optional_binaries => {
80             },
81             need_packages => {
82             },
83             };
84             }
85              
86             #
87             # 1: PROCESS CREATION
88             # 2: FILE CREATION TIME RETROACTIVELY CHANGED IN THE FILESYSTEM
89             # 3: NETWORK CONNECTION INITIATED
90             # 4: RESERVED FOR SYSMON STATUS MESSAGES
91             # 5: PROCESS ENDED
92             # 6: DRIVER LOADED INTO KERNEL
93             # 7: DLL (IMAGE) LOADED BY PROCESS
94             # 8: REMOTE THREAD CREATED
95             # 9: RAW DISK ACCESS
96             # 10: INTER-PROCESS ACCESS
97             # 11: FILE CREATED
98             # 12: REGISTRY MODIFICATION
99             # 13: REGISTRY MODIFICATION
100             # 14: REGISTRY MODIFICATION
101             # 15: ALTERNATE DATA STREAM CREATED
102             # 16: SYSMON CONFIGURATION CHANGE
103             # 17: PIPE CREATED
104             # 18: PIPE CONNECTED
105             #
106             sub get_event_id {
107 0     0 0   my $self = shift;
108 0           my ($event_id, $index, $type) = @_;
109              
110 0   0       $index ||= $self->index;
111 0   0       $type ||= $self->type;
112 0 0         $self->brik_help_run_undef_arg('get_event_id', $event_id) or return;
113              
114 0           my $user = $self->filter_user;
115 0           my $name = $self->filter_computer_name;
116 0           my $session = $self->filter_session;
117              
118 0           my $from = 0;
119 0           my $size = 10_000;
120 0           my $q = {
121             from => $from,
122             size => $size,
123             sort => [
124             { '@timestamp' => { order => "desc" } },
125             ],
126             query => {
127             bool => {
128             must => [
129             { term => { event_id => $event_id } },
130             { term => { source_name => 'Microsoft-Windows-Sysmon' } }
131             ]
132             }
133             }
134             };
135              
136 0 0         if (defined($user)) {
137 0           push @{$q->{query}{bool}{must}}, { term => { 'event_data.User' => $user } };
  0            
138             }
139 0 0         if (defined($name)) {
140 0           push @{$q->{query}{bool}{must}}, { term => { 'computer_name' => $name } };
  0            
141             }
142 0 0         if (defined($session)) {
143 0           push @{$q->{query}{bool}{must}},
  0            
144             { term => { 'event_data.LogonGuid' => $session } };
145             }
146              
147 0           my $r = $self->query($q, $index, $type);
148 0           my $hits = $self->get_query_result_hits($r);
149              
150 0           my @list = ();
151 0           for my $this (@$hits) {
152 0           $this = $this->{_source};
153             push @list, {
154             '@timestamp' => $this->{'@timestamp'},
155             event_id => $this->{event_id},
156             event_data => $this->{event_data},
157             computer_name => $this->{computer_name},
158             process_id => $this->{process_id},
159             provider_guid => $this->{provider_guid},
160             record_number => $this->{record_number},
161             thread_id => $this->{thread_id},
162             task => $this->{task},
163             user => $this->{user},
164             version => $this->{version},
165 0           };
166             }
167              
168 0           return \@list;
169             }
170              
171             sub get_process_create {
172 0     0 0   my $self = shift;
173 0           my ($index, $type) = @_;
174              
175 0   0       $index ||= $self->index;
176 0   0       $type ||= $self->type;
177              
178 0           return $self->get_event_id(1, $index, $type);
179             }
180              
181             sub get_file_creation_time_changed {
182 0     0 0   my $self = shift;
183 0           my ($index, $type) = @_;
184              
185 0   0       $index ||= $self->index;
186 0   0       $type ||= $self->type;
187              
188 0           return $self->get_event_id(2, $index, $type);
189             }
190              
191             sub get_network_connection_detected {
192 0     0 0   my $self = shift;
193 0           my ($index, $type) = @_;
194              
195 0   0       $index ||= $self->index;
196 0   0       $type ||= $self->type;
197              
198 0           return $self->get_event_id(3, $index, $type);
199             }
200              
201             sub get_sysmon_service_state_changed {
202 0     0 0   my $self = shift;
203 0           my ($index, $type) = @_;
204              
205 0   0       $index ||= $self->index;
206 0   0       $type ||= $self->type;
207              
208 0           return $self->get_event_id(4, $index, $type);
209             }
210              
211             sub get_process_terminated {
212 0     0 0   my $self = shift;
213 0           my ($index, $type) = @_;
214              
215 0   0       $index ||= $self->index;
216 0   0       $type ||= $self->type;
217              
218 0           return $self->get_event_id(5, $index, $type);
219             }
220              
221             sub get_driver_loaded {
222 0     0 0   my $self = shift;
223 0           my ($index, $type) = @_;
224              
225 0   0       $index ||= $self->index;
226 0   0       $type ||= $self->type;
227              
228 0           return $self->get_event_id(6, $index, $type);
229             }
230              
231             sub get_image_loaded {
232 0     0 0   my $self = shift;
233 0           my ($index, $type) = @_;
234              
235 0   0       $index ||= $self->index;
236 0   0       $type ||= $self->type;
237              
238 0           return $self->get_event_id(7, $index, $type);
239             }
240              
241             sub get_create_remote_thread {
242 0     0 0   my $self = shift;
243 0           my ($index, $type) = @_;
244              
245 0   0       $index ||= $self->index;
246 0   0       $type ||= $self->type;
247              
248 0           return $self->get_event_id(8, $index, $type);
249             }
250              
251             sub get_raw_access_read_detected {
252 0     0 0   my $self = shift;
253 0           my ($index, $type) = @_;
254              
255 0   0       $index ||= $self->index;
256 0   0       $type ||= $self->type;
257              
258 0           return $self->get_event_id(9, $index, $type);
259             }
260              
261             sub get_process_accessed {
262 0     0 0   my $self = shift;
263 0           my ($index, $type) = @_;
264              
265 0   0       $index ||= $self->index;
266 0   0       $type ||= $self->type;
267              
268 0           return $self->get_event_id(10, $index, $type);
269             }
270              
271             sub get_file_created {
272 0     0 0   my $self = shift;
273 0           my ($index, $type) = @_;
274              
275 0   0       $index ||= $self->index;
276 0   0       $type ||= $self->type;
277              
278 0           return $self->get_event_id(11, $index, $type);
279             }
280              
281             sub get_registry_object_added_or_deleted {
282 0     0 0   my $self = shift;
283 0           my ($index, $type) = @_;
284              
285 0   0       $index ||= $self->index;
286 0   0       $type ||= $self->type;
287              
288 0           return $self->get_event_id(12, $index, $type);
289             }
290              
291             sub get_registry_value_set {
292 0     0 0   my $self = shift;
293 0           my ($index, $type) = @_;
294              
295 0   0       $index ||= $self->index;
296 0   0       $type ||= $self->type;
297              
298 0           return $self->get_event_id(13, $index, $type);
299             }
300              
301             # XXX: 14
302             # XXX: 15
303              
304             sub get_sysmon_config_state_changed {
305 0     0 0   my $self = shift;
306 0           my ($index, $type) = @_;
307              
308 0   0       $index ||= $self->index;
309 0   0       $type ||= $self->type;
310              
311 0           return $self->get_event_id(16, $index, $type);
312             }
313              
314             sub _read_hashes {
315 0     0     my $self = shift;
316 0           my ($hashes) = @_;
317              
318             # SHA1=99052FD84F00B5279E304798F5C2675A1C201146,
319             # MD5=70C298C6990F5A0BBF60F5C035BAA0B9,
320             # SHA256=D4E8D0DCAF077A4FECA5C974EA430A2AD1FE3118F14512D662B26D8D09CD3A08,
321             # IMPHASH=089C9EDE118FC9F36EEBA769ACA5EA16
322 0           my $h = {};
323 0           my @hash_list = split(/,/, $hashes);
324 0           for (@hash_list) {
325 0 0         if (m{^.+=.+$}) {
326 0           my ($k, $v) = split(/=/, $_);
327 0 0 0       if (defined($k) && defined($v)) {
328 0           $h->{lc($k)} = lc($v);
329             }
330             }
331             }
332              
333 0           return $h;
334             }
335              
336             sub _ps {
337 0     0     my $self = shift;
338              
339 0 0         my $r = $self->get_process_create or return;
340              
341 0           my @ps = ();
342 0           for my $this (@$r) {
343 0           my $process_id = $this->{event_data}{ProcessId};
344 0           my $image = lc($this->{event_data}{Image});
345 0           my $command_line = lc($this->{event_data}{CommandLine});
346 0           my $parent_process_id = $this->{event_data}{ParentProcessId};
347 0           my $parent_image = lc($this->{event_data}{ParentImage});
348 0           my $parent_command_line = lc($this->{event_data}{ParentCommandLine});
349              
350 0           my $new = {
351             #process_id => $process_id,
352             image => $self->_fix_path(lc($image)),
353             #command_line => $self->_fix_path(lc($command_line)),
354             #parent_process_id => $parent_process_id,
355             parent_image => $self->_fix_path(lc($parent_image)),
356             #parent_command_line => $self->_fix_path(lc($parent_command_line)),
357             };
358              
359 0           my $hashes = $this->{event_data}{Hashes};
360 0           my $h = $self->_read_hashes($hashes);
361 0           for my $k (keys %$h) {
362 0           $new->{$k} = $h->{$k};
363             }
364              
365 0           push @ps, $new;
366             }
367              
368 0           return \@ps;
369             }
370              
371             sub _dedup_values {
372 0     0     my $self = shift;
373 0           my ($data, $value) = @_;
374              
375 0   0       $value ||= 'source';
376              
377 0           for my $k1 (keys %$data) {
378 0           for my $k2 (keys %{$data->{$k1}}) {
  0            
379 0           my $ary = $data->{$k1}{$k2};
380 0 0         if (ref($ary) eq 'ARRAY') {
381 0           my %uniq = map { $_ => 1 } @$ary;
  0            
382 0           $data->{$k1}{$k2} = [ sort { $a cmp $b } keys %uniq ];
  0            
383             }
384             }
385             }
386              
387 0           my @list = ();
388 0           for my $k1 (keys %$data) {
389 0           push @list, { $value => $k1, %{$data->{$k1}} };
  0            
390             }
391              
392 0           return \@list;
393             }
394              
395             sub _fix_path {
396 0     0     my $self = shift;
397 0           my ($path) = @_;
398              
399 0           $path =~ s{\\}{/}g;
400              
401 0           return $path;
402             }
403              
404             sub list_file_created_processes {
405 0     0 0   my $self = shift;
406 0           my ($index, $type) = @_;
407              
408 0 0         my $r = $self->get_file_created or return;
409              
410 0           my %list = ();
411 0           for my $this (@$r) {
412 0           my $image = $self->_fix_path(lc($this->{event_data}{Image}));
413 0           $list{$image}++;
414             }
415              
416 0           return [ sort { $a cmp $b } keys %list ];
  0            
417             }
418              
419             sub ps {
420 0     0 0   my $self = shift;
421              
422 0 0         my $r = $self->get_process_create or return;
423              
424 0           my %ps = ();
425 0           for my $this (@$r) {
426 0           my $source = $self->_fix_path(lc($this->{event_data}{ParentImage}));
427 0           my $target = $self->_fix_path(lc($this->{event_data}{Image}));
428              
429 0           push @{$ps{$source}{targets}}, $target;
  0            
430             }
431              
432 0           return $self->_dedup_values(\%ps);
433             }
434              
435             sub ps_image_loaded {
436 0     0 0   my $self = shift;
437              
438 0 0         my $r = $self->get_image_loaded or return;
439              
440 0           my %ps = ();
441 0           for my $this (@$r) {
442 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
443 0           my $target = $self->_fix_path(lc($this->{event_data}{ImageLoaded}));
444              
445 0           push @{$ps{$source}{targets}}, $target;
  0            
446             }
447              
448 0           return $self->_dedup_values(\%ps);
449             }
450              
451             sub ps_driver_loaded {
452 0     0 0   my $self = shift;
453              
454 0 0         my $r = $self->get_driver_loaded or return;
455              
456 0           my %ps = ();
457 0           for my $this (@$r) {
458 0           my $source = $self->_fix_path(lc($this->{event_data}{ImageLoaded}));
459 0           my $target = $this->{event_data}{Hashes};
460              
461 0           push @{$ps{$source}{targets}}, $target;
  0            
462             }
463              
464 0           return $self->_dedup_values(\%ps);
465             }
466              
467             sub ps_parent_image {
468 0     0 0   my $self = shift;
469              
470 0 0         my $r = $self->get_process_create or return;
471              
472 0           my %ps = ();
473 0           for my $this (@$r) {
474 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
475 0           my $target = $self->_fix_path(lc($this->{event_data}{ParentImage}));
476              
477 0           push @{$ps{$source}{targets}}, $target;
  0            
478             }
479              
480 0           return $self->_dedup_values(\%ps);
481             }
482              
483             sub ps_target_filename_created {
484 0     0 0   my $self = shift;
485              
486 0 0         my $r = $self->get_file_created or return;
487              
488 0           my %ps = ();
489 0           for my $this (@$r) {
490 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
491 0           my $target = $self->_fix_path(lc($this->{event_data}{TargetFilename}));
492              
493 0           push @{$ps{$source}{targets}}, $target;
  0            
494             }
495              
496 0           return $self->_dedup_values(\%ps);
497             }
498              
499             sub ps_target_filename_changed {
500 0     0 0   my $self = shift;
501              
502 0 0         my $r = $self->get_file_creation_time_changed or return;
503              
504 0           my %ps = ();
505 0           for my $this (@$r) {
506 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
507 0           my $target = $self->_fix_path(lc($this->{event_data}{TargetFilename}));
508              
509 0           push @{$ps{$source}{targets}}, $target;
  0            
510             }
511              
512 0           return $self->_dedup_values(\%ps);
513             }
514              
515             sub ps_target_image {
516 0     0 0   my $self = shift;
517              
518 0 0         my $r = $self->get_create_remote_thread or return;
519              
520 0           my %ps = ();
521 0           for my $this (@$r) {
522 0           my $source = $self->_fix_path(lc($this->{event_data}{SourceImage}));
523 0           my $target = $self->_fix_path(lc($this->{event_data}{TargetImage}));
524              
525 0           push @{$ps{$source}{targets}}, $target;
  0            
526             }
527              
528 0           return $self->_dedup_values(\%ps);
529             }
530              
531             sub ps_network_connections {
532 0     0 0   my $self = shift;
533              
534 0 0         my $r = $self->get_network_connection_detected or return;
535              
536 0           my %ps = ();
537 0           for my $this (@$r) {
538 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
539 0           my $src_ip = $this->{event_data}{SourceIp};
540 0   0       my $src_hostname = $this->{event_data}{SourceHostname} || '';
541 0           my $dest_ip = $this->{event_data}{DestinationIp};
542 0   0       my $dest_hostname = $this->{event_data}{DestinationHostname} || '';
543 0           my $src_port = $this->{event_data}{SourcePort};
544 0           my $dest_port = $this->{event_data}{DestinationPort};
545 0           my $protocol = lc($this->{event_data}{Protocol});
546              
547 0           my $target = "$protocol|[$src_ip]:$src_port:$src_hostname>".
548             "[$dest_ip]:$dest_port:$dest_hostname";
549              
550 0           push @{$ps{$source}{targets}}, $target;
  0            
551             }
552              
553 0           return $self->_dedup_values(\%ps);
554             }
555              
556             sub ps_registry_object_added_or_deleted {
557 0     0 0   my $self = shift;
558              
559 0 0         my $r = $self->get_registry_object_added_or_deleted or return;
560              
561 0           my %ps = ();
562 0           for my $this (@$r) {
563 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
564 0           my $target = $self->_fix_path($this->{event_data}{TargetObject});
565              
566 0           push @{$ps{$source}{targets}}, $target;
  0            
567             }
568              
569 0           return $self->_dedup_values(\%ps);
570             }
571              
572             sub ps_registry_value_set {
573 0     0 0   my $self = shift;
574              
575 0 0         my $r = $self->get_registry_value_set or return;
576              
577 0           my %ps = ();
578 0           for my $this (@$r) {
579 0           my $source = $self->_fix_path(lc($this->{event_data}{Image}));
580 0           my $target = $self->_fix_path($this->{event_data}{TargetObject});
581              
582 0           push @{$ps{$source}{targets}}, $target;
  0            
583             }
584              
585 0           return $self->_dedup_values(\%ps);
586             }
587              
588             sub ps_target_process_accessed {
589 0     0 0   my $self = shift;
590              
591 0 0         my $r = $self->get_process_accessed or return;
592              
593 0           my %ps = ();
594 0           for my $this (@$r) {
595 0           my $source = $self->_fix_path(lc($this->{event_data}{SourceImage}));
596 0           my $target = $self->_fix_path(lc($this->{event_data}{TargetImage}));
597              
598 0           push @{$ps{$source}{targets}}, $target;
  0            
599             }
600              
601 0           return $self->_dedup_values(\%ps);
602             }
603              
604             sub list_users {
605 0     0 0   my $self = shift;
606              
607 0 0         my $r = $self->unique_values('event_data.User') or return;
608              
609 0           my %h = ();
610 0 0 0       if (exists($r->{aggregations})
      0        
611             && exists($r->{aggregations}{1})
612             && exists($r->{aggregations}{1}{buckets})) {
613 0           my $buckets = $r->{aggregations}{1}{buckets};
614 0           for (@$buckets) {
615 0           $h{$_->{key}}++;
616             }
617             }
618              
619 0           return [ sort { $a cmp $b} keys %h ];
  0            
620             }
621              
622             sub list_sessions {
623 0     0 0   my $self = shift;
624              
625 0 0         my $r = $self->unique_values('event_data.LogonGuid') or return;
626              
627 0           my %h = ();
628 0 0 0       if (exists($r->{aggregations})
      0        
629             && exists($r->{aggregations}{1})
630             && exists($r->{aggregations}{1}{buckets})) {
631 0           my $buckets = $r->{aggregations}{1}{buckets};
632 0           for (@$buckets) {
633 0           $h{$_->{key}}++;
634             }
635             }
636              
637 0           return [ sort { $a cmp $b} keys %h ];
  0            
638             }
639              
640             sub list_computer_names {
641 0     0 0   my $self = shift;
642              
643 0 0         my $r = $self->unique_values('computer_name') or return;
644              
645 0           my %h = ();
646 0 0 0       if (exists($r->{aggregations})
      0        
647             && exists($r->{aggregations}{1})
648             && exists($r->{aggregations}{1}{buckets})) {
649 0           my $buckets = $r->{aggregations}{1}{buckets};
650 0           for (@$buckets) {
651 0           $h{$_->{key}}++;
652             }
653             }
654              
655 0           return [ sort { $a cmp $b} keys %h ];
  0            
656             }
657              
658             sub list_domains {
659 0     0 0   my $self = shift;
660              
661 0 0         my $r = $self->unique_values('user.domain') or return;
662              
663 0           my %h = ();
664 0 0 0       if (exists($r->{aggregations})
      0        
665             && exists($r->{aggregations}{1})
666             && exists($r->{aggregations}{1}{buckets})) {
667 0           my $buckets = $r->{aggregations}{1}{buckets};
668 0           for (@$buckets) {
669 0           $h{$_->{key}}++;
670             }
671             }
672              
673 0           return [ sort { $a cmp $b} keys %h ];
  0            
674             }
675              
676             sub build_list {
677 0     0 0   my $self = shift;
678 0           my ($data) = @_;
679              
680 0 0         $self->brik_help_run_undef_arg('build_list', $data) or return;
681 0 0         $self->brik_help_run_invalid_arg('build_list', $data, 'ARRAY') or return;
682              
683             # First, search which keys are multi-valued
684 0           my %a_keys = ();
685 0           my %s_keys = ();
686 0           for my $this (@$data) {
687 0           for my $k (keys %$this) {
688 0 0         if (ref($this->{$k}) eq 'ARRAY') {
    0          
    0          
689 0           $a_keys{$k}++;
690             }
691             elsif (ref($this->{$k}) eq 'HASH') {
692 0           $self->log->warning("build_list: uncaught data, skipping");
693             }
694             elsif (ref($this->{$k}) eq '') {
695 0           $s_keys{$k}++;
696             }
697             }
698             }
699              
700             # More than one key with multi-valued, case not handled yet.
701 0 0         if (keys %a_keys > 1) {
702 0           return $self->log->error("build_list: unable to process data");
703             }
704              
705 0           my @list = ();
706 0           for my $this (@$data) {
707 0           my $new = {};
708 0           for my $s (keys %s_keys) {
709 0           $new->{$s} = $this->{$s};
710             }
711 0 0         if (keys %a_keys > 0) {
712 0           my $sav = { %$new };
713 0           for my $a (keys %a_keys) {
714 0           for (@{$this->{$a}}) {
  0            
715 0           $new->{$a} = $_;
716 0           push @list, $new;
717 0           $new = { %$sav };
718             }
719             }
720             }
721             else {
722 0           push @list, $new;
723             }
724             }
725              
726 0           return \@list;
727             }
728              
729             sub write_list {
730 0     0 0   my $self = shift;
731 0           my ($data, $output) = @_;
732              
733 0 0         $self->brik_help_run_undef_arg('write_list', $data) or return;
734 0 0         $self->brik_help_run_invalid_arg('write_list', $data, 'ARRAY') or return;
735 0 0         $self->brik_help_run_undef_arg('write_list', $output) or return;
736              
737 0 0         my $fc = Metabrik::File::Csv->new_from_brik_init($self) or return;
738 0           $fc->use_quoting(1);
739 0           $fc->overwrite(1);
740 0           $fc->append(0);
741              
742             # Escape some chars so we can use regexes
743 0           for my $this (@$data) {
744 0           for my $k (keys %$this) {
745 0           $this->{$k} =~ s{\|}{\\|}g;
746 0           $this->{$k} =~ s{\.}{\\.}g;
747 0           $this->{$k} =~ s{\?}{\\?}g;
748 0           $this->{$k} =~ s{\(}{\\(}g;
749 0           $this->{$k} =~ s{\)}{\\)}g;
750 0           $this->{$k} =~ s{\*}{\\*}g;
751 0           $this->{$k} =~ s{\[}{\\[}g;
752 0           $this->{$k} =~ s{\]}{\\]}g;
753 0           $this->{$k} =~ s/{/\\{/g;
754 0           $this->{$k} =~ s/}/\\}/g;
755 0           $this->{$k} =~ s{^}{\^};
756 0           $this->{$k} =~ s{$}{\$};
757             }
758             }
759              
760 0 0         $fc->write($data, $output) or return;
761              
762 0           return $output;
763             }
764              
765             sub read_list {
766 0     0 0   my $self = shift;
767 0           my ($input) = @_;
768              
769 0 0         $self->brik_help_run_undef_arg('read_list', $input) or return;
770 0 0         $self->brik_help_run_file_not_found('read_list', $input) or return;
771              
772 0 0         my $fc = Metabrik::File::Csv->new_from_brik_init($self) or return;
773 0           $fc->use_quoting(1);
774              
775 0           return $fc->read($input);
776             }
777              
778             sub clean_ps_from_list {
779 0     0 0   my $self = shift;
780 0           my ($data, $input, $sources) = @_;
781              
782 0 0         $self->brik_help_run_undef_arg('clean_ps_from_list', $data) or return;
783 0 0         $self->brik_help_run_invalid_arg('clean_ps_from_list', $data, 'ARRAY') or return;
784 0 0         $self->brik_help_run_undef_arg('clean_ps_from_list', $input) or return;
785 0 0         $self->brik_help_run_file_not_found('clean_ps_from_list', $input) or return;
786              
787 0 0         if (defined($sources)) {
788 0 0         $self->brik_help_run_invalid_arg('clean_ps_from_list', $sources, 'ARRAY')
789             or return;
790             }
791              
792 0 0         my $csv_list = $self->read_list($input) or return;
793 0 0         my $data_list = $self->build_list($data) or return;
794              
795 0           my $first = $csv_list->[0];
796 0 0         if (! defined($first)) {
797 0           return $self->log->error("clean_ps_from_list: empty [$input] file?");
798             }
799 0           my @keys = keys %$first;
800 0           my $count = scalar @keys;
801              
802             #my $wl_remove = qr/(?:\\|^\^|\$$)/;
803 0           my $wl_remove_start = qr/^\^/;
804 0           my $wl_remove_end = qr/\$$/;
805 0           my $wl_remove_pipe = qr/\\|$/;
806              
807 0           my @clean = ();
808 0           for my $ps (@$data_list) {
809 0 0         if (defined($sources)) {
810 0           my $skip = 1;
811 0           for (@$sources) {
812 0 0         if ($ps->{source} eq $_) {
813 0           $skip = 0;
814 0           last;
815             }
816             }
817 0 0         next if $skip;
818             }
819 0           my $whitelisted = 0;
820 0           for my $csv (@$csv_list) {
821 0           my $this_count = 0;
822 0           for my $k (@keys) {
823 0           my $v = $ps->{$k};
824 0           my $wl = $csv->{$k};
825 0 0         if ($self->use_regex_match) {
826 0 0         if ($v =~ m{^$wl$}) {
827 0           $this_count++;
828             }
829             }
830             else {
831             # We have to remove escape chars.
832             #$wl =~ s{$wl_remove}{}g;
833             #$wl =~ s{\\|)}{}g;
834             #$wl =~ s{^\^}{}g;
835             #$wl =~ s{\$$}{}g;
836 0           $wl =~ s{$wl_remove_start}{}g;
837 0           $wl =~ s{$wl_remove_end}{}g;
838 0           $wl =~ s{$wl_remove_pipe}{}g;
839             #print "compare [$v] vs [$wl]\n";
840 0 0         if ($v eq $wl) {
841 0           $this_count++;
842             }
843             }
844             }
845 0 0         if ($this_count == $count) { # Whitelist matched
846 0           $whitelisted = 1;
847             #print "Whitelisted\n";
848 0           last;
849             }
850             }
851 0 0         if (! $whitelisted) {
852 0           push @clean, $ps;
853             }
854             }
855              
856 0           return \@clean;
857             }
858              
859             sub save_state {
860 0     0 0   my $self = shift;
861 0           my ($type) = @_;
862              
863 0           my @ps = qw(
864             ps
865             ps_driver_loaded
866             ps_image_loaded
867             ps_network_connections
868             ps_parent_image
869             ps_registry_object_added_or_deleted
870             ps_registry_value_set
871             ps_target_filename_changed
872             ps_target_filename_created
873             ps_target_image
874             ps_target_process_accessed
875             );
876              
877             # Process only one type
878 0 0         if (defined($type)) {
879 0           @ps = ( $type );
880             }
881              
882 0           for my $this (@ps) {
883 0           $self->log->info("save_state: saving state for type [$this] to [$this.csv]...");
884              
885 0           my $ps = $self->$this;
886 0 0         if (! defined($ps)) {
887 0           $self->log->error("save_state: failed [$this], skipping");
888 0           next;
889             }
890              
891 0           my $list = $self->build_list($ps);
892 0 0         if (! defined($list)) {
893 0           $self->log->error("save_state: failed build_list, skipping");
894 0           next;
895             }
896              
897 0           my $r = $self->write_list($list, "$this.csv");
898 0 0         if (! defined($r)) {
899 0           $self->log->error("save_state: failed write_list, skipping");
900 0           next;
901             }
902             }
903              
904 0           return 1;
905             }
906              
907             sub diff_current_state {
908 0     0 0   my $self = shift;
909 0           my ($type, $sources) = @_;
910              
911 0 0         if (defined($sources)) {
912 0 0         $self->brik_help_run_invalid_arg('diff_current_state', $sources, 'ARRAY')
913             or return;
914             }
915              
916 0           my @ps = qw(
917             ps
918             ps_driver_loaded
919             ps_image_loaded
920             ps_network_connections
921             ps_parent_image
922             ps_registry_object_added_or_deleted
923             ps_registry_value_set
924             ps_target_filename_changed
925             ps_target_filename_created
926             ps_target_image
927             ps_target_process_accessed
928             );
929              
930             # Process only one type
931 0 0         if (defined($type)) {
932 0           @ps = ( $type );
933             }
934              
935 0           my %diff = ();
936 0           for my $this (@ps) {
937 0 0         if (! $self->can($this)) {
938 0           $self->log->error("diff_current_state: state [$this] unknown, skipping");
939 0           next;
940             }
941 0           my $ps = $self->$this;
942 0 0         if (! defined($ps)) {
943 0           $self->log->error("diff_current_state: failed [$this], skipping");
944 0           next;
945             }
946              
947 0           $self->log->info("diff_current_state: processing [$this] against [$this.csv]...");
948              
949 0           my $diff = $self->clean_ps_from_list($ps, "$this.csv", $sources);
950 0 0         if (! defined($ps)) {
951 0           $self->log->error("diff_current_state: failed clean_ps_from_list, skipping");
952 0           next;
953             }
954              
955 0           $diff{$this} = $diff;
956             }
957              
958             # Regroup by similarity
959 0           my %grouped = ();
960 0           for my $k (keys %diff) {
961 0           my $list = $diff{$k};
962 0           my $group_by = 'source';
963 0           my $value = 'targets';
964 0           for my $this (@$list) {
965 0           push @{$grouped{$k}{$this->{$group_by}}}, $this->{$value};
  0            
966             }
967             }
968              
969 0           return \%grouped;
970             }
971              
972             1;
973              
974             __END__