cant connect to remote machine using WMI and Perl - perl

I'm trying to write a script that will get event log information off of a remote windows machine using the win32::ole module and a WMI query. I can ping the machine but no matter what my WMI connection always fails using the ConnectServer() method. I'm pretty sure its not a firewall related problem. Here is my code:
use Win32::OLE qw(in);
use Net::Ping;
use constant wbemFlagReturnImmediately => 0x10;
use constant wbemFlagForwardOnly => 0x20;
my $computer = "10.10.10.15";
my $user = "Administrator";
my $pwd = "pass";
$p = Net::Ping->new();
print "$computer is alive.\n" if $p->ping($host);
$p->close();
my $locatorObj =Win32::OLE->new("WbemScripting.SWbemLocator") or die "ERROR CREATING OBJ";
$locatorObj->{Security_}->{impersonationlevel} = 3;
my $objWMIService = $locatorObj->ConnectServer($computer, "root\civm2", $user, $pwd) or die "WMI connection failed.\n";
my $colItems = $objWMIService->ExecQuery("SELECT * FROM Win32_NTLogEvent", "WQL",
wbemFlagReturnImmediately | wbemFlagForwardOnly);
foreach my $objItem (in $colItems) {
print "Category: $objItem->{Category}\n";
print "CategoryString: $objItem->{CategoryString}\n";
print "ComputerName: $objItem->{ComputerName}\n";
print "Data: " . join(",", (in $objItem->{Data})) . "\n";
print "EventCode: $objItem->{EventCode}\n";
print "EventIdentifier: $objItem->{EventIdentifier}\n";
print "EventType: $objItem->{EventType}\n";
print "InsertionStrings: " . join(",", (in $objItem->{InsertionStrings})) . "\n";
print "Logfile: $objItem->{Logfile}\n";
print "Message: $objItem->{Message}\n";
print "RecordNumber: $objItem->{RecordNumber}\n";
print "SourceName: $objItem->{SourceName}\n";
print "TimeGenerated: $objItem->{TimeGenerated}\n";
print "TimeWritten: $objItem->{TimeWritten}\n";
print "Type: $objItem->{Type}\n";
print "User: $objItem->{User}\n";
print "\n";
}
Any ideas why my attempt to connect always fails? Thanks :)

The ConnectServer call has a couple of potential issues:
I believe it needs two back slashes.
And It has a typo: civm2 -> cimv2
And it might reveal more information by adding a call to retrieve the error information:
my $objWMIService = $locatorObj->ConnectServer($computer, "root\\cimv2", $user, $pwd)
or die "WMI connection failed.\n", Win32::OLE->LastError;

Related

Reg: Sending automated mail in perl using Windows

I have a certain script , which will segregate the log file and put the result.txt which is comming as expected. But i want to sent mail after this segregate log file attach it in the text file and sent. There is no error in this script but i need to enhance it. Please help me on how i can use it
#use Win32;
if (#ARGV != 2) {
print "Please pass atleast one paramer\n";
print "Usage:\n\t $0 <file_name><Pattern>\n";
exit;
}
$File_name = $ARGV[0];
$res_File_name = $File_name . "\.result\.txt";
$Pattern = $ARGV[1];
chomp($Pattern);
open(FD,"$File_name") or die ("File '$File_name' could not be open \n");
open(WFD,">$res_File_name") or die("File $res_File_name could not be opened\n");
print "Enter begin match pattern: ";
$bgn = <stdin>;
chomp($bgn);
print $bgn;
print "Enter end match pattern: ";
$en = <stdin>;
chomp($en);
while ($line = <FD>) {
chomp($line);
if ($line =~ /^$bgn/) { #seaching a patter at begining of the string.
print WFD "Begin pattern '$bgn' matched with the line '$line'\n";
}
if ($line =~ /$en$/) { #seaching a patter at end of the string.
print WFD "End pattern '$en' matched with the line '$line'\n";
#exit;
}
print WFD $_ if(/$Pattern/);
# main();
# use constant Service_Name =>'MyServ'
# use constant Service_Desc =>'MyServDesc'
# sub main()
# {
# $opt=shift(# ARGV)||""
# if ($opt =~ /^(-i|--install)$/i)
# {
install _service( Service_Name, Service_Desc)
# }
# elsif ($opt =~ /^(-r|--remove)$/i)
# {
# remove_service(Service_Name);
# }
# elsif ($opt =~ /^(run)$/i)
#}
# here we create a log file wth STDOUT and STDERR
# The log file will be created with extension .log
$log = $cwd . $bn . ".log";
# open(STDOUT, ">> $log") or die "Couldn't open $log for appending: $!\n";
# open(STDERR, ">&STDOUT") or die "Could";
close(FD);
close(WFD);
The standard way to create and send email using Perl is to use the many modules in the Email::* namespace.
For creating simple email, you should use Email::Simple.
use Email::Simple;
my $email = Email::Simple->create(
header => [
From => 'casey#geeknest.com',
To => 'drain#example.com',
Subject => 'Message in a bottle',
],
body => '...',
);
$email->header_set( 'X-Content-Container' => 'bottle/glass' );
For more complex email (i.e. ones with multiple parts, like file attachments or HTML versions) use Email::MIME.
To send an email, use Email::Sender (actually, in most cases, you can probably get away with Email::Sender::Simple)
use Email::Sender::Simple qw(sendmail);
sendmail($email); # The $email we created in the previous example.
Your first "enhancement" should be to add use strict and use warnings to the top of your program, and declare all your variables using my. That should be your first thought when writing any Perl program.
As for sending an email, you don't say what it is you want to send, but I suggest you use the MIME::Lite module.

STDOUT from Pidgin plugin script

Yesterday, I wrote a perl plugin script for Pidgin 2.10.9, running on Windows 7, and using Strawberry Perl 5.10.1.5
Basically, on the receipt of an IM, it uses backticks to call a console application (written in .NET) and returns the console output to the sender as an IM.
I had to reboot this morning, but ever since I rebooted, it has stopped working.
So, I changed the backticks to use "capture". That didn't work either, but it at least gave me this error:
(15:00:33) Plugin: Error: Error in IPC::System::Simple plumbing: "Can't dup STDOUT" - "Bad file descriptor" at (eval 12) line 53
I have no idea what's changed from yesterday to today, and wondered if anybody knew what might be causing the error?
Thanks
Edit: Thought I'd add my code
use Purple;
#use IPC::System::Simple qw(system systemx capture capturex);
use IPC::System::Simple qw(capture capturex);
%PLUGIN_INFO = (
perl_api_version => 2,
name => "PlugIn",
version => "0.1",
summary => "AutoResp",
description => "PlugIn",
author => "Mark Watkin",
url => "http://",
load => "plugin_load",
unload => "plugin_unload"
);
sub plugin_init {
return %PLUGIN_INFO;
}
sub plugin_load {
my $plugin = shift;
Purple::Debug::info("PlugIn", "plugin_load()\n");
$data = "";
$conversation_handle = Purple::Conversations::get_handle();
Purple::Signal::connect($conversation_handle, "received-im-msg", $plugin, \&signal_chat_callback, $data);
}
sub plugin_unload {
my $plugin = shift;
Purple::Debug::info("PlugIn", "plugin_unload()\n");
}
sub signal_chat_callback {
# The signal data and the user data come in as arguments
my ($account, $sender, $message, $conv, $flags) = #_;
Purple::Debug::info("PlugIn", "Account Alias \"" . $account->get_alias() . "\"\n");
if( $account->get_alias() eq "PlugIn" )
{
Purple::Debug::info("PlugIn", "Request: \"" . $message . "\"\n");
if(!$conv)
{
Purple::Debug::info("PlugIn", "No conversation\n");
$conv = Purple::Conversation->new(1, $account, $sender);
}
$im = $conv->get_im_data();
$im->send( "One moment please..." );
my $query = "";
# eval {
# $query = capture("\"D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe\" \"" . $message . "\"");
# #$query = capture("\"D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe\"", "\"" . $message . "\"");
# #my $query = capture("D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe");
# #my $query = `\"D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe\" \"$message\"`;
# #my $query = `dir /b`;
# };
# if( $# )
# {
# Purple::Debug::info("PlugIn", "Error: " . $# . "\n");
# }
Purple::Debug::info("PlugIn", "Query: " . $query . "\n");
open ( my $fh, "-|", "D:\\SourceCode\\PlugInNET\\bin\\Debug\\PlugInNET.exe \"$message\"" ) or die "Cannot run free, $ERRNO";
while (<$fh>)
{
Purple::Debug::info("PlugIn", "Read: Line " . $_ . "\n");
$query = $query . $_ . "\n";
}
close $fh;
Purple::Debug::info("PlugIn", "Query: " . $query . "\n");
if( $query eq "" )
{
$im->send( "I'm sorry, my brain doesn't seem to be functioning at the moment" );
} else {
#msgs = split(/-----------\n/, $query);
foreach( #msgs )
{
Purple::Debug::info("PlugIn", "Result Msg: \"" . $_ . "\"\n");
$im->send( "<BODY>" . $_ . "</BODY>" );
}
}
}
}
The plan was to fix up the paths once I had it working properly
Please consider using file handles instead of backticks to capture stdout from another source. You'll be able collect errors.
#!/usr/bin/perl
use strict;
use warnings;
use English;
# No taint protection in this example
open ( my $fh, '-|', '/usr/bin/free' ) or die "Cannot run free, $ERRNO";
while (<$fh>)
{
print;
}
close $fh;

Global symbol "$line" and "$addr" requires explicit package name

I'm trying to get the output to show a list of ip addresses and login with the corresponding country but I keep getting these errors: Global symbol $line and $addr requires explicit package name. It works fine in Perl but I'm running this script from the server. Anyone have any ideas? Thanks.
#!/usr/bin/perl
my $psql = "/usr/local/pgsql/current/bin/psql";
my $db = 'cpi';
my $args = "-U postgres -qc";
my $date = `/bin/date +\%y\%m\%d%H`;
my $reportfile = "/tmp/multiiplogins-$date";
my $sendmail = "/usr/sbin/sendmail -t -fcpi\#cpi-syndication.com";
my $mailsubject = "Login Report";
my $mailto = 'user#yahoo.com';
my $query = "SELECT userid, login, email, logins, ips FROM (SELECT userid,login,email, count(userid) AS logins, count(ipaddr) AS ips FROM (SELECT l.userid, u.login, u.email$
my $query2 = "SELECT l.userid, login, email, ipaddr FROM synloginaccess l, synusers u where l.accesstime > (now() - interval '24 hours') and l.type=2 and l.userid=u.userid $
open (REPORT, ">$reportfile");
my $command = qq/$psql $db $args "$query"/;
my $command2 = qq/$psql $db $args "$query2"/;
my $result = `$command`;
my $result2 = `$command2`;
#update IP addresses with country
use strict;
use warnings;
use Net::IPInfoDB;
my $g = Net::IPInfoDB->new;
$g->key("api_key");
#we split $login into an array, line-by-line
my #lines = split("\n",$result2);
for my $line (#lines) {
#now we iterate through every line one-by-one
$line =~ /(?<ip>\d+\.\d+\.\d+\.\d+)/;
my $addr = $g->get_country("$1");
print "$line " . "| ". "$addr->country_name" ."\n";
}
#print REPORT "$result2\n";
#print REPORT "\n";
print REPORT "$line " . "| ". "$addr->country_name" ."\n";
close REPORT;
mailReport();
sub mailReport{
#mail it
open(MAIL, "|$sendmail");
print MAIL "To: $mailto\n";
print MAIL "Subject: $mailsubject\n";
print MAIL "\n";
open (INFILE, "$reportfile");
my #contents = <INFILE>;
Your $line and $addr variables are no longer in scope when you try to print them after your for loop:
#print REPORT "$result2\n";
#print REPORT "\n";
print REPORT "$line " . "| ". "$addr->country_name" ."\n";
I imagine this line is supposed to be commented out.

Sometimes long running ssh commands stop printing to stdout

I have been using Perl::Net::SSH to automate running some scripts on my remote boxes. However, some of these scripts take a really long time to complete (hour or two) and sometimes, I stop getting data from them, without actually losing the connection.
Here's the code I'm using:
sub run_regression_tests {
for(my $i = 0; $i < #servers; $i++){
my $inner = $users[$i];
foreach(#$inner){
my $user = $_;
my $server = $servers[$i];
my $outFile;
open($outFile, ">" . $outputDir . $user . "#" . $server . ".log.txt");
print $outFile "Opening connection to $user at $server on " . localtime() . "\n\n";
close($outFile);
my $pid = $pm->start and next;
print "Connecting to $user#" . "$server...\n";
my $hasWentToDownloadYet = 0;
my $ssh = Net::SSH::Perl->new($server, %sshParams);
$ssh->login($user, $password);
$ssh->register_handler("stdout", sub {
my($channel, $buffer) = #_;
my $outFile;
open($outFile, ">>", $outputDir . $user . "#" . $server . ".log.txt");
print $outFile $buffer->bytes;
close($outFile);
my #lines = split("\n", $buffer->bytes);
foreach(#lines){
if($_ =~ m/REGRESSION TEST IS COMPLETE/){
$ssh->_disconnect();
if(!$hasWentToDownloadYet){
$hasWentToDownloadYet = 1;
print "Caught exit signal.\n";
print("Regression tests for ${user}\#${server} finised.\n");
download_regression_results($user, $server);
$pm->finish;
}
}
}
});
$ssh->register_handler("stderr", sub {
my($channel, $buffer) = #_;
my $outFile;
open($outFile, ">>", $outputDir . $user . "#" . $server . ".log.txt");
print $outFile $buffer->bytes;
close($outFile);
});
if($debug){
$ssh->cmd('tail -fn 40 /GDS/gds/gdstest/t-gds-master/bin/comp.reg');
}else{
my ($stdout, $stderr, $exit) = $ssh->cmd('. ./.profile && cleanall && my.comp.reg');
if(!$exit){
print "SSH connection failed for ${user}\#${server} finised.\n";
}
}
#$ssh->cmd('. ./.profile');
if(!$hasWentToDownloadYet){
$hasWentToDownloadYet = 1;
print("Regression tests for ${user}\#${server} finised.\n");
download_regression_results($user, $server);
}
$pm->finish;
}
}
sleep(1);
print "\n\n\nAll tests started. Tests typically take 1 hour to complete.\n";
print "If they take significantly less time, there could be an error.\n";
print "\n\nNo output will be printed until all commands have executed and finished.\n";
print "If you wish to watch the progress tail -f one of the logs this script produces.\n Example:\n\t" . 'tail -f ./gds1#tdgds10.log.txt' . "\n";
$pm->wait_all_children;
print "\n\nAll Tests are Finished. \n";
}
And here is my %sshParams:
my %sshParams = (
protocol => '2',
port => '22',
options => [
"TCPKeepAlive yes",
"ConenctTimeout 10",
"BatchMode yes"
]
);
Sometimes randomly one of the long running commands just halts printing/firing the stdout or stderr events and never exits. The ssh connection doesn't die (as far as I'm aware) because the $ssh->cmd is still blocking.
Any idea how to correct this behaviour?
In your %sshParams hash, you may need to add "TCPKeepAlive yes" to your options:
$sshParams{'options'} = ["BatchMode yes", "TCPKeepAlive yes"];
Those options might or might not be right for you, but the TCPKeepAlive is something I would recommend setting for any long running SSH connection. If you have any kind of stateful firewall in your path it could drop the state if it hasn't passed traffic over the connection for a long period of time.
It fails probably due to the way you look into the output for the REGRESSION TEST IS COMPLETE mark. It may be split over two different SSH packets and so your callback will never found it.
Better, use a remote command that ends when it is done as this one-liner:
perl -pe 'BEGIN {$p = open STDIN, "my.comp.reg |" or die $!}; kill TERM => -$p if /REGRESSION TEST IS COMPLETE/}'
Otherwise, you are closing the remote connection but not stopping the remote process that will stay alive.
Besides that, you should try using Net::OpenSSH or Net::OpenSSH::Parallel instead of Net::SSH::Perl:
use Net::OpenSSH::Parallel;
my $pssh = Net::OpenSSH::Parallel->new;
for my $i (0..$#server) {
my $server = $server[$i];
for my $user (#{$users[$ix]}) {
$pssh->add_host("$user\#$server", password => $password);
}
}
if ($debug) {
$pssh->all(cmd => { stdout_file => "$outputDir%USER%\#%HOST%.log.txt",
stderr_to_stdout => 1 },
'fail -fn 40 /GDS/gds/gdstest/t-gds-master/bin/comp.reg');
}
else {
$pssh->all(cmd => { stdout_file => "$outputDir%USER%\#%HOST%.log.txt",
stderr_to_stdout => 1 },
'. ./.profile && cleanall && my.comp.reg');
}
$pssh->all(scp_get => $remote_regression_results_path, "regression_results/%USER%\#%HOST%/");
$pssh->run;

Perl script works with -w switch but not without

This script works on localhost with the -w switch but not without. It also works when use strict and use warning are active.
apache2/error.log:
without switch (aborted script):
(2)No such file or directory: exec of ... failed
with the switch I get:
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
On the live web server neither one works. Perl is new to me, but I know some BASH and PHP.
I run Debian Lenny, Apache2, Perl 5.10.
#!/usr/bin/perl -w
$| = 1;
my $mailprog = '/usr/sbin/sendmail'; # where the mail program lives
my $to = "not\#for.you"; # where the mail is sent
my ($command,$email,#pairs,$buffer,$pair,$email_flag) ;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
# Split the pair up into individual variables. #
my($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables. #
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# aren't a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
## print "Name of form element is $name with value of $value \n";
if ($name eq 'email') {
$email = $value;
}
if ($name eq 'command') {
$command = $value;
}
}
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/ ) {
$email_flag = "ERROR";
}
my $urlcommand = $command;
if ($command eq 'Subscribe') {
$command = "SUBSCRIBE rpc-news";
}
if ($command eq 'Unsubscribe') {
$command = "UNSUBSCRIBE rpc-news";
}
if ($command eq 'Suspend') {
$command = "SET rpc-news NOMAIL";
}
if ($command eq 'Resume') {
$command = "SET rpc-news MAIL";
}
my $getInfo = '';
print "Content-Type: text/html\n";
if ($email_flag ne "ERROR") {
open(MAIL,"|$mailprog -t");
print MAIL "To: $to\n";
print MAIL "From: $email\n";
print MAIL "Subject: [rpc-news] $command \n";
print MAIL "Reply-to: $email \n";
print MAIL "$command \n";
print MAIL "EXIT \n";
close (MAIL);
$getInfo = "?result=good";
}
if ($email_flag eq "ERROR") {
$getInfo = "?result=bad";
}
my $rootURL= $ENV{'SERVER_NAME'};
my $url = "http://${rootURL}/thank_you.html${getInfo}&action=${urlcommand}";
print "Location: $url\n\n";
Did you create your script on a Windows machine and upload it to a Linux server without fixing the line endings? Without the -w switch, the shebang line may look like "#!/usr/bin/perl\r", so the system goes looking for a program named "perl\r" (or however the line ending looks). With the -w switch, "#!/usr/bin/perl" doesn't have an indecipherable line ending stuck to it. Instead, that gets stuck to -w where it doesn't cause failure.
I thought there was a perlfaq about this, but I can't seem to find it in the docs at the moment.
Update: I found it over on PerlMonks, in a really old Q&A topic that seems unrelated until you read the body of the message: Answer: How to get rid of premature end of script headers. Yeah, I know, if you were just browsing threads you wouldn't even stop on that one. But here's the text of the post:
If you developed this script on
Windows, it's possible that the script
file has non-UNIX line endings. (The
perl interpreter can handle them, but
the shebang line is interpreted by the
shell, and is not tolerant of
incorrect line endings.) If this is
the problem, the script may terminate
with an error right at the shebang
line.
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/
) {
$email_flag = "ERROR";
}
$email_flag only gets initialized here if the pattern matches - otherwise it's left undefined. You could add an else clause to ensure it gets initialized no matter what.
I would not use that code, it doesn't use CGI.pm (or CGI::Simple ...)
Get "TFMail -- Improved Form Mail" from "nms - web programs written by experts"
Its simple to install, and its written well ( it uses CGI ...)