Perl alternative to hash_hmac('ripemd160', $data, $key) in PHP - perl

I need to produce same result in Perl that hash_hmac('ripemd160', $data, $key) produces in PHP
Managed to trace it down to two perl modules, just cant get them working together...
Digest::HMAC and Crypt::RIPEMD160
use Crypt::RIPEMD160;
use Digest::HMAC;
$hmac = Digest::HMAC->new('bar', 'Crypt::RIPEMD160');
$hmac->add('foo');
$digest = $hmac->digest;
anyone got any ideas what am i doing wrong?
If i use the code above i get following error:
Can't call method "add" on an undefined value at /usr/lib64/perl5/vendor_perl/5.12.4/Digest/HMAC.pm line 28.
Since i was unable to pass the hash function reference in the code above, after looking at the HMAC module at the hmac function i thought i could write it in my code direct:
my $data = 'bar';
my $key = 'foo';
$block_size = 160;
$block_size ||= 64;
$key = Crypt::RIPEMD160->hash($key) if length($key) > $block_size;
my $k_ipad = $key ^ (chr(0x36) x $block_size);
my $k_opad = $key ^ (chr(0x5c) x $block_size);
my $digest = Crypt::RIPEMD160->hash($k_opad, Crypt::RIPEMD160->hash($k_ipad, $data));
this does produce a hash but still a wrong one
PHP generated hash: isceebbf5cd5e34c888b493cf7f7c39a7b181b65a3
The perl hash: hash21a2fa2bf39fd99d4c9cdf147added69c32d45f9e
To be honest i dont care how its done and what modules are used as long as I get same hash as the php function produces... at this point I am tempted writing a php script that i call from perl just to get that hash... :( as I am runing out of ideas...

The Digest::HMAC only includes Digest::HMAC_MD5 and Digest::HMAC_SHA1. However, I took a look at the Perl code for Digest::HMAC_MD5. The whole thing is about 20 lines of code. It basically creates two methods:
sub hmac_md5 {
hmac($_[0], $_[1], \&md5, 64);
}
and
sub hmac_md5_hex {
unpack("H*", &hmac_md5);
}
That's pretty much the entire program.
If you forget about the object oriented style of the package, and use the functional style, it looks like this might work for you:
hmac($data, $key, \&ripemd160, 160);
or maybe just:
hmac($data, $key \&ripemd160);
In fact, that's documented on the CPAN Digest::HMAC page itself.

I am perhaps a bit late in this discussion but when talking about Crypt::Digest::RIPEMD160 (I am the author of this module :) you can easily create HMAC with Crypt::Mac::HMAC from the same family of modules.
It is as simple as:
use Crypt::Mac::HMAC 'hmac';
$hmac_raw = hmac('RIPEMD160', $key, $data);

The reason your code doesn't work is that, while the interface provided by Crypt::RIPEMD160 looks similar to the standard Digest interface, it's not quite compatible: in particular, the reset() method of Crypt::RIPEMD160 apparently doesn't return a reference to the object it's called on, and the code in Digest::HMAC happens to rely on that detail.
This incompatibility would be a trivial things to fix by slightly tweaking either module, either to add the missing return value to Crypt::RIPEMD5 or to make Digest::HMAC less reliant on needless method chaining. The latter would be as easy as changing the line:
$self->{hasher}->reset->add($self->{k_opad}, $inner_digest);
in Digest::HMAC to:
$self->{hasher}->reset;
$self->{hasher}->add($self->{k_opad}, $inner_digest);
(Of course, I'm not suggesting that you do this yourself, although you could report the issue to the maintainers of those modules.)
However, with both modules as they currently are, it just won't work. The solutions I'd recommend would be to either use the non-OO interface, as David W. suggests, or try the newer Crypt::Digest::RIPEMD160 module, which properly implements the Digest interface and should play nicer with Digest::HMAC.
Edit:
Actually, David W.'s suggestion won't work as given, because Crypt::RIPEMD160 doesn't export a non-OO ripemd160() function. You could, however, easily create one:
use Crypt::RIPEMD160;
sub ripemd160 {
return Crypt::RIPEMD160->hash( join "", #_ );
}
and then use it like this:
use Digest::HMAC qw( hmac );
sub hmac_ripemd160 {
return hmac( #_[0, 1], \&ripemd160, 64 );
}
(Yes, 64 bytes is the correct block size from HMAC-RIPEMD160, since the input block length of RIPEMD160 is 16 32-bit words, which equals 512 bits or 64 bytes. In practice, using the wrong input block size is very unlikely to cause any issues, other than for interoperability of course, but the security proof of the HMAC construction assumes, for simplicity, that the key is padded to be exactly one input block long. Thus, and in order to ensure that all implementations of HMAC-RIPEMD160 produce the same output for the same key and message, it's best to stick to this rule.)
Edit 2: OK, I tried to test the code I posted above against the HMAC-RIPEMD160 test vectors from RFC 2286, and just could not get the results to match. What I finally realized was two things:
The non-OO hmac() function exported by Digest::HMAC assumes that the custom hash function passed to it will accept multiple parameters and concatenate them. My original implementation of the ripemd160() wrapper above did not (but I fixed it so that now it does). This is arguably a bug in Digest::HMAC, or at least in its documentation.
The Crypt::RIPEMD160 module comes with the submodule Crypt::RIPEMD160::MAC, which already implements HMAC-RIPEMD160, even though, for some perverse reason, the documentation doesn't actually use the name HMAC. If you look at the code, though, or just compare the output to the official test vectors, that's indeed exactly what it does.

Related

Make perl look ahead for sub prototypes

Perl is a bit too forgiving: If you pass extra arguments to subs they are simply ignored.
To avoid this I would like to use prototypes to make sure each sub is given the correct amount of arguments.
This works OK as long as I declare the prototype before using it:
sub mysub($);
sub mysub2($);
mysub(8);
mysub(8,2); # Complain here
sub mysub($) {
mysub2($#);
}
sub mysub2($) {
if($_[0] == 1) {
mysub(2);
}
print $#;
}
But I really hate splitting this up. I would much rather that Perl read the full file to see if there are declarations further down. So I would like to write something like:
use prototypes_further_down; # This does not work
mysub(8);
mysub(8,2); # Complain here
sub mysub($) {
mysub2($#);
}
sub mysub2($) {
if($_[0] == 1) {
mysub(2);
}
print $#;
}
Can I somehow ask Perl to do that?
To avoid this I would like to use prototypes to make sure each sub is given the correct amount of arguments.
No, you would not. Despite the similarity in name, Perl prototypes are not your father's function prototypes. Quoting The Problem with Prototypes (emphasis mine),
Perl 5's prototypes serve two purposes. First, they're hints to the parser to change the way it parses subroutines and their arguments. Second, they change the way Perl 5 handles arguments to those subroutines when it executes them. A common novice mistake is to assume that they serve the same language purpose as subroutine signatures in other languages. This is not true.
In addition to them not having the same intended purpose, bypassing prototypes is trivial, so they provide no actual protection against someone who deliberately wishes to call your code in (what you believe to be) the "wrong" way. As perldoc perlsub tells us,
The function declaration must be visible at compile time. The prototype affects only interpretation of new-style calls to the function, where new-style is defined as not using the & character. In other words, if you call it like a built-in function, then it behaves like a built-in function. If you call it like an old-fashioned subroutine, then it behaves like an old-fashioned subroutine. It naturally falls out from this rule that prototypes have no influence on subroutine references like \&foo or on indirect subroutine calls like &{$subref} or $subref->().
Method calls are not influenced by prototypes either, because the function to be called is indeterminate at compile time, since the exact code called depends on inheritance.
Even if you could get it to complain about mysub(8,2), &mysub(8,2) or $subref = \&mysub; $subref->(8,2) or (if mysub were an object method inside package MyModule) $o = MyModule->new; $o->mysub(8,2) would work without complaint.
If you want to validate how your subs are called using core Perl (prior to 5.20), then you need to perform the validation yourself within the body of the sub. Perl 5.20 and newer have a ("experimental" at the time of this writing) Signatures extension to sub declarations which may work for your purposes, but I've never used it myself, so I can't speak to its effectiveness or limitations. There are also many CPAN modules available for handling this sort of thing, which you can find by doing searches for things like "signature" or "prototype".
Regardless of your chosen approach, you will not be able to get compile-time errors about incorrect function signatures unless you define those signatures before they are used. In cases such as your example, where two subs mutually call each other, this can be accomplished by using a forward declaration to establish its signature in advance:
sub mysub($foo); # Forward declaration
sub mysub2 { mysub(8) }
sub mysub { mysub2('infinite loops ftw!') } # Complete version of the code

Returning "references" and not values from sub?

I have a sub in perl (generated automatically by SWIG) that I want to return multiple values from. However, I seem to be getting variable meta-data instead of the actual values.
sub getDate {
my $tm = *libswigperlc::MyClass_getDate;
($tm.sec, $tm.min, $tm.hour, $tm.day, $tm.month, $tm.year + 1900);
}
The caller is like this...
my ($sec,$min,$hour,$day,$month,$year) = $s->getDate();
print "$year-$month-$day $hour:$min\n";
The $tm.year + 1900 does return the value as wanted. If I add "+ 1" to the other values, they work as wanted too.
But
print $month;
results in
*libswigperlc::MyClass_getDatemonth
instead of
3
What is the best way to return the values to the caller?
I am a novice perl user - I use C++ normally.
Let's go for a longer answer here:
First of all, are you using strict and warnings pragmas? (use strict; use warnings;) They will save you a lot of time by taking some of your Perl freedom away (To me, without them you're stepping out from freedom into extreme anarchism (: ).
$tm . sec would do this: tries to concatenate $tm with sec. Then what's sec?
-If you are using strict pragma, then sec is a sub declared somewhere before the call
-If you are not using strict pragma (I guess this is the case) sec is used as a bareword.
What is *libswigperlc::MyClass_getDate? Is it returning an object that's overloading concatenation operator(.) and/or add operator (+) in it? If yes (and specially without strict/warnings pragmas) you may expect any kind of result depending on the definition of the overload functions. Getting a correct result that you are getting by putting + is one of the possibilities.
That's all that comes to my mind, I hope others add their explanations too or correct mine.
tchrist - you were right to question the typeglob line. That line was generated by Swig, and I had no understanding of it.
All I had to do was return the typeglob as is...
sub getDate {
*libswigperlc::MyClass_getDate2;
}
Now the caller can access the members like this...
my $tm = myClass->getDate();
print "Year = $tm->{year}";
At least now I understand it just well enough to know to leave it as it is, or to change it to be the way as per the original idea.

Can Perl method calls be intercepted?

Can you intercept a method call in Perl, do something with the arguments, and then execute it?
Yes, you can intercept Perl subroutine calls. I have an entire chapter about that sort of thing in Mastering Perl. Check out the Hook::LexWrap module, which lets you do it without going through all of the details. Perl's methods are just subroutines.
You can also create a subclass and override the method you want to catch. That's a slightly better way to do it because that's the way object-oriented programming wants you do to it. However, sometimes people write code that doesn't allow you to do this properly. There's more about that in Mastering Perl too.
To describe briefly, Perl has the aptitude to modify symbol table. You call a subroutine (method) via symbol table of the package, to which the method belongs. If you modify the symbol table (and this is not considered very dirty), you can substitute most method calls with calling the other methods you specify. This demonstrates the approach:
# The subroutine we'll interrupt calls to
sub call_me
{
print shift,"\n";
}
# Intercepting factory
sub aspectate
{
my $callee = shift;
my $value = shift;
return sub { $callee->($value + shift); };
}
my $aspectated_call_me = aspectate \&call_me, 100;
# Rewrite symbol table of main package (lasts to the end of the block).
# Replace "main" with the name of the package (class) you're intercepting
local *main::call_me = $aspectated_call_me;
# Voila! Prints 105!
call_me(5);
This also shows that, once someone takes reference of the subroutine and calls it via the reference, you can no longer influence such calls.
I am pretty sure there are frameworks to do aspectation in perl, but this, I hope, demonstrates the approach.
This looks like a job for Moose! Moose is an object system for Perl that can do that and lots more. The docs will do a much better job at explaining than I can, but what you'll likely want is a Method Modifier, specifically before.
You can, and Pavel describes a good way to do it, but you should probably elaborate as to why you are wanting to do this in the first place.
If you're looking for advanced ways of intercepting calls to arbitrary subroutines, then fiddling with symbol tables will work for you, but if you want to be adding functionality to functions perhaps exported to the namespace you are currently working in, then you might need to know of ways to call functions that exist in other namespaces.
Data::Dumper, for example, normally exports the function 'Dumper' to the calling namespace, but you can override or disable that and provide your own Dumper function which then calls the original by way of the fully qualified name.
e.g.
use Data::Dumper;
sub Dumper {
warn 'Dumping variables';
print Data::Dumper::Dumper(#_);
}
my $foo = {
bar => 'barval',
};
Dumper($foo);
Again, this is an alternate solution that may be more appropriate depending on the original problem. A lot of fun can be had when playing with the symbol table, but it may be overkill and could lead to hard to maintain code if you don't need it.
Yes.
You need three things:
The arguments to a call are in #_ which is just another dynamically scoped variable.
Then, goto supports a reference-sub argument which preserves the current #_ but makes another (tail) function call.
Finally local can be used to create lexically scoped global variables, and the symbol tables are buried in %::.
So you've got:
sub foo {
my($x,$y)=(#_);
print "$x / $y = " . ((0.0+$x)/$y)."\n";
}
sub doit {
foo(3,4);
}
doit();
which of course prints out:
3 / 4 = 0.75
We can replace foo using local and go:
my $oldfoo = \&foo;
local *foo = sub { (#_)=($_[1], $_[0]); goto $oldfoo; };
doit();
And now we get:
4 / 3 = 1.33333333333333
If you wanted to modify *foo without using its name, and you didn't want to use eval, then you could modify it by manipulating %::, for example:
$::{"foo"} = sub { (#_)=($_[0], 1); goto $oldfoo; };
doit();
And now we get:
3 / 1 = 3

How can I elegantly call a Perl subroutine whose name is held in a variable?

I keep the name of the subroutine I want to call at runtime in a variable called $action. Then I use this to call that sub at the right time:
&{\&{$action}}();
Works fine. The only thing I don't like is that it's ugly and every time I do it, I feel beholden to add a comment for the next developer:
# call the sub by the name of $action
Anyone know a prettier way of doing this?
UPDATE: The idea here was to avoid having to maintain a dispatch table every time I added a new callable sub, since I am the sole developer, I'm not worried about other programmers following or not following the 'rules'. Sacrificing a bit of security for my convenience. Instead my dispatch module would check $action to make sure that 1) it is the name of a defined subroutine and not malicious code to run with eval, and 2) that it wouldn't run any sub prefaced by an underscore, which would be marked as internal-only subs by this naming convention.
Any thoughts on this approach? Whitelisting subroutines in the dispatch table is something I will forget all the time, and my clients would rather me err on the side of "it works" than "it's wicked secure". (very limited time to develop apps)
FINAL UPDATE: I think I've decided on a dispatch table after all. Although I'd be curious if anyone who reads this question has ever tried to do away with one and how they did it, I have to bow to the collective wisdom here. Thanks to all, many great responses.
Rather than storing subroutine names in a variable and calling them, a better way to do this is to use a hash of subroutine references (otherwise known as a dispatch table.)
my %actions = ( foo => \&foo,
bar => \&bar,
baz => sub { print 'baz!' }
...
);
Then you can call the right one easily:
$actions{$action}->();
You can also add some checking to make sure $action is a valid key in the hash, and so forth.
In general, you should avoid symbolic references (what you're doing now) as they cause all kinds of problems. In addition, using real subroutine references will work with strict turned on.
Just &$action(), but usually it's nicer to use coderefs from the beginning, or use a dispatcher hash. For example:
my $disp = {foo => \&some_sub, bar => \&some_other_sub };
$disp->{'foo'}->();
Huh? You can just say
$action->()
Example:
sub f { return 11 }
$action = 'f';
print $action->();
$ perl subfromscalar.pl
11
Constructions like
'f'->() # equivalent to &f()
also work.
I'm not sure I understand what you mean. (I think this is another in a recent group of "How can I use a variable as a variable name?" questions, but maybe not.)
In any case, you should be able to assign an entire subroutine to a variable (as a reference), and then call it straightforwardly:
# create the $action variable - a reference to the subroutine
my $action = \&sing_out;
# later - perhaps much later - I call it
$action->();
sub sing_out {
print "La, la, la, la, la!\n"
}
The most important thing is: why do you want to use variable as function name. What will happen if it will be 'eval'?
Is there a list of functions that can be used? Or can it be any function? If list exists - how long it is?
Generally, the best way to handle such cases is to use dispatch tables:
my %dispatch = (
'addition' => \&some_addition_function,
'multiplication' => sub { $self->call_method( #_ ) },
);
And then just:
$dispatch{ $your_variable }->( 'any', 'args' );
__PACKAGE__->can($action)->(#args);
For more info on can(): http://perldoc.perl.org/UNIVERSAL.html
I do something similar. I split it into two lines to make it slightly more identifiable, but it's not a lot prettier.
my $sub = \&{$action};
$sub->();
I do not know of a more correct or prettier way of doing it. For what it's worth, we have production code that does what you are doing, and it works without having to disable use strict.
Every package in Perl is already a hash table. You can add elements and reference them by the normal hash operations. In general it is not necessary to duplicate the functionality by an additional hash table.
#! /usr/bin/perl -T
use strict;
use warnings;
my $tag = 'HTML';
*::->{$tag} = sub { print '<html>', #_, '</html>', "\n" };
HTML("body1");
*::->{$tag}("body2");
The code prints:
<html>body1</html>
<html>body2</html>
If you need a separate name space, you can define a dedicated package.
See perlmod for further information.
Either use
&{\&{$action}}();
Or use eval to execute the function:
eval("$action()");
I did it in this way:
#func = qw(cpu mem net disk);
foreach my $item (#func){
$ret .= &$item(1);
}
If it's only in one program, write a function that calls a subroutine using a variable name, and only have to document it/apologize once?
I used this: it works for me.
(\$action)->();
Or you can use 'do', quite similar with previous posts:
$p = do { \&$conn;};
$p->();

What's the best way to discover all subroutines a Perl module has?

What's the best way to programatically discover all of the subroutines a perl module has? This could be a module, a class (no #EXPORT), or anything in-between.
Edit: All of the methods below look like they will work. I'd probably use the Class::Sniff or Class::Inspector in production. However, Leon's answer is marked as 'accepted' since it answers the question as posed, even though no strict 'refs' has to be used. :-) Class::Sniff may be a good choice as it progresses; it looks like a lot of thought has gone into it.
sub list_module {
my $module = shift;
no strict 'refs';
return grep { defined &{"$module\::$_"} } keys %{"$module\::"}
}
ETA: if you want to filter out imported subroutines, you can do this
use B qw/svref_2object/;
sub in_package {
my ($coderef, $package) = #_;
my $cv = svref_2object($coderef);
return if not $cv->isa('B::CV') or $cv->GV->isa('B::SPECIAL');
return $cv->GV->STASH->NAME eq $package;
}
sub list_module {
my $module = shift;
no strict 'refs';
return grep { defined &{"$module\::$_"} and in_package(\&{*$_}, $module) } keys %{"$module\::"}
}
Class::Inspector:
Class::Inspector allows you to get information about a loaded class. Most or all of this information can be found in other ways, but they aren't always very friendly, and usually involve a relatively high level of Perl wizardry, or strange and unusual looking code. Class::Inspector attempts to provide an easier, more friendly interface to this information...
Have a look at this:
Class::Sniff
The interface is rather ad-hoc at the moment and is likely to change. After creating a new instance, calling the report method is your best option. You can then visually examine it to look for potential problems:
my $sniff = Class::Sniff->new({class => 'Some::Class'});
print $sniff->report;
This module attempts to help programmers find 'code smells' in the object-oriented code. If it reports something, it does not mean that your code is wrong. It just means that you might want to look at your code a little bit more closely to see if you have any problems.
At the present time, we assume Perl's default left-most, depth-first search order. We may alter this in the future (and there's a work-around with the paths method. More on this later)...