This question already exists:
Suppress SSL warnings
Closed 9 years ago.
I am executing open 3 as shown below I am getting below lines from sysout from SYSOUT
<May 7, 2013 1:21:59 AM IST> <Info> <Security> <BEA-090905> <Disabling CryptoJ JCE Provider self-integrity check for better startup performance. To enable this check, specify -Dweblogic.security.allowCryptoJDefaultJCEVerification=true>
<May 7, 2013 1:21:59 AM IST> <Info> <Security> <BEA-090906> <Changing the default Random Number Generator in RSA CryptoJ from ECDRBG to FIPS186PRNG. To disable this change, specify -Dweblogic.security.allowCryptoJDefaultPRNG=true>
<May 7, 2013 1:21:59 AM IST> <Notice> <Security> <BEA-090898> <Ignoring the trusted CA certificate "CN=CertGenCA,OU=FOR TESTING ONLY,O=MyOrganization,L=MyTown,ST=MyState,C=ka". The loading of the trusted certificate list raised a certificate parsing exception PKIX: Unsupported OID in the AlgorithmIdentifier object: 1.2.840.113549.1.1.11.>
My expected string
<Composites>
i=0
compositedetail=swlib:soaprov/soacomposite=eis/FileAdapter#eis/FileAdapter#
swlib:soaprov/soacomposite=eis/FileAdapter#eis/FileAdapter# starts with swlib
</Composites>
I want to ignore the lines from BEA security and print only my expected string .How can i do it?
my $command = $java . ' -classpath ' . $classpath . ' ' . $secOptions . ' ' . $className . ' ' . $serviceUrl . ' ' . $composites;
local (*HANDLE_IN, *HANDLE_OUT, *HANDLE_ERR);
my $pid = open3( *HANDLE_IN, *HANDLE_OUT, *HANDLE_ERR, "$command") ;
my $nextLine;
while(<HANDLE_OUT>) {
$nextLine= $_;
print $nextLine;
}
You could use regexps to do that. Of course you could use some kind of xml parser too, but it would be an overkill in this case.
my $debug = 1;#set 1 for debugging
while(my $nextLine=<HANDLE_OUT>) {
chomp($nextLine);
if ($nextLine =~ m!<BEA-!){
print "Skipping this line (BEA): |$nextLine|\n" if $debug;
}
print $nextLine."\n";
Related
December 10, 2014
Can someone kindly help me to resolve this issue where character '>' causes the perl program to exit prematurely when run on a remote Windows server?
The actual output is:
K:\ Volume in drive K is DataDisk
Volume Serial Number is E8BD-C593
Directory of K:\
04/15/2011 05:25 AM <DIR
The expected output is:
K:\>dir
Volume in drive K is DataDisk
Volume Serial Number is E8BD-C593
Directory of K:\
12/08/2014 11:18 PM <DIR> ftpvol
04/15/2011 05:25 AM <DIR> Images
1 File(s) 0 bytes
16 Dir(s) 246,180,012,032 bytes free
Here is the script:
#!/usr/bin/perl
use Net::Telnet ();
my $node = $ARGV[0];
my $ipAddress = $ARGV[1];
my $username = $ARGV[2];
my $password = $ARGV[3];
my $mmlCommand0 = "hostname&prcstate -l";
my $filedate = `date +%Y%m%d`; #date in format YYYYMMDD
chomp($filedate); #deletes newline character at end
my $numArgs = $#ARGV + 1;
if($numArgs == 4){
my $telnet = new Net::Telnet( Host=>$ipAddress, Port=>23, Timeout=>20, Errmode=>'die', Prompt=>'/>/');
$telnet->open() or die "hai $telnet->errmsg ";
$telnet->waitfor('/login name:/');
$telnet->print($username);
$telnet->waitfor('/password:/');
$telnet->print($password);
$telnet->waitfor('/Windows NT Domain:/');
$telnet->print("");
$telnet->waitfor('/>/');
## get printouts
#print $telnet->cmd($mmlCommand0);
print $telnet->cmd("K:");
print $telnet->cmd("dir");
}
else{
print "\n!!! Correct syntax is: command <node> <IP address> \nExample: \n\n";
}
print "\n\n";
exit(0);
script does not execute if I remove prompt or try to set another prompt.
However I think the error that the character '>' is always interpreted as the prompt.
my $telnet = new Net::Telnet( Host=>$ipAddress, Port=>23, Timeout=>20, Errmode=>'die');
$telnet->prompt('/$/');
Thanks in advance!
December 11, 2014
A "reply" button would be nice to have instead of having to edit an original port...
I am not quite following what Mr Llama has suggested. Accordingly if I am using the functions print() and waitfor() the promt should NOT be used. In that case I removed prompt however the code still does not work. Could you be kind to post a working code sample that will retrieve characters '<' and '>' in the printout and not treat either as a DOS prompt?
The Net::Telnet documentation says that you only need to use the prompt attribute if you're not using print() and waitfor() for communication (it's meant to be used with login().
In your case, the prompt value is being removed from the response. Try setting the prompt value to something that will never occur and that should fix your issue. Do be careful in what value you select as the prompt value will be treated as a regular expression.
Having a few issues with the below code..
my $file=File::Tail->new("/var/log/messages");
while (defined(my $line=$file->read)) {
print $sock "NOTICE #logs $line";
}
As you can see I'm tailing the servers message logs (which works) and printing it into an IRC socket as a NOTICE, but for some reason it's only printing out the first word of each line into the channel - for example, it's only printing out 'Jan' as that's the month.
Can anyone help with this?
[06:55:48] IRCBOT (~IRCBOT#10.1.0.4) joined the channel.
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:00] -IRCBOT- Jan
[06:56:02] -IRCBOT- Jan
Many Thanks in Advance!
EDIT: Just in case it matters, this is how I'm connecting to the IRC server..
use IO::Socket;
use File::Tail;
my $file=File::Tail->new("/var/log/messages");
my $server = "irc.example.co.uk";
my $nick = "IRCBOT";
my $login = "IRCBOT";
my $channel = "#logs";
my $sock = new IO::Socket::INET(PeerAddr => $server,
PeerPort => 6667,
Proto => 'tcp') or
die "Can't connect\n";
You need to prefix the text string with a : character,
print $sock "NOTICE #logs :$line";
If you want to escape the "$line", you can do something like:
print $sock "NOTICE #logs :\x01$line\x01";
By default, the IRC protocol separates parameters by spaces, you need to include the leading semicolon before a text string to indicate it is the trailing parameter and should not be separated.
NOTICE #logs Jan 1st 2014
is treated as a command plus 4 parameters,
NOTICE #logs :Jan 1st 2014 ... more stuff ... long line
is treated as a command plus one parameter that extends to CR LF (possibly including trailing whitespace)
I have a very specific problem that I am having trouble solving, it is relating to parsing and merging related data from different lines
I have a file that contains text in the format shown below:
======================================================
8:27:24 PM http://10.11.12.13:80
======================================================
GET /dog-pictures HTTP/1.1
Host: 10.11.12.13
Language: english
Agent: Unknown
Connection: closed
======================================================
======================================================
8:28:56 PM http://192.114.126.245:80
======================================================
GET /flowers HTTP/1.1
Host: 10.11.12.13
Language: english
======================================================
======================================================
8:29:07 PM http://10.11.12.13:80
======================================================
GET /africas-animals HTTP/1.1
Host: 10.11.12.13
Language: english
Agent: Unknown
Connection: open
======================================================
As you can see above each group of data in the text file is made up of three rows of equals signs (=======), but can contain a different number of rows of data within that.
The format I need the output to be in is as follows:
http://10.11.12.13/dog-pictures
http://192.114.126.245/flowers
http://10.11.12.13/africas-animals
Explanation of the bits I need merged:
======================================================
8:27:24 PM http://10.11.12.13:80 <--- Gets the first part from here**
======================================================
GET /dog-pictures HTTP/1.1 <--- Gets the seconds part from here**
Host: 10.11.12.13
Language: english
Agent: Unknown
Connection: closed
======================================================
Your help with this problem is much appreciated,
thank you in advance
Perhaps the following will assist you:
use strict;
use warnings;
open my $fh, '<', 'data.txt' or die $!;
# Read a file line
while (<$fh>) {
# If url captured on line beginning with time and read (separator) line
if ( my ($url) = /^\d+:\d+:\d+.+?(\S+):\d+$/ and <$fh> ) {
# Capture path
my ($path) = <$fh> =~ /\s+(\/\S+)\s+/;
print "$url$path\n" if $url and $path;
}
}
Output:
http://10.11.12.13/dog-pictures
http://192.114.126.245/flowers
http://10.11.12.13/africas-animals
There are only two lines that contain the information you want, and those are separated by a line of equal signs. The first regex tries to match a time string and capture the url on that line. The and <$fh> is used to get past the separator. The second regex captures the path on the next line. Finally, the url and path are printed.
Try doing this in Perl in a shell:
perl -lane '
if (/^\d+:\d+:\d+\s+\w+\s+([^:]+):/) {
$scheme = $1;
}
if (/^(GET|HEAD|POST|PUT|DELETE|OPTION|TRACE)/) {
$path = $F[1];
}
if (/^Host/) {
print "$scheme://$F[1]$path";
}
' file.txt
SCRIPT VERSION generated by perl -MO=Deparse with a bit of tweaking...
#!/usr/bin/env perl
# mimic `-l` switch to print like "say"
BEGIN { $/ = "\n"; $\ = "\n"; }
use strict; use warnings;
my ($scheme, $path);
# magic diamond operator
while (<ARGV>) {
chomp $_;
# splitting current line in #F array
my (#F) = split(' ', $_, 0);
# regex to catch the scheme (http)
if (/^\d+:\d+:\d+\s+\w+\s+([^:]+):/) {
$scheme = $1;
}
# if the current line match an HTTP verb, we feed $path variable
# with second column
if (/^(GET|HEAD|POST|PUT|DELETE|OPTION|TRACE)/) {
$path = $F[1];
}
# if the current line match HOST, we print the needed line
if (/^Host/) {
print "${scheme}://$F[1]$path";
}
}
USAGE
chmod +x script.pl
./script.pl file.txt
OUTPUT
http://10.11.12.13/dog-pictures
http://10.11.12.13/flowers
http://10.11.12.13/africas-animals
Perl:
perl -F -lane 'if(/http/){$x=$F[2]}if(/GET/){print $x.$F[1]}' your_file
if you would want to go for awk:
awk '/http/{x=$3}/GET/{print x""substr($2,1)}' your_file
By my #dir = $ftp->ls() i can get the list of all dir but witch one is latest how can i filter that one. I am using windows os and those dir is from FTP.
Thnaks
You'll get a qucik and dirty hack for your carelessly worded question:
First:
Assuming you are using Net::FTP
you have to call
$ftp->dir()
and not
$ftp->ls()
to get the long directory listing.
Then try this:
use feature "say";
use Net::FTP;
use Date::Parse;
$ftp = Net::FTP->new("ftp", Debug => 0)
or die "Cannot connect to some.host.name: $#";
$ftp->login("anonymous",'-anonymous#')
or die "Cannot login ", $ftp->message;
$ftp->cwd("/pub")
or die "Cannot change working directory ", $ftp->message;
#dir = $ftp->dir()
or die "ls()/dir() failed ", $ftp->message;
#map {say } #dir;
#Now parse the array of strings that dir() returned
#magic numbers to find substring with modif-date
my $start = 44;
my $len = 10;
#dir = map {$_->[0]} sort {$b->[1] <=> $a->[1]} map {[$_, str2time(substr($_, $start, $len))] } grep {/^d/} #dir;
$latest = $dir[0];
This will work only for directories with this format
drwxr-xr-x 17 root other 4096 Apr 12 2010 software
but not with this (note:year missing)
drwxr-xr-x 36 root root 4096 Nov 29 09:14 home
The code will also ignore symbolic links such as this:
lrwxrwxrwx 1 root root 8 May 30 2011 i -> incoming
but it will give you a start.
The
map{} sort{} map {} #array;
construct is called a "Schwartzian transform", and does most of the work.
The string returned by $ftp->dir can vary depending on the type of ftp server you are accessing. The OS and user configs can also influence the format of the string so parsing this string is likely to lead to problems even though it seems to be a quick solution. It is much easier to use $ftp->mdtm($file). This returns the last modified date and time as epoch time. Simple!
When I use LWP::UserAgent to retrieve content encoded in UTF-8 it seems LWP::UserAgent doesn't handle the encoding correctly.
Here's the output after setting the Command Prompt window to Unicode by the command chcp 65001 Note that this initially gives the appearance that all is well, but I think it's just the shell reassembling bytes and decoding UTF-8, From the other output you can see that perl itself is not handling wide characters correctly.
C:\>perl getutf8.pl
======================================================================
HTTP/1.1 200 OK
Connection: close
Date: Fri, 31 Dec 2010 19:24:04 GMT
Accept-Ranges: bytes
Server: Apache/2.2.8 (Win32) PHP/5.2.6
Content-Length: 75
Content-Type: application/xml; charset=utf-8
Last-Modified: Fri, 31 Dec 2010 19:20:18 GMT
Client-Date: Fri, 31 Dec 2010 19:24:04 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
<?xml version="1.0" encoding="UTF-8"?>
<name>Budějovický Budvar</name>
======================================================================
response content length is 33
....v....1....v....2....v....3....v....4
<name>Budějovický Budvar</name>
. . . . v . . . . 1 . . . . v . . . . 2 . . . . v . . . . 3 . . . .
3c6e616d653e427564c49b6a6f7669636bc3bd204275647661723c2f6e616d653e
< n a m e > B u d � � j o v i c k � � B u d v a r < / n a m e >
Above you can see the payload length is 31 characters but Perl thinks it is 33.
For confirmation, in the hex, we can see that the UTF-8 sequences c49b and c3bd are being interpreted as four separate characters and not as two Unicode characters.
Here's the code
#!perl
use strict;
use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $response = $ua->get('http://localhost/Bud.xml');
if (! $response->is_success) { die $response->status_line; }
print '='x70,"\n",$response->as_string(), '='x70,"\n";
my $r = $response->decoded_content((charset => 'UTF-8'));
$/ = "\x0d\x0a"; # seems to be \x0a otherwise!
chomp($r);
# Remove any xml prologue
$r =~ s/^<\?.*\?>\x0d\x0a//;
print "Response content length is ", length($r), "\n\n";
print "....v....1....v....2....v....3....v....4\n";
print $r,"\n";
print ". . . . v . . . . 1 . . . . v . . . . 2 . . . . v . . . . 3 . . . . \n";
print unpack("H*", $r), "\n";
print join(" ", split("", $r)), "\n";
Note that Bud.xml is UTF-8 encoded without a BOM.
How can I persuade LWP::UserAgent to do the right thing?
P.S. Ultimately I want to translate the Unicode data into an ASCII encoding, even if it means replacing each non-ASCII character with one question mark or other marker.
Update 1
I have accepted Ysth's "upgrade" answer - because I know it is the right thing to do when possible. However there is a work around to fix up the data into a well formed Perl Unicode string.
$r = decode("utf8", $r);
Update 2
My data gets fed to a non-Perl application that displays the data using Code Page 437 to Putty/Reflection/Teraterm terminals at many locations. The app is currently displaying something like:
Bud├ä┬øjovick├â┬¢ Budvar
I am going to use ($r = decode("UTF-8", $r)) =~ s/[\x80-\x{FFFF}]/\xFE/g; to get the app to display:
Bud■jovick■ Budvar
Moving away from CP437 would be a major job, so that is not going to happen in the short to medium term.
Update 3
CPAN has some interesting Unicode modules such as:
Text::Unidecode
Unicode::Map8
Unicode::Map
Unicode::Escape
Unicode::Transliterate
Text::Unidecode translated "Budějovický Budvar" into "Budejovicky Budvar" - which didn't seem to me a particularly impressive attempt at a phonetic transliteration but then I don't speak Czech. English speakers might prefer it to "Bud■jovick■ Budvar" though.
Upgrade to a newer libwwwperl. The old version you are using only honored the charset argument to decoded_content for text/* content types; the newer version also does so for application/xml or anything ending +xml.