kiz has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to make an authenticated connection to a web server (well, more accurately, to a java application on a Tomcat server).

The task is to connect to a script protected by a simple http Basic Authentication, and give it a .zip file to process.

((For those who really want to know, I'm trying to make a SWORD deposit into a DSpace server))

I can do the connection using curl:

curl -i --data-binary "@./myFile.zip" -H "Content-Disposition: filenam
+e=myFile.zip" -H "Content-Type:application/zip" -H "X-Packaging:http:
+//purl.org/net/sword-types/METSDSpaceSIP" -H "X-No-Op:false" -H "X-Ve
+rbose:true" http://myUsername:myPassword@my.host:port/path/to/script

[download]

This works.

However, I need to be able to do the web call from within a mod_perl application, so I want a perl-based transfer.... enter LWP::UserAgent. I'm starting by writing a straight script first, and then I'll tweek it to run under mod_perl.

Roughly speaking, my script equivalent is:

use LWP::UserAgent;

my $host = 'my.host:port';
my $username = 'myUsername';
my $password = 'myPassword';
my $realm = 'theRealm';
my $sword_url = "http://$host/path/to/script";
my $filename = "myFile.zip";

my $file = "";
open(FILE, "$filename" ) or die('cant open input file');
binmode FILE;
while(<FILE>) { $file .= $_; }
close FILE;

my $ua = LWP::UserAgent->new();

$ua->credentials(
    "$host",
    "$realm",
    "$username" => "$password"
);

my $req = HTTP::Request->new( POST => $sword_url );
my $length = do {use bytes; length $file};

# Header information needed by the application
$req->header( 'X-Packaging' => 'http://purl.org/net/sword-types/METSDS
+paceSIP',
              'X-No-Op' => 'false',
              'X-Verbose' => 'true',
              'Content-Disposition' => "filename=$filename"
 );

$req->content_type( 'application/zip' );
$req->content( $file );
$req->content_length($length);

my $res = $ua->request($req);    
if ($res->is_success) 
{
    print $res->content;
}
else 
{
    print $res->status_line, "\n";
}

[download]

This works fine when I'm talking to a Mod_perl based application, but fails when talking to the java application (and I've tried two now) - and the failure is "401: Unauthorised"

There are two possibilities:

  1. The java application does not recognise the basic authentication defined by LWP::UserAgent, whereas it does recognise the authentication given in the URL when using the curl client
  2. The LWP::UserAgent has a problem when username contains an '@' (which is a basic requirement of the java application.)
So: does anyone know if LWP::UserAgent has issues with usernames containing '@' characters, and does anyone have a suggestion for an alternative method of connecting to the target server?


-- Ian Stuart
A man depriving some poor village, somewhere, of a first-class idiot.

Replies are listed 'Best First'.
Re: Replicating curl's authentication in Perl
by ReturnOfThelonious (Beadle) on Oct 12, 2010 at 13:06 UTC
    The suggestion of looking at the curl connection is a good one. You can compare what you have with curl --trace tracefile to what you see with use LWP::Debug qw(+conns);

    You can use libcurl from Perl. It shouldn't be necessary to resolve such a simple problem, though.

    Curl takes the user:pass@ out of the url and just puts the user and password in the credentials, so it should work the same.

    Are you sure the user name contains an '@' character? The user name is just the part before the ':'. You would have to URL-encode an '@' sign for curl (not for LWP).

[reply]
[d/l]
[select]
*solved* Re: Replicating curl's authentication in Perl
by kiz (Monk) on Oct 12, 2010 at 14:09 UTC

    Got it....

    It was variable interpolation for a username with an '@' in it.

    use LWP::UserAgent;

my $target = 'sharegeo';  # opendepot, jorum, sharegeo

my ($host, $username, $password, $realm, $sword_url, $collection) = ()
+; 
for ($target) {
  /opendepot/ && do {
     $host = 'devel.edina.ac.uk:1201';
     $collection = '/sword-app/deposit/archive';
     $username = 'myUsername';
     $password = 'myPassword';
     $realm = 'SWORD';
     last;
  };
  /jorum/ && do {
     $host = 'dev1.jorum.ac.uk';
     $collection = '/sword/deposit/123456789/15';
     $username = 'me%40this.domain';
     $password = 'myPassword';
     $realm = 'SWORD';
     last;
  };
    /sharegeo/ && do {
     $host = 'devel.edina.ac.uk:9248';
     $collection = '/sword/deposit/123456789/2';
     $username = 'me%40that.domain';
     $password = 'anotherPassword';
     $realm = 'SWORD';
     last;
  };

}

# file to send via POST:
my $filename = "Broker_test_package.zip"; # A DSpace/Mets zip file

my $file = "";
open(FILE, "$filename" ) or die('cant open input file');
binmode FILE;
while(<FILE>) { $file .= $_; }
close FILE;

my $ua = LWP::UserAgent->new();

my $req = HTTP::Request->new( POST => 'http://'.$username.":".$passwor
+d."@".$host.$collection );

#my $length = do {use bytes; length $file};

# Tell SWORD to process the contents of the zip file as DSpaceMets
$req->header( 'X-Packaging' => 'http://purl.org/net/sword-types/METSDS
+paceSIP',
              'X-No-Op' => 'false',
              'X-Verbose' => 'true',
              'Content-Disposition' => "filename=$filename"
);
$req->content_type( 'application/zip' );

$req->content( $file );
#$req->content_length($length);

# Et Zzzzooo!
my $res = $ua->request($req);    

if ($res->is_success) 
{
    print $res->content;
}
else 
{
    print $res->status_line, "\n";
}

    [download]
    .... and that works for both a perl application (EPrints) and a java one (DSpace) Thanks to those who helped (on-line and off-line)


    -- Ian Stuart
    A man depriving some poor village, somewhere, of a first-class idiot.
[reply]
[d/l]
Re: Replicating curl's authentication in Perl
by Anonymous Monk on Oct 12, 2010 at 11:07 UTC
    So: does anyone know if LWP::UserAgent has issues with usernames containing '@' characters, and does anyone have a suggestion for an alternative method of connecting to the target server?

    LWP::UserAgent has no such issue, your program might if you use interpolation ( "fun@stuff" would try to interpolate the array @stuff)

[reply]
[d/l]
      That was one of my thoughts, however a data dump of the HTTP::Request object shows that the '@' has propagated through correctly: 
        'basic_authentication' => {
    'my.host:port' => {
      'SWORD' => [
        'me@here',
        'myPassword'
      
    }
  },

      [download]


      -- Ian Stuart
      A man depriving some poor village, somewhere, of a first-class idiot.
[reply]
[d/l]
        What exactly does curl send? headers and 50bytes of the content should suffice (don't forget to clean the auth headers)
[reply]

Back to Seekers of Perl Wisdom