Metabrik-Repository

 view release on metacpan or  search on metacpan

lib/Metabrik/Client/Ssl.pm  view on Meta::CPAN

         uri => [ qw(uri) ],
      },
      commands => {
         install => [ ], # Inherited
         verify_server => [ qw(uri|OPTIONAL) ],
         getcertificate => [ qw(uri|OPTIONAL) ],
         getcertificate2 => [ qw(host port) ],
      },
      require_modules => {
         'Data::Dumper' => [ ],
         'IO::Socket::SSL' => [ ],
         'LWP::UserAgent' => [ ],
         'LWP::ConnCache' => [ ],
         'URI' => [ ],
         'Net::SSLeay' => [ ],
         'Metabrik::String::Uri' => [ ],
      },
      need_packages => {
         ubuntu => [ qw(libssl-dev) ],
         debian => [ qw(libssl-dev) ],
         kali => [ qw(libssl-dev) ],

lib/Metabrik/Client/Ssl.pm  view on Meta::CPAN

   my $su = Metabrik::String::Uri->new_from_brik_init($self) or return;
   my $parsed = $su->parse($uri) or return;

   my $host = $parsed->{host};
   my $port = $parsed->{port};

   $self->log->debug("verify_server: trying host [".$parsed->{host}."] ".
      "with port [".$parsed->{port}."]");

   my $client = IO::Socket::SSL->new(
      PeerHost => $parsed->{host},
      PeerPort => $parsed->{port},
      SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
      SSL_verifycn_name => $parsed->{host},
      SSL_verifycn_scheme => 'http',
   );
   if (! defined($client) && ! length($!)) {
      $self->log->verbose("verify_server: not verified: [".
         $IO::Socket::SSL::SSL_ERROR."]");
      return 0;
   }
   elsif (! defined($client)) {
      return $self->log->error("verify_server: connection failed with ".
         "error: [$!]");
   }

   $self->log->verbose("verify_server: verified");

   return 1;
}

#
# Note: works only with IO::Socket::SSL, not with Net::SSL (using Crypt::SSLeay)
#
sub getcertificate {
   my $self = shift;
   my ($uri) = @_;

   $uri ||= $self->uri;
   $self->brik_help_run_undef_arg('getcertificate', $uri) or return;

   if ($uri !~ /^https:\/\//) {
      return $self->log->error("must use https to get a certificate");

lib/Metabrik/Client/Ssl.pm  view on Meta::CPAN

      return $self->log->error("unable to retrieve connection cache");
   }

   if (scalar(@$cc) == 0) {
      return $self->log->error("getcertificate: no connection cached");
   }

   my $sock = $cc->[0][0];

   my %info = ();
   # peer_certificate from IO::Socket::SSL/Crypt::SSLeay
   if ($sock->can('peer_certificate')) {
      my $authority = $sock->peer_certificate('authority'); # issuer
      my $owner = $sock->peer_certificate('owner'); # subject
      my $commonName = $sock->peer_certificate('commonName'); # cn
      my $subjectAltNames = $sock->peer_certificate('subjectAltNames');
      my $sslversion = $sock->get_sslversion;
      my $cipher = $sock->get_cipher;
      my $servername = $sock->get_servername; # Only when SNI is used
      #my $verify_hostname = $sock->verify_hostname('hostname', 'http');

lib/Metabrik/Client/Twitter.pm  view on Meta::CPAN

   $self->brik_help_run_undef_arg('connect', $consumer_secret) or return;
   $self->brik_help_run_undef_arg('connect', $access_token) or return;
   $self->brik_help_run_undef_arg('connect', $access_token_secret) or return;

   # Without that, we got:
   # "500 Can't connect to api.twitter.com:443 (Crypt-SSLeay can't verify hostnames)"
   #$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;

   my $nt;
   eval {
      local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
      $nt = Net::Twitter->new(
         traits => [qw/API::RESTv1_1/],
         consumer_key => $consumer_key,
         consumer_secret => $consumer_secret,
         access_token => $access_token,
         access_token_secret => $access_token_secret,
      );
   };
   if ($@) {
      chomp($@);

lib/Metabrik/Client/Twitter.pm  view on Meta::CPAN

sub tweet {
   my $self = shift;
   my ($message) = @_;

   $self->brik_help_run_undef_arg('tweet', $message) or return;

   my $nt = $self->connect or return;

   my $r;
   eval {
      local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
      $r = $nt->update($message);
   };
   if ($@) {
      chomp($@);
      return $self->log->error("tweet: unable to tweet [$@]");
   }
   elsif (! defined($r)) {
      return $self->log->error("tweet: unable to tweet [unknown error]");
   }

   return $message;
}

sub account_settings {
   my $self = shift;

   my $nt = $self->connect or return;

   my $r;
   eval {
      local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
      $r = $nt->account_settings;
   };
   if ($@) {
      chomp($@);
      return $self->log->error("account_settings: unable to call method [$@]");
   }
   elsif (! defined($r)) {
      return $self->log->error("account_settings: unable to call method [unknown error]");
   }

lib/Metabrik/Client/Twitter.pm  view on Meta::CPAN

   my @list = ();

   eval {
      my $r;
      my $previous_cursor;
      my $next_cursor = -1;
      while ($next_cursor) {
         $self->log->info("followers: iterating on users with next_cursor [$next_cursor]");

         local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
         $r = $nt->followers({ cursor => $next_cursor });
         last if ! defined($r);
         $next_cursor = $r->{next_cursor};
         $r->{previous_cursor} = $previous_cursor || 0;
         $previous_cursor = $next_cursor;

         for my $user (@{$r->{users}}) {
            $self->log->verbose("followers: found user [".$user->{screen_name}."]");

            push @list, {

lib/Metabrik/Client/Twitter.pm  view on Meta::CPAN

   my $nt = $self->connect or return;

   my @list = ();

   eval {
      my $r;
      my $cursor = -1;
      while ($cursor) {
         $self->log->info("following: iterating on users with cursor [$cursor]");

         local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
         $r = $nt->friends({ cursor => $cursor });
         last if ! defined($r);
         $cursor = $r->{next_cursor};

         for my $user (@{$r->{users}}) {
            $self->log->verbose("following: found user [".$user->{screen_name}."]");

            push @list, {
               name => $user->{name},
               screen_name => $user->{screen_name},

lib/Metabrik/Client/Twitter.pm  view on Meta::CPAN

sub follow {
   my $self = shift;
   my ($username) = @_;

   $self->brik_help_run_undef_arg('follow', $username) or return;

   my $nt = $self->connect or return;

   my $r;
   eval {
      local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
      $r = $nt->follow($username);
   };
   if ($@) {
      chomp($@);
      return $self->log->error("follow: unable to call method [$@]");
   }

   return $username;
}

sub unfollow {
   my $self = shift;
   my ($username) = @_;

   $self->brik_help_run_undef_arg('unfollow', $username) or return;

   my $nt = $self->connect or return;

   my $r;
   eval {
      local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
      $r = $nt->unfollow($username);
   };
   if ($@) {
      chomp($@);
      return $self->log->error("unfollow: unable to call method [$@]");
   }
   elsif (! defined($r)) {
      return $self->log->error("unfollow: unable to call method [unknown error]");
   }

lib/Metabrik/Client/Twitter.pm  view on Meta::CPAN

#
# https://dev.twitter.com/rest/public/rate-limits
#
sub rate_limit_status {
   my $self = shift;

   my $nt = $self->connect or return;

   my $r;
   eval {
      local $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';
      $r = $nt->rate_limit_status;
   };
   if ($@) {
      chomp($@);
      return $self->log->error("rate_limit_status: unable to call method [$@]");
   }
   elsif (! defined($r)) {
      return $self->log->error("rate_limit_status: unable to call method ".
         "[unknown error]");
   }

lib/Metabrik/Client/Www.pm  view on Meta::CPAN

         trace_redirect => [ qw(uri|OPTIONAL) ],
         screenshot => [ qw(uri output) ],
         eval_javascript => [ qw(js) ],
         info => [ qw(uri|OPTIONAL) ],
         mirror => [ qw(url|$url_list output|OPTIONAL datadir|OPTIONAL) ],
         parse => [ qw(html) ],
         get_last => [ ],
         get_last_code => [ ],
      },
      require_modules => {
         'IO::Socket::SSL' => [ ],
         'Progress::Any::Output' => [ ],
         'Progress::Any::Output::TermProgressBarColor' => [ ],
         'Data::Dumper' => [ ],
         'HTML::TreeBuilder' => [ ],
         'LWP::UserAgent' => [ ],
         'LWP::UserAgent::ProgressAny' => [ ],
         'HTTP::Request' => [ ],
         'HTTP::Request::Common' => [ ],
         'WWW::Mechanize' => [ ],
         'Mozilla::CA' => [ ],

lib/Metabrik/Client/Www.pm  view on Meta::CPAN

}

sub create_user_agent {
   my $self = shift;
   my ($uri, $username, $password) = @_;

   $self->log->debug("create_user_agent: creating agent");

   $uri ||= $self->uri;

   # Use IO::Socket::SSL which supports timeouts among other things.
   $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'IO::Socket::SSL';

   my $ssl_verify = $self->ssl_verify
      ? IO::Socket::SSL::SSL_VERIFY_PEER()
      : IO::Socket::SSL::SSL_VERIFY_NONE();

   my %args = (
      stack_depth => 0,  # Default is infinite, and will eat-up whole memory.
                         # 0 means completely turn off the feature.
      autocheck => 0,  # Do not throw on error by checking HTTP code. Let us do it.
      timeout => $self->rtimeout,
      ssl_opts => {
         verify_hostname => $self->ssl_verify,
         SSL_verify_mode => $ssl_verify,
         SSL_ca_file => Mozilla::CA::SSL_ca_file(),

lib/Metabrik/Client/Www.pm  view on Meta::CPAN

      if ($self->do_javascript) {
         # decoded_content method is available in WWW::Mechanize::PhantomJS
         # but is available in HTTP::Request response otherwise.
         $r{content} = $client->decoded_content;
      }
      else {
         $r{content} = $response->decoded_content;
      }
   }

   # Error messages seen from IO::Socket::SSL module.
   if ($r{content} =~ /^Can't connect to .+Connection timed out at /is) {
      $self->timeout(1);
      return $self->log->error("$method: $uri: connection timed out");
   }
   elsif ($r{content} =~ /^Can't connect to .+?\n\n(.+?) at /is) {
      return $self->log->error("$method: $uri: ".lcfirst($1));
   }
   elsif ($r{content} =~ /^Connect failed: connect: Interrupted system call/i) {
      return $self->log->error("$method: $uri: connection interrupted by syscall");
   }