File Coverage

blib/lib/Proc/Memory.pm

Criterion	Covered	Total	%
statement	55	66	83.3
branch	12	22	54.5
condition	1	5	20.0
subroutine	13	15	86.6
pod	5	7	71.4
total	86	115	74.7

use strict;
use warnings;
package Proc::Memory;

# ABSTRACT: Peek/Poke other processes' address spaces
our $VERSION = '0.008'; # VERSION

use Carp;
use Sentinel;
use Scalar::Util 'looks_like_number';
use Alien::libvas;
use Inline  'C' => 'DATA' =>
            enable => 'autowrap';
use Inline 0.56 with => 'Alien::libvas';

=pod

=encoding utf8

=head1 NAME

Proc::Memory - Peek/Poke into processes' address spaces

=head1 SYNOPSIS

    use Proc::Memory;

    my $mem = Proc::Memory->new(pid => $$);

    my $byte = $mem->peek(0x1000);
    my $u32  = $mem->read(0x1000, 4);
    $mem->poke(0x1000, 'L') = 12;


=head1 DESCRIPTION

PEEK/POKE are a BASIC programming language extension for reading and writing memory at a specified address across process boundaries. This module brings similiar capability to Perl.

Eventually, Memory searching capability will also be added.

=head1 IMPLEMENTATION

The module is a Perlish wrapper for L and doesn't expose any extra functionality. L claims support for following backends:

    • win32      - Windows API's {Read,Write}ProcessMemory
    • mach       - Mach Virtual Memory API (vm_copy) - macOS and GNU Hurd
    • process_vm - process_vm_{readv, writev} on Linux 3.2+
    • procfs-mem - /proc/$pid/mem on Linux and some BSDs
    • procfs-as  - /proc/$pid/as on SunOS/Solaris
    • ptrace     - ptrace(2), available on many Unices
    • memcpy     - Trivial implementation that doesn't supports foreign address spaces

I am not able to extensively test all these configurations (or test at all for Solaris). Continous Integration is set up for the Windows, macOS and Linux backends and they should work well. Additionally CPAN testers test it across a multitude of BSD and Linux systems. Filing issues (Preferably on Github) about more exotic systems is more than welcome!

=head1 METHODS AND ARGUMENTS

=over 4

=item new(pid)

Constructs a new Proc::Memory instance.

=cut

sub new {
	my $class = shift;
    my @opts = @_;
    unshift @opts, 'pid' if @_ % 2 == 1;

    my $self = {
        @opts
    };

    looks_like_number $self->{pid}
        or croak q/Pid isn't numeric/;

    $self->{vas} = xs_vas_open($self->{pid}, 0)
        or do {
            if (kill 0, $self->{pid}) {
                croak "PID doesn't exist"
            } else {
                croak "Process access permission denied"
            }
        };

	bless $self, $class;
	return $self;
}

=item peek(addr [, 'pack-string'])

Peeks at the given memory address. C defaults to C<'C'> (A single byte)

=cut

sub peek {
    my $self = shift;
    my $addr = shift;
    my $fmt = shift // 'C';
    $fmt eq 'C'
        or croak 'Pack strings not supported yet';

    my $buf = xs_vas_read($self->{vas}, $addr, 1);
    return $buf;
}



=item poke(addr [, 'pack-string']) = $value # or = ($a, $b)

Pokes a given memory address. If no pack-string is given, the rvalue is written as is

=cut

sub get_poke {
    carp 'Useless use of poke';
    undef;
}
sub set_poke {
    my @args = @{+shift};
    my $self   = shift @args;
    my $buf = shift;
    my $addr  = shift @args or croak 'Address must be specified';
    if (my $fmt = shift @args) {
        $buf = pack($fmt, ref($buf) eq 'ARRAY' ? @{$buf} : $buf);
    }

    my $nbytes = xs_vas_write($self->{vas}, $addr, $buf, length $buf);
    return $nbytes >= 0 ? $nbytes : undef;
}

sub poke :lvalue {
    defined wantarray or croak 'Useless use of poke';
    sentinel obj => [@_], get => \&get_poke, set => \&set_poke
}

=item read(addr, size)

Reads size bytes from given memory address.

=cut

#SV *xs_vas_read(void* vas, unsigned long src, size_t size) {
sub read {
    my $self = shift;
    my $addr = shift;
    my $size = shift;

    my $buf = xs_vas_read($self->{vas}, $addr, $size);
    return $buf;
}

=item write(addr, buf [, count])

Writes C to C

=cut

#ssize_t xs_vas_write(void* vas, unsigned long dst, SV *sv) {
sub write {
    my $self = shift;
    my $addr = shift;
    my $buf  = shift;
    my $bytes  = shift || length $buf;

    my $nbytes = xs_vas_write($self->{vas}, $addr, $buf, $bytes);
    return $nbytes >= 0 ? $nbytes : undef;
}

=item tie(addr, 'pack-string')

Returns a tied variable which can be used like any other variable.
To be implemented

=cut

=item search('pack-string')

To be implemented when libvas provides it

=cut

Inline->init();
1;

=back

=head1 GIT REPOSITORY

L

=head1 SEE ALSO

L
L

=head1 AUTHOR

Ahmad Fatoum C<<  >>, L

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2016 Ahmad Fatoum

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

__DATA__