Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re: LWP: How to find out local port number? (ISA)

by tye (Sage)
on Oct 13, 2014 at 17:04 UTC ( [id://1103648]=note: print w/replies, xml ) Need Help??


in reply to LWP: How to find out local port number?

You can tell LWP::Protocol that you want My::Https to be the class that implements the https protocol then write a My::Https class that mostly just inherits from LWP::Protocol::https but also provides an overridden _new_socket() method that calls SUPER::_new_socket(), records the local port number of the returned socket, then returns the socket.

- tye        

Replies are listed 'Best First'.
Re^2: LWP: How to find out local port number? (ISA)
by klaymen (Initiate) on Oct 14, 2014 at 07:59 UTC
    Thanks, that sounds promising... unfortunately I must admit I'm fighting a bit with it (I don't often use the OO interface I must admit). Can you tell me what's wrong with this (just a skeleton, without added funcitonality yet, and only for http)?
    use strict; use LWP::UserAgent; package MyHttp; use vars qw(@ISA); require LWP::Protocol::http; @ISA = qw( LWP::Protocol::http ); sub _new_socket { my($self, $host, $port, $timeout) = @_; my $s; print "Creating New socket: $host, $port, $timeout\n"; $s = $self->SUPER::_new_socket($host,$port,$timeout); print "ok\n"; return $s; } package main; LWP::Protocol::implementor( http => 'MyHttp' ); my $ua = LWP::UserAgent->new(ssl_opts => { SSL_verify_mode => 'SSL_VER +IFY_NONE'},); $ua->agent('Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; Triden +t/5.0)'); $ua->max_size(50000000); # 50MB at most $ua->timeout(45); my $request = HTTP::Request->new(GET => "http://www.google.ch/"); $request->protocol('HTTP/1.0'); # we don't want chunked replies $request->header('Accept' => '*/*'); $request->header('Accept-Encoding' => ''); # we don't want packed re +sults $request->header('Connection' => 'Close'); $request->header('Cache-Control' => 'no-cache'); my $resp = $ua->request($request); if ($resp->is_success) { my $data = $resp->content; print "$data\n"; }
    it produces:
    $ perl porttest.pl Creating New socket: www.google.ch, 80, 45 $
    As the first test message is printed, _new_socket is called - but obviously calling teh SUPER::_new_socket somehow fails (unfortunately I don't get any error message). Actually even if I don't overwrite anything, it does not work. Maybe some kind of constructor must be added (isn't it taken from the base class by default?)?

      That's where I'd jump into the Perl debugger and figure out why it is silently failing.

      Inspecting the code, I found:

      sub socket_class { my $self = shift; (ref($self) || $self) . "::Socket"; }

      So you might try adding:

      package MyHttp; sub socket_class { "LWP::Protocol::http::Socket" }

      But I don't see why that problem would cause a silent failure.

      - tye        

      Try   $self->SUPER::_new_socket( @_ ); for starters :)
        Doesn't help... I even added a printout of the object to be sure:
        sub _new_socket { my($self, $host, $port, $timeout) = @_; my $s; print "Creating New socket: $host, $port, $timeout\n"; print ref($self),"\n"; foreach my $k (keys %$self) {print "$k: $self->{$k}\n";} $s = $self->SUPER::_new_socket( @_ ); print "ok\n"; return $s; }
        With output
        Creating New socket: www.google.ch, 80, 45 MyHttp max_size: 50000000 ua: LWP::UserAgent=HASH(0xe09910) scheme: http
        So the "ok" is still not printed, it obviously crashes in SUPER::_new_socket or doesn't find it at all. Why don't I get any error message? Also, even when I don't overwrite anything - so by leaving the _new_socket function out completely - nothing happens. In my understanding, it should behave like the original class.. strange...

        PS: I found the error.. the following code works:

        use strict; use LWP::UserAgent; package myHttp; use vars qw(@ISA); require LWP::Protocol::http; @ISA = qw( LWP::Protocol::http ); sub _new_socket { my($self, $host, $port, $timeout) = @_; local($^W) = 0; # IO::Socket::INET can be noisy my $sock = LWP::Protocol::http::Socket->new(PeerAddr => $host, PeerPort => $port, LocalAddr => $self->{ua}{local +_address}, Proto => 'tcp', Timeout => $timeout, KeepAlive => !!$self->{ua}{con +n_cache}, SendTE => 1, $self->_extra_sock_opts($host, + $port), ); unless ($sock) { # IO::Socket::INET leaves additional error messages in $@ my $status = "Can't connect to $host:$port"; if ($@ =~ /\bconnect: (.*)/ || $@ =~ /\b(Bad hostname)\b/ || $@ =~ /\b(certificate verify failed)\b/ || $@ =~ /\b(Crypt-SSLeay can't verify hostnames)\b/ ) { $status .= " ($1)"; } die "$status\n\n$@"; } # perl 5.005's IO::Socket does not have the blocking method. eval { $sock->blocking(0); }; $sock; } package main; LWP::Protocol::implementor( http => 'myHttp' ); my $ua = LWP::UserAgent->new(ssl_opts => { SSL_verify_mode => 'SSL_VER +IFY_NONE'},); $ua->agent('Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; Triden +t/5.0)'); $ua->max_size(50000000); # 50MB at most $ua->timeout(45); my $request = HTTP::Request->new(GET => "http://www.google.ch/"); $request->protocol('HTTP/1.0'); # we don't want chunked replies $request->header('Accept' => '*/*'); $request->header('Accept-Encoding' => ''); # we don't want packed re +sults $request->header('Connection' => 'Close'); $request->header('Cache-Control' => 'no-cache'); my $resp = $ua->request($request); if ($resp->is_success) { my $data = $resp->content; print "$data\n"; }
        Problem is that "_new_socket" calls "socket_type" which concatenates a "::Socket" to the current type, and because "myHttp::Socket" is not defined, there is a problem. I "solved" it by manually copying over the function and replace "my $sock = $self->socket_class->new(..." by "my $sock = LWP::Protocol::http::Socket->new(...". Messy but only way I found that works; I tried putting in a socket_class funciton that copnstantly returns "LWP::Protocol::http::Socket", but this did not work :-/

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1103648]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-03-29 01:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found