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