Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added partial basic auth support and getstore

- Added basic auth URL detection
- Missing Base64 encoding of credentials
- Added getstore() method. Needs headers stripping
  and chunked transfer support to work properly
- Added tests for basic auth, headers stringification
  • Loading branch information...
commit 30a728cdf0bf971141172bde8d36bc5a60d485cb 1 parent c1e6214
@cosimo authored
Showing with 140 additions and 9 deletions.
  1. +65 −9 lib/LWP/Simple.pm
  2. +25 −0 t/basic_auth.t
  3. +50 −0 t/stringify-headers.t
View
74 lib/LWP/Simple.pm
@@ -6,6 +6,13 @@
class LWP::Simple {
+ our $VERSION = 0.03;
+
+ # TODO - Not implemented yet
+ method base64encode (Str $user, Str $pass) {
+ return "fake:notimplementedyet";
+ }
+
method default_port () {
return 80;
}
@@ -20,20 +27,46 @@ class LWP::Simple {
}
}
+ method has_basic_auth (Str $host) {
+
+ # ^ <username> : <password> @ <hostname> $
+ if $host ~~ /^ (\w+) \: (\w+) \@ (\N+) $/ {
+ return $0, $1, $2;
+ }
+
+ return;
+ }
+
method get (Str $url) {
return unless $url;
my ($scheme, $hostname, $port, $path) = self.parse_url($url);
+ my %headers = (
+ Accept => '*/*',
+ User-Agent => "Perl6-LWP-Simple/$VERSION",
+ Connection => 'close',
+ );
+
+ if my @auth = self.has_basic_auth($hostname) {
+ $hostname = @auth[2];
+ my $user = @auth[0];
+ my $pass = @auth[1];
+ my $base64enc = self.base64encode($user, $pass);
+ %headers<Authorization> = "Basic $base64enc";
+ }
+
+ %headers<Host> = $hostname;
+
+ my $headers_str = self.stringify_headers(%headers);
+
my $sock = IO::Socket::INET.new();
$sock.open($hostname, $port);
$sock.send(
"GET {$path} HTTP/1.1\r\n"
- ~ "Host: {$hostname}\r\n"
- ~ "Accept: */*\r\n"
- ~ "User-Agent: Perl6-LWP-Simple/0.02\r\n"
- ~ "Connection: close\r\n\r\n"
+ ~ $headers_str
+ ~ "\r\n"
);
my $page = $sock.recv();
@@ -46,6 +79,21 @@ class LWP::Simple {
say self.get($url);
}
+ method getstore (Str $url, Str $filename) {
+ return unless defined $url;
+
+ my $content = self.get($url);
+ if ! $content {
+ return
+ }
+
+ my $fh = open($filename, :w);
+ my $ok = $fh.print($content);
+ $fh.close;
+
+ return $ok;
+ }
+
method parse_url (Str $url) {
my $scheme;
@@ -65,18 +113,26 @@ class LWP::Simple {
#say 'port:', $port;
#say 'path:', @path;
- ($hostname, $port) = $hostname.split(':');
- if ! $port {
+ # rakudo: Regex with captures doesn't work here
+ if $hostname ~~ /^ .+ \: \d+ $/ {
+ ($hostname, $port) = $hostname.split(':');
+ }
+ else {
$port = self.default_port($scheme);
}
return ($scheme, $hostname, $port, $path);
}
+ method stringify_headers (%headers) {
+ my $str = '';
+ for sort %headers.keys {
+ $str ~= $_ ~ ': ' ~ %headers{$_} ~ "\r\n";
+ }
+ return $str;
+ }
+
}
1;
-#say LWP::Simple.get("http://www.google.com");
-#LWP::Simple.getprint('http://www.google.com');
-
View
25 t/basic_auth.t
@@ -0,0 +1,25 @@
+#
+# Test the basic auth code path
+#
+
+use v6;
+use Test;
+
+use LWP::Simple;
+
+my $basic-auth-url = 'https://cosimo:eelst@faveclub.eelst.com/elio/mp3s/';
+my @url = LWP::Simple.parse_url($basic-auth-url);
+
+is(@url[0], 'https', 'Scheme parsed correctly');
+is(@url[1], 'cosimo:eelst@faveclub.eelst.com', 'Hostname contains basic auth info');
+is(@url[2], 443, 'HTTPS demands port 443');
+is(@url[3], '/elio/mp3s/', 'Path extracted correctly');
+
+my ($user, $pass, $host) = LWP::Simple.has_basic_auth(@url[1]);
+
+is($user, 'cosimo', 'Basic auth info extracted correctly: user');
+is($pass, 'eelst', 'Basic auth info extracted correctly: pass');
+is($host, 'faveclub.eelst.com', 'Basic auth info extracted correctly: hostname');
+
+done_testing;
+
View
50 t/stringify-headers.t
@@ -0,0 +1,50 @@
+#
+# Test the parse_url() method
+#
+
+use v6;
+use Test;
+
+use LWP::Simple;
+
+my @test = (
+ { User-Agent => 'Opera/9.80 (WinNT; 6.0) Version/10.60' },
+ "User-Agent: Opera/9.80 (WinNT; 6.0) Version/10.60\r\n",
+ { Connection => 'close' },
+ "Connection: close\r\n",
+);
+
+for @test -> %headers, $expected_str {
+ my $hdr_str = LWP::Simple.stringify_headers(%headers);
+ is($hdr_str, $expected_str, 'OK - ' ~ $hdr_str);
+}
+
+my $hdr = LWP::Simple.stringify_headers({
+ User-Agent => 'Chrome/5.0',
+ Accept-Encoding => 'gzip',
+ Accept-Language => 'en;q=1, it;q=0.8, no-NB;q=0.5, es;q=0.6',
+ Connection => 'keepalive',
+});
+
+ok(
+ $hdr.match('User-Agent: Chrome'),
+ 'Composite headers are stringified correctly'
+);
+
+ok(
+ $hdr.match('Accept-Encoding: gzip'),
+ 'Composite headers are stringified correctly'
+);
+
+ok(
+ $hdr.match('Connection: keepalive'),
+ 'Composite headers are stringified correctly'
+);
+
+ok(
+ $hdr.match('Accept-Language: en;q=1'),
+ 'Composite headers are stringified correctly'
+);
+
+done_testing;
+
Please sign in to comment.
Something went wrong with that request. Please try again.