Perl library: Identifier too long - perl

I am attempting to obfusicate some code, and using a short "pm" library. The code is in the cgi-bin. But I am getting "Identifier too long" errors ... yet the line it's deciphering is only 1016 chars in plain form.
Here is the library:
package dml;
use Filter::Simple;
FILTER {
$_=~tr/[hjndr 9_45|863!7]/[acefbd2461507938]/;
}
And the actual program itself ...
BEGIN {
$path = 'D:/home/cristofa/';
}
use lib $path;
use dml;
! 9_44! 96476_6_68!h9d9d6666669n4!4d454_4 4|4 9n4!4d4 9d4j45634d6|6_9d4 63 ...
no dml;
I have shortened the code for obvious reasons.
As well as the "identifier too long", I can change other bits, (I think removing filter::simple and using tr~ on its own) and then get "NO is not allowed" referring to the 'no dml' line. I tried putting the data into $_='! 9_44 ...' but that comes back re changing a read only value!!!
If you're curious, the first two figures above SHOULD convert to "3d". I step through the decoded string two at a time, and thus hex for the above is "=", (since the first line of the decoded file is "$f='xyz';" - and I ran into problems trying to substitute the Dollar back to a variable - I ended up using "=$f='xyz';" in the script and then using $data=~s/=\$/\$/g; when converting)
But my 'dilemma' is why that 1016 byte line is causing the script to throw a "wobbly" when I have another program using a library which decodes 2678 bytes with no problem.

$ perl -E'
$_ = "! 9_44! 96476_6_68!h9d9d6666669n4!4d454_4 4|4 9n4!4d4 9d4j45634d6|6_9d4 63 ...";
tr/[hjndr 9_45|863!7]/[acefbd2461507938]/;
say;
'
3d24663d27687474703a2f2f7777772e636f61646d656d2e636f6d2f6c61796f75742f6d79d...
That is indeed a very very long identifier.
That looks like hex. Let's try converting the sequence from hex into bytes and rendering them on a UTF-8 terminal.
$ perl -E'
$_ = "! 9_44! 96476_6_68!h9d9d6666669n4!4d454_4 4|4 9n4!4d4 9d4j45634d6|6_9d4 63 ...";
tr/[hjndr 9_45|863!7]/[acefbd2461507938]/;
$_ = pack("H*", $_);
say;
'
=$f='http://www.coadmem.com/layout/my<garbage>
Bingo! You forgot $_ = pack("H*", $_); in your filter.
By the way, tr/[abc]/[def]/ is equivalent tr/][abc/][def/, which is equivalent to tr/abc/def/ (except for the returned value you ignore). Get rid of [ and ]!

Related

Decode binary octet string in a file with perl

I have a file that contains for some of the lines a number that is coded as text -> binary -> octets and I need to decode that to end up with the number.
All the lines where this encoded string is, begins with STRVID:
For example I have in one of the lines:
STRVID: SarI3gXp
If I do this echo "SarI3gXp" | perl -lpe '$_=unpack"B*"' I get the number in binary
0101001101100001011100100100100100110011011001110101100001110000
Now just to decode from binary to octets I do this (assign the previous command to a variable and then convert binary to octets
variable=$(echo "SarI3gXp" | perl -lpe '$_=unpack"B*"') ; printf '%x\n' "$((2#$variable))"
The result is the number but not in the correct order
5361724933675870
To get the previous number in the correct order I have to get for each couple of digits first the second digit and then the first digit to finally have the number I'm looking for. Something like this:
variable=$(echo "SarI3gXp" | perl -lpe '$_=unpack"B*"') ; printf '%x\n' "$((2#$variable))" | gawk 'BEGIN {FS = ""} {print $2 $1 $4 $3 $6 $5 $8 $7 $10 $9 $12 $11 $14 $13 $16 $15}'
And finally I have the number I'm looking for:
3516279433768507
I don't have any clue on how to do this automatically for every line that begins with STRVID: in my file. At the end what I need is the whole file but when a line begins with STRVID: then the decoded value.
When I find this:
STRVID: SarI3gXp
I will have in my file
STRVID: 3516279433768507
Can someone help with this?
First of all, all you need for the conversion is
unpack "h*", "SarI3gXp"
A perl one-liner using -p will execute the provided program for each line, and s///e allows us to modify a string with code as the replacement expression.
perl -pe's/^STRVID:\s*\K\S+/ unpack "h*", $& /e'
See Specifying file to process to Perl one-liner.
Please inspect the following sample demo code snippet for compliance with your problem.
You do not need double conversion when it can be done in one go.
Note: please read pack documentation , unpack utilizes same TEMPLATE
use strict;
use warnings;
use feature 'say';
while( <DATA> ) {
chomp;
/^STRVID: (.+)/
? say 'STRVID: ' . unpack("h*",$1)
: say;
}
__DATA__
It would be nice if you provide proper input data sample
STRVID: SarI3gXp
Perhaps the result of this script complies with your requirements.
To work with real input data file replace
while( <DATA> ) {
with
while( <> ) {
and pass filename as an argument to the script.
Output
It would be nice if you provide proper input data sample
STRVID: 3516279433768507
Perhaps the result of this script complies with your requirements.
To work with real input data file replace
while( <DATA> ) {
with
while( <> ) {
and pass filename as an argument to the script.
./script.pl input_file.dat
you can cross flip the numbers entirely via regex (and without back-references either) :
variable=$(echo "SarI3gXp" | perl -lpe '$_=unpack"B*"') ;
printf '%x\n' "$((2#$variable))" |
mawk -F'^$' 'gsub("..", "_&=&_") + gsub(\
"(^|[0-9]_)(_[0-9]|$)", _)+gsub("=",_)^_'
1 3516279433768507
The idea is to make a duplicate copy on the other side, like this :
_53=53__61=61__72=72__49=49__33=33__67=67__58=58__70=70_
then scrub out the leftovers, since the numbers u now want are anchoring the 2 sides of each equal sign ("=")

Can someone explain this loop to me?

I have the following Perl code. I Know what the end result is: if I run it and pass in an x9.37 file, it will spit out each field of text. That's great, but I am trying to port this to another language, and I can't read Perl at all. If someone could turn this into some form of pseudocode (I don't need working Java - I can write that part) I just need someone to explain what is going on in the Perl below!
#!/usr/bin/perl -w
use strict;
use Encode;
my $tiff_flag = 0;
my $count = 0;
open(FILE,'<',$ARGV[0]) or die 'Error opening input file';
binmode(FILE) or die 'Error setting binary mode on input file';
while (read (FILE,$_,4)) {
my $rec_len = unpack("N",$_);
die "Bad record length: $rec_len" unless ($rec_len > 0);
read (FILE,$_,$rec_len);
if (substr($_,0,2) eq "\xF5\xF2") {
$_ = substr($_,0,117);
}
print decode ('cp1047', $_) . "\n";
}
close FILE;
read (FILE,$_,4) : read 4 bytes from FILE input stream and load into the variable $_
$rec_len = unpack("N",$_): interpret the first 4 bytes of the variable $_ as an unsigned 32-bit integer in big-endian order, assign to the variable $rec_len
read (FILE,$_,$rec_len): read $rec_len bytes from FILE stream into variable $_
substr($_,0,2): the first two characters of the variable $_
"\xF5\xF2": a two-character string consisting of the bytes 245 and 242
$_ = substr($_,0,117): set $_ to the first 117 characters of $_
use Encode;print decode ('cp1047', $_): interpret the contents of $_ with "code page 1047", i.e., EBCDIC and output to standard output
-w is the old way of enabling warnings.
my declares a lexically scoped variable.
open with < opens a file for reading, the filename is taken from the #ARGV array, i.e. the program's parameters. FILE is the file handle associated with the file.
read reads four bytes into the $_ variable. unpack interprets it as an unsigned 32-bit long (so the following condition can fail only when it's 0).
The next read reads that many bytes to $_ again. substr extracts a substring, and if the first two bytes there are "\xf5\xf2", it shortens the string to the first 117 bytes. It then converts the string to the code page 1047.

How to match an integer after finding a keyword?

I have a text file content as below:
Starting log...
Sample at 10000000
Mode is set to 0
0007F43: CHANGE DETECTED at 290313 line 0 from 00 to 04
0007F46: Mismatched at 290316 line 0
0007F50: Matched occur at 290326 line 1
0007F53: Mismatched at 290336 line 2
0007F56: Matched occur at 290346 line 0
0007F60: Mismatched at 290356 line 2
0007F63: Matched occur at 290366 line 0
Saving log....
DONE!!!
I am running simple perl program as below to get the value for the line contains "Mismatched"
#!/usr/bin/perl
print "Starting perl script\n\n";
open (LOG,"dump.log");
while (<LOG>) {
next if !/Mismatched/;
/at\s+"([^"]+)"/;
print $1,"\n";
}
close(LOG);
print "DONE!!\n";
exit;
but what i get the error message as below, may I know what's wrong with my coding? Is it I miss anything related with chomp()?
Use of uninitialized value in print at test.pl line 9, <LOG> line 5.
Use of uninitialized value in print at test.pl line 9, <LOG> line 7.
Use of uninitialized value in print at test.pl line 9, <LOG> line 9.
DONE!!
And.. is there any suggestion to get the integer (i.e. 290316) after searching the keyword "Mismatched" by using more simple scripting? I just want to get the first value only..
$1 is getting printed even if it does not have anything. It should be in a condition:
print $1,"\n" if (/Mismatched at (\d+)/);
To store all values in an array:
push #arr,$1 if (/Mismatched at (\d+)/);
change regex to:
/at\s+(\d+)/;
You've got answers that show you the correct way to do this, but nothing yet that explains what you were doing wrong. The problem is in your regex.
/at\s+"([^"]+)"/
Let's break it down and see what it's trying to match.
at : the string 'at'
\s+ : one or more whitespace characters
" : a double quote character
([^"]+) : one or more characters that aren't double quote characters
" : a double quote character
So, effectively, you're looking for 'at' followed by a double quoted string. And you're capturing (into $1) the contents of the double quoted string.
But none of your data contains any double quote characters. So there are no double quoted strings. So nothing ever matches and nothing ever gets captured into $1. Which is why you get the 'uninitialised value' error when you try to print $1.
I'd be interested to hear why you thought you wanted to match double quote characters in a piece of text that doesn't contain any of them.
I'd change your script to implement a more modern perl style:
#!/usr/bin/perl
use strict;
use warnings;
print "Starting perl script\n\n";
open my $LOG, '<', 'dump.log' or die $!;
while( <$LOG> ) {
print "$1\n" if /Mismatched at (\d+)/;
}
close $LOG;
print "DONE!!\n";

Weird behavior with Perl string concatenation

I'm working on a pretty simple script, reading a maplist.txt file and using the \n separated map names in it to build a command string - however, I'm getting some unexpected behavior.
My full code:
# compiles a map pack from maplist.txt
# for every server.
# Filipe Dobreira <dobreira#gmail.com>
# v1 # Sept. 2011
use strict;
my #servers = <*>;
foreach my $server (#servers)
{
# we only want folders:
next if -f $server;
print "server: $server\n";
my $maplist = $server . '/orangebox/cstrike/maplist.txt';
my $mapdir = $server . '/orangebox/cstrike/maps';
print " maplist: $maplist\n";
print " map folder: $mapdir\n";
# check if the maplist actually exists:
if(!(-e $maplist))
{
print "!!! failed to find $maplist\n";
next;
}
open MAPLIST, "<$maplist";
foreach my $map (<MAPLIST>)
{
chomp($map);
next if !$map;
# full path to the map file:
my $mapfile = "$mapdir/$map.bsp";
print "$mapfile\n";
}
}
Where I declare $mapfile, I expect the result to be something like:
zombieescape1/orangebox/cstrike/maps/ze_stargate_escape_v8.bsp
However, it seems like the concatenation is being made to the START of the string, and the final result ends up being something like:
.bspiescape1/orangebox/cstrike/maps/ze_stargate_escape_v8
So the .bsp portion is actually being written over the start of the leftmost string. I have very little perl experience, and I can only assume this is me failing to understand some quirk or operator behavior.
Note: I've also tried using "${mapdir}/${map}.bsp", concatenating everything with the dot operator, and a join "", $mapdir, $map, ".bsp", with the same result.
Thanks in advance.
PS: for reference, here's what a maplist.txtlooks like:
zm_3dubka_v3
zm_4way_tunnel_v2
zm_abstractchode_pyramid2
zm_anotheruglyzmap_v1e
zm_app7e_betterbworld_JDfix_v3
zm_atix_helicopter_mini
zm_base_winter_beta3
zm_battleforce_panic_ua
zm_black_lion_macd_v8
zm_bunker_f57_v2
zm_burbsdelchode_b3
zm_choddarena_b12
zm_choddasnowpanic_b4
zm_citylife_V2b
zm_crazycity
zm_deep_thought_nv
zm_desert_fortress_v2
ZM_desprerados_a1
zm_doomlike_station_v2
zm_dust_arena_v1_final
zm_exhibit_night_2F
zm_facility_v1
zm_farm3_nav72
zm_firewall_samarkand
zm_fortress_b7
zm_ghs_flats
zm_gl33m4x_errata
zm_idm_hauntedhouse_v1
zm_industry_v2
zm_kruma_kakariko_village_006
zm_kruma_panic_004
zm_lila_off!ce_v4
zm_little_city_v5pf_fix
zm_moonlight_v3_pF
zm_moon_roflicious_pF_02
zm_moocbblechode_b2
zm_mountain_b2
zm_neko_abura_v2
zm_neko_athletic_park_v2
zm_novum_v3_JDfix
zm_ocx_orly_v4
zm_officeattack_b5a
zm_officerush_betav7
zm_officesspace_pfss
zm_omi_facility_pfv2
zm_penumbra_PF3
zm_raindance_ak_v2
zm_roflicious_pfcf2
zm_roy_abandoned_canals_new
zm_roy_barricade_factory
zm_roy_highway
zm_roy_industrial_complex
zm_roy_old_industrial_pF
zm_roy_the_ship_pf
zm_roy_zombieranch_night_b4
zm_survival_f2a
zm_temple_v3pf
zm_towers_v3
zm_tx_highschool_zkedit_v2
zm_unpanicv2_pF
zm_vc2_office_redone_b1
zm_wasteyard_beta3
zm_winterfun_b4a
zm_wtfhax_v6
zm_wtfhax_v6e
zm_wwt_twinsteel_v8
I'd guess that the maplist.txt has non-unix line endings - probably dos - and as result you see what looks like prepending.
The problem is that the chomp() is only consuming one of the two line ending characters, leaving the carriage return behind.
You might find that if you set the Perl special variable $/ (input record seperator) before opening the map list, that chomp then does the job - it will consume both line-ending characters.
$/ = qq{\r\n};
Another solution would be to convert the line endings in the file before processing, perhaps using dos2unix.

Perl Regex Error Help

I'm receiving a similar error in two completely unrelated places in our code that we can't seem to figure out how to resolve. The first error occurs when we try to parse XML using XML::Simple:
Malformed UTF-8 character (unexpected end of string) in substitution (s///) at /usr/local/lib/perl5/XML/LibXML/Error.pm line 217.
And the second is when we try to do simple string substitution:
Malformed UTF-8 character (unexpected non-continuation byte 0x78, immediately after start byte 0xe9) in substitution (s///) at /gold/content/var/www/alltrails.com/cgi-bin/API/Log.pm line 365.
The line in question in our Log.pm file is as follows where $message is a string:
$message =~ s/\s+$//g;
Our biggest problem in troubleshoot this is that we haven't found a way to identify the input that is causing this to occur. My hope is that some else has run into this issue before and can provide advice or sample code that will help us resolve it.
Thanks in advance for your help!
Not sure what the cause is, but if you want to log the message that is causing this, you could always add a __DIE__ signal handler to make sure you capture the error:
$SIG{__DIE__} = sub {
if ($_[0] =~ /Malformed UTF-8 character/) {
print STDERR "message = $message\n";
}
};
That should at least let you know what string is triggering these errors.
Can you do a hex dump of the source data to see what it looks like?
If your reading this from a file, you can do this with a tool like "od".
Or, you can do this inside the perl script itself by passing the string to a function like this:
sub DumpString {
my #a = unpack('C*',$_[0]);
my $o = 0;
while (#a) {
my #b = splice #a,0,16;
my #d = map sprintf("%03d",$_), #b;
my #x = map sprintf("%02x",$_), #b;
my $c = substr($_[0],$o,16);
$c =~ s/[[:^print:]]/ /g;
printf "%6d %s\n",$o,join(' ',#d);
print " "x8,join(' ',#x),"\n";
print " "x9,join(' ',split(//,$c)),"\n";
$o += 16;
}
}
Sounds like you have an "XML" file that is expected to have UTF-8 encoded characters but doesn't. Try just opening it and looking for hibit characters.