I am trying to replace SendMessage API with SendMessageTimeout in an installation script (that refreshes the environment -- registry and stuff). After replacing the installer is crashing. I have compiled the sub routine separately and it works alright.
Is it because SendMessageTimeout is in a different module -- Win32::GUI? I am unable to find a source to download this module. Apologies for the naivety, I am totally new to Perl and this is the only change I had to make.
use Win32::API;
sub refreshEnvironment()
{
use constant WM_WININICHANGE => 0x001A;
use constant HWND_BROADCAST => 0xffff;
use constant SMTO_ABORTIFHUNG => 0x0002;
print("Refreshing the environment.\n");
my $sm = new Win32::API(
"user32",
"SendMessageTimeout",
['N', 'N', 'I', 'P', 'N','I', 'P'], 'N'
);
if (! defined ($sm)) {
print("SendMessage api did not initialize.\n");
return;
}
my $buffer = "Environment";
my $res = $sm->Call(HWND_BROADCAST, WM_WININICHANGE, 0, $buffer, SMTO_ABORTIFHUNG, 2000, NULL);
print("SendMessage refresh environment done\n");
}
refreshEnvironment();
Related
Environment settings
OS : RHEL 6.6 (kernel 2.6.32) - x86_64
httpd : httpd-2.2.15-39
perl : 5.10.1-136
CGI API :
perl-CGI-3.15-136
perl-CGI-Session-4.35-6
I am using a static html page with Perl-CGI defined variables in the static html. This html is read in through perl, and then passed to a perl CGI script for eval.
Note:
While reading the static html, I am using UTF-8 encoding like
open( IN ,"<:encoding(UTF-8)", $file_path )
After reading the status HTML page, the output is passed back to the CGI script through a variable and then pressed in to eval to evaluate the variables.
Finally, the eval(uated) output from CGI is print which can be read through http daemon.
In the CGI script I am using
binmode(STDIN, ':encoding(UTF-8)');
binmode(STDOUT, ':encoding(UTF-8)');
The static HTML looks something like this
When I check the output of print in the CGI script, I see the complete output as desired, like this
However on the Browser, the hidden input fields are getting truncated in an unwanted manner. Like this
When I checked the wireshark output for the text/html, which is being printed back from the server to the browser, this is also getting truncated.
Like this
The HTML header has proper Content-Type and charset declaration.
The same code is working fine with EN language
The same code is working fine with zh(chinese) language as well.
When the language is set to japanese in the browser, and we read from HTTP_ACCEPT_LANGUAGE that it is 'ja', than we print the japanese specific data.
We are not using cgid module of apache.
Are we supposed to use some special encoding for japanese language??
Or it is a double encoding issue. I have tried removing the encoding when I am reading the static html file, however, that also did not help.
The same code is working fine with RHEL 5.x (2.6.18-308), and perl-CGI-Session (4.42-2), perl (5.8.8-38) httpd (2.2.3-63), there was no perl-CGI in RHEL-5.x.
I kind of found the solution to the problem. In our code we used to add a data in the CGI::Session object, which had the language. In the following form
$session->param( KEY_SESSION_LANG, $code ).
Where $session is a CGI::Session object and KEY_SESSION_LANG is 'language' and $code is something that we get from HTTP_ACCEPT_LANGUAGE. When we see 'en' we used to set it as perl constant 'en', when we got 'ja' we used to set it as perl constant 'ja'.
When we used to form the session object we used to get a session file as (perl version RHEL 5.x (2.6.18-308) & perl-CGI-Session-4.42-2 ) for JA language we used to get the following in the cgi file
cat cgisess_e31c8d21af82b59fd064babc7ca25c01
$D = {'_SESSION_ID' => 'e31c8d21af82b59fd064babc7ca25c01','_SESSION_ETIME' => 6000,'language' => 'ja','permit' => 'yes','_SESSION_REMOTE_ADDR' => '192.168.101.1','_SESSION_CTIME' => 1441090386,'execute' => 'yes','_SESSION_ATIME' => 1441090387,'_SESSION_EXPIRE_LIST' => {}};*a = \undef;;$D
For perl CGI Session in RHEL 6.6 this is coming out to be
cat cgisess_e31c8d21af82b59fd064babc7ca25c01
$D = {'_SESSION_ID' => 'e31c8d21af82b59fd064babc7ca25c01','_SESSION_ETIME' => 6000,'language' => *a,'permit' => 'yes','_SESSION_REMOTE_ADDR' => '192.168.101.1','_SESSION_CTIME' => 1441090386,'execute' => 'yes','_SESSION_ATIME' => 1441090387,'_SESSION_EXPIRE_LIST' => {}};*a = \undef;;$D
language data for ja is becoming *a. The same is also reflected when we use perl dumper for getting in memory data.
I checked the /usr/share/perl5/vendor_perl/CGI/Session.pm and it had following information in it
=head1 A Warning about UTF8
Trying to use UTF8 in a program which uses CGI::Session has lead to problems. See RT#21981 and RT#28516.
In the first case the user tried "use encoding 'utf8';" in the program, and in the second case the user tried "$dbh->do(qq|set names 'utf8'|);".
Until this problem is understood and corrected, users are advised to avoid UTF8 in conjunction with CGI::Session.
For details, see: http://rt.cpan.org/Public/Bug/Display.html?id=28516 (and ...id=21981).
=head1 TRANSLATIONS
This document is also available in Japanese.
Now when I used the perl dumper following things happened. I quote below from my offical analysis presented on our local development portal
I think the problem is because of perl-CGI-Session OSS package, please see the analysis below.
Some inputs from the CGI session source code.
## Inputs ##
From the file /usr/share/perl5/vendor_perl/CGI/Session.pm
## Following are the status of CGI session, set internally after modification to any of the parameters ##
sub STATUS_NEW () { 1 } # denotes session that's just created
sub STATUS_MODIFIED () { 2 } # denotes session that needs synchronization
sub STATUS_DELETED () { 4 } # denotes session that needs deletion
sub STATUS_EXPIRED () { 8 } # denotes session that was expired.
--snip --
I::Session - persistent session data in CGI applications
=head1 SYNOPSIS
# Object initialization:
use CGI::Session;
$session = new CGI::Session();
$CGISESSID = $session->id();
We are setting the "language" parameter in the session object. (We create a CGI object, set cookie to it, to get sid, and through sid get the session object). For setting up the language parameter we do
$session->param( 'language', ); ---> language_value = en(english) or ja(japanese). When we have completed the printing of the HTML page in /opt/packageManager/pm_gui/cgi/status.cgi file, I checked the cgi session object it is as follows
For EN Language
Before executing session flush
[09/10/2015 16:13:41] [23722] <ERROR> status.cgi : 267 :
$VAR1 = bless( {
'_STATUS' => 2,
'_DATA' => {
'_SESSION_ETIME' => 6000,
'_SESSION_ID' => '995d11334f2c39b95b3fdb86cecd9655',
'permit' => 'yes',
'language' => 'en',
Then after this when I flush the session as $session->flush() and check the session object it is
[09/10/2015 16:13:41] [23722] <ERROR> status.cgi : 270 :
$VAR1 = bless( {
'_STATUS' => 0,
'_DATA' => {
'_SESSION_ETIME' => 6000,
'_SESSION_ID' => '995d11334f2c39b95b3fdb86cecd9655',
'permit' => 'yes',
'language' => 'en',
Inference 1: session status changed after doing flush. This is good, and should be done.
For JP Language
Before executing session flush
[09/10/2015 16:14:54] [31910] status.cgi : 267 :
$VAR1 = bless( {
'_STATUS' => 2,
'_DATA' => {
'_SESSION_ID' => '1cd1b7860af4c71264f3969fe74e7a44',
'_SESSION_ETIME' => 6000,
'language' => *a
Then after this, when I flush the session as $session->flush() and check the session object it is NOT THERE. SCRIPT CRASHES HERE IT SELF
Inference 2 : Doing flush with language JP, is terminating the session, and that is why the session gets destroyed. And that is why, ending data in response is truncated
Due to the wrong value being set in memory, in session object, and then the implicit flush by CGI session is failing on the disk. Which results in termination of the session object, and in between termination of session, and and data loss of HTML.
I checked the actual code in sessions.pm file and it seems to be coming in from here
sub param {
my ($self, #args) = #_;
--snip--
# USAGE: $s->param($name, $value);
# USAGE: $s->param($name1 => $value1, $name2 => $value2 [,...]);
# DESC: updates one or more **public** records using simple syntax
if ((#args % 2) == 0) {
my $modified_cnt = 0;
ARG_PAIR:
while (my ($name, $val) = each %args) {
if ( $name =~ m/^_SESSION_/) {
carp "param(): attempt to write to private parameter";
next ARG_PAIR;
}
$self->{_DATA}->{ $name } = $val; ----> HERE
++$modified_cnt;
}
$self->_set_status(STATUS_MODIFIED);
return $modified_cnt;
}
As a solution, we stopped putting 'ja' value as a perl constant, but now are putting it as a string "ja" and it seems to be working fine now.
On a modern setup (Windows 7 64-bit, IE 11, ActiveState Perl 5.16 64-bit), the Click method in Win32::IEAutomation (v0.5) does not seem to work. Here is an example, lightly adapted from the documentation:
use Win32::IEAutomation;
my $ie = Win32::IEAutomation->new( visible => 1);
$ie->gotoURL('http://www.google.com');
$ie->getLink('linktext:', "About")->Click;
At this point, I should see the "About" page in IE. But I still see Google's home page in IE, and I cannot use the Content method in Win32::IEAutomation to get the source of the "About" page.
I have the same problem on an older setup (Vista SP2 64-bit, IE 9, ActiveState Perl 5.10.1). But the problem does not arise when I use a similar setup with IE8 instead of IE9. The problem thus seems to lie with a difference between IE8 and subsequent IE versions.
Is there anything that I can do to get the example script working with more recent versions of IE?
Win32::IEAutomation is a thin wrapper around the various interfaces exposed by InternetExplorer.Application and MSHTML.
Therefore, I tried to replicate the problem by writing a script to do the navigation without using Win32::IEAutomation. Using the click method on a link did not initiate navigation whereas passing its href to Navigate2 did.
The click method "Simulates a click by causing the HTMLFrameSiteEvents::onclick event to fire," meaning any onClick handlers defined on the page will be involved. I am not sure why specifically navigation is not being initiated.
However, the problem is not specific to Google's home page: I tried it with example.com, and invoking the click method on a link on that page did not initiate navigation either.
Here is the script I used as a testbed:
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Win32::OLE qw(EVENTS in valof);
$Win32::OLE::Warn = 3;
my $url = 'https://www.google.com/';
my %event_handler = (
DocumentComplete => \&onDocumentComplete,
);
my %page_handler = (
'https://www.google.com/'
=> \&onPageGoogleHome,
'https://www.google.com/intl/en/about/'
=> \&onPageGoogleAbout,
);
my $ie = Win32::OLE->new(
"InternetExplorer.Application", sub { $_[0]->Quit }
);
Win32::OLE->WithEvents($ie, \&Event, 'DWebBrowserEvents2');
$ie->{Visible} = 1;
$ie->Navigate2($url);
Win32::OLE->MessageLoop;
Win32::OLE->SpinMessageLoop;
$ie->Quit;
sub Event {
my ($ie, $event, #argv) = #_;
if (exists $event_handler{$event}) {
$event_handler{$event}->($ie, \#argv);
}
else {
# unhandled event
}
return;
}
sub onDocumentComplete {
my ($ie, $argv) = #_;
my $url = valof($argv->[-1]);
if (exists $page_handler{$url}) {
$page_handler{$url}->($ie, $argv);
}
else {
# unhandled page
}
return;
}
sub onPageGoogleHome {
my ($ie, $argv) = #_;
say "We are on Google's home page";
my $links = $ie->Document->links;
my $about_link;
for my $link (in $links) {
if ($link->innerText eq 'About') {
say "Found 'About' link";
$about_link = $link;
last;
}
}
if ($about_link) {
# Doesn't work:
# $about_link->click;
$ie->Navigate2($about_link->href);
}
return;
}
sub onPageGoogleAbout {
my ($ie, $argv) = #_;
say "Yay, we are on the about page!";
Win32::OLE->QuitMessageLoop;
return;
}
Version information:
This is perl 5, version 19, subversion 12 (v5.19.12) built for MSWin32-x64-multi-thread
Internet Explorer 11
Windows 8.1 Pro 64-bit
I observe the same faulty behavior with the ->Click() in Strawberry Perl v5.18.2 and Win32::IEAutomation v0.5 and IE v11.0.9600.17105.
My work around is to use the gotoURL() method directly. This obviously would not work with javascript actions, but does for this particular example.
use strict;
use warnings;
use Win32::IEAutomation;
my $ie = Win32::IEAutomation->new( visible => 1);
$ie->gotoURL('http://www.google.com');
my $about = $ie->getLink('linktext:' => 'About')
or die "Unable to find About";
# $about->Click(); # <--- does not work, using alternative method
$ie->gotoURL($about->linkUrl());
So, I just started trying to use the perl curses module for a project I'm working on. The documentation seems to be extremely lacking, what little I can find on cpan seems to be half-finished and assumes previous curses library experience, which I don't have. I have two issues I am trying to solve, my code so far:
#!/usr/bin/perl
use strict;
use Curses::UI;
use Term::ReadKey;
my ($cols, $rows, $wp, $hp) = GetTerminalSize();
my $cui = new Curses::UI( -color_support => 1);
sub eDialog {
my $return = $cui->dialog(
-message => "Are you sure?",
-title => "Really quit?",
-buttons => ['yes', 'no']
);
exit(0) if $return;
}
sub entryUpdate {
my $mainentry = shift;
if($mainEntry->get() =~ m/.*\n$/)
{
print STDERR $mainEntry->get();
}
}
$cui->set_binding( \&eDialog , "\cQ");
my $mainWin = $cui->add(
'viewWin', 'Window',
-border => 1,
-height => ($rows - 3),
-bfg => 'green'
);
my $mainView = $mainWin->add(
"viewWid", "TextViewer",
-wrapping => 1
);
my $entryWin = $cui->add(
'entryWin', 'Window',
-border => 1,
-y => ($rows - 3),
-height => 1,
-bfg => 1
);
my $mainEntry = $entryWin->add(
"entryWid", "TextEntry",
-onchange => \&entryUpdate()
);
$mainEntry->focus();
$cui->mainloop();
I managed to get the UI set up how I want it, but actually making it work is proving problematic.
1). I want to be able to, when text is typed into the $mainEntry widget, detect when enter/return is pressed, and execute a subroutine to do stuff with the text typed into the widget, then clear it out. (I tried accomplishing this with the entryUpdate subroutine, but that isn't working at all, no matter how I've tried to do it.)
2). I want to be able to periodically (Say, every 1 second or 500ms), execute another subroutine, and have the string it returns added to the $mainView widget.
Getting either or both of these to work has proven to be a huge issue thus far, I just dont know enough about how curses works and I haven't been able to find the information I need anywhere. Any help would be much appreciated.
1) You can simply bind the return key to a subrouting using set_binding:
use Curses qw(KEY_ENTER);
$mainEntry->set_binding(sub {
$mainView->text($mainView->text . $mainEntry->get . "\n");
$mainView->draw;
$mainEntry->text("");
}, KEY_ENTER);
2) It seems that there are timer methods (found them by grepping the Curses-UI source code), but they are not documented, which is probably an issue. Here's how it's used:
$cui->set_timer('timer_name', sub {
$mainView->text($mainView->text . scalar(localtime)."\n");
$mainView->draw;
}, 1);
I need to open an SFTP connection in Perl and I need to use a dsa key file but I can't actually store the file on the hard disk for security reasons. I am trying to use Net::SFTP.
my $sftp = Net::SFTP->new(
$host, user=>"$userid",
ssh_args => {
identity_files => [ $pathToInMemoryKeyFile ]
}
);
I think I know how to get a string represented as an in memory file handle but I don't know how to get the path of that file handle such that I can pass it in as one of the ssh_args. Does anybody have any suggestions?
Thanks!
I've looked through the various options of doing SFTP (Net::SFTP hasn't been updated since 2005, Net::SFTP::Foreign is more up to date) and they all do key authentication via a file.
Net::SFTP is backed by Net::SSH::Perl which is a pure Perl SSH implementation. You can do some patching to make it do what you want. I'm going to sketch it out for you.
Patch or put a wrapper around Net::SSH::Perl::Auth::PublicKey->authenticate to look for a new configuration key. Let's call it identity_keys.
sub authenticate {
my $auth = shift;
my $ssh = $auth->{ssh};
my $sent = 0;
if (my $agent = $auth->mgr->agent) {
do {
$sent = $auth->_auth_agent;
} until $sent || $agent->num_left <= 0;
}
return $sent if $sent;
##### This is the new bit which tries any keys passed in. ######
my $ik = $ssh->config->get('identity_keys') || [];
for my $key (#$ik) {
return 1 if $auth->_auth_key($key);
}
my $if = $ssh->config->get('identity_files') || [];
my $idx = $auth->{_identity_idx} || 0;
for my $f (#$if[$idx..$#$if]) {
$auth->{_identity_idx}++;
return 1 if $auth->_auth_identity($f);
}
}
auth_key would be a copy of _auth_identity but calling Net::SSH::Perl::Key->read_private_key which would be the guts of Net::SSH::Perl::Key->read_private_pem minus opening and reading the key from a file. read_private_pem would then be gutted to use read_private_key.
Alternatively, use an ssh-agent. It holds the decrypted private key in memory, so you can immediately wipe it from the disk.
Greetings,
I'm trying to develop some tests for Mason components which requires running them on the command line instead of the web server. When I try this, I get an error:
perl -MHTML::Mason::Request -MHTML::Mason::Interp -I./lib \
-e '$int = HTML::Mason::Interp->new( data_dir => "/home/friedo/cache", comp_root => "/home/friedo/comps" ); $m = HTML::Mason::Request->new( comp => "/dummy", interp => $int ); $m->comp("/dummy")'
Results in:
Can't call method "dir_path" on an undefined value at lib/HTML/Mason/Request.pm line 1123.
The error is thrown when the call to ->comp is attempted. I can't figure out what's wrong with the configuration. The component is there and appears to be compiled just fine, and it works via Apache.
This is using HTML::Mason 1.35.
Edit: Let's try a bounty for this one. The alternative is me having to dive deep into Mason's guts! :)
Edit again: Thanks very much to David for pointing out the crucial detail that I missed for getting this to work.
This was actually for a test framework that needed to exercise a module that calls some Mason comps -- under normal operation the module is provided with a Mason request object to use for that purpose, but I couldn't get that to work offline. The key was using an Interpreter object instead, so I ended up doing the following, which is a little silly but makes the tests work:
sub _mason_out {
...
my $buf;
if ( $ENV{MASON_TEST} ) {
my $int = HTML::Mason::Interp->new( comp_root => $self->{env}->comp_dir,
out_method => \$buf );
$int->exec( $comp, %args );
} else {
my $m = $self->{mason_object};
$m->comp( { store => \$buf }, $comp, %args );
}
return $buf;
}
I think this fails because your Request object hasn't built a component stack at the point that it is called. Use the Interp->exec() method instead as described in Using Mason from a Standalone Script
perl -MHTML::Mason::Interp -I./lib \
-e 'HTML::Mason::Interp->new( data_dir => "/home/friedo/cache", comp_root => "/home/friedo/comps" )->exec("/dummy")'