Dogcows Code - chaz/p5-Linux-Proc-Maps/blob - lib/Linux/Proc/Maps.pm

   1 package Linux::Proc::Maps;
   2 # ABSTRACT: Read and write /proc/[pid]/maps files
   3 # KEYWORDS: linux proc procfs
   4
   5 use 5.008;
   6 use warnings;
   7 use strict;
   8
   9 our $VERSION = '0.002'; # VERSION
  10
  11 use Carp qw(croak);
  12 use Exporter qw(import);
  13 use namespace::clean -except => [qw(import)];
  14
  15 our @EXPORT_OK = qw(read_maps write_maps parse_maps_single_line format_maps_single_line);
  16
  17
  18 sub read_maps {
  19     my %args = @_ == 1 ? (pid => $_[0]) : @_;
  20
  21     my $file = $args{file};
  22
  23     if (!$file and my $pid = $args{pid}) {
  24         if ($pid =~ /^\d+$/) {
  25             require File::Spec::Functions;
  26             my $procfs = $args{mnt} || $ENV{PERL_LINUX_PROC_MAPS_MOUNT} ||
  27                          File::Spec::Functions::catdir(File::Spec::Functions::rootdir(), 'proc');
  28             $file = File::Spec::Functions::catfile($procfs, $pid, 'maps');
  29         }
  30         else {
  31             $file = $args{pid};
  32         }
  33     }
  34
  35     $file or croak 'Filename or PID required';
  36     open(my $fh, '<:encoding(UTF-8)', $file) or croak "Open failed ($file): $!";
  37
  38     my @regions;
  39
  40     while (my $line = <$fh>) {
  41         chomp $line;
  42
  43         my $region = parse_maps_single_line($line);
  44         next if !$region;
  45
  46         push @regions, $region;
  47     }
  48
  49     return \@regions;
  50 }
  51
  52
  53 sub write_maps {
  54     my $regions = shift or croak 'Regions required';
  55     my %args = @_;
  56
  57     ref $regions eq 'ARRAY' or croak 'Regions must be an arrayref';
  58
  59     my $out = '';
  60
  61     for my $region (@$regions) {
  62         $out .= format_maps_single_line($region);
  63     }
  64
  65     # maybe print out the memory regions to a filehandle
  66     my $fh = $args{fh};
  67     if (!$fh and my $file = $args{file}) {
  68         open($fh, '>:encoding(UTF-8)', $file) or croak "Open failed ($file): $!";
  69     }
  70     print $fh $out if $fh;
  71
  72     return $out;
  73 }
  74
  75
  76 sub parse_maps_single_line {
  77     my $line = shift or croak 'Line from a maps file required';
  78
  79     chomp $line;
  80
  81     my ($addr1, $addr2, $read, $write, $exec, $shared, $offset, $device, $inode, $pathname) = $line =~ m{
  82         ^
  83         ([[:xdigit:]]+)-([[:xdigit:]]+)
  84         \s+ ([r-])([w-])([x-])([sp])
  85         \s+ ([[:xdigit:]]+)
  86         \s+ ([[:xdigit:]]+:[[:xdigit:]]+)
  87         \s+ (\d+)
  88         (?: \s+ (.*))?
  89     }x;
  90
  91     return if !$addr1;
  92
  93     no warnings 'portable';     # for hex() on 64-bit perls
  94
  95     return {
  96         address_start   => hex($addr1),
  97         address_end     => hex($addr2),
  98         read            => 'r' eq $read,
  99         write           => 'w' eq $write,
 100         execute         => 'x' eq $exec,
 101         shared          => 's' eq $shared,
 102         offset          => hex($offset),
 103         device          => $device,
 104         inode           => $inode,
 105         pathname        => $pathname || '',
 106     };
 107 }
 108
 109
 110 sub format_maps_single_line {
 111     my $region = shift or croak 'Region required';
 112
 113     my @args = @{$region}{qw(address_start address_end read write execute shared offset device inode)};
 114     $args[2] = $args[2] ? 'r' : '-';
 115     $args[3] = $args[3] ? 'w' : '-';
 116     $args[4] = $args[4] ? 'x' : '-';
 117     $args[5] = $args[5] ? 's' : 'p';
 118
 119     return sprintf("%-72s %s\n", sprintf("%x-%x %s%s%s%s %08x %s %d", @args), $region->{pathname});
 120 }
 121
 122
 123 1;
 124
 125 __END__
 126
 127 =pod
 128
 129 =encoding UTF-8
 130
 131 =head1 NAME
 132
 133 Linux::Proc::Maps - Read and write /proc/[pid]/maps files
 134
 135 =head1 VERSION
 136
 137 version 0.002
 138
 139 =head1 SYNOPSIS
 140
 141     use Linux::Proc::Maps qw(read_maps);
 142
 143     # by pid:
 144     my $vm_regions = read_maps(pid => $$);
 145
 146     # by pid with explicit procfs mount:
 147     my $vm_regions = read_maps(mnt => '/proc', pid => 123);
 148
 149     # by file:
 150     my $vm_regions = read_maps(file => '/proc/456/maps');
 151
 152 =head1 DESCRIPTION
 153
 154 This module reads and writes F</proc/[pid]/maps> files that contain listed mapped memory regions.
 155
 156 =head1 FUNCTIONS
 157
 158 =head2 read_maps
 159
 160 Read and parse a maps file, returning an arrayref of regions (each represented as a hashref). See
 161 L</parse_maps_single_line> to see the format of the hashrefs.
 162
 163     my $regions = read_maps(%args);
 164
 165 Arguments:
 166
 167 =over 4
 168
 169 =item *
 170
 171 C<file> - Path to maps file
 172
 173 =item *
 174
 175 C<pid> - Process ID (one of C<file> or C<pid> is required)
 176
 177 =item *
 178
 179 C<mnt> - Absolute path where L<proc(5)> is mounted (optional, default: C</proc>)
 180
 181 =back
 182
 183 =head2 write_maps
 184
 185 Returns a string with the contents of a maps file from the memory regions passed.
 186
 187     my $file_content = write_maps(\@regions, %args);
 188
 189 This is the opposite of L</read_maps>.
 190
 191 Arguments:
 192
 193 =over 4
 194
 195 =item *
 196
 197 C<fh> - Write maps to this open file handle (optional)
 198
 199 =item *
 200
 201 C<file> - Open this filepath and write maps to that file (optional)
 202
 203 =back
 204
 205 =head2 parse_maps_single_line
 206
 207 Parse and return a single line from a maps file into a region represented as a hashref.
 208
 209     my $region = parse_maps_single_line($line);
 210
 211 For example,
 212
 213     # address         perms offset  dev   inode   pathname
 214     08048000-08056000 r-xp 00000000 03:0c 64593   /usr/sbin/gpm
 215
 216 becomes:
 217
 218     {
 219         address_start   => 134512640,
 220         address_end     => 134569984,
 221         read            => 1,
 222         write           => '',
 223         execute         => 1,
 224         shared          => '',
 225         offset          => 0,
 226         device          => '03:0c'
 227         inode           => '64593',
 228         pathname        => '/usr/sbin/gpm',
 229     }
 230
 231 =head2 format_maps_single_line
 232
 233 Return a single line for a maps file from a region represented as a hashref.
 234
 235     my $line = format_maps_single_line(\%region);
 236
 237 This is the opposite of L</parse_maps_single_line>.
 238
 239 =head1 SEE ALSO
 240
 241 L<proc(5)> describes the file format.
 242
 243 =head1 CAVEATS
 244
 245 Integer overloading may occur if you try to parse memory regions from address spaces larger than
 246 your current architecture (or perl) supports. This is currently not fatal, though you will get
 247 warnings from perl that you probably shouldn't ignore.
 248
 249 =head1 BUGS
 250
 251 Please report any bugs or feature requests on the bugtracker website
 252 L<https://github.com/chazmcgarvey/Linux-Proc-Maps/issues>
 253
 254 When submitting a bug or request, please include a test-file or a
 255 patch to an existing test-file that illustrates the bug or desired
 256 feature.
 257
 258 =head1 AUTHOR
 259
 260 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 261
 262 =head1 COPYRIGHT AND LICENSE
 263
 264 This software is copyright (c) 2016 by Charles McGarvey.
 265
 266 This is free software; you can redistribute it and/or modify it under
 267 the same terms as the Perl 5 programming language system itself.
 268
 269 =cut