perl/lib/Thrasher/Protocol/Purple/Jabber.pm

   1 package Thrasher::Protocol::Purple::Jabber;
   2 use strict;
   3 use warnings;
   4
   5 =head1 NAME
   6
   7 Thrasher::Protocol::Purple::Jabber - Protocol for connecting to Jabber
   8 servers via a gateway.
   9
  10 =head1 WTF?
  11
  12 Well, my proximate reason for developing this was so I could debug
  13 file transfer support using a local XMPP server instead of hammering
  14 on one of the "real" services with lots of half-assed file transfers
  15 that would look an awful lot like a hack attack.
  16
  17 But... we actually get alot of requests for this at Barracuda,
  18 specifically, people asking to connect to GTalk as a transport.
  19 While a much, much better transport for such a thing could be
  20 written, this has the virtue of being I<easy>, once all the other
  21 hard work is done.
  22
  23 =cut
  24
  25 use base "Thrasher::Protocol::Purple";
  26
  27 use Thrasher::Log qw(log debug);
  28 use Thrasher::Constants qw($NS_REGISTER);
  29 use Thrasher::XML qw(strip_resource);
  30
  31 sub prpl {
  32     return "prpl-jabber";
  33 }
  34
  35 sub registration_items {
  36     return qw(username password connect_server bool_auth_plain_in_clear);
  37 }
  38
  39 sub registration_defaults {
  40     return { connect_server => "",
  41              bool_auth_plain_in_clear => "1"};
  42 }
  43
  44 sub registration_xml {
  45     my $self = shift;
  46     my $jid = shift;
  47
  48     my $registration = $self->{backend}->registered($jid);
  49
  50     # Add an optional connect server to override the usual server.
  51     # We still need to work out how to pass number for ports, but
  52     # I don't need that now.
  53     return [[[$NS_REGISTER, 'instructions'], {},
  54              ['Please provide your username and password for '
  55               .$self->name]],
  56             ($registration ? ([[$NS_REGISTER, 'registered'], {}, []])
  57              : ()),
  58             [[$NS_REGISTER, 'username'], {},
  59              [$registration->{username} ? ($registration->{username}) : ()]],
  60             [[$NS_REGISTER, 'password'], {},
  61              [$registration->{password} ? ($registration->{password}) : ()]],
  62             [[$NS_REGISTER, 'connect_server'], {},
  63              [$registration->{connect_server} ?
  64               $registration->{connect_server} : ()]],
  65             [[$NS_REGISTER, 'bool_auth_plain_in_clear'], {},
  66              [defined($registration->{bool_auth_plain_in_clear}) ?
  67               ($registration->{bool_auth_plain_in_clear}) : ()]]
  68         ];
  69
  70 }
  71
  72 sub process_remote_username {
  73     my $self = shift;
  74     my $username = shift;
  75
  76     return strip_resource($username);
  77 }
  78
  79
  80 sub name { "XMPP" }
  81 sub identifier { "xmpp" }
  82 sub gateway_prompt { "Enter XMPP Username:" }
  83 sub gateway_desc { "Enter XMPP Username:" }
  84
  85 1;