Permalink
Browse files

version 0.69, includes updated dlls (I hope)

  • Loading branch information...
1 parent 6466f18 commit 0502c58fcd44b45b3c6d8cbf5228e84863331742 @bulk88 committed Jun 27, 2012
Showing with 1,553 additions and 445 deletions.
  1. +21 −1 API.h
  2. +432 −130 API.pm
  3. +251 −79 API.xs
  4. BIN API_test.dll
  5. BIN API_test64.dll
  6. +4 −4 Callback.pm
  7. +220 −150 Callback/Callback.xs
  8. +43 −0 Changes
  9. +23 −13 META.yml
  10. +7 −2 Makefile.PL
  11. +54 −20 Type.pm
  12. +103 −0 api-test/API_test.cpp
  13. +16 −0 api-test/API_test.def
  14. +21 −1 api-test/API_test.h
  15. +16 −9 call_asm_x64_msvc.asm
  16. +8 −2 call_i686.h
  17. +18 −8 call_x86_64.h
  18. +137 −26 t/00_API.t
  19. +179 −0 t/v69.t
View
22 API.h
@@ -23,19 +23,25 @@ typedef unsigned long long_ptr;
#define T_FLOAT 4
#define T_DOUBLE 5
#define T_CHAR 6
+#define T_SHORT 7
#define T_STRUCTURE 51
#define T_POINTERPOINTER 22
-#define T_CODE 101
+#define T_CODE 55
+
+#define T_FLAG_UNSIGNED (0x80)
+#define T_FLAG_NUMERIC (0x40)
typedef char *ApiPointer(void);
typedef long ApiNumber(void);
typedef float ApiFloat(void);
typedef double ApiDouble(void);
typedef void ApiVoid(void);
typedef int ApiInteger(void);
+typedef short ApiShort(void);
+//This is a packing padding nightmare, union or reorder, side effects unknown
typedef struct {
int t;
LPBYTE b;
@@ -54,3 +60,17 @@ typedef struct {
typedef struct {
SV* object;
} APICALLBACK;
+
+#define STATIC_ASSERT(expr) ((void)sizeof(char[1 - 2*!!!(expr)]))
+
+//because of unknown alignment, put 2 wide nulls,
+//some permutation will be 1 wide null char
+#pragma pack(push)
+#pragma pack(push, 1)
+typedef struct {
+ wchar_t null1;
+ wchar_t null2;
+ LARGE_INTEGER counter;
+} SENTINAL_STRUCT;
+#pragma pack(pop)
+#pragma pack(pop)
View
562 API.pm
@@ -18,10 +18,17 @@ package Win32::API;
require Exporter; # to export the constants to the main:: space
require DynaLoader; # to dynuhlode the module.
@ISA = qw( Exporter DynaLoader );
+@EXPORT_OK = qw( ReadMemory IsBadReadPtr IsBadStringPtr MoveMemory
+WriteMemory ); # symbols to export on request
-use vars qw( $DEBUG );
+use vars qw( $DEBUG $sentinal );
$DEBUG = 0;
+BEGIN {
+sub ERROR_NOACCESS () { 998 }
+}
+
+
sub DEBUG {
if ($Win32::API::DEBUG) {
printf @_ if @_ or return 1;
@@ -38,7 +45,7 @@ use File::Basename ();
#######################################################################
# STATIC OBJECT PROPERTIES
#
-$VERSION = '0.68';
+$VERSION = '0.69';
#### some package-global hash to
#### keep track of the imported
@@ -56,83 +63,102 @@ bootstrap Win32::API;
# PUBLIC METHODS
#
sub new {
- my ($class, $dll, $proc, $in, $out, $callconvention) = @_;
- my $hdll;
- my $self = {};
-
- if ($^O eq 'cygwin' and $dll ne File::Basename::basename($dll)) {
-
- # need to convert $dll to win32 path
- # isn't there an API for this?
- my $newdll = `cygpath -w "$dll"`;
- chomp $newdll;
- DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
- $dll = $newdll;
+ my ($class, $dll, $hproc) = (shift, shift);
+ if(! defined $dll){
+ $hproc = shift;
}
+ my ($proc, $in, $out, $callconvention) = @_;
+ my ($hdll, $freedll) = (0, 0);
+ my $self = {};
+ if(! defined $hproc){
+ if ($^O eq 'cygwin' and $dll ne File::Basename::basename($dll)) {
+
+ # need to convert $dll to win32 path
+ # isn't there an API for this?
+ my $newdll = `cygpath -w "$dll"`;
+ chomp $newdll;
+ DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
+ $dll = $newdll;
+ }
- #### avoid loading a library more than once
- if (exists($Libraries{$dll})) {
- DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
- $hdll = $Libraries{$dll};
- }
- else {
- DEBUG "Win32::API::new: Loading library '$dll'\n";
- $hdll = Win32::API::LoadLibrary($dll);
+ #### avoid loading a library more than once
+ if (exists($Libraries{$dll})) {
+ DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
+ $hdll = $Libraries{$dll};
+ }
+ else {
+ DEBUG "Win32::API::new: Loading library '$dll'\n";
+ $hdll = Win32::API::LoadLibrary($dll);
+ $freedll = 1;
+ # $Libraries{$dll} = $hdll;
+ }
-# $Libraries{$dll} = $hdll;
+ #### if the dll can't be loaded, set $! to Win32's GetLastError()
+ if (!$hdll) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED Loading library '$dll': $!\n";
+ return undef;
+ }
}
-
- #### if the dll can't be loaded, set $! to Win32's GetLastError()
- if (!$hdll) {
- $! = Win32::GetLastError();
- DEBUG "FAILED Loading library '$dll': $!\n";
- delete $Libraries{$dll};
- return undef;
+ else{
+ if(IsBadReadPtr($hproc, 4)){
+ Win32::SetLastError(ERROR_NOACCESS);
+ DEBUG "FAILED Function pointer '$hproc' is not a valid memory location\n";
+ return undef;
+ }
}
-
- #### determine if we have a prototype or not
+ #### determine if we have a prototype or not, outtype is for future use in XS
if ((not defined $in) and (not defined $out)) {
- ($proc, $self->{in}, $self->{intypes}, $self->{out}, $self->{cdecl}) =
- parse_prototype($proc);
- return undef unless $proc;
+ ($proc, $self->{in}, $self->{intypes}, $self->{out}, $self->{outtype},
+ $self->{cdecl}) = parse_prototype($class, $proc);
+ if( ! $proc ){
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ return undef;
+ }
$self->{proto} = 1;
}
else {
$self->{in} = [];
if (ref($in) eq 'ARRAY') {
foreach (@$in) {
- push(@{$self->{in}}, type_to_num($_));
+ push(@{$self->{in}}, $class->type_to_num($_));
}
}
else {
my @in = split '', $in;
foreach (@in) {
- push(@{$self->{in}}, type_to_num($_));
+ push(@{$self->{in}}, $class->type_to_num($_));
}
}
- $self->{out} = type_to_num($out);
+ $self->{out} = $class->type_to_num($out);
$self->{cdecl} = calltype_to_num($callconvention);
}
- #### first try to import the function of given name...
- my $hproc = Win32::API::GetProcAddress($hdll, $proc);
-
- #### ...then try appending either A or W (for ASCII or Unicode)
- if (!$hproc) {
- my $tproc = $proc;
- $tproc .= (IsUnicode() ? "W" : "A");
+ if(!$hproc){ #if not non DLL func
+ #### first try to import the function of given name...
+ $hproc = Win32::API::GetProcAddress($hdll, $proc);
+
+ #### ...then try appending either A or W (for ASCII or Unicode)
+ if (!$hproc) {
+ my $tproc = $proc;
+ $tproc .= (IsUnicode() ? "W" : "A");
- # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
- $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
+ $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ }
+
+ #### ...if all that fails, set $! accordingly
+ if (!$hproc) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED GetProcAddress for Proc '$proc': $!\n";
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ return undef;
+ }
+ DEBUG "GetProcAddress('$proc') = '$hproc'\n";
}
-
- #### ...if all that fails, set $! accordingly
- if (!$hproc) {
- $! = Win32::GetLastError();
- DEBUG "FAILED GetProcAddress for Proc '$proc': $!\n";
- return undef;
+ else {
+ DEBUG "Using non-DLL function pointer '$hproc' for '$proc'\n";
}
- DEBUG "GetProcAddress('$proc') = '$hproc'\n";
#### ok, let's stuff the object
$self->{procname} = $proc;
@@ -141,9 +167,10 @@ sub new {
$self->{proc} = $hproc;
#### keep track of the imported function
- $Libraries{$dll} = $hdll;
- $Procedures{$dll}++;
-
+ if(defined $dll){
+ $Libraries{$dll} = $hdll;
+ $Procedures{$dll}++;
+ }
DEBUG "Object blessed!\n";
#### cast the spell
@@ -168,6 +195,7 @@ sub Import {
sub DESTROY {
my ($self) = @_;
+ return if ! defined $self->{dllname};
#### decrease this library's procedures reference count
$Procedures{$self->{dllname}}--;
@@ -188,7 +216,7 @@ sub calltype_to_num {
if (!$type || $type eq "__stdcall") {
return 0;
}
- elsif ($type eq "_cdecl") {
+ elsif ($type eq "_cdecl" || $type eq "__cdecl") {
return 1;
}
else {
@@ -197,15 +225,26 @@ sub calltype_to_num {
}
}
+
sub type_to_num {
+ die "wrong class" if shift ne "Win32::API";
my $type = shift;
my $out = shift;
- my $num;
+ my ($num, $numeric);
+ if(index($type, 'num', 0) == 0){
+ substr($type, 0, length('num'), '');
+ $numeric = 1;
+ }
+ else{
+ $numeric = 0;
+ }
if ( $type eq 'N'
or $type eq 'n'
or $type eq 'l'
- or $type eq 'L')
+ or $type eq 'L'
+ or $type eq 'Q'
+ or $type eq 'q')
{
$num = 1;
}
@@ -236,7 +275,7 @@ sub type_to_num {
}
else {
$num = 0;
- }
+ }#not valid return types of the C func
unless (defined $out) {
if ( $type eq 's'
or $type eq 'S')
@@ -251,22 +290,124 @@ sub type_to_num {
elsif ($type eq 'k'
or $type eq 'K')
{
- $num = 101;
+ $num = 55;
}
}
+ $num |= 0x40 if $numeric;
return $num;
}
+package Win32::API::More;
+
+@ISA = qw ( Win32::API );
+sub type_to_num {
+ die "wrong class" if shift ne "Win32::API::More";
+ my $type = shift;
+ my $out = shift;
+ my ($num, $numeric);
+ if(index($type, 'num', 0) == 0){
+ substr($type, 0, length('num'), '');
+ $numeric = 1;
+ }
+ else{
+ $numeric = 0;
+ }
+
+ if ( $type eq 'N'
+ or $type eq 'n'
+ or $type eq 'l'
+ or $type eq 'L'
+ or $type eq 'Q'
+ or $type eq 'q'
+ or (! $out and # in XS short 'in's are interger/numbers code
+ $type eq 'S'
+ || $type eq 's'))
+ {
+ $num = 1;
+ if(defined $out && ($type eq 'N' || $type eq 'L'
+ || $type eq 'S' || $type eq 'Q')){
+ $num |= 0x80;
+ }
+ }
+ elsif ($type eq 'P'
+ or $type eq 'p')
+ {
+ $num = 2;
+ }
+ elsif ($type eq 'I'
+ or $type eq 'i')
+ {
+ $num = 3;
+ if(defined $out && $type eq 'I'){
+ $num |= 0x80;
+ }
+ }
+ elsif ($type eq 'f'
+ or $type eq 'F')
+ {
+ $num = 4;
+ }
+ elsif ($type eq 'D'
+ or $type eq 'd')
+ {
+ $num = 5;
+ }
+ elsif ($type eq 'c'
+ or $type eq 'C')
+ {
+ $num = 6;
+ if(defined $out && $type eq 'C'){
+ $num |= 0x80;
+ }
+ }
+ elsif ($type eq 's') #7 is only used for out params
+ {
+ $num = 7;
+ }
+ elsif ($type eq 'S')
+ {
+ $num = 7 | 0x80;
+ }
+ else {
+ $num = 0;
+ } #not valid return types of the C func
+ unless (defined $out) {
+ if ( $type eq 't'
+ or $type eq 'T')
+ {
+ $num = 51;
+ }
+ elsif ($type eq 'b'
+ or $type eq 'B')
+ {
+ $num = 22;
+ }
+ elsif ($type eq 'k'
+ or $type eq 'K')
+ {
+ $num = 55;
+ }
+ }
+ $num |= 0x40 if $numeric;
+ return $num;
+}
+package Win32::API;
+
sub parse_prototype {
- my ($proto) = @_;
+ my ($class, $proto) = @_;
my @in_params = ();
- my @in_types = ();
- if ($proto =~ /^\s*(\S+)(?:\s+(\w+))?\s+(\S+)\s*\(([^\)]*)\)/) {
- my $ret = $1;
- my $callconvention = $2;
- my $proc = $3;
- my $params = $4;
+ my @in_types = (); #one day create a BNF-ish formal grammer parser here
+ if ($proto =~ /^\s*((?:(?:un|)signed\s+|) #optional signedness
+ \S+)(?:\s*(\*)\s*|\s+) #type and maybe a *
+ (?:(\w+)\s+)? # maybe a calling convention
+ (\S+)\s* #func name
+ \(([^\)]*)\) #param list
+ /x) {
+ my $ret = $1.(defined($2)?$2:'');
+ my $callconvention = $3;
+ my $proc = $4;
+ my $params = $5;
$params =~ s/^\s+//;
$params =~ s/\s+$//;
@@ -276,35 +417,41 @@ sub parse_prototype {
foreach my $param (split(/\s*,\s*/, $params)) {
my ($type, $name);
- if ($param =~ /(\S+)\s+(\S+)/) {
- ($type, $name) = ($1, $2);
+ #match "in_t* _var" "in_t * _var" "in_t *_var" "in_t _var" "in_t*_var" supported
+ #unsigned or signed or nothing as prefix supported
+ # "in_t ** _var" and "const in_t* var" not supported
+ if ($param =~ /((?:(?:un|)signed\s+|)\w+)(?:\s*(\*)\s*|\s+)(\w+)/) {
+ ($type, $name) = ($1.(defined($2)? $2:''), $3);
+ }
+ {
+ no warnings 'uninitialized';
+ if($type eq '') {goto BADPROTO;} #something very wrong, bail out
}
-
if (Win32::API::Type::is_known($type)) {
if (Win32::API::Type::is_pointer($type)) {
DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
$type,
Win32::API::Type->packing($type),
- type_to_num('P');
- push(@in_params, type_to_num('P'));
+ $class->type_to_num('P');
+ push(@in_params, $class->type_to_num('P'));
}
else {
DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
$type,
Win32::API::Type->packing($type),
- type_to_num(Win32::API::Type->packing($type));
- push(@in_params, type_to_num(Win32::API::Type->packing($type)));
+ $class->type_to_num(Win32::API::Type->packing($type, undef, 1));
+ push(@in_params, $class->type_to_num(Win32::API::Type->packing($type, undef, 1)));
}
}
elsif (Win32::API::Struct::is_known($type)) {
DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
- $type, 'S', type_to_num('S');
- push(@in_params, type_to_num('S'));
+ $type, 'T', Win32::API::More->type_to_num('T');
+ push(@in_params, Win32::API::More->type_to_num('T'));
}
else {
warn
"Win32::API::parse_prototype: WARNING unknown parameter type '$type'";
- push(@in_params, type_to_num('I'));
+ push(@in_params, $class->type_to_num('I'));
}
push(@in_types, $type);
@@ -317,36 +464,39 @@ sub parse_prototype {
DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
$ret,
Win32::API::Type->packing($ret),
- type_to_num('P');
- return ($proc, \@in_params, \@in_types, type_to_num('P'),
- calltype_to_num($callconvention));
+ $class->type_to_num('P');
+ return ($proc, \@in_params, \@in_types, $class->type_to_num('P', 1),
+ $ret, calltype_to_num($callconvention));
}
else {
DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
$ret,
Win32::API::Type->packing($ret),
- type_to_num(Win32::API::Type->packing($ret));
+ $class->type_to_num(Win32::API::Type->packing($ret, undef, 1), 1);
return (
$proc, \@in_params, \@in_types,
- type_to_num(Win32::API::Type->packing($ret)),
- calltype_to_num($callconvention)
+ $class->type_to_num(Win32::API::Type->packing($ret, undef, 1), 1),
+ $ret, calltype_to_num($callconvention)
);
}
}
else {
warn
"Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'";
- return ($proc, \@in_params, \@in_types, type_to_num('I'),
- calltype_to_num($callconvention));
+ return ($proc, \@in_params, \@in_types, $class->type_to_num('I', 1),
+ $ret, calltype_to_num($callconvention));
}
}
else {
+ BADPROTO:
warn "Win32::API::parse_prototype: bad prototype '$proto'";
return undef;
}
}
+
+
1;
__END__
@@ -364,23 +514,39 @@ Win32::API - Perl Win32 API Import Facility
#### Method 1: with prototype
use Win32::API;
- $function = Win32::API->new(
- 'mydll, 'int sum_integers(int a, int b)',
+ $function = Win32::API::More->new(
+ 'mydll', 'int sum_integers(int a, int b)',
);
$return = $function->Call(3, 2);
- #### Method 2: with parameter list
+ #### Method 2: with prototype and your function pointer
use Win32::API;
- $function = Win32::API->new(
+ $function = Win32::API::More->new(
+ undef, 38123456, 'int name_ignored(int a, int b)',
+ );
+ $return = $function->Call(3, 2);
+
+ #### Method 3: with parameter list
+
+ use Win32::API;
+ $function = Win32::API::More->new(
'mydll', 'sum_integers', 'II', 'I',
);
$return = $function->Call(3, 2);
- #### Method 3: with Import
+ #### Method 4: with parameter list and your function pointer
+
+ use Win32::API;
+ $function = Win32::API::More->new(
+ undef, 38123456, 'name_ignored', 'II', 'I',
+ );
+ $return = $function->Call(3, 2);
+
+ #### Method 5: with Import
use Win32::API;
- Win32::API->Import(
+ Win32::API::More->Import(
'mydll', 'int sum_integers(int a, int b)',
);
$return = sum_integers(3, 2);
@@ -395,7 +561,8 @@ Win32::API - Perl Win32 API Import Facility
=head1 ABSTRACT
With this module you can import and call arbitrary functions
-from Win32's Dynamic Link Libraries (DLL), without having
+from Win32's Dynamic Link Libraries (DLL) or arbitrary functions for
+which you have a pointer (MS COM, etc), without having
to write an XS extension. Note, however, that this module
can't do everything. In fact, parameters input and output is
limited to simpler cases.
@@ -411,9 +578,13 @@ A short example of how you can use this module (it just gets the PID of
the current process, eg. same as Perl's internal C<$$>):
use Win32::API;
- Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ Win32::API::More->Import("kernel32", "int GetCurrentProcessId()");
$PID = GetCurrentProcessId();
+Starting with 0.69. Win32::API initiated objects are deprecated due to numerous
+bugs and improvements, use Win32::API::More now. The use statement remains
+as C<use Win32::API;>.
+
The possibilities are nearly infinite (but not all are good :-).
Enjoy it.
@@ -424,23 +595,23 @@ To use this module put the following line at the beginning of your script:
use Win32::API;
You can now use the C<new()> function of the Win32::API module to create a
-new Win32::API object (see L<IMPORTING A FUNCTION>) and then invoke the
+new Win32::API::More object (see L<IMPORTING A FUNCTION>) and then invoke the
C<Call()> method on this object to perform a call to the imported API
(see L<CALLING AN IMPORTED FUNCTION>).
-Starting from version 0.40, you can also avoid creating a Win32::API object
+Starting from version 0.40, you can also avoid creating a Win32::API::More object
and instead automatically define a Perl sub with the same name of the API
function you're importing. The details of the API definitions are the same,
just the call is different:
- my $GetCurrentProcessId = Win32::API->new(
+ my $GetCurrentProcessId = Win32::API::More->new(
"kernel32", "int GetCurrentProcessId()"
);
my $PID = $GetCurrentProcessId->Call();
#### vs.
- Win32::API->Import("kernel32", "int GetCurrentProcessId()");
+ Win32::API::More->Import("kernel32", "int GetCurrentProcessId()");
$PID = GetCurrentProcessId();
Note that C<Import> returns 1 on success and 0 on failure (in which case you
@@ -449,8 +620,9 @@ can check the content of C<$^E>).
=head2 IMPORTING A FUNCTION
You can import a function from a 32 bit Dynamic Link Library (DLL) file
-with the C<new()> function. This will create a Perl object that contains the
-reference to that function, which you can later C<Call()>.
+with the C<new()> function or, starting in 0.69, supply your own
+function pointer. This will create a Perl object that contains
+the reference to that function, which you can later C<Call()>.
What you need to know is the prototype of the function you're going to import
(eg. the definition of the function expressed in C syntax).
@@ -461,17 +633,28 @@ one uses Win32::API's internal representation for parameters.
=head2 IMPORTING A FUNCTION BY PROTOTYPE
-You need to pass 2 parameters:
+You need to pass 2 or 3 parameters:
=over 4
=item 1.
-The name of the library from which you want to import the function.
+The name of the library from which you want to import the function. If the
+name is undef, you are requesting a object created from a function pointer,
+and must supply item 2.
=item 2.
-The C prototype of the function.
+This parameter is optional, most people should skip it, skip does not mean
+supplying undef. Supply a function pointer in the format of number 1234, not
+string "\x01\x02\x03\x04". Undef will be returned if the pointer is not
+readable, GetLastError will be ERROR_NOACCESS.
+
+=item 3.
+
+The C prototype of the function. If you are using a function pointer, the name
+of the function should be something "friendly" to you and no attempt is made
+to retrive such a name from any DLL's export table.
=back
@@ -482,25 +665,39 @@ automatically turned into a C C<NULL> value.
See L<Win32::API::Type> for a list of the known parameter types and
L<Win32::API::Struct> for information on how to define a structure.
+If a prototype type is exactly C<signed char> or C<unsigned char> for an
+"in" parameter or the return parameter, and for "in" parameters only
+C<signed char *> or C<unsigned char *> the parameters will be treated as a
+number, C<0x01>, not C<"\x01">. "UCHAR" is not "unsigned char". Change the
+C prototype if you want numeric handling for your chars.
+
=head2 IMPORTING A FUNCTION WITH A PARAMETER LIST
-You need to pass 4 parameters:
+You need to pass at minimum 4 parameters.
=over 4
=item 1.
The name of the library from which you want to import the function.
=item 2.
-The name of the function (as exported by the library).
+This parameter is optional, most people should skip it, skip does not mean
+supplying undef. Supply a function pointer in the format of number C<1234>,
+not string C<"\x01\x02\x03\x04">. Undef will be returned if the pointer is not
+readable, GetLastError will be ERROR_NOACCESS.
=item 3.
-The number and types of the arguments the function expects as input.
+The name of the function (as exported by the library) or for function pointers
+a name that is "friendly" to you. No attempt is made to retrive such a
+name from any DLL's export table in the 2nd case.
=item 4.
-The type of the value returned by the function.
+The number and types of the arguments the function expects as input.
=item 5.
+The type of the value returned by the function.
+
+=item 6.
And optionally you can specify the calling convention, this defaults to
'__stdcall', alternatively you can specify '_cdecl'.
@@ -545,11 +742,16 @@ a couple of directories, including:
So, you don't have to write F<C:\windows\system\kernel32.dll>;
only F<kernel32> is enough:
- $GetTempPath = new Win32::API('kernel32', ...
+ $GetTempPath = new Win32::API::More('kernel32', ...
=item B<2.>
-Now for the second parameter: the name of the function.
+Since this function is from a DLL, skip the 2nd parameter. Skip does not
+mean supplying undef.
+
+=item B<3.>
+
+Now for the real second parameter: the name of the function.
It must be written exactly as it is exported
by the library (case is significant here).
If you are using Windows 95 or NT 4.0, you can use the B<Quick View>
@@ -560,7 +762,11 @@ somewhere "32 bit word machine"; as a rule of thumb,
when you see that all the exported functions are in upper case,
the DLL is a 16 bit one and you can't use it.
If their capitalization looks correct, then it's probably a 32 bit
-DLL.
+DLL. If you have Platform SDK or Visual Studio, you can use the Dumpbin
+tool. Call it as "dumpbin /exports name_of_dll.dll" on the command line.
+If you have Mingw GCC, use objdump as
+"objdump -x name_of_dll.dll > dlldump.txt" and search for the word exports in
+the very long output.
Also note that many Win32 APIs are exported twice, with the addition of
a final B<A> or B<W> to their name, for - respectively - the ASCII
@@ -570,11 +776,11 @@ an B<A> to the name and try again; if the extension is built on a
Unicode system, then it will try with the B<W> instead.
So our function name will be:
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', ...
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', ...
In our case C<GetTempPath> is really loaded as C<GetTempPathA>.
-=item B<3.>
+=item B<4.>
The third parameter, the input parameter list, specifies how many
arguments the function wants, and their types. It can be passed as
@@ -597,24 +803,41 @@ argument; allowed types are:
=over 4
=item C<I>:
-value is an integer (int)
+value is an unsigned integer (unsigned int)
+
+=item C<i>:
+value is an signed integer (signed int or int)
=item C<N>:
-value is a number (long)
+value is a unsigned pointer sized number (unsigned long)
+
+=item C<n>:
+value is a signed pointer sized number (signed long or long)
=item C<F>:
value is a floating point number (float)
=item C<D>:
value is a double precision number (double)
+=item C<S>:
+value is a unsigned short (unsigned short)
+
+=item C<s>:
+value is a signed short (signed short or short)
+
=item C<C>:
-value is a char (char)
+value is a char (char), pass as C<"a>", not C<97>, C<"abc"> will truncate to C<"a">
=item C<P>:
value is a pointer (to a string, structure, etc...)
+padding out the buffer string is required, buffer overflow detection is
+performed. Pack and unpack the data yourself. If P is a return type, only
+null terminated strings or NULL pointer are supported. It is suggested to
+not use P as a return type and instead use N and read the memory yourself, and
+free the pointer if applicable.
-=item C<S>:
+=item C<T>:
value is a Win32::API::Struct object (see below)
=item C<K>:
@@ -632,10 +855,10 @@ string (C<LPSTR>):
The fourth and final parameter is the type of the value returned by the
function. It can be one of the types seen above, plus another type named B<V>
(for C<void>), used for functions that do not return a value.
-In our example the value returned by GetTempPath() is a C<DWORD>, so
-our return type will be B<N>:
+In our example the value returned by GetTempPath() is a C<DWORD>, which is a
+typedef for unsigned long, so our return type will be B<N>:
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', 'NP', 'N');
Now the line is complete, and the GetTempPath() API is ready to be used
in Perl. Before calling it, you should test that $GetTempPath is
@@ -644,7 +867,7 @@ loaded; in this case, C<$!> will be set to the error message reported
by Windows.
Our definition, with error checking added, should then look like this:
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', 'NP', 'N');
if(not defined $GetTempPath) {
die "Can't import API GetTempPath: $!\n";
}
@@ -668,25 +891,24 @@ Perl will C<croak> an error message and C<die>.
The two parameters needed here are the length of the buffer
that will hold the returned temporary path, and a pointer to the
buffer itself.
-For numerical parameters, you can use either a constant expression
-or a variable, while B<for pointers you must use a variable name> (no
-Perl references, just a plain variable name).
-Also note that B<memory must be allocated before calling the function>,
+For numerical parameters except for char, you can use either a constant expression
+or a variable, it will be numified similar to the expression C<($var+0)>.
+For pointers, also note that B<memory must be allocated before calling the function>,
just like in C.
For example, to pass a buffer of 80 characters to GetTempPath(),
it must be initialized before with:
$lpBuffer = " " x 80;
This allocates a string of 80 characters. If you don't do so, you'll
-probably get C<Runtime exception> errors, and generally nothing will
-work. The call should therefore include:
+probably get a fatal buffer overflow error starting in 0.69.
+The call should therefore include:
$lpBuffer = " " x 80;
$GetTempPath->Call(80, $lpBuffer);
And the result will be stored in the $lpBuffer variable.
-Note that you don't need to pass a reference to the variable
+Note that you never need to pass a reference to the variable
(eg. you B<don't need> C<\$lpBuffer>), even if its value will be set
by the function.
@@ -762,18 +984,98 @@ you can still use the low-level approach to use structures:
you have to pack() the required elements in a variable:
- $lpPoint = pack('LL', 0, 0); # store two LONGs
+ $lpPoint = pack('ll', 0, 0); # store two LONGs
=item 2.
to access the values stored in a structure, unpack() it as required:
- ($x, $y) = unpack('LL', $lpPoint); # get the actual values
+ ($x, $y) = unpack(';;', $lpPoint); # get the actual values
=back
The rest is left as an exercise to the reader...
+=head2 EXPORTED FUNCTIONS
+
+=head3 ReadMemory
+
+ $copy_of_memblock = ReadMemory($SourcePtr, $length);
+
+Reads the source pointer for C<$length> number of bytes. Returns a copy of
+the memory block in a scalar. No readability checking is done on C<$SourcePtr>.
+C<$SourcePtr>'s format is 123456, not C<"\x01\x02\x03\x04">.
+
+=head3 WriteMemory
+
+ WriteMemory($DestPtr, $sourceScalar, $length);
+
+Copies the string contents of the C<$sourceScalar> scalar to C<$DestPtr> for
+C<$length> bytes. $length must be less than or equal to the length of
+C<$sourceScalar>, otherwise the function croaks. No readability checking is
+done on C<$DestPtr>. C<$DestPtr>'s format is 123456, not
+C<"\x01\x02\x03\x04">. Returns nothing.
+
+=head3 MoveMemory
+
+ MoveMemory($destPtr, $sourcePtr, $length);
+
+Copies a block of memory from one location to another. The source and
+destination blocks may overlap. All pointers are in the format of 123456,
+not C<"\x01\x02\x03\x04">. No readability checking is done. Returns nothing.
+
+=head3 IsBadReadPtr
+
+ if(IsBadReadPtr($ptr, $length)) {die "bad ptr";}
+
+Probes a memory block for C<$length> bytes for readability. Returns true if
+access violation occurs, otherwise false is returned. This function is useful
+to avoid dereferencing pointers which will crash the perl process. This function
+has many limitations, including not detecting uninitialized memory, not
+detecting freed memory, and not detecting giberrish. It can not tell whether a
+function pointer is valid x86 machine code. Ideally, you should never use it,
+or remove it once your code is stable. C<$ptr> is in the format of 123456,
+not C<"\x01\x02\x03\x04">. See MS's documentation for alot more
+on this function of the same name.
+
+
+=head1 HISTORY
+
+=over 4
+
+=item return value signedness
+
+Prior to 0.69, for numeric integer types, the return scalar was always signed.
+Unsigned-ness was ignored.
+
+=item shorts
+
+Prior to 0.69, shorts were not supported. 'S' meant a sturct. To fix this
+Win32::API::More class was created for 0.69. 'S'/'s' now means short, per pack's
+letters. Struct has been moved to letter 'T'. Win32::API will continue to exist
+for legacy code.
+
+=item float return types
+
+Prior to 0.69, if a function had a return type of float, it was silently
+not called.
+
+=item buffer overflow protection
+
+Introduced in 0.69. If disabling is required, which is highly
+B<not recommended>, set an enviromental variable called
+WIN32_API_SORRY_I_WAS_AN_IDIOT to 1.
+
+=item automatic un/pack
+
+Starting with 0.69, when using Win32::API::More, there is automatic un/packing
+of pointers to numbers-ish things for in parameters when using the C
+prototype interface.
+
+=back
+
+See the C<Changes> file for more details.
+
=head1 AUTHOR
Aldo Calpini ( I<dada@perl.it> ).
View
330 API.xs
@@ -10,7 +10,7 @@
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <memory.h>
-
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -51,39 +51,38 @@
#error "Don't know what architecture I'm on."
#endif
-void pointerCallPack(SV* param, int idx, AV* types) {
- dSP;
- SV* type;
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
+#endif
+
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#endif
- type = *( av_fetch(types, idx, 0) );
+void pointerCallPack(pTHX_ SV * obj, SV * param, SV * type) {
+ dSP;
ENTER;
- SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVsv(type)));
- XPUSHs(param);
- PUTBACK;
- call_pv("Win32::API::Type::Pack", G_DISCARD);
+ EXTEND(SP, 3);
+ PUSHs(obj);
+ PUSHs(type);
+ PUSHs(param);
PUTBACK;
-
- FREETMPS;
+ call_pv("Win32::API::Type::Pack", G_VOID);
LEAVE;
}
-void pointerCallUnpack(SV* param, int idx, AV* types) {
- dSP;
- SV* type;
- type = *( av_fetch(types, idx, 0) );
+void pointerCallUnpack(pTHX_ SV * obj, SV * param, SV * type) {
+ dSP;
ENTER;
- SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVsv(type)));
- XPUSHs(param);
+ EXTEND(SP, 3);
+ PUSHs(obj);
+ PUSHs(type);
+ PUSHs(param);
PUTBACK;
- call_pv("Win32::API::Type::Unpack", G_DISCARD);
- PUTBACK;
-
- FREETMPS;
+ call_pv("Win32::API::Type::Unpack", G_VOID);
LEAVE;
}
@@ -92,6 +91,39 @@ MODULE = Win32::API PACKAGE = Win32::API
PROTOTYPES: DISABLE
+BOOT:
+{
+ SV * sentinal;
+ SENTINAL_STRUCT sentinal_struct;
+ LARGE_INTEGER counter;
+#ifdef WIN32_API_DEBUG
+ const char * const SDumpStr = "(XS)Win32::API::boot: APIPARAM layout, member %s, SzOf %u, offset %u\n";
+#endif
+ STATIC_ASSERT(sizeof(sentinal_struct) == 12); //8+2+2
+#ifdef WIN32_API_DEBUG
+#define DUMPMEM(type,name) printf(SDumpStr, #type " " #name, sizeof(((APIPARAM *)0)->name), offsetof(APIPARAM, name));
+ DUMPMEM(int,t);
+ DUMPMEM(LPBYTE,b);
+ DUMPMEM(char,c);
+ DUMPMEM(char*,p);
+ DUMPMEM(long_ptr,l);
+ DUMPMEM(float,f);
+ DUMPMEM(double,d);
+ printf("(XS)Win32::API::boot: APIPARAM total size=%u\n", sizeof(APIPARAM));
+#undef DUMPMEM
+#endif
+ //this is not secure against malicious overruns
+ //QPC doesn't like unaligned pointers
+ if(!QueryPerformanceCounter(&counter))
+ croak("Win32::API::boot: internal error\n");
+ sentinal_struct.counter = counter;
+ sentinal_struct.null1 = L'\0';
+ sentinal_struct.null2 = L'\0';
+ sentinal = get_sv("Win32::API::sentinal", 1);
+ sv_setpvn(sentinal, (char*)&sentinal_struct, sizeof(sentinal_struct));
+}
+
+
HINSTANCE
LoadLibrary(name)
char *name;
@@ -117,6 +149,8 @@ CODE:
OUTPUT:
RETVAL
+#//IsUnicode should be a package level var set from BOOT:
+
bool
IsUnicode()
CODE:
@@ -129,6 +163,10 @@ OUTPUT:
RETVAL
+#//ToUnicode, never make this public API without rewrite, terrible design
+#//no use of SvCUR, no use of svutf8 flag, no writing into XSTARG, malloc usage
+#//Win32 the mod has much nicer converters in XS
+
void
ToUnicode(string)
LPCSTR string
@@ -151,6 +189,9 @@ PPCODE:
XSRETURN_NO;
}
+#//FromUnicode, never make this public API without rewrite, terrible design
+#//no use of SvCUR, no usage of svutf8, no writing into XSTARG, malloc usage
+#//Win32 the mod has much nicer converters in XS
void
FromUnicode(uString)
@@ -196,13 +237,62 @@ PPCODE:
XSRETURN(1);
void
+IsBadReadPtr(addr, len)
+ long_ptr addr
+ UV len
+ALIAS:
+ IsBadStringPtr = 1
+PREINIT:
+ SV * retsv;
+PPCODE:
+ if(ix){
+ if(IsBadStringPtr((void *)addr,len)) goto RET_YES;
+ else goto RET_NO;
+ }
+ if(IsBadReadPtr((void *)addr,len)){
+ RET_YES:
+ retsv = &PL_sv_yes;
+ }
+ else{
+ RET_NO:
+ retsv = &PL_sv_no;
+ }
+ XPUSHs(retsv);
+
+
+void
ReadMemory(addr, len)
long_ptr addr
long len
PPCODE:
- EXTEND(SP, 1);
- XPUSHs(sv_2mortal(newSVpv((char *) addr, len)));
- XSRETURN(1);
+ mXPUSHs(newSVpvn((char *) addr, len));
+
+#//idea, one day length is optional, 0/undef/not present means full length
+#//but this sub is more dangerous then
+void
+WriteMemory(destPtr, sourceSV, length)
+ long_ptr destPtr
+ SV * sourceSV
+ size_t length;
+PREINIT:
+ char * sourcePV;
+ STRLEN sourceLen;
+PPCODE:
+ sourcePV = SvPV(sourceSV, sourceLen);
+ if(length < sourceLen)
+ croak("Win32::API::WriteMemory, $length < length($source)", length, sourceLen);
+ //they can't overlap
+ memcpy((void *)destPtr, (void *)sourcePV, length);
+
+
+void
+MoveMemory(Destination, Source, Length)
+ long_ptr Destination
+ long_ptr Source
+ size_t Length
+PPCODE:
+ MoveMemory((void *)Destination, (void *)Source, Length);
+
void
Call(api, ...)
@@ -211,6 +301,7 @@ PPCODE:
FARPROC ApiFunction;
APIPARAM *params;
APIPARAM retval;
+ SV * retsv;
// APISTRUCT *structs;
// APICALLBACK *callbacks;
SV** origST;
@@ -236,7 +327,8 @@ PPCODE:
int words_pushed;
BOOL c_call;
BOOL has_proto = FALSE;
-
+ UCHAR is_more = sv_isa(api, "Win32::API::More");
+ SV * sentinal = get_sv("Win32::API::sentinal", 0);
obj = (HV*) SvRV(api);
obj_proc = hv_fetch(obj, "proc", 4, FALSE);
@@ -261,80 +353,104 @@ PPCODE:
call_type = hv_fetch(obj, "cdecl", 5, FALSE);
c_call = call_type ? SvTRUE(*call_type) : FALSE;
+
if(items-1 != nin+1) {
croak("Wrong number of parameters: expected %d, got %d.\n", nin+1, items-1);
}
if(nin >= 0) {
- params = (APIPARAM *) safemalloc((nin+1) * sizeof(APIPARAM));
- // structs = (APISTRUCT *) safemalloc((nin+1) * sizeof(APISTRUCT));
- // callbacks = (APICALLBACK *) safemalloc((nin+1) * sizeof(APICALLBACK));
- origST = (SV**) safemalloc((nin+1) * sizeof(SV*));
+ //malloc isn't croak-safe
+ params = (APIPARAM *) _alloca((nin+1) * sizeof(APIPARAM));
+ // structs = (APISTRUCT *) _alloca((nin+1) * sizeof(APISTRUCT));
+ // callbacks = (APICALLBACK *) _alloca((nin+1) * sizeof(APICALLBACK));
+ origST = (SV**) _alloca((nin+1) * sizeof(SV*));
/* #### FIRST PASS: initialize params #### */
for(i = 0; i <= nin; i++) {
+ SV* pl_stack_param = ST(i+1);
in_type = av_fetch(inlist, i, 0);
tin = SvIV(*in_type);
+ //unsigned meaningless no sign vs zero extends are done bc uv/iv is
+ //the biggest native integer on the cpu, big to small is truncation
+ tin &= ~T_FLAG_UNSIGNED;
+ //unimplemented except for char
+ if((tin & ~ T_FLAG_NUMERIC) != T_CHAR){
+ tin &= ~T_FLAG_NUMERIC;
+ }
switch(tin) {
case T_NUMBER:
params[i].t = T_NUMBER;
- params[i].l = (long_ptr) SvIV(ST(i+1)); //xxx not sure about T_NUMBER length on Win64
+ params[i].l = (long_ptr) SvIV(pl_stack_param); //xxx not sure about T_NUMBER length on Win64
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%ld\n", i, params[i].t, params[i].l);
#endif
break;
case T_CHAR:
params[i].t = T_CHAR;
- params[i].p = (char *) SvPV_nolen(ST(i+1));
+ //ASM x64 vs i686 is messy, both must fill
+ params[i].c = (SvPV_nolen(pl_stack_param))[0];
+ params[i].l = (long_ptr)(params[i].c);
#ifdef WIN32_API_DEBUG
- printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%s\n", i, params[i].t, params[i].p);
+ printf("(XS)Win32::API::Call: params[%d].t=%d, as char .u=%c\n", i, params[i].t, (char)params[i].l);
#endif
- params[i].l = (long_ptr) (params[i].p)[0];
+ break;
+ case (T_CHAR|T_FLAG_NUMERIC):
+ params[i].t = T_CHAR;
+ //unreachable unless had a proto in Perl
+ //ASM x64 vs i686 is messy, both must fill
+ params[i].c = (char) SvIV(pl_stack_param);
+ params[i].l = (long_ptr)(params[i].c);
#ifdef WIN32_API_DEBUG
- printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%c\n", i, params[i].t, params[i].l);
+ printf("(XS)Win32::API::Call: params[%d].t=%d, as num .u=0x%X\n", i, params[i].t, (unsigned char) SvIV(pl_stack_param));
#endif
- //}
break;
case T_FLOAT:
params[i].t = T_FLOAT;
- params[i].f = (float) SvNV(ST(i+1));
+ params[i].f = (float) SvNV(pl_stack_param);
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%f\n", i, params[i].t, params[i].f);
#endif
break;
case T_DOUBLE:
params[i].t = T_DOUBLE;
- params[i].d = (double) SvNV(ST(i+1));
+ params[i].d = (double) SvNV(pl_stack_param);
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%f\n", i, params[i].t, params[i].d);
#endif
break;
- case T_POINTER:
- params[i].t = T_POINTER;
- origST[i] = ST(i+1);
+ case T_POINTER:{
+ params[i].t = T_POINTER; //chance of useless unpack later
+ if(SvREADONLY(pl_stack_param)) //Call() param was a string litteral
+ pl_stack_param = sv_mortalcopy(pl_stack_param);
+ origST[i] = pl_stack_param;
if(has_proto) {
- if(SvOK(ST(i+1))) {
- pointerCallPack(ST(i+1), i, intypes);
- params[i].p = (char *) SvPV_nolen(ST(i+1));
+ if(SvOK(pl_stack_param)) {
+ if(is_more) {
+ pointerCallPack(aTHX_ api, pl_stack_param, *av_fetch(intypes, i, 0));
+ }
+ goto PTR_IN_USE_PV;
/* When arg is undef, use NULL pointer */
} else {
params[i].p = NULL;
}
} else {
- if(SvIOK(ST(i+1)) && SvIV(ST(i+1)) == 0) {
+ if(SvIOK(pl_stack_param) && SvIV(pl_stack_param) == 0) {
params[i].p = NULL;
} else {
- params[i].p = (char *) SvPV_nolen(ST(i+1));
+ PTR_IN_USE_PV:
+ sv_catsv(pl_stack_param, get_sv("Win32::API::sentinal", 0));
+ params[i].p = SvPVX(pl_stack_param);
}
}
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%s\n", i, params[i].t, params[i].p);
#endif
break;
+ }
case T_POINTERPOINTER:
params[i].t = T_POINTERPOINTER;
- if(SvROK(ST(i+1)) && SvTYPE(SvRV(ST(i+1))) == SVt_PVAV) {
- pparray = (AV*) SvRV(ST(i+1));
+ if(SvROK(pl_stack_param) && SvTYPE(SvRV(pl_stack_param)) == SVt_PVAV) {
+ pparray = (AV*) SvRV(pl_stack_param);
ppref = av_fetch(pparray, 0, 0);
if(SvIOK(*ppref) && SvIV(*ppref) == 0) {
params[i].b = NULL;
@@ -350,7 +466,7 @@ PPCODE:
break;
case T_INTEGER:
params[i].t = T_NUMBER;
- params[i].l = (long_ptr) (int) SvIV(ST(i+1));
+ params[i].l = (long_ptr) (int) SvIV(pl_stack_param);
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: params[%d].t=%d, .u=%d\n", i, params[i].t, params[i].l);
#endif
@@ -362,44 +478,49 @@ PPCODE:
params[i].t = T_STRUCTURE;
- if(SvROK(ST(i+1))) {
- mg = mg_find(SvRV(ST(i+1)), 'P');
+ if(SvROK(pl_stack_param)) {
+ mg = mg_find(SvRV(pl_stack_param), 'P');
if(mg != NULL) {
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: SvRV(ST(i+1)) has P magic\n");
#endif
origST[i] = mg->mg_obj;
// structs[i].object = mg->mg_obj;
} else {
- origST[i] = ST(i+1);
+ origST[i] = pl_stack_param;
// structs[i].object = ST(i+1);
}
}
+ else {
+ croak("Win32::API::Call: parameter %d must be a Win32::API::Struct object!\n", i+1);
+ }
}
break;
case T_CODE:
params[i].t = T_CODE;
#ifdef WIN32_API_DEBUG
- printf("(XS)Win32::API::Call: got a T_CODE, (SV=0x%08x) (SvPV='%s')\n", ST(i+1), SvPV_nolen(ST(i+1)));
+ printf("(XS)Win32::API::Call: got a T_CODE, (SV=0x%08x) (SvPV='%s')\n", pl_stack_param, SvPV_nolen(pl_stack_param));
#endif
- if(SvROK(ST(i+1))) {
+ if(SvROK(pl_stack_param)) {
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: fetching code...\n");
#endif
- code = hv_fetch((HV*) SvRV(ST(i+1)), "code", 4, 0);
+ code = hv_fetch((HV*) SvRV(pl_stack_param), "code", 4, 0);
if(code != NULL) {
params[i].l = SvIV(*code);
// callbacks[i].object = ST(i+1);
- origST[i] = ST(i+1);
+ origST[i] = pl_stack_param;
} else {
croak("Win32::API::Call: parameter %d must be a Win32::API::Callback object!\n", i+1);
}
} else {
croak("Win32::API::Call: parameter %d must be a Win32::API::Callback object!\n", i+1);
}
break;
-
+ default:
+ croak("Win32::API::Call: (internal error) unknown type %u\n", tin);
+ break;
}
}
@@ -468,14 +589,25 @@ PPCODE:
}
/* nin is actually number of parameters minus one. I don't know why. */
- retval.t = tout;
+ retval.t = tout & ~T_FLAG_NUMERIC; //flag numeric not in ASM
Call_asm(ApiFunction, params, nin + 1, &retval, c_call);
/* #### THIRD PASS: postfix pointers/structures #### */
for(i = 0; i <= nin; i++) {
- if(params[i].t == T_POINTER && has_proto) {
- if(SvOK(origST[i])) {
- pointerCallUnpack(origST[i], i, intypes);
+ if(params[i].t == T_POINTER && params[i].p){
+ char * sen = SvPVX(sentinal);
+ char * end = SvEND(origST[i]);
+ end -= (sizeof(SENTINAL_STRUCT));
+ if(memcmp(end, sen, sizeof(SENTINAL_STRUCT))){
+ HV * env = get_hv("ENV", GV_ADD);
+ SV ** buf_check = hv_fetchs(env, "WIN32_API_SORRY_I_WAS_AN_IDIOT", 0);
+ if(buf_check && sv_true(*buf_check)) {0;}
+ else{croak("Win32::API::Call: parameter %d had a buffer overflow", i+1);}
+ }else{ //remove the sentinal off the buffer
+ SvCUR_set(origST[i], SvCUR(origST[i])-sizeof(SENTINAL_STRUCT));
+ }
+ if(has_proto && is_more) {
+ pointerCallUnpack(aTHX_ api, origST[i], *av_fetch(intypes, i, 0));
}
}
if(params[i].t == T_STRUCTURE) {
@@ -499,60 +631,100 @@ PPCODE:
}
}
#ifdef WIN32_API_DEBUG
- printf("(XS)Win32::API::Call: freeing memory...\n");
-#endif
- if(nin >= 0) {
- safefree(params);
- safefree(origST);
- }
-#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: returning to caller.\n");
#endif
/* #### NOW PUSH THE RETURN VALUE ON THE (PERL) STACK #### */
+ XSprePUSH;
EXTEND(SP, 1);
+
+ //un/signed prefix is ignored unless implemented, only T_CHAR implemented
+ if((tout & ~(T_FLAG_NUMERIC|T_FLAG_UNSIGNED)) != T_CHAR){
+ tout &= ~T_FLAG_NUMERIC;
+ }
switch(tout) {
+ case T_INTEGER:
case T_NUMBER:
#ifdef WIN32_API_DEBUG
- printf("(XS)Win32::API::Call: returning %d.\n", retval.l);
+ printf("(XS)Win32::API::Call: returning %Id.\n", retval.l);
+#endif
+ retsv = newSViv(retval.l);
+ break;
+ case (T_INTEGER|T_FLAG_UNSIGNED):
+ case (T_NUMBER|T_FLAG_UNSIGNED):
+#ifdef WIN32_API_DEBUG
+ printf("(XS)Win32::API::Call: returning %Iu.\n", retval.l);
+#endif
+ retsv = newSVuv(retval.l);
+ break;
+ case T_SHORT:
+#ifdef WIN32_API_DEBUG
+ printf("(XS)Win32::API::Call: returning %hd.\n", retval.l);
+#endif
+ retsv = newSViv((IV)(short)retval.l);
+ break;
+ case (T_SHORT|T_FLAG_UNSIGNED):
+#ifdef WIN32_API_DEBUG
+ printf("(XS)Win32::API::Call: returning %hu.\n", retval.l);
#endif
- XSRETURN_IV(retval.l);
+ retsv = newSVuv((UV)(unsigned short)retval.l);
break;
case T_FLOAT:
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: returning %f.\n", retval.f);
#endif
- XSRETURN_NV((double) retval.f);
+ retsv = newSVnv((double) retval.f);
break;
case T_DOUBLE:
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: returning %f.\n", retval.d);
#endif
- XSRETURN_NV(retval.d);
+ retsv = newSVnv(retval.d);
break;
case T_POINTER:
if(retval.p == NULL) {
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: returning NULL.\n");
#endif
- XSRETURN_IV(0);
+ RET_PTR_NULL:
+ if(!is_more) retsv = newSViv(0);//old api
+ else retsv = &PL_sv_undef; //undef much clearer
} else {
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: returning 0x%x '%s'\n", retval.p, retval.p);
#endif
- XSRETURN_PV(retval.p);
+ //The user is probably leaking, new pointers are almost always
+ //caller's responsibility
+ if(IsBadStringPtr(retval.p, ~0)) goto RET_PTR_NULL;
+ else {
+ retsv = newSVpv(retval.p, 0);
+ }
}
break;
- case T_INTEGER:
+ case T_CHAR:
+ case (T_CHAR|T_FLAG_UNSIGNED):
+#ifdef WIN32_API_DEBUG
+ printf("(XS)Win32::API::Call: returning char 0x%X .\n", (char)retval.l);
+#endif
+ retsv = newSVpvn((char *)&retval.l, 1);
+ break;
+ case (T_CHAR|T_FLAG_NUMERIC):
+#ifdef WIN32_API_DEBUG
+ printf("(XS)Win32::API::Call: returning numeric char %hd.\n", (char)retval.l);
+#endif
+ retsv = newSViv((IV)(char)retval.l);
+ break;
+ case (T_CHAR|T_FLAG_NUMERIC|T_FLAG_UNSIGNED):
#ifdef WIN32_API_DEBUG
- printf("(XS)Win32::API::Call: returning %d.\n", retval.l);
+ printf("(XS)Win32::API::Call: returning numeric unsigned char %hu.\n", (unsigned char)retval.l);
#endif
- XSRETURN_IV(retval.l);
+ retsv = newSVuv((UV)(unsigned char)retval.l);
break;
case T_VOID:
default:
#ifdef WIN32_API_DEBUG
printf("(XS)Win32::API::Call: returning UNDEF.\n");
#endif
- XSRETURN_UNDEF;
+ retsv = &PL_sv_undef;
break;
}
+ mPUSHs(retsv);
View
BIN API_test.dll
Binary file not shown.
View
BIN API_test64.dll
Binary file not shown.
View
8 Callback.pm
@@ -12,7 +12,7 @@
package Win32::API::Callback;
-$VERSION = '0.68';
+$VERSION = '0.69';
require Exporter; # to export the constants to the main:: space
require DynaLoader; # to dynuhlode the module.
@@ -77,16 +77,16 @@ sub new {
$self{in} = [];
if (ref($in) eq 'ARRAY') {
foreach (@$in) {
- push(@{$self{in}}, Win32::API::type_to_num($_));
+ push(@{$self{in}}, Win32::API->type_to_num($_));
}
}
else {
my @in = split '', $in;
foreach (@in) {
- push(@{$self{in}}, Win32::API::type_to_num($_));
+ push(@{$self{in}}, Win32::API->type_to_num($_));
}
}
- $self{out} = Win32::API::type_to_num($out);
+ $self{out} = Win32::API->type_to_num($out);
$self{sub} = $proc;
my $self = bless \%self, $class;
View
370 Callback/Callback.xs
@@ -17,12 +17,26 @@
#include "EXTERN.h"
#include "perl.h"
+
+//undo perl messing with stdio
+//perl's stdio emulation layer is not OS thread safe
+#define NO_XSLOCKS
#include "XSUB.h"
#define CROAK croak
+
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
+#endif
+
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#endif
+
+
#include "../API.h"
-#pragma optimize("", off)
+
/*
* some Perl macros for backward compatibility
@@ -60,7 +74,6 @@ int PerformCallback(SV* self, int nparams, APIPARAM* params);
SV* fakesv;
int fakeint;
-char *fakepointer;
int RelocateCode(unsigned char* cursor, unsigned int displacement) {
int skip;
@@ -272,6 +285,8 @@ int CallbackMakeStruct(SV* self, int nparam, char *addr) {
// return structobj;
}
+//turn off "global optimizations", -Od -O1 and -O2 tested ok
+#pragma optimize("g", off)
int CALLBACK CallbackTemplate() {
SV* myself = (SV*) 0xC0DE0001; // checkpoint_SELFPOS
int nparams = 0xC0DE0002; // checkpoint_NPARAMS
@@ -285,7 +300,20 @@ int CALLBACK CallbackTemplate() {
// sv_dump(myself);
// if(SvROK(myself)) sv_dump(SvRV(myself));
#endif
-
+#ifdef aTHX
+ {
+ dTHX;
+ if(aTHX == NULL) {
+//perl overrode CRT's fprintf, undo that since the error message has to be
+//printed with zero perl involvement
+ fprintf(stderr, "Win32::API::Callback::CallbackTemplate: no perl interp "
+ "in thread id %u, callback can not run\n", GetCurrentThreadId());
+ r = 0; //dont return uninitialized value
+ checkpoint = 0xC0DE0050;
+ goto END;
+ }
+ }
+#endif
params = (APIPARAM*) safemalloc( nparams * sizeof(APIPARAM) );
checkpoint = 0xC0DE0010; // checkpoint_PUSHI
i = 0xC0DE0003; // checkpoint_IPOS
@@ -335,8 +363,13 @@ int CALLBACK CallbackTemplate() {
#ifdef WIN32_API_DEBUG
printf("(C)CallbackTemplate: RETURNING\n");
#endif
+ END:
+ checkpoint = 0xC0DE0060;
return r;
}
+//restore back to cmd line defaults
+#pragma optimize( "", on )
+
int PerformCallback(SV* self, int nparams, APIPARAM* params) {
SV* mycode;
@@ -385,36 +418,126 @@ int PerformCallback(SV* self, int nparams, APIPARAM* params) {
return r;
}
+unsigned char * FixupAsmSection(unsigned char * cursor, unsigned int section_PUSH, unsigned int j,
+ unsigned int displacement, unsigned char ebpcounter
+#ifdef WIN32_API_DEBUG
+ , char * SvType
+#endif
+ ){
+ unsigned int i, r;
+#ifdef WIN32_API_DEBUG
+ printf("(C)FixupAsmSection: section_PUSH is: 0x%08X\n", section_PUSH);
+#endif
+ for(i=0; i < section_PUSH; i++) {
+ // 8B 15 18 75 3A 00 mov edx,dword ptr [_fakeint (3A7518h)]
+ if(*(cursor+0) == 0x8B
+ //below is a disp32 source
+ //look at ModR/M Byte table in Intel x86 manual, then this makes sense
+ && (((*(cursor+1) & 0x0F) == 0x05 || (*(cursor+1) & 0x0F) == 0x0D) && (*(cursor+1) & 0xF0) < 0x40)
+ && *((int*)(cursor+2)) == (int) &fakeint
+ ) {
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate: FOUND THE %s at 0x%x\n", cursor, SvType);
+ printf("(C)CallbackCreate: writing EBP+%02Xh\n", ebpcounter);
+#endif
+ *(cursor+0) = 0x8B;
+ *(cursor+1) = *(cursor+1) + 0x40; //0x40 is from disp32 to disp 8 ebp
+ *(cursor+2) = ebpcounter;
+ *(cursor+3) = 0x90; // push ecx
+ *(cursor+4) = 0x90; // push esi
+ *(cursor+5) = 0x90; // pop esi
+ cursor += 5;
+ i += 4;
+ }
+ //-Od puts A1 18 85 3A 00 mov eax, ds:_fakeint
+ //opcode A1 is a special case, not a table
+ else if(*(cursor+0) == 0xA1
+ && *((int*)(cursor+1)) == (int) &fakeint){
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate: FOUND THE %s at 0x%x\n", cursor, SvType);
+ printf("(C)CallbackCreate: writing EBP+%02Xh\n", ebpcounter);
+#endif
+ *(cursor+0) = 0x8B;
+ *(cursor+1) = 0x45;
+ *(cursor+2) = ebpcounter;
+ *(cursor+3) = 0x90;
+ *(cursor+4) = 0x90;
+ cursor += 4;
+ i += 3;
+ }
+ else
+ if(*(cursor+0) == 0xC7
+ && *(cursor+1) == 0x45
+ && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC)
+ && *((int*)(cursor+3)) == 0xC0DE0003
+ ) {
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate: FOUND NPARAM at 0x%x\n", cursor);
+ printf("(C)CallbackCreate: writing = 0x%08X\n", j);
+#endif
+ *((int*)(cursor+3)) = j;
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate: NPARAM now is = 0x%08X\n", *((int*)(cursor+3)));
+#endif
+ cursor += 6;
+ i += 5;
+ } else {
+ r = RelocateCode(cursor, displacement);
+ cursor += r;
+ if(r > 1) i += (r-1);
+ }
+
+ }
+ return cursor;
+}
+
unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* callback) {
unsigned char * code;
unsigned char * cursor;
unsigned int i, j, r, toalloc, displacement;
unsigned char ebpcounter = 8;
- unsigned char * source = (unsigned char *) (void *) CallbackTemplate;
+ unsigned char * source;
BOOL done = FALSE;
unsigned int distance = 0;
BOOL added_INIT_STRUCT = FALSE;
int N_structs = 0;
+ unsigned char * myCallbackTemplate = (unsigned char *)CallbackTemplate;
+ unsigned char * myPerformCallback = (unsigned char *)PerformCallback;
+ unsigned char epilog_back_up;
unsigned int
checkpoint_PUSHI = 0,
checkpoint_PUSHL = 0,
checkpoint_PUSHP = 0,
checkpoint_PUSHS = 0,
checkpoint_END = 0,
- checkpoint_DONE = 0;
+ checkpoint_DONE = 0,
+ checkpoint_GOTO_END = 0,
+ checkpoint_END_LABEL = 0
+ ;
unsigned int
section_START,
section_PUSHI,
section_PUSHL,
section_PUSHP,
section_PUSHS,
- section_END;
-
+ section_END,
+ section_END_END_LABEL;
+ //this block deals with VC's ILT jump table
+ if(*myCallbackTemplate == 0xE9){
+//E9 is opcode for JMP rel32, +5 is next instruction +1 is rel32 num
+ myCallbackTemplate = myCallbackTemplate+5+(*(DWORD_PTR *)(myCallbackTemplate+1));
+ }
+ source = myCallbackTemplate;
cursor = source;
+ //this block deals with VC's ILT jump table
+ if(*myPerformCallback == 0xE9){
+//E9 is opcode for JMP rel32, +5 is next instruction +1 is rel32 num
+ myPerformCallback = myPerformCallback+5+(*(DWORD_PTR *)(myPerformCallback+1));
+ }
while(!done) {
if(*(cursor+0) == 0x10
@@ -461,6 +584,34 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
checkpoint_PUSHS = distance - 3;
}
+ if(*(cursor+0) == 0x50
+ && *(cursor+1) == 0x00
+ && *(cursor+2) == 0xDE
+ && *(cursor+3) == 0xC0
+ ) {
+ if(*(cursor+4) == 0xE9){//E9 = jmp rel32
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate.Study: checkpoint_GOTO_END=%d\n", distance);
+#endif
+ checkpoint_GOTO_END = distance + 4;
+ }
+ else{
+ croak("unknown opcode %.2X after 0xC0DE0050 checkpoint");
+ }
+
+ }
+
+ if(*(cursor+0) == 0x60
+ && *(cursor+1) == 0x00
+ && *(cursor+2) == 0xDE
+ && *(cursor+3) == 0xC0
+ ) {
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate.Study: checkpoint_END_LABEL=%d\n", distance);
+#endif
+ checkpoint_END_LABEL = distance + 4;
+ }
+
if(*(cursor+0) == 0x99
&& *(cursor+1) == 0x99
&& *(cursor+2) == 0xDE
@@ -479,24 +630,45 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
}
#endif
-
-
-
if(*(cursor+0) == 0xC9 // leave
- && *(cursor+1) == 0xC3 // ret
+ && *(cursor+1) == 0xC3 // ret
) {
#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate.Study: checkpoint_DONE=%d\n", distance);
+ printf("(C)CallbackCreate.Study: leave ret checkpoint_DONE=%d\n", distance);
#endif
- checkpoint_DONE = distance + 2;
+ epilog_back_up = 2;
+ checkpoint_DONE = distance + 2;
done = TRUE;
}
+ if(*(cursor+0) == 0x8B
+ && *(cursor+1) == 0xE5 //mov esp,ebp
+ && *(cursor+2) == 0x5D //pop ebp
+ && *(cursor+3) == 0xC3 //ret
+ ) {
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate.Study: mov pop ret checkpoint_DONE=%d\n", distance);
+#endif
+ epilog_back_up = 4;
+ checkpoint_DONE = distance + 4;
+ done = TRUE;
+ }
+// this can't possibly work, we can't write in the stdcall stack unwind amount
+// the dyn func will be broken if we go down this path
+
+// // this test only works if the compiler does not reorder the functions in the output.
+// if((unsigned char *) myCallbackTemplate < (unsigned char *) myPerformCallback &&
+// cursor >= (unsigned char *) myPerformCallback) {
+// checkpoint_DONE = distance;
+// done = TRUE;
+// }
// this test only works if the compiler does not reorder the functions in the output.
- if((unsigned char *) CallbackTemplate < (unsigned char *) PerformCallback &&
- cursor >= (unsigned char *) PerformCallback) {
- checkpoint_DONE = distance;
- done = TRUE;
+ if((unsigned char *) myCallbackTemplate < (unsigned char *) myPerformCallback &&
+ cursor >= (unsigned char *) myPerformCallback) {
+ //havent reached the malloc yet, this is safe, no malloc in
+ //XS_Win32__API__Callback_CallbackCreate
+ croak("Win32::API::Callback::CallbackCreate: "
+ "Compiler not supported (couldn't find end of CallbackTemplate)");
}
// TODO: add fallback (eg. if cursor >= CallbackCreate then done)
@@ -510,7 +682,13 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
section_PUSHP = checkpoint_PUSHS - checkpoint_PUSHP;
section_PUSHS = checkpoint_END - checkpoint_PUSHS;
section_END = checkpoint_DONE - checkpoint_END;
+ section_END_END_LABEL = checkpoint_END_LABEL - checkpoint_END;
+#ifdef WIN32_API_DEBUG
+ printf("(C)CallbackCreate: section_PUSHS is: 0x%08X\n", section_PUSHS);
+ printf("(C)CallbackCreate: section_PUSHI is: 0x%08X\n", section_PUSHI);
+ printf("(C)CallbackCreate: section_PUSHP is: 0x%08X\n", section_PUSHP);
+#endif
toalloc = section_START;
toalloc += section_END;
@@ -543,9 +721,8 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
#ifdef WIN32_API_DEBUG
printf("(C)CallbackCreate: fakeint is at: 0x%08X\n", &fakeint);
- printf("(C)CallbackCreate: fakepointer is at: 0x%08X\n", &fakepointer);
printf("(C)CallbackCreate: fakesv is at: 0x%08X\n", &fakesv);
- printf("(C)CallbackCreate: CallbackTemplate is at: 0x%08X\n", CallbackTemplate);
+ printf("(C)CallbackCreate: CallbackTemplate is at: 0x%08X\n", myCallbackTemplate);
printf("(C)CallbackCreate: allocating %d bytes\n", toalloc);
#endif
code = (unsigned char *) malloc(toalloc);
@@ -629,47 +806,11 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
memcpy( (void *) cursor, source + checkpoint_PUSHS, section_PUSHS );
displacement = cursor - (source + checkpoint_PUSHS);
- for(i=0; i < section_PUSHS; i++) {
-
- if(*(cursor+0) == 0x8B
- && *(cursor+1) == 0x15
- && *((int*)(cursor+2)) == (int) &fakeint
- ) {
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: FOUND THE SVPV at 0x%x\n", cursor);
- printf("(C)CallbackCreate: writing EBP+%02Xh\n", ebpcounter);
-#endif
- *(cursor+0) = 0x8B;
- *(cursor+1) = 0x55;
- *(cursor+2) = ebpcounter;
- *(cursor+3) = 0x90; // nop
- *(cursor+4) = 0x90; // nop
- *(cursor+5) = 0x90; // nop
- cursor += 5;
- i += 4;
- } else
- if(*(cursor+0) == 0xC7
- && *(cursor+1) == 0x45
- && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC)
- && *((int*)(cursor+3)) == 0xC0DE0003
- ) {
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: FOUND NPARAM at 0x%x\n", cursor);
- printf("(C)CallbackCreate: writing = 0x%08X\n", j);
-#endif
- *((int*)(cursor+3)) = j;
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: NPARAM now is = 0x%08X\n", *((int*)(cursor+3)));
-#endif
- cursor += 6;
- i += 5;
- } else {
- r = RelocateCode(cursor, displacement);
- cursor += r;
- if(r > 1) i += (r-1);
- }
-
- }
+ cursor = FixupAsmSection(cursor, section_PUSHS, j, displacement, ebpcounter
+#ifdef WIN32_API_DEBUG
+ ,"SVPV"
+#endif
+ );
}
if(params[j].t == T_NUMBER) {
@@ -679,47 +820,11 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
memcpy( (void *) cursor, source + checkpoint_PUSHI, section_PUSHI );
displacement = cursor - (source + checkpoint_PUSHI);
- for(i=0; i < section_PUSHI; i++) {
-
- if(*(cursor+0) == 0x8B
- && *(cursor+1) == 0x15
- && *((int*)(cursor+2)) == (int) &fakeint
- ) {
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: FOUND THE SVIV at 0x%x\n", cursor);
- printf("(C)CallbackCreate: writing EBP+%02Xh\n", ebpcounter);
-#endif
- *(cursor+0) = 0x8B;
- *(cursor+1) = 0x55;
- *(cursor+2) = ebpcounter;
- *(cursor+3) = 0x90; // push ecx
- *(cursor+4) = 0x90; // push esi
- *(cursor+5) = 0x90; // pop esi
- cursor += 5;
- i += 4;
- } else
- if(*(cursor+0) == 0xC7
- && *(cursor+1) == 0x45
- && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC)
- && *((int*)(cursor+3)) == 0xC0DE0003
- ) {
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: FOUND NPARAM at 0x%x\n", cursor);
- printf("(C)CallbackCreate: writing = 0x%08X\n", j);
-#endif
- *((int*)(cursor+3)) = j;
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: NPARAM now is = 0x%08X\n", *((int*)(cursor+3)));
-#endif
- cursor += 6;
- i += 5;
- } else {
- r = RelocateCode(cursor, displacement);
- cursor += r;
- if(r > 1) i += (r-1);
- }
-
- }
+ cursor = FixupAsmSection(cursor, section_PUSHI, j, displacement, ebpcounter
+#ifdef WIN32_API_DEBUG
+ ,"SVIV"
+#endif
+ );
}
@@ -730,47 +835,11 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
memcpy( (void *) cursor, source + checkpoint_PUSHP, section_PUSHP );
displacement = cursor - (source + checkpoint_PUSHP);
- for(i=0; i < section_PUSHP; i++) {
-
- if(*(cursor+0) == 0x8B
- && *(cursor+1) == 0x15
- && *((int*)(cursor+2)) == (int) &fakeint
- ) {
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: FOUND THE SVPV at 0x%x\n", cursor);
- printf("(C)CallbackCreate: writing EBP+%02Xh\n", ebpcounter);
-#endif
- *(cursor+0) = 0x8B;
- *(cursor+1) = 0x55;
- *(cursor+2) = ebpcounter;
- *(cursor+3) = 0x90; // nop
- *(cursor+4) = 0x90; // nop
- *(cursor+5) = 0x90; // nop
- cursor += 5;
- i += 4;
- } else
- if(*(cursor+0) == 0xC7
- && *(cursor+1) == 0x45
- && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC)
- && *((int*)(cursor+3)) == 0xC0DE0003
- ) {
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: FOUND NPARAM at 0x%x\n", cursor);
- printf("(C)CallbackCreate: writing = 0x%08X\n", j);
-#endif
- *((int*)(cursor+3)) = j;
-#ifdef WIN32_API_DEBUG
- printf("(C)CallbackCreate: NPARAM now is = 0x%08X\n", *((int*)(cursor+3)));
-#endif
- cursor += 6;
- i += 5;
- } else {
- r = RelocateCode(cursor, displacement);
- cursor += r;
- if(r > 1) i += (r-1);
- }
-
- }
+ cursor = FixupAsmSection(cursor, section_PUSHP, j, displacement, ebpcounter
+#ifdef WIN32_API_DEBUG
+ ,"SVPV"
+#endif
+ );
}
ebpcounter += 4;
@@ -781,6 +850,11 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
#endif
memcpy( (void *) cursor, source + checkpoint_END, section_END );
+//fixup the goto END; now that the END section is in place, +1 skip E9
+ *(int *)(code+checkpoint_GOTO_END+1) //rel 32 operand
+ = (cursor + section_END_END_LABEL) //abs ptr jmp target, after 0xC0DE0060 mov checkpoint
+ - (code+checkpoint_GOTO_END+1+4); //next instruction after the JMP rel32
+
displacement = cursor - (source + checkpoint_END);
for(i=0; i < section_END; i++) {
@@ -793,8 +867,9 @@ unsigned char * CallbackCreate(int nparams, APIPARAM *params, SV* self, SV* call
printf("(C)CallbackCreate: adjusting callback epilogue...\n");
#endif
- // #### back up two bytes (leave/ret)
- cursor -= 2;
+ // #### back up the cursor to two bytes for (leave/ret)
+ // or 4 bytes for mov/pop/ret
+ cursor -= epilog_back_up;
// #### insert the callback epilogue
*(cursor+0) = 0x8B; // mov esp,ebp
@@ -858,7 +933,7 @@ CODE:
#endif
EXTEND(SP, 1);
if(nin >= 0) {
- params = (APIPARAM *) safemalloc((nin+1) * sizeof(APIPARAM));
+ params = (APIPARAM *) _alloca((nin+1) * sizeof(APIPARAM));
for(i = 0; i <= nin; i++) {
in_type = av_fetch(inlist, i, 0);
params[i].t = SvIV(*in_type);
@@ -868,9 +943,6 @@ CODE:
RETVAL = (unsigned int) CallbackCreate(nin+1, params, self, sub);
#ifdef WIN32_API_DEBUG
printf("(XS)CallbackCreate: got RETVAL=0x%08x\n", RETVAL);
-#endif
- if(nin > 0) safefree(params);
-#ifdef WIN32_API_DEBUG
printf("(XS)CallbackCreate: returning to caller\n");
#endif
OUTPUT:
@@ -906,5 +978,3 @@ CODE:
obj = (HV*) SvRV(self);
obj_code = hv_fetch(obj, "code", 4, FALSE);
if(obj_code != NULL) free((unsigned char *) SvIV(*obj_code));
-
-
View
43 Changes
@@ -1,5 +1,48 @@
History of Win32::API perl extension.
+2012-??-?? Win32::API v0.69 bulk88
+ - Fixed RT #12057, dll leak if func not found
+ (https://rt.cpan.org/Ticket/Display.html?id=12057)
+ - Fixed RT #77048, shorts and short typedefs crashed since 'S'
+ was mapped wrong to structs, fix in Win32::API::More, struct now 'T'
+ in ::More, 'S'/'s' now dies on Win32::API if not Win32::APU::Sturct objs,
+ not crashes
+ (https://rt.cpan.org/Ticket/Display.html?id=77048)
+ - Fixed RT #77055, returned numbers are always signed, unsigneds
+ fixed in Win32::API::More
+ (https://rt.cpan.org/Ticket/Display.html?id=77055)
+ - Fixed RT #77182, "int* var" works, "int *var" unparsable,
+ fixed in core and ::More
+ (https://rt.cpan.org/Ticket/Display.html?id=77182)
+ - Fixed/Added RT #39810, in Win32::API::More for C proto created objs,
+ pointer to numbers are automatically packed and unpacked, now 1234 or
+ 0x04D2 not "\xD2\x04\x00\x00", feature was implemented but broken
+ previously
+ - Fixed, on x64 float "in" params were broken, in 0.68, 4 byte floats were
+ converted to 8 byte doubles of the same (approx) numeric
+ value when being prepared for XMM register loading, a C func
+ that takes floats will read 4 bytes from an XMM register, not 8
+ - Fixed, on x64, for msvc builds, the callstack was lost during
+ Call_x64_real
+ - for a func with char * as return type, NULL caused crash, and perl
+ memleak if it didn't crash on 32bit, char * as a return type's handing
+ is still very flawed, signed/unsigned doesn't work, float * doesn't work,
+ if the char * is dynamically allocated by its source, it is leaked
+ - for a func with char as return type, undef was always returned, fixed
+ - void ** and something ** don't parse, now errors out cleanly on a **
+ - stability improvements to Win32::API::Callback, -Od, -O1, -O2 and
+ Incremental Linkings/ILT now ok on MSVC 2003
+ - on 32 bits, funcs with float return type were silently never called, fixed
+ - if a buffer overflow for pointers is detected, a die is thrown, unless env
+ var "WIN32_API_SORRY_I_WAS_AN_IDIOT" is set
+ - Added, adding unsigned or signed prefixes to C prototype for char
+ family (in only, out not implemented) cause numeric treatment for the
+ scalar parameter, not string
+ treatment, previously unsigned/signed were unparsable
+ - Added Win32::API objs from non-DLL function pointers
+ use as "$function = new Win32::API::More(undef, 123456, 'GetHandle',
+ 'P', 'I');", 123456 is the function pointer
+
2012-04-10 Win32::API v0.68 Cosimo
- Temporarily skip RT#53914 related Callback test that's crashing
View
36 META.yml
@@ -1,20 +1,30 @@
--- #YAML:1.0
-name: Win32-API
-version: 0.65
-abstract: Perl Win32 API Import Facility
-license: perl
+name: Win32-API
+version: 0.68
+abstract: Perl Win32 API Import Facility
author:
- - Cosimo Streppone <cosimo@cpan.org>
- - Aldo Calpini <dada@perl.it>
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
+ - Aldo Calpini <dada@perl.it>, Cosimo Streppone <cosimo@cpan.org>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Test::More: 0
+ Win32: 0
+resources:
+ repository: https://github.com/cosimo/perl5-win32-api
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02