problem with LWP: "POST" 1

[sebastiannielsen]

Im trying to make a CGI proxy, that will relay GET and POST to my firewall.
GET are working, even with a query string. I have tested it.
But POST are not working. When im trying to "POST", nothing are posted, the firewall dosent notice any changes. For example if i want to disable the SSH, the firewall leave it enabled after pressing "save". But firewall changes it if i do exactly the same thing but connect directly to firewall.

I have marked the lines where im think the problem is.


Here is my code:

#!c:/perl/bin/perl.exe

use CGI ':standard';
use LWP::UserAgent;

my $ua = new LWP::UserAgent;

$ua->agent("IPCop Login client");
$dir = $ENV{'PATH_INFO'};

if ($dir =~ m/http/) {
print "Location: $dir\n\n";
}
else
{

if ($dir =~ m/^\//) {
$dir =~ s/^\///;
}

$adir = '[URL unfurl="true"]https://ipcop.localdomain:445/'.$dir;[/URL]

$ua->credentials(#Do you really think i will leave out my firewall password?);
$ua->timeout(30);
$met = $ENV{'REQUEST_METHOD'};
$req = HTTP::Request->new();
$req->method($met);
$req->header("Host", "ipcop.localdomain");

###### POSSIBLY PROBLEM SECTION ######

$len = int($ENV{'CONTENT_LENGTH'});
if ($met eq "POST") {
        read(STDIN,$buffer,$len);
} else {
        $buffer = $ENV{'QUERY_STRING'};
}
if ($buffer) {
if ($met eq "POST") {
$req->content($buffer);
}
else
{
$adir = $adir."?".$buffer;
}
}
$req->url($adir);

###### END OF SECTION ######

my $res = $ua->request($req);

my $headers = $res->headers_as_string."\n";
my $body =  $res->content;

if ($res->is_success) {
$body =~ s/url[(]/xxc(/gi;
$body =~ s/action=/boolsend=/gi;
$body =~ s/src=/abcget=/gi;
$body =~ s/href=/linkget=/gi;

$body =~ s/xxc[(]([^()]+)*[)]/url(http:\/\/[URL unfurl="true"]www.sebpage.no-ip.com\/login.cgi\/$1)/gi;[/URL]
$body =~ s/boolsend=[ '"]*([^ '"]+)*[ '"]*/action=http:\/\/[URL unfurl="true"]www.sebpage.no-ip.com\/login.cgi\/$1[/URL] /gi;
$body =~ s/abcget=[ '"]*([^ '"]+)*[ '"]*/src=http:\/\/[URL unfurl="true"]www.sebpage.no-ip.com\/login.cgi\/$1[/URL] /gi;
$body =~ s/linkget=[ '"]*([^ '"]+)*[ '"]*/href=http:\/\/[URL unfurl="true"]www.sebpage.no-ip.com\/login.cgi\/$1[/URL] /gi;
print $headers.$body;
}
else
{
$headers =~ s/Location:[ ]?(.+)*\n/Location: http:\/\/[URL unfurl="true"]www.sebpage.no-ip.com\/login.cgi\/$1\n/gi;[/URL]

print $headers.$body;
}
}

 

[fishiface]

I can't see anything obvious so, rather than guess, I'm going to propose using PTKDB, a diagnostic technique which I find invaluable for awkward situations like this.

The PTKDB package depends on X11, which can be offputting, but I find the technique so useful that I have installed minimal X on a number of machines purely so that I can use this tool. I tend to work from a 'doze workstation, so I have WinAxe installed there, although there are good alternatives.

Add the following to the top of your code:

#!/usr/bin/perl -d:ptkdb
BEGIN{ $ENV{DISPLAY} = 'myws.mydom:0.0'; }

When you next connect, you can step through your code line by line and examine the contents of variables and objects as you go.

I use this tool for debugging cgi scripts as well as network listeners - anywhere where conventional debugging requires enormous effort to configure an appropriate simulation of the real execution environment. It's also excellent for ferreting out problems with, eg, suid environments.

Yours,


fish

["]As soon as we started programming, we found to our surprise that it wasn't as easy to get programs right as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs.["]
--Maur

 

[sebastiannielsen]

When im trying to run the script with the extra lines, i get INTERNAL SERVER ERROR.
Lines removed: #!c:/perl/bin/perl.exe
Lines added:
#!c:/perl/bin/perl.exe -dtkdb
BEGIN{ $ENV{DISPLAY} = 'myws.mydom:0.0'; }

I should install ptkdb now as the log showed that ptkdb was not installed.

 

[fishiface]

You also need to replace 'myws.mydom' with the address of the machine running the window manager.

f

["]As soon as we started programming, we found to our surprise that it wasn't as easy to get programs right as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs.["]
--Maur

 

[sebastiannielsen]

window manager? Winsta0?

 

[fishiface]

The window manager runs at the user's "end" of an X connection and keeps track of the windows. X terminology feels backwards to many people so I normally try to avoid talking about clients and servers, but the server is the user's end and the client is the application end.

If you're running a linux box with X-Windows, then everything is easy and the address you require is simply "localhost".

My usual setup is a 'doze workstation called jeep running WinAxe ( an X-server ) so I set DISPLAY to "jeep:0.0".

Perhaps if you let me know a little about your setup I can offer better advice.

HTH,

f

["]As soon as we started programming, we found to our surprise that it wasn't as easy to get programs right as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs.["]
--Maur

 

[sebastiannielsen]

Did you see my shebang line in the code at the first post? its beginning on c:/, also im running a windows machine.
I tought you knew that already.

Im running the webserver on windows 2000 server family.

Should download WinAxe and see if it works better...

 

[fishiface]

Sorry - missed that

In that case, forget everything I've been wittering about 'X'. Ptkdb uses tk, a windowing toolkit, which uses X in the 'nix environment but also talks nicely to native Windows (so you don't need WinAxe or the DISPLAY setting).

As I've not done this with a 'doze-based server, I suggest you check out this link -

http://twiki.org/cgi-bin/view/Codev/PerlPtkdb

- which makes life much simpler.


["]As soon as we started programming, we found to our surprise that it wasn't as easy to get programs right as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs.["]
--Maur

 

[sebastiannielsen]

thanks! i found the problem with the debugger....
It will take some time to solve the problem, as the problem was found in the module:

this line:
die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";

causes the problems i have: content do not get submitted.

 

[sebastiannielsen]

(cannot edit post here so i post a new)

Can I convert the scalar $buffer to something non-scalar?

 

[fishiface]

I think that you are misinterpreting the error message. The method [tt]content()[/tt] wants a scalar. The line you quote dies if given a scalar reference. If your code is dying on that line, then you are sending it a reference instead of a scalar. The [tt]ref()[/tt] function returns an empty string if handed a scalar, which would not trigger the [tt]die[/tt].

I believe you are round about here in Message.pm

sub _set_content {
    my $self = $_[0];
    if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") {
        ${$self->{_content}} = $_[1];
    } else {
        die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
        $self->{_content} = $_[1];
        delete $self->{_content_ref};
    }
    delete $self->{_parts} unless $_[2];
}

It would be useful for you to try again, setting a break point on the first line of this method. Run to that point and display the value of @_. If you post that value I should be able to help further.

Yours,

fish

["]As soon as we started programming, we found to our surprise that it wasn't as easy to get programs right as we had thought. Debugging had to be discovered. I can remember the exact instant when I realized that a large part of my life from then on was going to be spent in finding mistakes in my own programs.["]
--Maur

 

[sebastiannielsen]

buffer contains:

'ENABLE_SSH=on&ENABLE_SSH_PROTOCOL1=on&ENABLE_SSH_PORTFW=on&ENABLE_SSH_PASSWORDS=on&ENABLE_SSH_KEYS=on&ACTION=Spara'

@_ contains in _set_content:

[bless( {'_content' => '','_uri' => undef,'_headers' => bless( {'content-type' => 'application/x-

http://www-form-urlencoded','content-length'

=> 114,'host' => 'ipcop.localdomain'}, 'HTTP::Headers' ),'_method' => 'POST'}, 'HTTP::Request' ),'ENABLE_SSH=on&ENABLE_SSH_PROTOCOL1=on&ENABLE_SSH_PORTFW=on&ENABLE_SSH_PASSWORDS=on&ENABLE_SSH_KEYS=on&ACTION=Spara']

$_[1] is also 'ENABLE_SSH=on&ENABLE_SSH_PROTOCOL1=on&ENABLE_SSH_PORTFW=on&ENABLE_SSH_PASSWORDS=on&ENABLE_SSH_KEYS=on&ACTION=Spara'

 

[sebastiannielsen]

The $req variable contains when its ready for dispatch to $ua->request:


bless( {'_content' => 'ENABLE_SSH=on&ENABLE_SSH_PROTOCOL1=on&ENABLE_SSH_PORTFW=on&ENABLE_SSH_PASSWORDS=on&ENABLE_SSH_KEYS=on&ACTION=Spara','_uri' => bless( do{\(my $o = '

https://ipcop.localdomain:445/cgi-bin/remote.cgi')},

'URI::https' ),'_headers' => bless( {'content-type' => 'application/x-

http://www-form-urlencoded','content-length'

=> 114,'host' => 'ipcop.localdomain'}, 'HTTP::Headers' ),'_method' => 'POST'}, 'HTTP::Request' )