Ещё один jabber-shell

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;
use utf8;
use locale;
use open qw( :utf8 :std );
use Getopt::Long qw(:config bundling);
use AnyEvent;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Ext::Disco;
use AnyEvent::XMPP::Ext::Version;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;


my $SCRIPT = $0;
my $VERSION = '0.1';
my $PORT = '5222';
my $PASSWORD = '';
my @ADMINS = ();
my $JID = '';
my $DEBUG = 0;
my $TLS = 1;
my $HTTP = 0;

sub usage
{
    print <<USAGE;
Jabber shell v$VERSION: shell robot to execute commands via jabber

Usage: $SCRIPT [options]


Options (default in brackets):
    --jid,      -j  jabber ID, e. g. 'name\@jabber.org' or 'name\@jabber.org/resource'
    --password, -w  password for the account ($PASSWORD)
    --port,     -p  port to connect ($PORT)

    --admin,    -a  authorized accounts to execute commands from (@ADMINS)

    --[no]debug     turn debug on/off ($DEBUG)

    --help,     -h  this help message


Examples:

$SCRIPT -j solo\@jabber.ru/home -w qwerty --admin buck\@jabber.org

USAGE

    exit (0);
}

GetOptions(
    'port|p=i'       => \$PORT,
    'password|passwd|w=s'   => \$PASSWORD,
    'admin|a=s'      => \@ADMINS,
    'debug|d!'       => \$DEBUG,
    'jid|jabber|j=s' => \$JID,
    'help|h'         => sub {usage}
);

unless ($JID)
{
    usage();
}


my $j       = AnyEvent->condvar;
my $cl      = AnyEvent::XMPP::Client->new (debug => $DEBUG);
my $disco   = AnyEvent::XMPP::Ext::Disco->new;
my $version = AnyEvent::XMPP::Ext::Version->new;

$cl->add_extension ($disco);
$cl->add_extension ($version);

$cl->set_presence (undef, "Jabber shell bot v$VERSION", 1);

$cl->add_account ($JID, $PASSWORD);
warn "connecting to $JID...\n";

$cl->reg_cb (
   session_ready => sub {
      my ($cl, $acc) = @_;
      warn "connected!\n";
   },
   contact_request_subscribe => sub {
      my ($cl, $acc, $roster, $contact) = @_;
      $contact->send_subscribed;
      warn 'Subscribed to ' . $contact->jid . "\n";
   },
   error => sub {
      my ($cl, $acc, $error) = @_;
      warn 'Error encountered: ' . $error->string . "\n";
      $j->broadcast;
   },
   disconnect => sub {
      warn "Got disconnected: [@_]\n";
      $j->broadcast;
   },
   message => sub {
      my ($cl, $acc, $msg) = @_;
      return unless $msg;
      my $cmd = $msg->any_body;
      my $adm = $msg->from;

      warn "# $adm -> $cmd:\n";

      my $repl = $msg->make_reply;

      if ($adm ~~ @ADMINS)
      {
          my $out = '';
          if ($cmd =~ s/^\s*cd\s+//)
          {
             $out = chdir($cmd) ? `pwd` : 'Failed'
          } else
          {
              $out = `$cmd 2>&1`
          }
          if ($out)
          {
            warn $out;
            $repl->add_body($out);
          }
      } else
      {
          warn "Forbidden.\n";
          $repl->add_body('Forbidden');
      }

      $repl->send;
   },
);

$cl->start;

$j->wait;

exit(0);