AnyEvent::HTTPを使った簡易的なcURLのようなもの

aehttp.pl

#!/usr/bin/perl

use strict;
use warnings;

use File::Basename qw/basename dirname/;
use Getopt::Long qw/:config no_ignore_case gnu_compat/;
use Pod::Usage;
use AnyEvent::HTTP;
use AnyEvent::Socket;
use AnyEvent::TLS;

my $SCRIPT = basename $0;

{ $|=1; my $_old = select(STDERR); $|=1; select($_old);}

my $help;
my $dump_header;
my @header;
my $keepalive;
my $persistent;
my $timeout;
my $recurse;
my $proxy;
my $tcp_timeout;
my $tcp_connect_host;

my $sslv2;
my $sslv3;
my $tlsv1;
my $tlsv1_1;
my $tlsv1_2;
my $tlsv1_3;

# 今のところ GET のみ対応

GetOptions(
  'help|h'             => \$help,
  'dump-header|D=s'    => \$dump_header,
  'header|H=s'         => \@header,
  'keepalive!'         => \$keepalive,
  'persistent!'        => \$persistent,
  'timeout=i'          => \$timeout,
  'recurse=i'          => \$recurse,
  'tcp-timeout=i'      => \$tcp_timeout,
  'tcp-connect-host=s' => \$tcp_connect_host,
  'sslv2'              => \$sslv2,
  'sslv3'              => \$sslv3,
  'tlsv1'              => \$tlsv1,
  'tlsv1_1'            => \$tlsv1_1,
  'tlsv1_2'            => \$tlsv1_2,
  'tlsv1_3'            => \$tlsv1_3,
) or pod2usage(exitval => 2);

pod2usage(exitval => 0, verbose => 0) if $help;

my %tls = (); 
if (defined($sslv2) || defined($sslv3) || defined($tlsv1) || defined($tlsv1_1) || defined($tlsv1_2) || defined($tlsv1_2)) {
  $tls{sslv2}   = $sslv2;
  $tls{sslv3}   = $sslv3;
  $tls{tlsv1}   = $tlsv1;
  $tls{tlsv1_1} = $tlsv1_1;
  $tls{tlsv1_2} = $tlsv1_2;
  $tls{tlsv1_3} = $tlsv1_3;
}

my @opt;
push @opt, headers    => { map { map {s/^\s*(.*?)\s*$/$1/;$_} split(':', $_) } @header } if (@header);
push @opt, keepalive  => $keepalive  if (defined $keepalive);
push @opt, persistent => $persistent if (defined $persistent);
push @opt, timeout    => $timeout    if (defined $timeout);
push @opt, recurse    => $recurse    if (defined $recurse);
push @opt, tls_ctx    => {cache=>1, %tls} if (%tls);

#{
#  use Data::Dumper;
#  local $" = " ";
#  print Dumper(\@opt);
#  exit 0;
#}

my $dump_header_fh;
if (defined $dump_header) {
  if ($dump_header eq '-') {
    open $dump_header_fh, '>&', "STDOUT"       or die "$!\n";
  } else {
    open $dump_header_fh, '>>', "$dump_header" or die "$!\n";
  }
}

my ($url) = @ARGV;

pod2usage(exitval => 1) if not defined $url;

my $cv = AnyEvent->condvar;

http_request(
  GET => $url,
  @opt,
  tcp_connect => sub {
      my ($host, $service, $connect_cb, $prepare_cb) = @_;
      tcp_connect(
          $tcp_connect_host // $host,
          $service,
          sub {
              return $connect_cb->(@_);
          },
          (defined $tcp_timeout) ? sub { $tcp_timeout; } : $prepare_cb, #$prepare_cb,
      );
  },
  on_header => sub {
    my ($headers) = @_;
    if (defined $dump_header_fh) {
      for my $k (keys %{$headers}) {
        print $dump_header_fh "$k : $headers->{$k}\n";
      }
      print $dump_header_fh "\n";
    }
    1;
  },
  on_body => sub {
    my ($body, $headers) = @_;
    print "$body" if defined($body);
    1;
  },
  sub {
    my ($body, $headers) = @_;
    if ($headers->{Status} =~ /59./) {
      print STDERR "$headers->{Status} $headers->{Reason}\n";
    }
    $cv->send($headers->{Status});
  }
);

my $status = $cv->recv;

if ($status =~ /59./) {
  exit(28);
}

exit(0);

__END__

=head1 NAME

aehttp.pl - AnyEvent::HTTP CLI

=head1 SYNOPSIS

 sample [options] url
 Options:
  --help
  --no-persistend
  -H / --header
  -D / --dump-header
  --no-keepalive
  --timeout=SEC
  --recurse=COUNT
  --tcp-timeout=SEC
  --tcp-connect-host=HOST is parameter given to tcp_connect()
  --sslv2
  --sslv3
  --tlsv1_0
  --tlsv1_1
  --tlsv1_2
  --tlsv1_3
=cut