#!/usr/bin/perl
# env-of --- print environment variables of running process
# Author: Noah Friedman <friedman@splode.com>
# Created: 2008-01-10
# Public domain

# $Id: env-of,v 1.5 2013/08/21 19:23:09 friedman Exp $

# Commentary:
# Code:

$^W = 1; # enable warnings

use strict;
use POSIX;
use Symbol;
use Getopt::Long;

my $opt_verbose = 0;

sub xcat
{
  my $fh = gensym;
  open ($fh, $_[0]) || return;

  local $/ = undef;
  scalar <$fh>;
}

sub basename
{
  local $_ = shift;
  s=.*/==;
  return $_;
}


sub pids
{
  my $dfh = gensym;
  opendir ($dfh, "/proc") || return ;
  my @pids = sort { $a <=> $b } grep { /^\d+$/ } readdir $dfh;
  closedir ($dfh);
  return @pids;
}

sub cmdline
{
  my $pid = shift;
  my $cmdline = xcat ("/proc/$pid/cmdline");
  return unless defined $cmdline;
  split (/\0/, $cmdline);
}

sub exe
{
  my $pid = shift;
  my $exe = readlink ("/proc/$pid/exe");
  return $exe;
}

sub stat_name
{
  my $pid = shift;
  my $stat = xcat ("/proc/$pid/stat");
  return unless defined $stat;
  my @s = split (/\s+/, $stat);
  $s[1] =~ s/^\((.*)\)$/$1/;
  return $s[1];
}

sub pidof
{
  my ($name) = @_;
  my $re = ($name =~ m|^/(.*)/$| ? $1 : undef);

  my @allpids = pids ();
  my @pid;
  for my $p (@allpids)
    {
      my @cmdline = cmdline ($p);
      if (@cmdline
          && ($cmdline[0] eq $name
              || basename ($cmdline[0]) eq $name
              || (defined $re && $cmdline[0] =~ $re)))
        {
          push @pid, $p;
          next;
        }

      my $exe = exe ($p);
      if (defined $exe
          && ($exe eq $name
              || basename ($exe) eq $name
              || (defined $re && $exe =~ $re)))
        {
          push @pid, $p;
          next;
        }

      my $stat_name = stat_name ($p);
      if (defined $stat_name
          && ($stat_name eq $name
              || (defined $re && $stat_name =~ $re)))
        {
          push @pid, $p;
        }
    }

  return @pid;
}

sub env
{
  my $pid = shift;
  local $_ = xcat ("/proc/$pid/environ");
  return unless defined $_;

  my %env;
  map { my ($key, $val) = split (/=/, $_, 2);
        $env{$key} = $val;
      } split (/\0/, $_);

  return \%env;
}

sub varnames
{
  my $env = shift;
  my %var;

  map { if (m=^/(.*)/$=)
          {
            my $re = $1;
            map { $var{$_} = 1 if $_ =~ $re } keys %$env;
          }
        else
          {
            $var{$_} = 1;
          }
      } @_;

  return keys %var;
}

sub sprintenv
{
  my $env = shift;
  my @vars = @_ ? varnames ($env, @_) : keys %$env;

  map { sprintf ("%s=%s\n", $_, $env->{$_})
          if exists $env->{$_} }
      sort { $a cmp $b } @vars;
}

sub parse_options
{
  local *ARGV = \@{$_[0]}; # modify our local arglist, not real ARGV.
  Getopt::Long::config (qw(bundling auto_abbrev require_order));
  GetOptions ("v|verbose" => \$opt_verbose);
}

sub main
{
  parse_options (\@_);
  my $procname = @_ ? shift : $$;
  my @varnames = @_;

  my @pid = ($procname =~ /^\d+$/
             ? $procname
             : pidof ($procname));
  unless (@pid)
    {
      print STDERR "$procname: Cannot find process by name\n";
      exit 1;
    }

  if ($opt_verbose || @pid > 1)
    {
      map {
        my $env = env ($_);
        if ($env)
          {
            my @cmdline = cmdline ($_);
            unless (@cmdline)
              {
                $cmdline[0] = exe ($_) || "";
              }

            printf "%d: %s\n", $_, join (" ", @cmdline);
            print sprintenv ($env, @varnames), "\n";
          }
      } @pid;
    }
  else
    {
      unless (-d "/proc/$pid[0]")
        {
          print STDERR "$pid[0]: No such process\n";
          exit 1;
        }
      my $env = env ($pid[0]);
      print sprintenv ($env, @varnames) if $env;
    }
}

main (@ARGV);

# eof