IO-Lambda

 view release on metacpan or  search on metacpan

lib/IO/Lambda/HTTP/Authen/NTLM.pm  view on Meta::CPAN

	use IO::Lambda qw(:all);
	use IO::Lambda::HTTP;
	
	my $req = HTTP::Request-> new( GET => "http://company.com/protected.html" );
	
	my $r = IO::Lambda::HTTP-> new(
		$req,
		username   => 'moo',
		password   => 'foo',
		keep_alive => 1,
	)-> wait;
	
	print ref($r) ? $r-> as_string : $r;

=head1 DESCRIPTION

IO::Lambda::HTTP::Authen::NTLM allows to authenticate against servers that are
using the NTLM authentication scheme popularized by Microsoft. This type of
authentication is common on intranets of Microsoft-centric organizations.

lib/IO/Lambda/HTTP/Client.pm  view on Meta::CPAN

	$self-> {deadline}     = $options{timeout} + time if defined $options{timeout};
	$self-> {deadline}     = $options{deadline}       if defined $options{deadline};
	$self-> {max_redirect} = defined($options{max_redirect}) ? $options{max_redirect} : 7;

	delete @options{qw(deadline timeout max_redirect)};
	$self-> {$_} = $options{$_} for keys %options;

	my %headers;
	$headers{'User-Agent'} = "perl/IO-Lambda-HTTP v$IO::Lambda::VERSION";

	if ( $self-> {keep_alive}) {
		unless ( $self-> {conn_cache}) {
			require LWP::ConnCache;
			$self-> {conn_cache} = LWP::ConnCache-> new;
		}
		unless ( $req-> protocol) {
			$req-> protocol('HTTP/1.1');
		}
		$headers{Host}         = $req-> uri-> host;
		$headers{Connection}   = 'Keep-Alive';
		$headers{'Keep-Alive'} = 300;

lib/IO/Lambda/HTTP/Client.pm  view on Meta::CPAN

The requestor can optionally use a shared C<HTTP::Cookies> object to support cookies.
If not set, a local cookie jar is created an used fo reventual redirects. To disable that,
set C<cookie_jar> to 0. See L<HTTP::Cookies> for details.

=item deadline SECONDS = undef

Aborts a request and returns C<'timeout'> string as an error if the request is
not finished before the deadline (in epoch seconds). If undef, timeout never
occurs.

=item keep_alive BOOLEAN

If set, all incoming request objects are silently converted use HTTP/1.1, and 
connections are automatically reused. Same as combination of the following:

   $req-> protocol('HTTP/1.1');
   $req-> headers-> header( Host => $req-> uri-> host);
   new( $req, conn_cache => LWP::ConnCache-> new);

=item max_redirect NUM = 7

lib/IO/Lambda/HTTP/Server.pm  view on Meta::CPAN

sub _close($$)
{
	warn "$_[1]\n" if $DEBUG;
	close($_[0]);
}

sub _msg
{
	my ( $status, $msg, $close) = @_;
	my $resp = "HTTP/1.1 $status${CRLF}Content-Length: ".length($msg)."$CRLF";
	$resp .= "Connection: ".($close ? 'close' : 'keep-alive')."$CRLF";
	$resp .= "Date: ". scalar(localtime).$CRLF;
	$resp .= "Content-Type: text/plain$CRLF" if length($msg);
	$resp .= $CRLF . $msg;
	return $resp;
}

sub _bye
{
	my ( $self, $conn, $close, $msg) = @_;
	tail {

lib/IO/Lambda/HTTP/Server.pm  view on Meta::CPAN

	tail {
		my ( $match, $error) = @_;
		return $self->_timeout($conn) if defined($error) and $error eq 'timeout';
		return _close $conn, $error unless defined $match;
		warn length($buf), " bytes read\n" if $DEBUG > 1;

		my $req = HTTP::Request-> parse( $match);
		return $self->_bad_request($conn, 1) unless $req;

		my $proto = (( $req->protocol // '') =~ /^HTTP\/([\d\.]+)$/i) ? $1 : 1.0;
		my $keep_alive =
			$proto >= 1.1 &&
			(lc( $req->header('Connection') // 'keep-alive') eq 'keep-alive');
		$keep_alive = 0 if $self->{shutdown};

		my $cl = length($match) + ($req->header('Content-Length') // 0);
		context readbuf, $conn, \$buf, $cl, $self->{timeout};
	tail {
		my ( undef, $error) = @_;
		return $self->_timeout($conn) if defined($error) and $error eq 'timeout';
		return _close $conn, $error if defined $error;

		warn length($buf), " bytes read\n" if $DEBUG > 1;
		unless ($req = HTTP::Request-> parse( $buf)) {
			return lambda {
				context $self->_bad_request($conn, !$keep_alive);
			tail {
				this->start if $keep_alive && !($self->{shutdown} && !length($buf)); 
			}};
		}
		substr( $buf, 0, $cl, '');

		my $resp;
		eval { ($resp, $error) = $cb->($req, \%session); };
		if ($@) {
			$error = $@;
			warn $@;
		}
		context UNIVERSAL::isa( $resp, 'IO::Lambda') ?
			$resp : lambda { $resp, $error };
	tail {
		my $error;
		($resp, $error) = @_;
		$keep_alive = 0 if $self->{shutdown};
		if ( $error ) {
			$resp = _msg("500 Server Error", $error, !$keep_alive);
		} elsif ( UNIVERSAL::isa( $resp, 'HTTP::Response')) {
			$resp->header(Connection => ($keep_alive ? 'keep-alive' : 'close'));
			$resp->protocol("HTTP/1.1");
			$resp = $resp->as_string($CRLF);
		} else {
			$resp = _msg("200 OK", $resp // '', !$keep_alive);
		}
		context writebuf, $conn, \$resp, length($resp), 0, $self->{timeout};
	tail {
		my ( undef, $error) = @_;
		return _close $conn, $error if defined $error;
		warn length($resp), " bytes written\n" if $DEBUG > 1;
		return this->start if $keep_alive && !($self->{shutdown} && !length($buf));

		warn "[$session_data->{remote}] disconnect\n" if $DEBUG;
		if ( !close($conn)) {
			warn "error during response:$!\n" if $DEBUG;
		}
	}}}}}}
}

sub http_server(&$;@)
{

lib/IO/Lambda/HTTP/UserAgent.pm  view on Meta::CPAN

sub cookie_jar { $#_ ? $_[0]->{cookie_jar} = $_[1] : $_[0]->{cookie_jar} }
sub conn_cache { $#_ ? $_[0]->{conn_cache} = $_[1] : $_[0]->{conn_cache} }
sub signature  { $#_ ? $_[0]->{signature } = $_[1] : $_[0]->{signature } }
sub protocol   { $#_ ? $_[0]->{protocol  } = $_[1] : $_[0]->{protocol  } }
sub timeout    { $#_ ? $_[0]->{timeout   } = $_[1] : $_[0]->{timeout   } }

sub request
{
	my ( $self, $req, %xopt ) = @_;

	my $keep_alive = 0;
	my %headers;
	$headers{'User-Agent'} = $self->signature;
	if ( $self->protocol eq 'HTTP/1.1') {
		unless ( $req-> protocol) {
			$req-> protocol('HTTP/1.1');
		}
		$headers{Host}         = $req-> uri-> host;
		$headers{Connection}   = 'Keep-Alive';
		$headers{'Keep-Alive'} = 300;
		$keep_alive = 1;
	}

	my $h = $req-> headers;
	while ( my ($k, $v) = each %headers) {
		$h-> header($k, $v) unless defined $h-> header($k);
	}

	my $class = $xopt{class} // 'IO::Lambda::HTTP::Client';
	return $class->new($req,
		%xopt,
		cookie_jar => $self->cookie_jar,
		conn_cache => $self->conn_cache,
		keep_alive => $keep_alive,
		timeout    => $self->timeout,
	);
}

1;

=pod

=head1 NAME

t/04_tcp.t  view on Meta::CPAN

		context session($conn);
		tail {
			$last_session_response = shift;
			close $conn;
		};
	};
};
ok( $server-> is_passive, 'server is created' );
$server-> start;
ok( $server-> is_waiting, 'server is alive' );

# prepare connection to the server
sub sock
{
	my $x = IO::Socket::INET-> new(
		PeerAddr  => 'localhost',
		PeerPort  => $port,
		Proto     => 'tcp',
	);
	die "connect() error: $!\n" unless $x;

t/08_http.t  view on Meta::CPAN

is( $resp->code, "200", "httpd lambda code");
is( $resp->content, "case2", "httpd lambda response");
$resp = http_lambda("localhost:$port")->wait;
is( $resp->code, "500", "httpd error code");
is( $resp->content, "case3", "httpd error response");

$r = HTTP::Request-> new( GET => "http://localhost:$port/");

$num = 0;
my $conn_cache = LWP::ConnCache->new;
$resp = IO::Lambda::HTTP::Client->new($r, keep_alive => 1, conn_cache => $conn_cache, proxy => undef)->wait;
is( $resp->code, "200", "httpd keep_alive code");
is( $resp->content, "case1", "httpd keep_alive response");
is( scalar $conn_cache->get_connections(), 1, "1 active connection");
$resp = IO::Lambda::HTTP::Client->new($r, keep_alive => 1, conn_cache => $conn_cache, proxy => undef)->wait;
is( $resp->code, "200", "httpd keep_alive code");
is( $resp->content, "case2", "httpd keep_alive response");

done_testing;