CGI::Session not setting cookie - cgi

I have some code that has been working fine - until I moved the session initialisation into one of my modules. Now the cookie is no longer being set via print->header - and so a new session is created every time I run it. Here's the (heavily pruned/edited) code:
# login.pl
use CGI;
use CGI::Session ( '-ip_match' );
use DBI;
use MyPM qw(&open_db &close_db &getSession);
use strict;
use warnings;
my $cgi = new CGI;
my $dbh = open_db;
my $session = getSession($cgi, $dbh); # Call to MyPM.pm
close_db($dbh);
...... code ......
print $session->header(-type => 'application/json');
print $json;
=======================================
# MyPM.pm
use CGI::Session ( '-ip_match' );
our #ISA = qw(Exporter);
our #EXPORT_OK = qw( open_db close_db getSession );
sub getSession {
my $cgi = shift;
my $dbh = shift;
my $CGICOOKIE = $cgi->cookie('CGISESSID') || 'x';
my $lng = length($CGICOOKIE);
if ( $lng != 32 ) print redirect( -URL => $home );
my $session = CGI::Session->new('driver:MySQL', $cgi, { Handle=>$dbh }) ;
return $session;
}
If I change the call to getSession back into this:
my $session = CGI::Session->new('driver:MySQL', $cgi, { Handle=>$dbh });
It works perfectly again and the cookie is set.
Where might I be going wrong?

I realised the problem is when I am checking for the cookie - I am checking for a cookie of 32 characters ... but ignoring the fact that it may be missing.
Sorry for my stupidity!

Related

How does one redirect using an Apache Perl Handler?

I have an Apache Handler that sets an extension, .redir, to a Perl script. The code is as follows:
Action redir-url /cgi-bin/redir.pl
AddHandler redir-url .redir
The script should simply redirect the user to the page contained in the .redir file. Example:
so.redir:
http://stackoverflow.com/
If the user visits http://example.com/so.redir, they will be redirected to http://stackoverflow.com/.
My current code is as follows, though it returns an error 500, and probably is completely off:
#!/usr/bin/perl
use strict;
use warnings;
use Path::Class;
use autodie;
my $file = file($ENV{'PATH_TRANSLATED'});
my $file_handle = $file->openw();
my #list = ('a', 'list', 'of', 'lines');
foreach my $line ( #list ) {
# Add the line to the file
$file_handle->print("Location: ".$line."\n\n");
}
Thank you for any help!
Back in the cgi-days we used to have a small subroutine that does the redirecting:
sub redirect_url {
my ($url, %params) = #_;
$params{Location} = $url;
if ( ($ENV{'HTTP_USER_AGENT'}=~m|Mozilla\/4\.|)
&& !($ENV{'HTTP_USER_AGENT'}=~m|MSIE|) ) {
# handle redirects on netscape 4.x
$params{Status} = '303 See Other'
unless exists $params{Status};
$params{'Content-Type'} = 'text/html; charset=utf-8'
unless exists $params{'Content-Type'};
$params{Content} =<<EOF;
<html>
<head>
<script language="JavaScript"><!--
location.href = "$params{Location}";
//--></script>
</head>
<body bgcolor="#FFFFFF">
Redirect
</body>
EOF
}
else {
$params{Status} = '301 Moved Permanently'
unless exists $params{Status};
$params{'Content-Type'} = 'text/plain; charset=utf-8'
unless exists $params{'Content-Type'};
}
$params{Expires} = 'Fri, 19 May 1996 00:00:00 GMT'
unless exists $params{Expires};
$params{Pragma} = 'no-cache'
unless exists $params{Pragma};
$params{'Cache-Control'} = 'no-cache'
unless exists $params{'Cache-Control'};
my $content = exists $params{Content}
? $params{Content} : $params{Status};
delete $params{Content};
while (my ($key, $value) = each %params) {
print "$key: $value\n";
}
print "\n";
print $content;
exit 0;
}
so if I get the rest of your code rite:
use strict;
my $file = $ENV{'PATH_TRANSLATED'};
open (my $fh, '<', $file) or die 'cant open';
my $url = <$fh>;
chomp($url);
redirect_url($url);
would do the job.

Apache PerlAuthzHandler and form POST vars

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.

issue accessing lexical scope using B

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).

i am having a issue with json codeigniter rest its not closing the tag

i am having a problem with json codeigniter rest
i am making this call to the server and the problem its that its not closing the json tags
s, USA","clientUID":"7","email":null,"idipad":"2","dateModified":null},{"id":"19","uid":null,"name":"Wayne Corporation, Inc.","phone":"932345324","address":"Second st. 312, Gotham City","clientUID":"7","email":"waynecorp#gmail.com","idipad":"1","dateModified":null}]
its missing the final }
this is the code that creates the response :
$this->response(array('login'=>'login success!','user_admin_id'=>$user_id,'client'=>$client,'users'=>$users,'projects'=>$projects,'plans'=>$plans,'meetings'=>$meetings,'demands'=>$demands,'tasks'=>$tasks,'presences'=>$presences,'contractors'=>$contractors,'companies'=>$companies), 200);
this is the client call using curl :
$this->curl->create('http://dev.onplans.ch/onplans/index.php/api/example/login/format/json');
// Option & Options
$this->curl->option(CURLOPT_BUFFERSIZE, 10);
$this->curl->options(array(CURLOPT_BUFFERSIZE => 10));
// More human looking options
$this->curl->option('buffersize', 10);
// Login to HTTP user authentication
$this->curl->http_login('admin', '1234');
// Post - If you do not use post, it will just run a GET request
//$post = array('remember'=>'true','email'=>'admin.architect#onplans.ch','password'=>'password');
$post = array('remember'=>'true','email'=>'admin.architect#onplans.ch','password'=>'password');
$this->curl->post($post);
// Cookies - If you do not use post, it will just run a GET request
$vars = array('remember'=>'true','email'=>'manuel#ffff.com','password'=>'password');
$this->curl->set_cookies($vars);
// Proxy - Request the page through a proxy server
// Port is optional, defaults to 80
//$this->curl->proxy('http://example.com', 1080);
//$this->curl->proxy('http://example.com');
// Proxy login
//$this->curl->proxy_login('username', 'password');
// Execute - returns responce
echo $this->curl->execute();
// Debug data ------------------------------------------------
// Errors
$this->curl->error_code; // int
$this->curl->error_string;
print_r('error :::::LOGINN REMOTE:::::'.$this->curl->error_string);
// Information
$this->curl->info; // array
print_r('info :::::::::::::'.$this->curl->info);
the response belong to the rest api codeigniter from phil
/**
* Response
*
* Takes pure data and optionally a status code, then creates the response.
*
* #param array $data
* #param null|int $http_code
*/
public function response($data = array(), $http_code = null)
{
global $CFG;
// If data is empty and not code provide, error and bail
if (empty($data) && $http_code === null)
{
$http_code = 404;
// create the output variable here in the case of $this->response(array());
$output = NULL;
}
// If data is empty but http code provided, keep the output empty
else if (empty($data) && is_numeric($http_code))
{
$output = NULL;
}
// Otherwise (if no data but 200 provided) or some data, carry on camping!
else
{
// Is compression requested?
if ($CFG->item('compress_output') === TRUE && $this->_zlib_oc == FALSE)
{
if (extension_loaded('zlib'))
{
if (isset($_SERVER['HTTP_ACCEPT_ENCODING']) AND strpos($_SERVER['HTTP_ACCEPT_ENCODING'], 'gzip') !== FALSE)
{
ob_start('ob_gzhandler');
}
}
}
is_numeric($http_code) OR $http_code = 200;
// If the format method exists, call and return the output in that format
if (method_exists($this, '_format_'.$this->response->format))
{
// Set the correct format header
header('Content-Type: '.$this->_supported_formats[$this->response->format]);
$output = $this->{'_format_'.$this->response->format}($data);
}
// If the format method exists, call and return the output in that format
elseif (method_exists($this->format, 'to_'.$this->response->format))
{
// Set the correct format header
header('Content-Type: '.$this->_supported_formats[$this->response->format]);
$output = $this->format->factory($data)->{'to_'.$this->response->format}();
}
// Format not supported, output directly
else
{
$output = $data;
}
}
header('HTTP/1.1: ' . $http_code);
header('Status: ' . $http_code);
// If zlib.output_compression is enabled it will compress the output,
// but it will not modify the content-length header to compensate for
// the reduction, causing the browser to hang waiting for more data.
// We'll just skip content-length in those cases.
if ( ! $this->_zlib_oc && ! $CFG->item('compress_output'))
{
header('Content-Length: ' . strlen($output));
}
exit($output);
}
This answer was referenced from Github issue. Also raised by Pedro Dinis, i guest.
I met this problem today and take me long hours to search for the solution. I share here with hope to help someone like me.
The key is to replace around line 430 in the library file: REST_Controller.php :
header('Content-Length: ' . strlen($output));
by
header('Content-Length: ' . strlen("'".$output."'"));
UPDATE: The problem was solved here
Or you can just comment out the code, it will run fine. :)

Powershell HTTP POST File Upload for REST api

I am new to Powershell and having trouble sending a file via an HTTP POST request. Everything is working perfectly except for sending/uploading the file. Is this possible using my existing code?
Here is my code:
# VARIABLES
$myFile = "c:\sample_file.csv"
$updateUrl = "http://www.example.com/processor"
$postData = "field1=value1"
$postData += "&field2=value2"
$postData += "&myFile=" + $myFile
# EXECUTE FUNCTION
updateServer -url $updateUrl -data $postData
function updateServer {
param(
[string]$url = $null,
[string]$data = $null,
[System.Net.NetworkCredential]$credentials = $null,
[string]$contentType = "application/x-www-form-urlencoded",
[string]$codePageName = "UTF-8",
[string]$userAgent = $null
);
if ( $url -and $data ){
[System.Net.WebRequest]$webRequest = [System.Net.WebRequest]::Create($url);
$webRequest.ServicePoint.Expect100Continue = $false;
if ( $credentials ){
$webRequest.Credentials = $credentials;
$webRequest.PreAuthenticate = $true;
}
$webRequest.ContentType = $contentType;
$webRequest.Method = "POST";
if ( $userAgent ){
$webRequest.UserAgent = $userAgent;
}
$enc = [System.Text.Encoding]::GetEncoding($codePageName);
[byte[]]$bytes = $enc.GetBytes($data);
$webRequest.ContentLength = $bytes.Length;
[System.IO.Stream]$reqStream = $webRequest.GetRequestStream();
$reqStream.Write($bytes, 0, $bytes.Length);
$reqStream.Flush();
$resp = $webRequest.GetResponse();
$rs = $resp.GetResponseStream();
[System.IO.StreamReader]$sr = New-Object System.IO.StreamReader -argumentList $rs;
$sr.ReadToEnd();
}
}
Two thoughts. First it seems you're uploading the filename but not the file's contents. Second, if you upload the file's contents within the POST you're likely going to need to URL encode the data using something like [System.Web.HttpUtility]::UrlEncode(). Also, check out my answer to this related SO question.
I found the solution to this problem here. I think I may have come across this when I was building my script originally or a snippet of it somewhere else as it is nearly identical to what I have except more thorough.