How do I specify packet data in Net::RawIP? - perl

According to the cpan documentation I can create a raw packet with the following code:
use Net::RawIP;
$n = Net::RawIP->new({
ip => {
saddr => 'my.target.lan',
daddr => 'my.target.lan',
},
});
tcp => {
source => 139,
dest => 139,
psh => 1,
syn => 1,
},
});
$n->send;
But where do I declare the data the packet contains?
Can I send the packet with another module?

Since you are sending a tcp packet you need as the documentations says to specify:
$n = Net::RawIP->new({
ip => {
saddr => 'my.target.lan',
daddr => 'my.target.lan',
},
tcp => {
source => 139,
dest => 139,
psh => 1,
syn => 1,
data => $your_data
},
});

Related

Perl RawIP maximum data size

I'm trying to send some data over TCP using Net::RawIP in Perl. Unfortunately i get the error
sendto() at /usr/lib/x86_64-linus-gnu/perl5/5.24/Net/RawIP.pm line 630
if the TCP data field is bigger than about 1470 characters:
my $n = Net::RawIP->new({
ip => {
saddr => '[src]',
daddr => '[dst]',
},
tcp => {
source => 7777,
dest => 7777,
data => "x" x 150
}
});
$n->send;
works, but
my $n = Net::RawIP->new({
ip => {
saddr => '[src]',
daddr => '[dst]',
},
tcp => {
source => 7777,
dest => 7777,
data => "x" x 1500 # size changed here
}
});
$n->send;
crashes. Any ideas why this happens?
You're building a packet that's too large, so sendto is returning error EMSGSIZE.
EMSGSIZE
The socket type requires that message be sent atomically, and the size of the message to be sent made this impossible.
It's no mystery it starts failing around 1500; that's the maximum an Ethernet frame can carry.
You need to use multiple packets or multiple packet fragments.

Perl RawIP CWR Flag

I'm using Net::RawIP to send packets with specific TCP flags. Is there a way to set the CWR flag?
TCP protokey "res2" sets the ECE flag, but "res1" seems to set the NS flag:
$n = Net::RawIP->new({
ip => {
saddr => 'my.target.lan',
daddr => 'my.target.lan',
},
tcp => {
source => 123,
dest => 123,
res1 => 1,
res2 => 1,
fin => 1,
syn => 1
}
});
Here's a Wireshark capture of the packet's flags:
res2 is two bits wide.
res2 => 1 # ECE
res2 => 2 # CWR
res2 => 3 # ECE & CWR
(It might be the opposite on big-endian machines, but I doubt it.)
(res1 is the 4 bits labeled as "Reserved" and "Nonce" in the Wireshark capture.)

Perl Mongo find object Id

You would think it is a simple thing. I have a list of object id's that are in my collection. I would like to get a single record based on an object id. Have Googled, but nothing helpful.
So I have object id: 5106c7703abc120a04070b34
my $client = MongoDB::MongoClient->new;
my $db = $client->get_database( 'myDatabase' );
my $id_find = $db->get_collection('mycollection')->find({},{_id => MongoDB::OID->new(value => "5106c7703abc120a04070b34")});
print Dumper $id_find;
This prints:
$VAR1 = bless( {
'_skip' => 0,
'_ns' => 'MindCrowd_test.Users',
'_grrrr' => 0,
'partial' => 0,
'_query' => {},
'_tailable' => 0,
'_client' => bless( {
'w' => 1,
'query_timeout' => 30000,
'find_master' => 0,
'_servers' => {},
'sasl' => 0,
'wtimeout' => 1000,
'j' => 0,
'timeout' => 20000,
'sasl_mechanism' => 'GSSAPI',
'auto_connect' => 1,
'auto_reconnect' => 1,
'db_name' => 'admin',
'ssl' => 0,
'ts' => 0,
'inflate_dbrefs' => 1,
'port' => 27017,
'host' => 'mongodb://localhost:27017',
'dt_type' => 'DateTime',
'max_bson_size' => 16777216
}, 'MongoDB::MongoClient' ),
'_limit' => 0,
'slave_okay' => 0,
'_request_id' => 0,
'immortal' => 0,
'started_iterating' => 0
}, 'MongoDB::Cursor' );
I have tried different verions of the above find. All of them fail to compile:
$mongo->my_db->my_collection(find({_id => "ObjectId(4d2a0fae9e0a3b4b32f70000"}));
$mongo->my_db->my_collection(
find({ _id => MongoDB::OID->new(value => "4d2a0fae9e0a3b4b32f70000")})
);
NONE of them work. How do I find (findone) a single record using the object id??
the find methods returns a Cursor object for iterating through. If you only want one record use the find_one method which returns a value.
my $client = MongoDB::MongoClient->new;
my $db = $client->get_database( 'myDatabase' );
my $id_find = $db->get_collection('mycollection')->find_one({_id => MongoDB::OID->new(value => "5106c7703abc120a04070b34")});
print Dumper $id_find;
The answer to this has changed. MongoDB::OID has been deprecated, replaced by BSON::OID, which does not have a method that allows you to pass in the 24-byte hex string that you have. Here's what you have to do these days:
my $id = "5c7463277fc2198b64654feb";
my $oid = BSON::OID->new(oid => pack('H24', $id));
my $result = $db->get_collection('mycollection')->find_id($oid);
pack creates a 12-byte binary sequence from the 24-bytes of hexadecimal data you have in $id. This is what BSON::OID is expecting, and then the perl driver constructs the correct filter for you in the background.

How to manipulate and send packets caught with Net::PCAP on windows

I need to change the tcp/ip headers of packets caught with Net::PCAP. I know this is possible with Net::RawIP, but this doesn't work under windows?
Is there a module for this that works with windows? Is there at least to do this in windows with another programming language that I can call in perl, such as C?
To demonstrate what I want to do, here is the code using Net::RawIP, which does not work under windows because I can't install the module:
$n = Net::RawIP->new({
ip => {
saddr => 'my.target.lan',
daddr => 'my.target.lan',
},
tcp => {
source => 139,
dest => 139,
psh => 1,
syn => 1,
data => $your_data
},
});
$n->send();
Try pcap_sendpacket using this per module https://metacpan.org/pod/Net::Pcap

trying to parse text and html from email over IMAP using MAIL::IMAPClient but text is hidden in parts and multi-parts

I can connect to the IMAP mail server easy enough:
use Mail::IMAPClient;
use MIME::Base64;
use MIME::Parser;
my $imap = Mail::IMAPClient->new(
Server => '192.168.2.2',
User => 'xxxxxx',
Password => 'yyyyyy',
Ssl => 1,
Uid => 1,
);
my $folders = $imap->folders
or die "List folders error: ", $imap->LastError, "\n";
print "Folders: #$folders\n";
$sfolder="INBOX.2012";
$imap->select( $sfolder )
or die "Select '$Opt{sfolder}' error: ", $imap->LastError, "\n";
my #msgs = $imap->messages or die "Could not messages: $#\n";
However, the text and html I want is not easily parsed due to codes like this:
Content-Transfer-Encoding:base64
Content-Type:text/html; charset=utf-8
Content-Transfer-Encoding:base64
Content-Type:text/html; charset=utf-8
Content-Transfer-Encoding:
Content-Type:multipart/mixed; boundary="----------=_4F0F4830.7079357A"
Multipart
Content-Transfer-Encoding:
Content-Type:multipart/mixed; boundary="----=_Part_4487195_1184536749.1326753403034"
Multipart
Content-Transfer-Encoding:
Content-Type:multipart/alternative; boundary=--boundary_164442_d184e417-739f-
46d6-824a-6ea1846e79de
Multipart
Content-Transfer-Encoding:
Content-Type:multipart/mixed; boundary="----=_Part_3882878_23916831.1326509484032"
Multipart
Content-Transfer-Encoding:
I tried this but it only works on a tiny number of different encodings.
if ($imap->get_header($msg,"Content-Transfer-Encoding")=~ /base64/i) {
print "\nMatch base64";
if ($imap->get_header($msg,"Content-Type")=~m/text/i ) {
push(#mail,decode_base64($imap->body_string($msg)));
}
elsif ($imap->get_header($msg,"Content-Type")=~m/image/i )
{ print "\nImage detected"; }
elsif ($imap->get_header($msg,"Content-Type")=~m/application/i )
{ print "\nApplication detected"; }
There are 7bit and 8bit variants and other encoding methods that contain the html or text I want for later use. I successfully use decode_base64() to decode base64. The worse ones to decode are the ones that contain multi-part codes. I feel like I am re-inventing the wheel and there must be a library or module that can do all the heavy lifting for me.
Other content types such as .jpg,.gif, and .pdf should simply be ignored. The multi-part emails contain at least 1 part that I an interested but many that are useless to me.
After further research this structure has some of the information I need but don't know how to get it out efficiently is another matter.
Dumping:$VAR1 = bless( {
'bodyparms' => {
'boundary' => '----=_NextPart_002_BC64_7D688C1F.A2FF9BE0'
},
'bodyextra' => undef,
'_top' => 1,
'bodydisp' => 'NIL',
'_id' => 'HEAD',
'bodysubtype' => 'mixed',
'PartsIndex' => {
'1.3' => bless( {
'bodyparms' => 'NIL',
'bodyid' => '<d9e26cc0-019c-4ac0-9b1e-9c9ac8424f52>',
'bodyextra' => 'NIL',
'bodydisp' => 'NIL',
'_id' => '1.3',
'bodysubtype' => 'jpeg',
'_prefix' => '1.3',
'bodysize' => '4808',
'bodytype' => 'image',
'bodyMD5' => 'NIL',
'bodylang' => 'NIL',
'bodydesc' => 'NIL',
'bodyenc' => 'base64'
}, 'Mail::IMAPClient::BodyStructure' ),
'1.1' => bless( {
'bodyparms' => {
'boundary' => '----=_NextPart_000_36AE_880DDD08.0A776E35'
},
'bodyextra' => undef,
'bodydisp' => 'NIL',
'_id' => '1.1',
'bodysubtype' => 'alternative',
'_prefix' => '1.1',
'bodytype' => 'MULTIPART',
'bodystructure' => [
bless( {
'bodyparms' => {
'charset' => 'utf-8'
},
'bodyextra' => 'NIL',
'bodyid' => 'NIL',
'bodydisp' => 'NIL',
'_id' => '1.1.1',
'bodysubtype' => 'PLAIN',
'_prefix' => '1.1.1',
'bodysize' => '1971',
'bodytype' => 'TEXT',
'bodyMD5' => 'NIL',
'textlines' => '74',
'bodylang' => 'NIL',
'bodydesc' => 'NIL',
'bodyenc' => 'quoted-printable'
}, 'Mail::IMAPClient::BodyStructure' ),
bless( {
'bodyparms' => {
'charset' => 'utf-8'
},
'bodyextra' => 'NIL',
'bodyid' => 'NIL',
'bodydisp' => 'NIL',
'_id' => '1.1.2',
'bodysubtype' => 'HTML',
'_prefix' => '1.1.2',
'bodysize' => '23364',
'bodytype' => 'TEXT',
'bodyMD5' => 'NIL',
'textlines' => '331',
'bodylang' => 'NIL',
'bodydesc' => 'NIL',
'bodyenc' => 'quoted-printable'
}, 'Mail::IMAPClient::BodyStructure' )
],
'bodyloc' => 'NIL',
'bodylang' => 'NIL'
}, 'Mail::IMAPClient::BodyStructure' ),
'1' => bless( {
'bodyparms' => {
'boundary' => '----=_NextPart_001_EA96_2BF8DEDE.32622D51'
},
'bodyextra' => undef,
'bodydisp' => 'NIL',
'_id' => 1,
'bodysubtype' => 'related',
'_prefix' => 1,
'bodytype' => 'MULTIPART',
'bodystructure' => [
$VAR1->{'PartsIndex'}{'1.1'},
bless( {
'bodyparms' => 'NIL',
'bodyid' => '<5dff39db-e81c-4410-be75-8662564fd328>',
'bodyextra' => 'NIL',
'bodydisp' => 'NIL',
'_id' => '1.2',
'bodysubtype' => 'jpeg',
'_prefix' => '1.2',
'bodysize' => '14406',
'bodytype' => 'image',
'bodyMD5' => 'NIL',
'bodylang' => 'NIL',
'bodydesc' => 'NIL',
'bodyenc' => 'base64'
}, 'Mail::IMAPClient::BodyStructure' ),
$VAR1->{'PartsIndex'}{'1.3'},
bless( {
'bodyparms' => 'NIL',
'bodyid' => '<717f2ef4-f795-4d1c-87cc-283c9b0a59b0>',
'bodyextra' => 'NIL',
'bodydisp' => 'NIL',
'_id' => '1.4',
'bodysubtype' => 'gif',
'_prefix' => '1.4',
'bodysize' => '2912',
'bodytype' => 'image',
'bodyMD5' => 'NIL',
'bodylang' => 'NIL',
'bodydesc' => 'NIL',
'bodyenc' => 'base64'
}, 'Mail::IMAPClient::BodyStructure' )
],
'bodyloc' => 'NIL',
'bodylang' => 'NIL'
}, 'Mail::IMAPClient::BodyStructure' ),
'1.2' => $VAR1->{'PartsIndex'}{'1'}{'bodystructure'}[1],
'1.1.2' => $VAR1->{'PartsIndex'}{'1.1'}{'bodystructure'}[1],
'2' => bless( {
'bodyparms' => {
'name' => 'BKD-7361945220.pdf'
},
'bodyid' => 'NIL',
'bodyextra' => 'NIL',
'bodydisp' => {
'attachment' => {
'filename' => 'BKD-7361945220.pdf'
}
},
'_id' => 2,
'bodysubtype' => 'octetstream',
'_prefix' => 2,
'bodysize' => '47540',
'bodytype' => 'application',
'bodyMD5' => 'NIL',
'bodystructure' => [],
'bodylang' => 'NIL',
'bodydesc' => 'NIL',
'bodyenc' => 'base64'
}, 'Mail::IMAPClient::BodyStructure' ),
'1.4' => $VAR1->{'PartsIndex'}{'1'}{'bodystructure'}[3],
'1.1.1' => $VAR1->{'PartsIndex'}{'1.1'}{'bodystructure'}[0]
},
'_prefix' => 'HEAD',
'PartsList' => [
1,
'1.1',
'1.1.1',
'1.1.2',
'1.2',
'1.3',
'1.4',
2
],
'bodytype' => 'MULTIPART',
'bodystructure' => [
$VAR1->{'PartsIndex'}{'1'},
$VAR1->{'PartsIndex'}{'2'}
],
'bodyloc' => 'NIL',
'bodylang' => 'NIL'
}, 'Mail::IMAPClient::BodyStructure' );
As you can see none of the values are guaranteed to be part of every part on the PartsIndex and some them are nested.
variable of interest for each PartsIndex item:
bodytype
bodysubtype
bodyenc
Parse mail messages with Courriel:
use strictures;
use Mail::IMAPClient qw();
use Courriel qw();
sub walk_parts {
my ($obj, $callback) = #_;
if ($obj->is_multipart) {
for my $part ($obj->parts) {
walk_parts($part, $callback);
}
} else {
$callback->($obj);
}
}
my $imap = Mail::IMAPClient->new(
…
) or die $#;
my $folders = $imap->folders
or die $imap->LastError;
$imap->select('INBOX')
or die $imap->LastError;
my #messages = $imap->messages
or die $imap->LastError;
for my $id (#messages) {
my $raw = $imap->message_string($id)
or die $imap->LastError;
my $email = Courriel->parse(text => $raw);
walk_parts $email, sub {
my ($part) = #_;
my $content = $part->content;
my $type = $part->mime_type;
}
}
I tried using a couple of prebuilt modules but they had too many dependencies and was hard to work with. This solution adds no dependencies beyond the original. I also had issues with the dependencies for libMagic, see above, and I did not want anyone who uses my program to have to deal with that issue either.
You have to call decode twice once for the main parent, and again for each child. Since this $imap->get_bodystructure($msg); contains all the information you need why add dependencies where none are needed. It took many many hours to figure out how to decode it manually, but it was worth it.
You can add whatever decoders you want to the decode() subroutine. I only need to decode the text/html and base64 encoded versions there of. The IMAPClient functions give you a list of all parents and children so you don't have to go making a list by yourself. The tricky part is you can have any number of parent each with any number of children, but only the children contain useful data. The parents can be ignored, since many of their values are blank,undef, or 'NIL' (literally). In fact a vast number of variables have the value of 'NIL'. Even ones that the email client could have answered for the user like bodyMD5 and bodylang are USUALLY equal 'NIL'. Due to the overwhelming use of 'NIL' parsing and using other fields may prove futile. Depend on your imap server and the people you recieve email from you mileage may vary.
If you have further questions leave a comment.
use Mail::IMAPClient;
use MIME::Base64;
use MIME::Parser;
sub decode {
($process, $imap) =#_;
if ($process->bodytype eq "TEXT") {
print "\n Text SubType:".$process->bodysubtype;
if ($process->bodyenc eq "base64") {
return decode_base64($imap->bodypart_string($msg,$process->id));
}
elsif (index(" -7bit- -8bit- -quoted-printable- ",lc($process->bodyenc)) !=-1 ) {
return $imap->bodypart_string($msg,$process->id);
}
print "\n==========Insert new decoder here============";
print "\n".$imap->bodypart_string($msg,$process->id);
print "\n=================================================";
}
return "";
}
#insert your login code with credentials here
$imap->select( $sfolder )
or die "Select '$Opt{sfolder}' error: ", $imap->LastError, "\n";
my #msgs = $imap->messages or die "Could not messages: $#\n";
foreach $msg (#msgs) {
my $raw = $imap->message_string($msg)
or die $imap->LastError;
$struct = $imap->get_bodystructure($msg);
#MULTIPART is a container designation and does not contain anything useful by itself.
#However it will still process all of the children that have content
if ($struct->bodytype ne "MULTIPART") { print "\n BodyEnc:".$struct->bodyenc();}
$rDecode=decode($struct,$imap);
#do not insert blanks.
if ($rDecode ne "" && (length($rDecode)>2)) {push(#mail,$rDecode); }
foreach $dumpme ($struct->bodystructure()) {
if ($dumpme->bodytype() eq "MULTIPART") {next;}
$rDecode="";
$rDecode=decode($dumpme,$imap);
#do not insert blanks.
if (($rDecode ne "") && (length($rDecode)>2) ) {
push(#mail,$rDecode); }
}
}
You need a MIME parser. Unfortunately, even then, you will need some normalization of your own, because there are multiple ways to represent the same data in MIME.