I am mapping the GetFullPathName windows API in a perl6 script using NativeCall, for so I wrote the following:
#!perl6
use NativeCall;
constant \WIN32_MAX_PATH = 260;
#I may use directly $path.IO.absolute()
sub Win32-GetFullPathName(
Str $lpFileName is encoded('utf16'),
int32 $nBufferLength,
#Str $lpBuffer is encoded('utf16') is rw,
Blob $lpBuffer is rw,
Str $lpFilenameIndex is rw)
returns int32
is native('kernel32.dll')
is symbol('GetFullPathNameW')
{ * }
my $path = '.';
my $fp-size = Win32-GetFullPathName(
$path, # $path ~ "\0", # <!-- this hack make it working fine
WIN32_MAX_PATH,
#my Str $fpath = ' ' x WIN32_MAX_PATH;
my $buffer = buf16.allocate(WIN32_MAX_PATH),
Str );
put "[$fp-size] => ", $buffer.decode('utf16').substr(0, $fp-size);
The code is working randomly, until I append a "\0" after $path.
[EDIT] The results when called multiple times:
[12] => D:\dev\pa.t
[12] => D:\dev\pa.
[12] => D:\dev\pa.槟
[9] => D:\dev\pa
[9] => D:\dev\pa
Is there another proper way to do it?
I suspect a MoarVM bug in src/strings/utf16.c, in particular line 403:
result = MVM_realloc(result, *output_size);
which should probably read
result = MVM_realloc(result, *output_size + 2);
If you could verify that this fixes your problem, feel free to file a bug report or even create a pull request.
Related
I'm trying to read a gz file line by line in Perl6, however, I'm getting blocked:
How to read gz file line by line in Perl6 however, this method, reading everything into :out uses far too much RAM to be usable except on very small files.
I don't understand how to use Perl6's Compress::Zlib to get everything line by line, although I opened an issue on their github https://github.com/retupmoca/P6-Compress-Zlib/issues/17
I'm trying Perl5's Compress::Zlib to translate this code, which works perfectly in Perl5:
use Compress::Zlib;
my $file = "data.txt.gz";
my $gz = gzopen($file, "rb") or die "Error reading $file: $gzerrno";
while ($gz->gzreadline($_) > 0) {
# Process the line read in $_
}
die "Error reading $file: $gzerrno" if $gzerrno != Z_STREAM_END ;
$gz->gzclose() ;
to something like this using Inline::Perl5 in Perl6:
use Compress::Zlib:from<Perl5>;
my $file = 'chrMT.1.vcf.gz';
my $gz = Compress::Zlib::new(gzopen($file, 'r');
while ($gz.gzreadline($_) > 0) {
print $_;
}
$gz.gzclose();
but I can't see how to translate this :(
I'm confused by Lib::Archive example https://github.com/frithnanth/perl6-Archive-Libarchive/blob/master/examples/readfile.p6 I don't see how I can get something like item 3 here
There should be something like
for $file.IO.lines(gz) -> $line { or something like that in Perl6, if it exists, I can't find it.
How can I read a large file line by line without reading everything into RAM in Perl6?
Update Now tested, which revealed an error, now fixed.
Solution #2
use Compress::Zlib;
my $file = "data.txt.gz" ;
my $handle = try open $file or die "Error reading $file: $!" ;
my $zwrap = zwrap($handle, :gzip) ;
for $zwrap.lines {
.print
}
CATCH { default { die "Error reading $file: $_" } }
$handle.close ;
I've tested this with a small gzipped text file.
I don't know much about gzip etc. but figured this out based on:
Knowing P6;
Reading Compress::Zlib's README and choosing the zwrap routine;
Looking at the module's source code, in particular the signature of the zwrap routine our sub zwrap ($thing, :$zlib, :$deflate, :$gzip);
And trial and error, mainly to guess that I needed to pass the :gzip adverb.
Please comment on whether my code works for you. I'm guessing the main thing is whether it's fast enough for the large files you have.
A failed attempt at solution #5
With solution #2 working I would have expected to be able to write just:
use Compress::Zlib ;
.print for "data.txt.gz".&zwrap(:gzip).lines ;
But that fails with:
No such method 'eof' for invocant of type 'IO::Path'
This is presumably because this module was written before the reorganization of the IO classes.
That led me to #MattOates' IO::Handle like object with .lines ? issue. I note no response and I saw no related repo at https://github.com/MattOates?tab=repositories.
I am focusing on the Inline::Perl5 solution that you tried.
For the call to $gz.gzreadline($_): it seems like gzreadline tries to return the line read from the zip file by modifying its input argument $_ (treated as an output argument, but it is not a true Perl 5 reference variable[1]), but the modified value is not returned to the Perl 6 script.
Here is a possoble workaround:
Create a wrapper module in the curent directory, e.g. ./MyZlibWrapper.pm:
package MyZlibWrapper;
use strict;
use warnings;
use Compress::Zlib ();
use Exporter qw(import);
our #EXPORT = qw(gzopen);
our $VERSION = 0.01;
sub gzopen {
my ( $fn, $mode ) = #_;
my $gz = Compress::Zlib::gzopen( $fn, $mode );
my $self = {gz => $gz};
return bless $self, __PACKAGE__;
}
sub gzreadline {
my ( $self ) = #_;
my $line = "";
my $res = $self->{gz}->gzreadline($line);
return [$res, $line];
}
sub gzclose {
my ( $self ) = #_;
$self->{gz}->gzclose();
}
1;
Then use Inline::Perl5 on this wrapper module instead of Compress::Zlib. For example ./p.p6:
use v6;
use lib:from<Perl5> '.';
use MyZlibWrapper:from<Perl5>;
my $file = 'data.txt.gz';
my $mode = 'rb';
my $gz = gzopen($file, $mode);
loop {
my ($res, $line) = $gz.gzreadline();
last if $res == 0;
print $line;
}
$gz.gzclose();
[1]
In Perl 5 you can modify an input argument that is not a reference, and the change will be reflected in the caller. This is done by modifying entries in the special #_ array variable. For example: sub quote { $_[0] = "'$_[0]'" } $str = "Hello"; quote($str) will quote $str even if $str is not passed by reference.
I am passing about seven fields from an HTML form to a Perl CGI script.
Some of the values are not getting recovered using a variety of methods (POST, GET, CGI.pm or raw code).
That is, this code
my $variable = $q->param('varname');
resulted in about half the variables either being empty or undef, although the latter may have been a coincidental situation from the HTML page, which uses JavaScript.
I wrote a test page on the same platform with a simple form going to a simple CGI, and also got results where onpy half the parameters were represented. The remaining values were empty after the assignment.
I tried both POST and GET. I also tried GET and printed the query string after attempting to write out the variables; everything was in the query string as it should be. I'm using CGI.pm for this.
I tried to see if the variable values had been parsed successfully by CGI.pm by creating a version of my test CGI code which just displays the
parameters on the HTML page. The result is a bunch of odd strings like
CGI=HASH(0x02033)->param('qSetName')
suggesting that assignment of these values results in a cast of some kind, so I was unable to tell if they actually 'contained' the proper values.
My real form uses POST, so I just commented out the CGI.pm code and iterated over STDIN and it had all the name-value pairs as it should have.
Everything I've done points to CGI.pm, so I will try reinstalling it.
Here's the test code that missed half the vars:
#!/usr/bin/perl;
use CGI;
my $q = new CGI;
my $subject = $q->param('qSetSubject');
my $topic = $q->param('qTopicName');
my $userName = $q->param('uName');
my $accessLevel = $q->param('accessLevel');
my $category = $q->param('qSetCat');
my $type = $q->param('qSetType');
print "Content-Type: text/html\n\n";
print "<html>\n<head><title>Test CGI<\/title><\/head>\n<body>\n\n<h2>Here Are The Variables:<\/h2>\n";
print "<list>\n";
print "<li>\$q->param(\'qSetSubject\') = $subject\n";
print "<li>\$q->param(\'qTopicName\') = $topic\n";
print "<li>\$q->param(\'uName\') = $userName\n";
print "<li>\$q->param(\'qSetCat\') = $accessLevel\n";
print "<li>\$q->param(\'qSetType\') = $category\n";
print "<li>\$q->param(\'accessLevel\') = $type\n";
print "<\/list>\n";
The results of ikegami's code are here:
qSetSubject: precalculus
qTopicName: polar coordinates
uName: kjtruitt
accessLevel: private
category: mathematics
type: grid-in
My attempt to incorporate ikegami's code
%NAMES = (
seqNum => 'seqNum',
uName => 'userName',
qSetName => 'setName',
accessLevel => 'accessLevel',
qSetCat => 'category',
qTopicName => 'topic',
qSetType => 'type',
qSetSubject => 'subject',
);
use CGI;
my $cgi = CGI->new();
print "Content-Type:text/html\n\n";
#print($cgi->header('text/plain'));
for my $name ($cgi->param) {
for ($cgi->param($name)) {
#print("$name: ".( defined($_) ? $_ : '[undef]' )."\n");
print "$NAMES{$name} = $_\n";
${$NAMES{$name}} = $_;
}
}
print "<html>\n<head><title>Test CGI<\/title><\/head>\n<body>\n\n<h2>Here Are The Variables:<\/h2>\n";
print "Hello World!\n";
print "<list>\n";
print "<li>\$q->param(\'qSetSubject\') = $subject\n";
print "<li>\$q->param(\'qTopicName\') = $topic\n";
print "<li>\$q->param(\'uName\') = $userName\n";
print "<li>\$q->param(\'qSetCat\') = $accessLevel\n";
print "<li>\$q->param(\'qSetType\') = $category\n";
print "<li>\$q->param(\'accessLevel\') = $type\n";
print "<\/list>\n";
You are receiving
qSetSubject: precalculus
qTopicName: polar coordinates
uName: kjtruitt
accessLevel: private
category: mathematics
type: grid-in
so
my $category = $q->param('qSetCat');
my $type = $q->param('qSetType');
should be replaced with
my $category = $q->param('category');
my $type = $q->param('type');
First time user, looking for help with a script that's been driving me crazy.
Basically, I need to create a set number of files of an exact size (512KB, 2MB, 1GB) to test a SAN. These files need to be filled with random text so that the SAN doesn't catch the nuls and does actually allocate the blocks - that's also the reason I couldn't just use fsutils.
Now, I've been messing with the new-bigrandomfile by Verboon and tweaking it to my needs.
However I'm getting the error:
You cannot call a method on a null-valued expression.
At L:\random5.ps1:34 char:9
+ $stream.Write($longstring)
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~
+ CategoryInfo : InvalidOperation: (:) [], RuntimeException
+ FullyQualifiedErrorId : InvokeMethodOnNull
This is the bit of code I've come up with so far; I'll add a loop at the end to copy the file I just created N times so to fill up the lun.
Set-Strictmode -Version 2.0
#temp file
$file = "c:\temp\temp.rnd"
#charset size
$charset = 64
#Block Size
$blocksize = 512
#page size
$Pagesize = 512KB
#Number of blocks in a page
$blocknum = $Pagesize / $blocksize
#Resulting/desired test file size
$filesize = 1GB
#number of pages in a file
$pagenum = $filesize / $Pagesize
# create the stream writer
$stream = System.IO.StreamWriter $file
# get a 64 element Char[]; I added the - and _ to have 64 chars
[char[]]$chars = 'azertyuiopqsdfghjklmwxcvbnAZERTYUIOPQSDFGHJKLMWXCVBN0123456789-_'
1..$Pagenum | ForEach-Object {
# get a page's worth of blocks
1..$blocknum| ForEach-Object {
# randomize all chars and...
$rndChars = $chars | Get-Random -Count $chars.Count
# ...join them in a string
$string = -join $rndChars
# repeat random string N times to get a full block string length
$longstring = $string * ($blocksize / $charset)
# write 1 block to file
$stream.Write($longstring)
# release resources by clearing string variables
Clear-Variable string, longstring
}
}
$stream.Close()
$stream.Dispose()
# release resources through garbage collection
[GC]::Collect()
$file.Close()
I've tried a gazillion variants like:
$stream = [System.IO.StreamWriter] $file
$stream = System.IO.StreamWriter $file
$stream = NewObject System.IO.StreamWriter $file
Of course, being a total noob at powershell, I've tried using quotes, brackets, provided the full path instead of the variable, etc. All (or most) seem to be valid syntax variants, according to a ton of examples I found online, but the output is still the same.
In case you have any improvement to suggest or alternative way to perform this task I'm all ears.
Edited the script above: just a couple of " for $file made the error disappear, - thanks LinuxDisciple; however, the file gets created but stays at 0 bytes and the script stuck in a loop.
Fix your instantiation of StreamWriter to any of these correct variants:
$stream = [System.IO.StreamWriter]::new($file)
$stream = [IO.StreamWriter]::new($file) # the default namespace may be omitted
$stream = New-Object System.IO.StreamWriter $file
You can specify encoding:
$stream = [IO.StreamWriter]::new(
$file,
$false, # don't append
[Text.Encoding]::ASCII
)
See StreamWriter on MSDN for available constructors and parameters.
PowerShell ISE offers autocomplete with tooltips:
type [streamw and press Ctrl-Space to autocomplete the full .NET class name
type ]:: to see the available methods and properties
type new and press Ctrl-Space to see the constructor overrides
whenever needed, put the caret at the method name and press Ctrl-Space for the tooltip
I know nothing about powershell but a few things:
Are you sure $longstring has a value before you call stream.Write()? It sounds like it's null and that's why the error. If you can somehow output the value of $longstring to the console, it would help you make sure that it has a value.
Also, troubleshoot the code with a simplified version of your code, so that you can pinpoint what's going on, for example
$file = c:\temp\temp.rnd
$stream = System.IO.StreamWriter $file
$longstring = 'whatever'
$stream.Write($longstring)
I have a mod_perl PerlAuthzHandler authorizing access to directories served by Apache2. In terms of controlling access it is working well.
A side effect, though, is that it seems to be preventing POST form variables from being available to PHP apps in the protected locations. At least when I comment out the PerlAuthzHandler and reload Apache the PHP app functions again. I think either the full environment is not being inherited by Perl or Perl is sending a cleansed environment on.
Is it possible to ensure that all POST variables are available to the PHP application after authorization?
Details
User authentication is managed by simplesamlphp on this box, the SP, and ADFS, the IdP. The addition to the simplesamlphp installation is the use of PerlAuthzHandler.
Apache configuration
The Apache configuration for the location in question looks like this:
<Location /activity>
ErrorDocument 401 "/simplesaml/authmemcookie.php"
AuthName "MCLAnet"
AuthType Cookie
Require valid-user
PerlSetvar Auth_memCookie_SessionTableSize "40"
PerlAuthzHandler My::simple
PerlSetVar VALID_GROUP_EXPR "status-acad or staff-g"
</Location>
Authorization handler
The authorization handler retrieves group memberships recorded in setting up the session and compared to a VALID_GROUP_EXPRESSION in the PerlSetVar:
#! /usr/bin/perl
package My::simple;
# Version 1.0 MCLA CSS
use Apache2::Access ();
use Apache2::RequestUtil ();
# load modules that are going to be used
use Data::Dumper;
use CGI qw(:standard);
use CGI::Cookie;
use Cache::Memcached;
use PHP::Serialization qw(serialize unserialize);
# compile (or import) constants
use Apache2::Const -compile => qw(OK FORBIDDEN);
$debug=0;
$debug_file="/tmp/xxx";
dmp('prerun',('test'));
sub handler {
my $r = shift;
my $user = $r->user;
dmp('0 user',$user);
# ------------------------ get valid group(s) for this session
my $valid_group_expr=$r->dir_config("VALID_GROUP_EXPR");
dmp('1 valid group list',$valid_group_expr);
# -- get the session cooke to retrieve the session <ID>
$query = new CGI;
# fetch existing cookies
my %cookies = CGI::Cookie->fetch;
# dmp('Cookies',%cookies);
my $ID = $cookies{'SimpleSAMLSessionID'}->value;
dmp('2 SimpleSAMLSessionID value',$ID);
my $SessionID='simpleSAMLphp.session.' . $ID;
# -- use the session ID to look up the value of memcached key simpleSAMLphp.session.<ID>
my $cache = new Cache::Memcached {
'servers' => ['127.0.0.1:11211'],
'compress_threshold' => 10_000,
};
# Get the value from cache:
my $value = $cache->get($SessionID);
# dmp('mamcache value',($value));
# -- use the value data to find the groups
my $hashref = unserialize($value);
# dmp('mamcache unserialized',($hashref));
my %hash = %{ $hashref };
%hash = % { $hash {'data'}{chr(0) . 'SimpleSAML_Session' . chr(0) . 'authData'}{'default-sp'}{'Attributes'} };
my #groups = # { $hash{'groups'} };
dmp("3 Comparing $valid_group_expr to", \#groups);
my $result=evaluate($valid_group_expr,#groups);
if ($result) {
dmp("this guy oK",$result);
return Apache2::Const::HTTP_OK;
}
dmp("blowing this guy off",$result);
$r->log_reason("Not a member of group " . $valid_group_expr);
return Apache2::Const::FORBIDDEN;
# return Apache2::Const::HTTP_FORBIDDEN;
# return Apache2::Const::HTTP_OK;
# return Apache2::Const::DECLINED;
}
# ======================= utility functions
# evaluate returns the boolean value of the expression $expr
# after substituting membership information in #groups
#
# valid operators are
#
# &&, and, AND logical AND
# ||, or, OR logical OR
# !, NOT, not logical NOT
#
# expression must be infix and precidence can be indicated by ()
sub evaluate {
my ($expr,#groups)=#_;
# print "$expr\n";
# print Dumper(\%group_hash);
# operator tokens
my %token_hash = (
'(' => '(',
')' => ')',
'AND' => '&&',
'and' => '&&',
'or' => '||',
'OR' => '||',
'!' => '!',
'not' => '!',
'NOT' => '!',
) ;
# add the group array into the token hash as TRUEs
foreach $v (#groups) {
$v=~s/ /_/g;
$token_hash{$v} = 1;
}
dmp('merged hash',\%token_hash);
# merge the two hashes into %token_hash
# foreach my $tkey ( keys %group_hash) { $token_hash{$tkey} = $group_hash{$tkey}; }
# print Dumper(\%token_hash);
$expr=~s/\(/ ( /g;
$expr=~s/\)/ ) /g;
$expr=~s/\!/ ! /g;
# print "$expr\n";
my #expr_hash=split (/ /,$expr);
$expr='';
foreach my $t (#expr_hash) {
if ($t ne '') {
if (exists ($token_hash{$t})) { $t = $token_hash{$t} } else {$t = 0;}
$expr = $expr . "$t ";
}
}
dmp("expression",$expr);
my $result=0;
my $assignment="\$result = $expr;";
dmp("assignment",$assignment);
eval($assignment);
dmp("result",$result);
return $result;
}
# debug dump structure funcion
sub dmp {
if ($debug == 1) {
my ($label,#value) = #_;
my $temp = Dumper(#value);
open (T, ">>$debug_file"); # || die "Can't open $debug_file: $!\n";
print T "$label: $temp\n";
close (T);
}
}
1;
Failing PHP script
The simple PHP form below displays no value when the Perl authorization is enabled. If I comment out the PerlAuthzHandler line both $_POST'[submit'] and $_POST['in1'] are set.
<?php
if (isset($_POST['submit'])) { print_r($_POST); }
$form=<<<EOT
<form name="test" action="y.php" method="post">
<input name="in1">
<input type="submit" name="submit">
</form>
EOT;
print $form;
?>
Again, authentication (simplesamlphp/ADFS) and authorization both work as expected. The exception is that when authorization is used no $_POST variables are available.
RESOLUTION
As often happens the problem was of my own making. One of the kind monks at perlmonks.org pointed out that the Perl handler contained the line:
$query = new CGI;
Removing that did it. Since I was in fact only accessing but not changing anything there was no point to it and in fact $query was never used.
For debugging purposes I'd like to Access the lexical scope of different subroutines with a specific Attribute set. That works fine. I get a Problem when the first variable stores a string, then I get a empty string. I do something like this:
$pad = $cv->PADLIST; # $cv is the coderef to the sub
#scatchpad = $pad->ARRAY; # getting the scratchpad
#varnames = $scratchpad[0]->ARRAY; # getting the variablenames
#varcontents = $scratchpad[1]->ARRAY; # getting the Content from the vars
for (0 .. $#varnames) {
eval {
my $name = $varnames[$_]->PV;
my $content;
# following line matches numbers, works so far
$content = $varcontent[$_]->IVX if (scalar($varcontent[$_]) =~ /PVIV=/);
# should match strings, but does give me undef
$content = B::perlstring($varcontent[$_]->PV) if (scalar($varcontent[$_]) =~ /PV=/);
print "DEBUGGER> Local variable: ", $name, " = ", $content, "\n";
}; # there are Special vars that throw a error, but i don't care about them
}
Like I said in the comment the eval is to prevent the Errors from the B::Special objects in the scratchpad.
Output:
Local variable: $test = 42
Local variable: $text = 0
The first Output is okay, the second should Output "TEXT" instead of 0.
What am I doing wrong?
EDIT: With a little bit of coding I got all values of the variables , but not stored in the same indexes of #varnames and #varcontents. So now is the question how (in which order) the values are stored in #varcontents.
use strict;
use warnings;
use B;
sub testsub {
my $testvar1 = 42;
my $testvar2 = 21;
my $testvar3 = "testval3";
print "printtest1";
my $testvar4 = "testval4";
print "printtest2";
return "returnval";
}
no warnings "uninitialized";
my $coderef = \&testsub;
my $cv = B::svref_2object ( $coderef );
my $pad = $cv->PADLIST; # get scratchpad object
my #scratchpad = $pad->ARRAY;
my #varnames = $scratchpad[0]->ARRAY; # get varnames out of scratchpad
my #varcontents = $scratchpad[1]->ARRAY; # get content array out of scratchpad
my #vars; # array to store variable names adn "undef" for special objects (print-values, return-values, etc.)
for (0 .. $#varnames) {
eval { push #vars, $varnames[$_]->PV; };
if ($#) { push #vars, "undef"; }
}
my #cont; # array to store the content of the variables and special objects
for (0 .. $#varcontents) {
eval { push #cont, $varcontents[$_]->IV; };
eval { push #cont, $varcontents[$_]->PV; };
}
print $vars[$_], "\t\t\t", $cont[$_], "\n" for (0 .. $#cont);
EDIT2: Added runnable script to demonstrate the issue: Variablenames and variablevalues are not stored in the same index of the two Arrays (#varnames and #varcontents).