How do I check an installed Apache module in Perl? - linux

I'm writing a Perl script to check and see if a module is currently installed for Apache. In Bash, I would use:
# httpd -M | grep fcgid
Syntax OK
fcgid_module (shared)
I want this to return a value of TRUE if that module exists and FALSE if it does not. I'm running into a problem though, because httpd -M always outputs "Syntax OK."
Here is what I 've got so far:
#!/usr/bin/perl
my $FCGID = "";
if (`httpd -M | grep fcgid`) {
$FCGID = "enabled"
} else {
$FCGID = "disabled"
}
The IF always evaluates as true though.
About my configuration:
x86_64 GNU/Linux
# cat /etc/redhat-release
CentOS release 6.2 (Final)
# httpd -v
Server version: Apache/2.2.15 (Unix)
# perl -v
This is perl, v5.10.1 (*) built for x86_64-linux-thread-multi
Open to suggestions. I'm pretty new at Perl and still kinda new at Bash scripting.

perl 2>/dev/null -le 'my #list = qx(httpd -D DUMP_MODULES ); print "FCGI found" if ( grep { $_ =~ /fcgi/ } #list ) '

It turns out I just need to redirect the output and I was confused about how to do that.
$ httpd -M 2> /dev/null | grep fcgid_module
fcgid_module (shared)
So in PERL, I can evaluate that BASH expression and save it into a variable and test against the variable in the IF statement.
my $FCGI = "";
my $FCGI_mod = `httpd -M 2> /dev/null | grep fcgid_module`;
if ( $FCGI_mod eq "" ) {
$FCGI = "disabled"
} else {
$FCGI = "enabled"
}
It's not the prettiest, but it does what I need it to.
Thank you to those who looked into it!

Related

Variables with ssh and awk with perl

Trying to execute remotely a bunch of commands in a perl script
This looks like that :
$CMD1 = "/usr/sbin/mminfo -av -q \"savetime>'-1 day 18:00:00',savetime<'17:59:59'\" -r \"ssid,totalsize,nfiles,pool\"|grep \"xxxxx\"|/usr/bin/awk '!seen[\$1]++'";
print Dumper $CMD1;
$CMD = "/usr/bin/ssh xxxx\#$SRV \'$CMD1\' 2>&1";
print Dumper $CMD;
But I still have problem with the $1 in the awk command, It seems to be cancelled when running.
What I can see :
$VAR1 = '/usr/sbin/mminfo -av -q "savetime>\'-1 day 18:00:00\',savetime<\'17:59:59\'" -r "ssid,totalsize,nfiles,pool"|grep "xxxxxx"|/usr/bin/awk \'!seen[$1]++\'';
$VAR1 = '/usr/bin/ssh xxxxx#\'xxxxxx\' \'/usr/sbin/mminfo -av -q "savetime>\'-1 day 18:00:00\',savetime<\'17:59:59\'" -r "ssid,totalsize,nfiles,pool"|grep "xxxxx"|/usr/bin/awk \'!seen[$1]++\'\' 2>&1';
So the '$1' of the awk command is passed correctly to the remote but when running :
#RESU = `$CMD`;
print Dumper #RESU;
I can see that my $1 is missing (or interpretated by the remote shell as a null value) :
$VAR1 = 'awk: ligne de commande:1: !seen[]++
';
$VAR2 = 'awk: ligne de commande:1: ^ syntax error
';
$VAR3 = 'awk: ligne de commande:1: error: expression indice non valide
';
I've tried many things like quoting or double-quoting the string, creating the string with perl 'qq' function, putting value of $CMD1 directly in $CMD and escaping quotes but no way.
And of course, my awk is piped to another awk (not provided here).
I don't want a solution which runs awk localy since I've millions lines returned from the 'mminfo' command.
Any clue (or a better way to do that !) ?
You might want to break it into smaller pieces for readability, and use the multi-arg invocation of system to avoid perl having to spawn a shell. The q() function goes a long way toward avoiding quoting hell.
$mminfo = q{/usr/sbin/mminfo -av -q "savetime>'-1 day 18:00:00',savetime<'17:59:59'" -r "ssid,totalsize,nfiles,pool"};
$awk = q{/usr/bin/awk '/xxxxx/ && !seen[$1]++');
print Dumper [$mminfo, $awk];
#cmd = ( "/usr/bin/ssh", "xxxx\#$SRV", "$mminfo | $awk" );
print Dumper \#cmd;
system #cmd;
Even if you can not use modules in your final environment, you may be able to use them in your local machine. In that case you can use them to quote the command programmatically and then just copy and paste the quoted string into the script you are developing. For instance:
use strict;
use warnings;
use Net::OpenSSH;
my $quoted_cmd1 = Net::OpenSSH->shell_quote('/usr/sbin/mminfo', '-av',
-q => q(savetime>'-1 day 18:00:00',savetime<'17:59:59'),
-r => 'ssid,totalsize,nfiles,pool',
\\'|',
'grep', 'xxxxx',
\\'|',
'/usr/bin/awk', '!seen[$1]++');
my $SRV = "foo";
my $quoted_cmd = Net::OpenSSH->shell_quote('/usr/bin/ssh', "xxxx\#$SRV",
$quoted_cmd1,
\\'2>&1');
print "$quoted_cmd\n";
Which outputs...
/usr/bin/ssh xxxx#foo '/usr/sbin/mminfo -av -q '\''savetime>'\''\'"''"'-1 day 18:00:00'\''\'"''"',savetime<'\''\'\''17:59:59\'\'' -r ssid,totalsize,nfiles,pool | grep xxxxx | /usr/bin/awk '\''!seen[$1]++'\' 2>&1

how to redirect this perl script's output to file?

I don't have much experience with perl, and would appreciate any/all feedback....
[Before I start: I do not have access/authority to change the existing perl scripts.]
I run a couple perl scripts several times a day, but I would like to begin capturing their output in a file.
The first perl script does not take any arguments, and I'm able to "tee" its output without issue:
/asdf/loc1/rebuild-stuff.pl 2>&1 | tee $mytmpfile1
The second perl script hangs with this command:
/asdf/loc1/create-site.pl --record=${newsite} 2>&1 | tee $mytmpfile2
FYI, the following command does NOT hang:
/asdf/loc1/create-site.pl --record=${newsite} 2>&1
I'm wondering if /asdf/loc1/create-site.pl is trying to process the | tee $mytmpfile2 as additional command-line arguments? I'm not permitted to share the entire script, but here's the beginning of its main routine:
...
my $fullpath = $0;
$0 =~ s%.*/%%;
# Parse command-line options.
...
Getopt::Long::config ('no_ignore_case','bundling');
GetOptions ('h|help' => \$help,
'n|dry-run|just-print' => \$preview,
'q|quiet|no-mail' => \$quiet,
'r|record=s' => \$record,
'V|noverify' => \$skipverify,
'v|version' => \$version) or exit 1;
...
Does the above code provide any clues? Other than modifying the script, do you have any tips for allowing me to capture its output in a file?
It's not hanging. You are "suffering from buffering". Like most programs, Perl's STDOUT is buffered by default. Like most programs, Perl's STDOUT is flushed by a newline when connected to a terminal, and block buffered otherwise. When STDOUT isn't connected to a terminal, you won't get any output until 4 KiB or 8 KiB of output is accumulated (depending on your version of Perl) or the program exits.
You could add $| = 1; to the script to disable buffering for STDOUT. If your program ends with a true value or exits using exit, you can do that without changing the .pl file. Simply use the following wrapper:
perl -e'
$| = 1;
$0 = shift;
do($0);
my $e = $# || $! || "$0 didn\x27t return a true value\n";
die($e) if $e;
' -- prog args | ...
Or you could fool the program into thinking it's connected to a terminal using unbuffer.
unbuffer prog args | ...

prstat in Ubuntu or Centos

As the Java Performance said:
Solaris prstat has additional capabilities
such as reporting both user and kernel or system CPU utilization along with other
microstate information using the prstat -m and -L options. The -m option prints
microstate information, and -L prints statistics on per lightweight process.
There is any tool available like prstat in Centos or Ubuntu ?
I believe the Linux commands you are looking for are top and pstree .
Here is ptree for Linux,
#!/bin/sh
# Solaris style ptree
[ -x /usr/bin/ptree ] && exec /usr/bin/ptree "$#"
# Print process tree
# $1 = PID : extract tree for this process
# $1 = user : filter for this (existing) user
# $1 = user $2 = PID : do both
PATH=/bin:/usr/bin:/usr/sbin:/sbin
export PATH
psopt="-e"
case $1 in
[a-z]*) psopt="-u $1";shift;;
esac
[ -z "$1" ] &&
exec ps $psopt -Ho pid=,args=
#some effort to add less to the ps list
tmp=/tmp/ptree.$$
trap 'rm $tmp' 0 HUP INT TERM
ps $psopt -Ho pid=,args= >$tmp
<$tmp awk '
{ ci=index(substr($0,7),$2); o[ci]=$0 }
ci>s[a] { s[++a]=ci }
$1==pid {
for(i=1;i<=a;i++) {
si=s[i]; if(si<=ci) print o[si]
}
walkdown=ci
next
}
ci<walkdown { exit }
walkdown!=0 { print }
' pid="$1"
There is no prstat "equivalent" tool in Linux. You can use a combination of top and ps (or /proc/$pid/ resources) to get some useful result; maybe writing a shell script (using grep, sed and awk) which collects results from above commands and files.
Just for reference I found this link about top command and kernel, user and idle CPU utilization intresting
http://blog.scoutapp.com/articles/2015/02/24/understanding-linuxs-cpu-stats
Hope this helps.

Dropping privileges from perl script?

I have a perl script running as root, and from within it I want to execute a system command bar as a lesser priveleged user foo. So I have my system call wrapped as follows:
sub dosys
{
system(#_) == 0
or die "system #_ failed: $?";
}
And so I want to say:
as user foo dosys("bar")
Is there a mechanism within perl or the underlying bash shell that I can use to do this? (I would prefer one that didn't require installing an additional cpan library if possible)
The POSIX module is a Perl core module, and it includes the functions:
setuid()
setgid()
and related get*id() functions, though the values are also available through special variables:
$) and $( (effective and real GID)
$< and $> (effective and real UID)
You can also try setting those directly (per $EGID and $UID).
system('su www-data -c whoami')
> www-data
You have to change groups first, remember to quash supplementary groups, and then change user. You'll want to do this in a separate process, so that the [UG]ID changing doesn't affect privs on your root process.
sub su_system {
my $acct = shift;
my $gid = getgrnam $acct; # XXX error checking!
my $uid = getpwnam $acct;
if (fork) { # XXX error checking!
wait;
return $? >> 8;
}
# -- child
$( = $) = "$gid $gid"; # No supp. groups; see perlvar $)
$< = $> = $uid;
exec #_; # XXX not as safe as exec {prog} #argv
# oh, and what if $acct had [ug]id zero? darn
}
Proceed with caution.

How to find/cut for only the filename from an output of ls -lrt in Perl

I want the file name from the output of ls -lrt, but I am unable to find a file name. I used the command below, but it doesn't work.
$cmd=' -rw-r--r-- 1 admin u19530 3506 Aug 7 03:34 sla.20120807033424.log';
my $result=`cut -d, -f9 $cmd`;
print "The file name is $result\n";
The result is blank. I need the file name as sla.20120807033424.log
So far, I have tried the below code, and it works for the filename.
Code
#!/usr/bin/perl
my $dir = <dir path>;
opendir (my $DH, $dir) or die "Error opening $dir: $!";
my %files = map { $_ => (stat("$dir/$_"))[9] } grep(! /^\.\.?$/, readdir($DH));
closedir($DH);
my #sorted_files = sort { $files{$b} <=> $files{$a} } (keys %files);
print "the file is $sorted_files[0] \n";
use File::Find::Rule qw( );
use File::stat qw( stat );
use List::Util qw( reduce );
my ($oldest) =
map $_ ? $_->[0] : undef, # 4. Get rid of stat data.
reduce { $a->[1]->mtime < $b->[1]->mtime ? $a : $b } # 3. Find one with oldest mtime.
map [ $_, scalar(stat($_)) ], # 2. stat each file.
File::Find::Rule # 1. Find relevant files.
->maxdepth(1) # Don't recurse.
->file # Just plain files.
->in('.'); # In whatever dir.
File::Find::Rule
File::stat
List::Util
You're making it harder for yourself by using -l. This will do what you want
print((`ls -brt`)[0]);
But it is generally better to avoid shelling out unless Perl can't provide what you need, and this can be done easily
print "$_\n" for (sort { -M $a <=> -M $b } glob "*")[0];
if the name of log file is under your control, ie., free of space or other special characters, perhaps a quick & dirty job will do:
my $cmd=' -rw-r--r-- 1 admin u19530 3506 Aug 7 03:34 sla.20120807033424.log more more';
my #items = split ' ', $cmd;
print "log filename is : #items[8..$#items]";
print "\n";
It's not possible to do it reliably with -lrt - if you were willing to choose other options you could do it.
BTW you can still sort by reverse time with -rt even without the -l.
Also if you must use ls, you should probably use -b.
my $cmd = ' -rw-r--r-- 1 admin u19530 3506 Aug 7 03:34 sla.20120807033424.log';
$cmd =~ / ( \S+) $/x or die "can't find filename in string " ;
my $filename = $1 ;
print $filename ;
Disclaimer - this won't work if filename has spaces and probably under other circumstances. The OP will know the naming conventions of the files concerned. I agree there are more robust ways not using ls -lrt.
Maybe as this:
ls -lrt *.log | perl -lane 'print $F[-1]'

Resources