sin/samba-mirror
1
0
Fork 0
mirror of https://github.com/samba-team/samba.git synced 2024-12-23 17:34:34 +03:00
Code
7a4e2bef18
samba-mirror/script/traffic_summary.pl

708 lines
25 KiB
Perl
Raw Normal View History

script: Add script to provide an anonymous summary from tshark The tshark command needs to output a PDML XML stream, which this command will read. The summary is intended not to expose private or customer data while allowing a good view on the range and frequency of the network traffic. Signed-off-by: Gary Lockyer <gary@catalyst.net.nz> Reviewed-by: Douglas Bagnall <douglas.bagnall@catalyst.net.nz> Reviewed-by: Andrew Bartlett <abartlet@samba.org>
2017-02-17 00:51:43 +03:00
#! /usr/bin/perl
#
# Summarise tshark pdml output into a form suitable for the load test tool
#
# Copyright (C) Catalyst.Net Ltd 2017
#
# Catalyst.Net's contribution was written by Gary Lockyer
# <gary@catalyst.net.nz>.
#
# 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; either version 3 of the License, or
# (at your option) any later version.
#
# 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, see <http://www.gnu.org/licenses/>.
#
use warnings;
use strict;
use Getopt::Long;
use Pod::Usage;
BEGIN {
unless (eval "require XML::Twig") {
warn "traffic_summary requires the perl module XML::Twig\n" .
"on Ubuntu/Debian releases run\n".
" sudo apt install libxml-twig-perl \n".
"or install from CPAN\n".
"\nThe reported error was:\n$@";
exit(1);
}
}
my %ip_map; # Map of IP address to sequence number
my $ip_sequence = 0; # count of unique IP addresses seen
my $timestamp; # Packet timestamp
my $stream; # Wireshark stream number
my $ip_proto; # IP protocol (IANA protocl number)
my $source; # source IP address
my $dest; # destination address
my $proto; # application protocol name
my $description; # protocol specific description
my %proto_data; # protocol specific data captured for the current packet
my $malformed_packet; # Indicates the current packet has errors
my $ldap_filter; # cleaned ldap filter
my $ldap_attributes; # attributes requested in an ldap query
# Dispatch table mapping the wireshark variables of interest to the
# functions responsible for processing them
my %field_dispatch_table = (
'timestamp' => \&timestamp,
'ip.src' => \&ip_src,
'ipv6.src' => \&ip_src,
'ip.dst' => \&ip_dst,
'ipv6.dst' => \&ip_dst,
'ip.proto' => \&ip_proto,
'udp.stream' => \&stream,
'tcp.stream' => \&stream,
'dns.flags.opcode' => \&field_data,
'dns.flags.response' => \&field_data,
'netlogon.opnum' => \&field_data,
'kerberos.msg_type' => \&field_data,
'smb.cmd' => \&field_data,
'smb2.cmd' => \&field_data,
'ldap.protocolOp' => \&field_data,
'gss-api.OID' => \&field_data,
'ldap.gssapi_encrypted_payload' => \&field_data,
'ldap.baseObject' => \&field_data,
'ldap.scope' => \&field_data,
'ldap.AttributeDescription' => \&ldap_attribute,
'ldap.modification_element' => \&ldap_add_modify,
'ldap.AttributeList_item_element' => \&ldap_add_modify,
'ldap.operation' => \&field_data,
'ldap.authentication' => \&field_data,
'lsarpc.opnum' => \&field_data,
'samr.opnum' => \&field_data,
'dcerpc.pkt_type' => \&field_data,
'epm.opnum' => \&field_data,
'dnsserver.opnum' => \&field_data,
'drsuapi.opnum' => \&field_data,
'browser.command' => \&field_data,
'smb_netlogon.command' => \&field_data,
'srvsvc.opnum' => \&field_data,
'nbns.flags.opcode' => \&field_data,
'nbns.flags.response' => \&field_data,
'_ws.expert.message' => \&field_data,
);
# Dispatch table mapping protocols to the routine responsible for formatting
# their output. Protocols not in this table are ignored.
#
my %proto_dispatch_table = (
'dns' => sub { return format_opcode( 'dns.flags.response')},
'rpc_netlogon' => sub { return format_opcode( 'netlogon.opnum')},
'kerberos' => \&format_kerberos,
'smb' => sub { return format_opcode( 'smb.cmd')},
'smb2' => sub { return format_opcode( 'smb2.cmd')},
'ldap' => \&format_ldap,
'cldap' => \&format_ldap,
'lsarpc' => sub { return format_opcode( 'lsarpc.opnum')},
'samr' => sub { return format_opcode( 'samr.opnum')},
'dcerpc' => sub { return format_opcode( 'dcerpc.pkt_type')},
'epm' => sub { return format_opcode( 'epm.opnum')},
'dnsserver' => sub { return format_opcode( 'dnsserver.opnum')},
'drsuapi' => sub { return format_opcode( 'drsuapi.opnum')},
'browser' => sub { return format_opcode( 'browser.command')},
'smb_netlogon' => sub { return format_opcode( 'smb_netlogon.command')},
'srvsvc' => sub { return format_opcode( 'srvsvc.opnum')},
'nbns' => sub { return format_opcode( 'nbns.flags.response')},
);
# XPath entry to extract the kerberos cname
my $kerberos_cname_path =
'packet/proto/field[@name = "kerberos.as_req_element"]'
. '/field[@name = "kerberos.req_body_element"]'
. '/field[@name = "kerberos.cname_element"]'
. '/field[@name = "kerberos.name_string"]'
. '/field[@name = "kerberos.KerberosString"]';
# XPath entry to extract the ldap filter
my $ldap_filter_path =
'field[@name = "ldap.searchRequest_element"]/field';
# Create an XML Twig parser and register the event handlers.
#
my $t = XML::Twig->new(
start_tag_handlers => {
'packet' => \&packet_start,
},
twig_handlers => {
'packet' => \&packet,
'proto' => \&protocol,
'field' => \&field,
$kerberos_cname_path => \&kerberos_cname,
$ldap_filter_path => \&ldap_filter,
},
);
#------------------------------------------------------------------------------
# Main loop
#
#------------------------------------------------------------------------------
my $help = 0;
GetOptions( 'help|h' => \$help) or pod2usage(2);
pod2usage(1) if $help;
if (@ARGV) {
foreach my $file (@ARGV) {
eval {
$t->parsefile( $file);
};
if ($@) {
print STDERR "Unable to process $file, ".
"did you run tshark with the -T pdml option?";
}
}
} else {
pod2usage(1) if -t STDIN;
eval {
$t->parse( \*STDIN);
};
if ($@) {
print STDERR "Unable to process input, ".
"are you running tshark with the -T pdml option?";
}
}
#------------------------------------------------------------------------------
# New packet detected reset the globals
#------------------------------------------------------------------------------
sub packet_start
{
my ($t, $packet) = @_;
$timestamp = "";
$stream = "";
$ip_proto = "";
$source = "";
$dest = "";
$description = undef;
%proto_data = ();
$malformed_packet = undef;
$ldap_filter = "";
$ldap_attributes = "";
}
#------------------------------------------------------------------------------
# Complete packet element parsed from the XML feed
# output the protocol summary if required
#------------------------------------------------------------------------------
sub packet
{
my ($t, $packet) = @_;
my $data;
if (exists $proto_dispatch_table{$proto}) {
if ($malformed_packet) {
$data = "\t\t** Malformed Packet ** " . ($proto_data{'_ws.expert.message.show'} || '');
} else {
my $rsub = $proto_dispatch_table{$proto};
$data = &$rsub();
}
print "$timestamp\t$ip_proto\t$stream\t$source\t$dest\t$proto\t$data\n";
}
$t->purge;
}
#------------------------------------------------------------------------------
# Complete protocol element parsed from the XML input
# Update the protocol name
#------------------------------------------------------------------------------
sub protocol
{
my ($t, $protocol) = @_;
if ($protocol->{att}->{showname}) {
}
# Tag a packet as malformed if the protocol is _ws.malformed
# and the hide attribute is not 'yes'
if ($protocol->{att}->{name} eq '_ws.malformed'
&& !($protocol->{att}->{hide} && $protocol->{att}->{hide} eq 'yes')
) {
$malformed_packet = 1;
}
# Don't set the protocol name if it's a wireshark malformed
# protocol entry, or the packet was truncated during capture
my $p = $protocol->{att}->{name};
if ($p ne '_ws.malformed' && $p ne '_ws.short') {
$proto = $p;
}
}
#------------------------------------------------------------------------------
# Complete field element parsed, extract any data of interest
#------------------------------------------------------------------------------
sub field
{
my ($t, $field) = @_;
my $name = $field->{att}->{name};
# Only process the field if it has a corresponding entry in
# %field_dispatch_table
if (exists $field_dispatch_table{$name}) {
my $rsub = $field_dispatch_table{$name};
&$rsub( $field);
}
}
#------------------------------------------------------------------------------
# Process a timestamp field element
#------------------------------------------------------------------------------
sub timestamp
{
my ($field) = @_;
$timestamp = $field->{att}->{value};
}
#------------------------------------------------------------------------------
# Process a wireshark stream element, used to group a sequence of requests
# and responses between two IP addresses
#------------------------------------------------------------------------------
sub stream
{
my ($field) = @_;
$stream = $field->{att}->{show};
}
#------------------------------------------------------------------------------
# Process a source ip address field, mapping the IP address to it's
# corresponding sequence number.
#------------------------------------------------------------------------------
sub ip_src
{
my ($field) = @_;
$source = map_ip( $field);
}
#------------------------------------------------------------------------------
# Process a destination ip address field, mapping the IP address to it's
# corresponding sequence number.
#------------------------------------------------------------------------------
sub ip_dst
{
my ($field) = @_;
$dest = map_ip( $field);
}
#------------------------------------------------------------------------------
# Process an ip protocol element, extracting IANA protocol number
#------------------------------------------------------------------------------
sub ip_proto
{
my ($field) = @_;
$ip_proto = $field->{att}->{value};
}
#------------------------------------------------------------------------------
# Extract an ldap attribute and append it to ldap_attributes
#------------------------------------------------------------------------------
sub ldap_attribute
{
my ($field) = @_;
my $attribute = $field->{att}->{show};
if (defined $attribute) {
$ldap_attributes .= "," if $ldap_attributes;
$ldap_attributes .= $attribute;
}
}
#------------------------------------------------------------------------------
# Process a field element, extract the value, show and showname attributes
# and store them in the %proto_data hash.
#
#------------------------------------------------------------------------------
sub field_data
{
my ($field) = @_;
my $name = $field->{att}->{name};
$proto_data{$name.'.value'} = $field->{att}->{value};
$proto_data{$name.'.show'} = $field->{att}->{show};
$proto_data{$name.'.showname'} = $field->{att}->{showname};
}
#------------------------------------------------------------------------------
# Process a kerberos cname element, if the cname ends with a $ it's a machine
# name. Otherwise it's a user name.
#
#------------------------------------------------------------------------------
sub kerberos_cname
{
my ($t, $field) = @_;
my $cname = $field->{att}->{show};
my $type;
if( $cname =~ /\$$/) {
$type = 'machine';
} else {
$type = 'user';
}
$proto_data{'kerberos.cname.type'} = $type;
}
#------------------------------------------------------------------------------
# Process an ldap filter, remove the values but keep the attribute names
#------------------------------------------------------------------------------
sub ldap_filter
{
my ($t, $field) = @_;
if ( $field->{att}->{show} && $field->{att}->{show} =~ /^Filter:/) {
my $filter = $field->{att}->{show};
# extract and save the objectClass to keep the value
my @object_classes;
while ( $filter =~ m/\((objectClass=.*?)\)/g) {
push @object_classes, $1;
}
# extract and save objectCategory and the top level value
my @object_categories;
while ( $filter =~ m/(\(objectCategory=.*?,|\(objectCategory=.*?\))/g
) {
push @object_categories, $1;
}
# Remove all the values from the attributes
# Input
# Filter: (nCName=DC=DomainDnsZones,DC=sub1,DC=ad,DC=rh,DC=at,DC=net)
# Output
# (nCName)
$filter =~ s/^Filter:\s*//; # Remove the 'Filter: ' prefix
$filter =~ s/=.*?\)/\)/g; # Remove from the = to the first )
# Now restore the parts of objectClass and objectCategory that are being
# retained
#
for my $cat (@object_categories) {
$filter =~ s/\(objectCategory\)/$cat/;
}
for my $class (@object_classes) {
$filter =~ s/\(objectClass\)/($class)/;
}
$ldap_filter = $filter;
} else {
# Ok not an ldap filter so call the default field handler
field( $t, $field);
}
}
#------------------------------------------------------------------------------
# Extract the attributes from ldap modification and add requests
#------------------------------------------------------------------------------
sub ldap_add_modify
{
my ($field) = @_;
my $type = $field->first_child('field[@name="ldap.type"]');
my $attribute = $type->{att}->{show} if $type;
if (defined $attribute) {
$ldap_attributes .= "," if $ldap_attributes;
$ldap_attributes .= $attribute;
}
}
#------------------------------------------------------------------------------
# Map an IP address to a unique sequence number. Assigning it a sequence number
# if one has not already been assigned.
#
#------------------------------------------------------------------------------
sub map_ip
{
my ($field) = @_;
my $ip = $field->{att}->{show};
if ( !exists( $ip_map{$ip})) {
$ip_sequence++;
$ip_map{$ip} = $ip_sequence;
}
return $ip_map{$ip};
}
#------------------------------------------------------------------------------
# Format a protocol operation code for output.
#
#------------------------------------------------------------------------------
sub format_opcode
{
my ($name) = @_;
my $operation = $proto_data{$name.'.show'};
my $description = $proto_data{$name.'.showname'} || '';
# Strip off the common prefix text, and the trailing (n).
# This tidies up most but not all descriptions.
$description =~ s/^[^:]*?: ?// if $description;
$description =~ s/^Message is a // if $description;
$description =~ s/\(\d+\)\s*$// if $description;
$description =~ s/\s*$// if $description;
return "$operation\t$description";
}
#------------------------------------------------------------------------------
# Format ldap protocol details for output
#------------------------------------------------------------------------------
sub format_ldap
{
my ($name) = @_;
if ( exists( $proto_data{'ldap.protocolOp.show'})
|| exists( $proto_data{'gss-api.OID.show'})
) {
my $operation = $proto_data{'ldap.protocolOp.show'};
my $description = $proto_data{'ldap.protocolOp.showname'} || '';
my $oid = $proto_data{'gss-api.OID.show'} || '';
my $base_object = $proto_data{'ldap.baseObject.show'} || '';
my $scope = $proto_data{'ldap.scope.show'} || '';
# Now extract operation specific data
my $extra;
my $extra_desc;
$operation = '' if !defined $operation;
if ($operation eq 6) {
# Modify operation
$extra = $proto_data{'ldap.operation.show'};
$extra_desc = $proto_data{'ldap.operation.showname'};
} elsif ($operation eq 0) {
# Bind operation
$extra = $proto_data{'ldap.authentication.show'};
$extra_desc = $proto_data{'ldap.authentication.showname'};
}
$extra = '' if !defined $extra;
$extra_desc = '' if !defined $extra_desc;
# strip the values out of the base object
if ($base_object) {
$base_object =~ s/^<//; # leading '<' if present
$base_object =~ s/>$//; # trailing '>' if present
$base_object =~ s/=.*?,/,/g; # from = up to the next comma
$base_object =~ s/=.*?$//; # from = up to the end of string
}
# strip off the leading prefix on the extra_description
# and the trailing (n);
$extra_desc =~ s/^[^:]*?: ?// if $extra_desc;
$extra_desc =~ s/\(\d+\)\s*$// if $extra_desc;
$extra_desc =~ s/\s*$// if $extra_desc;
# strip off the common prefix on the description
# and the trailing (n);
$description =~ s/^[^:]*?: ?// if $description;
$description =~ s/\(\d+\)\s*$// if $description;
$description =~ s/\s*$// if $description;
return "$operation\t$description\t$scope\t$base_object"
."\t$ldap_filter\t$ldap_attributes\t$extra\t$extra_desc\t$oid";
} else {
return "\t*** Unknown ***";
}
}
#------------------------------------------------------------------------------
# Format kerberos protocol details for output.
#------------------------------------------------------------------------------
sub format_kerberos
{
my $msg_type = $proto_data{'kerberos.msg_type.show'};
my $cname_type = $proto_data{'kerberos.cname.type'} || '';
my $description = $proto_data{'kerberos.msg_type.showname'} || '';
# Tidy up the description
$description =~ s/^[^:]*?: ?// if $description;
$description =~ s/\(\d+\)\s*$// if $description;
$description =~ s/\s*$// if $description;
return "$msg_type\t$description\t$cname_type";
}
=pod
=head1 NAME
traffic_summary.pl - summarise tshark pdml output
=head1 USAGE
B<traffic_summary.pl> [FILE...]
Summarise samba network traffic from tshark pdml output. Produces a tsv
delimited summary of samba activity.
To process unencrypted traffic
tshark -r capture.file -T pdml | traffic_summary.pl
To process encrypted kerberos traffic
tshark -r capture.file -K krb5.keytab -o kerberos.decrypt:true -T pdml | traffic_summary.pl
To display more detailed documentation, including details of the output format
scripts/traffic_summary: documentation typo Signed-off-by: Douglas Bagnall <douglas.bagnall@catalyst.net.nz> Reviewed-by: Andrew Bartlett <abartlet@samba.org>
2017-03-01 07:33:09 +03:00
perldoc traffic_summary.pl
script: Add script to provide an anonymous summary from tshark The tshark command needs to output a PDML XML stream, which this command will read. The summary is intended not to expose private or customer data while allowing a good view on the range and frequency of the network traffic. Signed-off-by: Gary Lockyer <gary@catalyst.net.nz> Reviewed-by: Douglas Bagnall <douglas.bagnall@catalyst.net.nz> Reviewed-by: Andrew Bartlett <abartlet@samba.org>
2017-02-17 00:51:43 +03:00
NOTE: tshark pdml output is very verbose, so it's better to pipe the tshark
output directly to traffic_summary, rather than generating
intermediate pdml format files.
=head1 OPTIONS
B<--help> Display usage message and exit.
=head1 DESCRIPTION
Summarises tshark pdml output into a format suitable for load analysis
and input into load generation tools.
It reads the pdml input from stdin or the list of files passed on the command line.
=head2 Output format
The output is tab delimited fields and one line per summarised packet.
=head3 Fields
B<timestamp> Packet timestamp
B<IP protocol> The IANA protocol number
B<Wireshark Stream Number> Calculated by wireshark groups related requests and responses
B<Source IP> The unique sequence number for the source IP address
B<Destination IP> The unique sequence number for the destination IP address
B<protocl> The protocol name
B<opcode> The protocol operation code
B<Description> The protocol or operation description
B<extra> Extra protocol specific data, may be more than one field
=head2 IP address mapping
Rather than capturing and printing the IP addresses. Each unique IP address
seen is assigned a sequence number. So the first IP address seen will be 1,
the second 2 ...
=head2 Packets collected
Packets containing the following protocol records are summarised:
dns
rpc_netlogon
kerberos
smb
smb2
ldap
cldap
lsarpc
samr
dcerpc
epm
dnsserver
drsuapi
browser
smb_netlogon
srvsvc
nbns
Any other packets are ignored.
In addition to the standard elements extra data is returned for the following
protocol record.
=head3 kerberos
cname_type machine cname ends with a $
user cname does not end with a $
=head3 ldap
scope Query Scope
0 - Base
1 - One level
2 - sub tree
base_object ldap base object
ldap_filter the ldap filter, attribute names are retained but the values
are removed.
ldap_attributes ldap attributes, only the names are retained any values are
discarded, with the following two exceptions
objectClass all the attribute values are retained
objectCategory the top level value is retained
i.e. everything from the = to the first ,
=head3 ldap modifiyRequest
In addition to the standard ldap fields the modification type is also captured
modify_operator for modifyRequests this contains the modifiy operation
0 - add
1 - delete
2 - replace
modify_description a description of the operation if available
=head3 modify bindRequest
In addition to the standard ldap fields details of the authentication
type are captured
authentication type 0 - Simple
3 - SASL
description Description of the authentication mechanism
oid GSS-API OID's
1.2.840.113554.1.2.2 - Kerberos v5
1.2.840.48018.1.2.2 - Kerberos V5
(incorrect, used by old Windows versions)
1.3.6.1.5.5.2 - SPNEGO
1.3.6.1.5.2.5 - IAKERB
1.3.6.1.4.1.311.2.2.10 - NTLM SSP
1.3.6.1.5.5.14 - SCRAM-SHA-1
1.3.6.1.5.5.18 - SCRAM-SHA-256
1.3.6.1.5.5.15.1.1.* - GSS-EAP
1.3.6.1.5.2.7 - PKU2U
1.3.6.1.5.5.1.1 - SPKM-1
1.3.6.1.5.5.1.2 - SPKM-2
1.3.6.1.5.5.1.3 - SPKM-3
1.3.6.1.5.5.9 - LIPKEY
1.2.752.43.14.2 - NETLOGON
=head1 DEPENDENCIES
tshark
XML::Twig For Ubuntu libxml-twig-perl, or from CPAN
use Getopt::Long
use Pod::Usage
=head1 Diagnostics
=head2 ** Unknown **
Unable to determine the operation being performed, for ldap it typically
indicates a kerberos encrypted operation.
=head2 ** Malformed Packet **
tshark indicated that the packet was malformed, for ldap it usually indicates TLS
encrypted traffic.
=head1 LISENCE AND COPYRIGHT
Copyright (C) Catalyst.Net Ltd 2017
Catalyst.Net's contribution was written by Gary Lockyer
<gary@catalyst.net.nz>.
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; either version 3 of the License, or
(at your option) any later version.
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, see <http://www.gnu.org/licenses/>.
=cut
Copy Permalink