[Bps-public-commit] plient branch, master, updated. 833788123eed328198b1e7316694ec0d34cb9a03
? sunnavy
sunnavy at bestpractical.com
Tue May 4 03:02:45 EDT 2010
The branch, master has been updated
via 833788123eed328198b1e7316694ec0d34cb9a03 (commit)
from 0d266bd89a0f547a7026fbd018baa57d5ac2c0ee (commit)
Summary of changes:
bin/plient | 58 +++++++++++++++++++++++++++++++++++++--
lib/Plient.pm | 32 +++++++++++++++++-----
lib/Plient/Handler/HTTPLite.pm | 21 ++++++++++++--
lib/Plient/Handler/LWP.pm | 24 ++++++++++++++--
lib/Plient/Handler/curl.pm | 30 +++++++++++++++++---
lib/Plient/Handler/wget.pm | 34 ++++++++++++++++++-----
6 files changed, 171 insertions(+), 28 deletions(-)
- Log -----------------------------------------------------------------
commit 833788123eed328198b1e7316694ec0d34cb9a03
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue May 4 15:01:20 2010 +0800
add basic auth support
diff --git a/bin/plient b/bin/plient
index 2026ccd..ac871c0 100755
--- a/bin/plient
+++ b/bin/plient
@@ -3,11 +3,13 @@ use strict;
use warnings;
use Getopt::Long;
require Plient unless $ENV{PLIENT_BUNDLE_MODE};
+require Plient::Util unless $ENV{PLIENT_BUNDLE_MODE};
Plient->import( 'plient', 'plient_support' );
my %args;
-GetOptions( \%args, 'help|h', 'support|s=s', 'request|X=s', 'output|o=s' )
+GetOptions( \%args, 'help|h', 'support|s=s', 'request|X=s', 'output|o=s',
+ 'user|u=s' )
or die 'unknown option';
my $USAGE =<<EOF;
@@ -17,6 +19,7 @@ EXAMPLES:
plient -s http_get # ditto
plient http://cpan.org/ # fetch http://cpan.org
plient -o /tmp/cpan.html http://cpan.org/ # write to file
+ plient -u user:password http://foo.org # use basic auth
EOF
if ( $args{help} ) {
@@ -41,11 +44,60 @@ my $method = $args{'request'} || 'get';
for my $uri (@uri) {
$uri = 'http://' . $uri unless $uri =~ /^\w+:/;
+ my $u = $args{user};
+ my ( $user, $password ) = split /:/, $args{user}, 2;
+ if ($user) {
+ while ( !defined $password ) {
+ $password = prompt_password("password for $user:");
+ }
+ }
+
if ( $args{output} ) {
- plient( $method, $uri, { output_file => $args{output} } );
+ plient(
+ $method, $uri,
+ {
+ output_file => $args{output},
+ user => $user,
+ password => $password,
+ }
+ );
+ }
+ else {
+ print plient(
+ $method, $uri,
+ {
+ user => $user,
+ password => $password,
+ }
+ );
+ }
+}
+
+sub prompt_password {
+ my $prompt = shift;
+ my $password;
+ print "$prompt ";
+ eval { require Term::ReadKey; };
+ if ($@) {
+
+ # no Term::ReadKey available, let's use stty
+ if ( my $stty = Plient::Util::which('stty') ) {
+ system "stty -echo";
+ $password = <STDIN>;
+ system "stty echo";
+ }
+ else {
+ # no stty either, let's just read password as normal
+ # TODO this is bad, need improve
+ $password = <STDIN>;
+ }
}
else {
- print plient( $method, $uri );
+ Term::ReadKey::ReadMode('noecho');
+ $password = Term::ReadKey::ReadLine(0);
+ Term::ReadKey::ReadMode(0); #reset
}
+ chomp $password;
+ return $password;
}
diff --git a/lib/Plient.pm b/lib/Plient.pm
index e104bf9..6de62e5 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -282,16 +282,34 @@ $method: for HTTP(S), can be 'get', 'post', 'head', etc.
$uri: e.g. http://cpan.org
-$args: hashref
+$args: hashref, useful keys are:
- output_file: the file path returned content from server will be written to.
- if this option is set, plient() will return 1 if with success.
+=over 4
+
+=item output_file
+
+the file path returned content from server will be written to.
+if this option is set, plient() will return 1 if with success.
+
+=item user and password
+
+for HTTP(S), these will be used to set Authorization header
+
+=item auth_method
+
+currently, only 'Basic' is supported, default is 'Basic'
- headers: hashref, this will be sent as HTTP(S) headers. e.g.
- { 'User-Agent' => 'plient/0.01' }
+=item headers
+
+hashref, this will be sent as HTTP(S) headers. e.g.
+ { 'User-Agent' => 'plient/0.01' }
+
+=item body
+
+hashref, this will be sent as HTTP(S) post data. e.g.
+ { 'title' => 'foo', body => 'bar' }
- body: hashref, this will be sent as HTTP(S) post data.
- { 'title' => 'foo', body => 'bar' }
+=back
=head2 plient_support( $protocol, $method, $args )
diff --git a/lib/Plient/Handler/HTTPLite.pm b/lib/Plient/Handler/HTTPLite.pm
index cf0e578..c08e3c0 100644
--- a/lib/Plient/Handler/HTTPLite.pm
+++ b/lib/Plient/Handler/HTTPLite.pm
@@ -20,7 +20,7 @@ sub init {
$method{http_get} = sub {
my ( $uri, $args ) = @_;
my $http = HTTP::Lite->new;
- add_headers( $http, $args->{headers} ) if $args->{headers};
+ add_headers( $http, $uri, $args );
$http->proxy( $ENV{http_proxy} ) if $ENV{http_proxy};
my $res = $http->request($uri) || '';
@@ -39,7 +39,7 @@ sub init {
my ( $uri, $args ) = @_;
my $http = HTTP::Lite->new;
$http->proxy( $ENV{http_proxy} ) if $ENV{http_proxy};
- add_headers( $http, $args->{headers} ) if $args->{headers};
+ add_headers( $http, $uri, $args );
$http->prepare_post( $args->{body} ) if $args->{body};
my $res = $http->request($uri) || '';
if ( $res == 200 || $res == 301 || $res == 302 ) {
@@ -57,10 +57,25 @@ sub init {
}
sub add_headers {
- my ( $http, $headers ) = @_;
+ my ( $http, $uri, $args ) = @_;
+ my $headers = $args->{headers} || {};
for my $k ( keys %$headers ) {
$http->add_req_header( $k, $headers->{$k} );
}
+
+ if ( $args->{user} && defined $args->{password} ) {
+ my $method = lc $args->{auth_method} || 'basic';
+ if ( $method eq 'basic' ) {
+ require MIME::Base64;
+ $http->add_req_header( "Authorization",
+ 'Basic '
+ . MIME::Base64::encode_base64( "$args->{user}:$args->{password}", '' )
+ );
+ }
+ else {
+ die "aborting: unsupported auth method: $method";
+ }
+ }
}
__PACKAGE__->_add_to_plient if $Plient::bundle_mode;
diff --git a/lib/Plient/Handler/LWP.pm b/lib/Plient/Handler/LWP.pm
index 81c91ea..5a91ed1 100644
--- a/lib/Plient/Handler/LWP.pm
+++ b/lib/Plient/Handler/LWP.pm
@@ -30,7 +30,7 @@ sub init {
# XXX TODO tweak the new arguments
my $ua = LWP::UserAgent->new;
$ua->env_proxy;
- add_headers( $ua, $args->{headers} ) if $args->{headers};
+ add_headers( $ua, $uri, $args );
my $res = $ua->get($uri);
if ( $res->is_success ) {
return $res->decoded_content;
@@ -47,7 +47,7 @@ sub init {
# XXX TODO tweak the new arguments
my $ua = LWP::UserAgent->new;
$ua->env_proxy;
- add_headers( $ua, $args->{headers} ) if $args->{headers};
+ add_headers( $ua, $uri, $args );
my $res =
$ua->post( $uri,
$args->{body} ? ( content => $args->{body} ) : () );
@@ -89,10 +89,28 @@ sub init {
}
sub add_headers {
- my ( $ua, $headers ) = @_;
+ my ( $ua, $uri, $args ) = @_;
+ my $headers = $args->{headers} || {};
for my $k ( keys %$headers ) {
$ua->default_header( $k, $headers->{$k} );
}
+
+ if ( $args->{user} && defined $args->{password} ) {
+ my $method = lc $args->{auth_method} || 'basic';
+ if ( $method eq 'basic' ) {
+ require MIME::Base64;
+ $ua->default_header(
+ "Authorization",
+ 'Basic '
+ . MIME::Base64::encode_base64(
+ "$args->{user}:$args->{password}", ''
+ )
+ )
+ }
+ else {
+ die "aborting: unsupported auth method: $method";
+ }
+ }
}
__PACKAGE__->_add_to_plient if $Plient::bundle_mode;
diff --git a/lib/Plient/Handler/curl.pm b/lib/Plient/Handler/curl.pm
index be0843e..e833274 100644
--- a/lib/Plient/Handler/curl.pm
+++ b/lib/Plient/Handler/curl.pm
@@ -35,7 +35,8 @@ sub init {
$method{http_get} = sub {
my ( $uri, $args ) = @_;
my $headers = translate_headers( $args->{headers} );
- if ( open my $fh, "$curl -s -L $uri $headers |" ) {
+ my $auth = translate_auth($args);
+ if ( open my $fh, "$curl -k -s -L $headers $auth $uri |" ) {
local $/;
<$fh>;
}
@@ -68,9 +69,10 @@ sub init {
}
}
- my $headers = translate_headers( $args->{headers} );
+ my $headers = translate_headers($args);
+ my $auth = translate_auth($args);
- if ( open my $fh, "$curl -s -L $uri $data $headers |" ) {
+ if ( open my $fh, "$curl -s -L $data $headers $auth $uri |" ) {
local $/;
<$fh>;
}
@@ -82,7 +84,8 @@ sub init {
$method{http_head} = sub {
my ( $uri, $args ) = @_;
my $headers = translate_headers( $args->{headers} );
- if ( open my $fh, "$curl -s -I -L $uri $headers |" ) {
+ my $auth = translate_auth($args);
+ if ( open my $fh, "$curl -s -I -L $headers $auth $uri |" ) {
local $/;
my $head = <$fh>;
$head =~ s/\r\n$//;
@@ -105,13 +108,30 @@ sub init {
}
sub translate_headers {
- my $headers = shift;
+ my $args = shift || {};
+ my $headers = $args->{headers};
return '' unless $headers;
my $str;
for my $k ( keys %$headers ) {
$str .= " -H '$k:$headers->{$k}'";
}
return $str;
+
+}
+
+sub translate_auth {
+ my $args = shift || {};
+ my $auth = '';
+ if ( $args->{user} && defined $args->{password} ) {
+ my $method = lc $args->{auth_method} || 'basic';
+ if ( $method eq 'basic' ) {
+ $auth = " -u '$args->{user}:$args->{password}'";
+ }
+ else {
+ die "aborting: unsupported auth method: $method";
+ }
+ }
+ return $auth;
}
__PACKAGE__->_add_to_plient if $Plient::bundle_mode;
diff --git a/lib/Plient/Handler/wget.pm b/lib/Plient/Handler/wget.pm
index 6192f9e..fb39822 100644
--- a/lib/Plient/Handler/wget.pm
+++ b/lib/Plient/Handler/wget.pm
@@ -37,8 +37,9 @@ sub init {
$method{http_get} = sub {
my ( $uri, $args ) = @_;
- my $headers = translate_headers( $args->{headers} );
- if ( open my $fh, "$wget -q -O - $headers $uri |" ) {
+ my $headers = translate_headers( $args );
+ my $auth = translate_auth($args);
+ if ( open my $fh, "$wget -q -O - $headers $auth $uri |" ) {
local $/;
<$fh>;
}
@@ -50,7 +51,8 @@ sub init {
$method{http_post} = sub {
my ( $uri, $args ) = @_;
- my $headers = translate_headers( $args->{headers} );
+ my $headers = translate_headers( $args );
+ my $auth = translate_auth($args);
my $data = '';
if ( $args->{body} ) {
@@ -72,7 +74,7 @@ sub init {
}
}
- if ( open my $fh, "$wget -q -O - $data $headers $uri |" ) {
+ if ( open my $fh, "$wget -q -O - $data $headers $auth $uri |" ) {
local $/;
<$fh>;
}
@@ -85,8 +87,9 @@ sub init {
$method{http_head} = sub {
my ( $uri, $args ) = @_;
# we can't use -q here, or some version may not show the header
- my $headers = translate_headers( $args->{headers} );
- if ( open my $fh, "$wget -S --spider $headers $uri 2>&1 |" ) {
+ my $headers = translate_headers( $args );
+ my $auth = translate_auth($args);
+ if ( open my $fh, "$wget -S --spider $headers $auth $uri 2>&1 |" ) {
my $head = '';
my $flag;
while ( my $line = <$fh>) {
@@ -124,7 +127,8 @@ sub init {
}
sub translate_headers {
- my $headers = shift;
+ my $args = shift || {};
+ my $headers = $args->{headers};
return '' unless $headers;
my $str;
for my $k ( keys %$headers ) {
@@ -133,6 +137,22 @@ sub translate_headers {
return $str;
}
+sub translate_auth {
+ my $args = shift || {};
+ my $auth = '';
+ if ( $args->{user} && defined $args->{password} ) {
+ my $method = lc $args->{auth_method} || 'basic';
+ if ( $method eq 'basic' ) {
+ $auth =
+ " --user '$args->{user}' --password '$args->{password}'";
+ }
+ else {
+ die "aborting: unsupported auth method: $method";
+ }
+ }
+ return $auth;
+}
+
__PACKAGE__->_add_to_plient if $Plient::bundle_mode;
1;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list