The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl

use FindBin qw($Bin);
use lib "$Bin/../lib";

use Net::BEEP::Lite;
use Net::BEEP::Lite::Session;
use Net::BEEP::Lite::TLSProfile;

# connect to the server (this will die if it can't).
my $session = Net::BEEP::Lite::beep_connect(Host => "localhost",
					  Port => $ARGV[0]) ||
  die "could not connect to peer";

# if the remote end advertises TLS, we attempt to start it.
print "seeing if remote peer advertises $Net::BEEP::Lite::TLSProfile::URI\n";
if ($session->has_remote_profile($Net::BEEP::Lite::TLSProfile::URI)) {
  my $tls_profile = new Net::BEEP::Lite::TLSProfile
    (SSL_verify_mode => 0x01,
     SSL_ca_file     => "./localhost_ca-cacert.pem",
     Debug 	     => 1);

  # if you want to see the SSL debugging...
  # $IO::Socket::SSL::DEBUG = 4;

  $tls_profile->start_TLS($session) || die "could not establish TLS";

  print "Peer certificate: ", $session->{peer_certificate}, "\n";
  # you can also get the peer cert fields directly from the SSL socket
  # (although this uses an "internal" session API:
  print "Peer subject: ", $session->_socket()->peer_certificate("subject"),
    "\n";

  print "Peer now supports (after TLS):\n",
    join("\n", $session->remote_profiles()), "\n\n";
} else {
  print "Peer does not support TLS\n";
  print "Peer does support:\n", join("\n", $session->remote_profiles()), "\n";
}

# start a channel for the echo profile (this will die if it can't).
my $channel_num = $session->start_channel
  (URI        => 'http://xml.resource.org/profiles/NULL/ECHO',
   ServerName => "host.example.com");

my $channel_num_2 = $session->start_channel
  (URI => 'http://xml.resource.org/profiles/NULL/ECHO');


my $resp = $session->send_and_recv_message(Content-Type => 'text/plain',
					   Content      => "Echo this!",
					   Channel      => $channel_num);

print "Received the following response payload:\n", $resp->payload(), "\n";

$resp = $session->send_and_recv_message(Content => "yeah, echo this!\n",
				        Channel => $channel_num);

print "Received the following response payload:\n", $resp->payload(), "\n";
print "The payload had a content type of ", $resp->content_type(), "\n";

$resp = $session->send_and_recv_message
  (Content => "echoing on the other channel\n",
   Channel => $channel_num_2);
print "Received the following response payload:\n", $resp->payload(), "\n";

$resp = $session->close_channel($channel_num_2);

$resp = $session->close_channel($channel_num);

print "Socket seems to have closed early\n" if not $session->_is_connected();

$resp = $session->close_channel(0);