bot.pl 9.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use 5.010; # //
  5. use IO::Socket::SSL qw(SSL_VERIFY_NONE);
  6. use IO::Async::Loop;
  7. use Net::Async::WebSocket::Client;
  8. use Net::Async::Matrix 0.11_002;
  9. use JSON;
  10. use YAML;
  11. use Data::UUID;
  12. use Getopt::Long;
  13. use Data::Dumper;
  14. binmode STDOUT, ":encoding(UTF-8)";
  15. binmode STDERR, ":encoding(UTF-8)";
  16. my $loop = IO::Async::Loop->new;
  17. # Net::Async::HTTP + SSL + IO::Poll doesn't play well. See
  18. # https://rt.cpan.org/Ticket/Display.html?id=93107
  19. ref $loop eq "IO::Async::Loop::Poll" and
  20. warn "Using SSL with IO::Poll causes known memory-leaks!!\n";
  21. GetOptions(
  22. 'C|config=s' => \my $CONFIG,
  23. 'eval-from=s' => \my $EVAL_FROM,
  24. ) or exit 1;
  25. if( defined $EVAL_FROM ) {
  26. # An emergency 'eval() this file' hack
  27. $SIG{HUP} = sub {
  28. my $code = do {
  29. open my $fh, "<", $EVAL_FROM or warn( "Cannot read - $!" ), return;
  30. local $/; <$fh>
  31. };
  32. eval $code or warn "Cannot eval() - $@";
  33. };
  34. }
  35. defined $CONFIG or die "Must supply --config\n";
  36. my %CONFIG = %{ YAML::LoadFile( $CONFIG ) };
  37. my %MATRIX_CONFIG = %{ $CONFIG{matrix} };
  38. # No harm in always applying this
  39. $MATRIX_CONFIG{SSL_verify_mode} = SSL_VERIFY_NONE;
  40. # Track every Room object, so we can ->leave them all on shutdown
  41. my %bot_matrix_rooms;
  42. my $bridgestate = {};
  43. my $roomid_by_callid = {};
  44. my $bot_verto = Net::Async::WebSocket::Client->new(
  45. on_frame => sub {
  46. my ( $self, $frame ) = @_;
  47. warn "[Verto] receiving $frame";
  48. on_verto_json($frame);
  49. },
  50. );
  51. $loop->add( $bot_verto );
  52. my $sessid = lc new Data::UUID->create_str();
  53. my $bot_matrix = Net::Async::Matrix->new(
  54. %MATRIX_CONFIG,
  55. on_log => sub { warn "log: @_\n" },
  56. on_invite => sub {
  57. my ($matrix, $invite) = @_;
  58. warn "[Matrix] invited to: " . $invite->{room_id} . " by " . $invite->{inviter} . "\n";
  59. $matrix->join_room( $invite->{room_id} )->get;
  60. },
  61. on_room_new => sub {
  62. my ($matrix, $room) = @_;
  63. warn "[Matrix] have a room ID: " . $room->room_id . "\n";
  64. $bot_matrix_rooms{$room->room_id} = $room;
  65. # log in to verto on behalf of this room
  66. $bridgestate->{$room->room_id}->{sessid} = $sessid;
  67. $room->configure(
  68. on_message => \&on_room_message,
  69. );
  70. my $f = send_verto_json_request("login", {
  71. 'login' => $CONFIG{'verto-dialog-params'}{'login'},
  72. 'passwd' => $CONFIG{'verto-config'}{'passwd'},
  73. 'sessid' => $sessid,
  74. });
  75. $matrix->adopt_future($f);
  76. # we deliberately don't paginate the room, as we only care about
  77. # new calls
  78. },
  79. on_unknown_event => \&on_unknown_event,
  80. on_error => sub {
  81. print STDERR "Matrix failure: @_\n";
  82. },
  83. );
  84. $loop->add( $bot_matrix );
  85. sub on_unknown_event
  86. {
  87. my ($matrix, $event) = @_;
  88. print Dumper($event);
  89. my $room_id = $event->{room_id};
  90. my %dp = %{$CONFIG{'verto-dialog-params'}};
  91. $dp{callID} = $bridgestate->{$room_id}->{callid};
  92. if ($event->{type} eq 'm.call.invite') {
  93. $bridgestate->{$room_id}->{matrix_callid} = $event->{content}->{call_id};
  94. $bridgestate->{$room_id}->{callid} = lc new Data::UUID->create_str();
  95. $bridgestate->{$room_id}->{offer} = $event->{content}->{offer}->{sdp};
  96. $bridgestate->{$room_id}->{gathered_candidates} = 0;
  97. $roomid_by_callid->{ $bridgestate->{$room_id}->{callid} } = $room_id;
  98. # no trickle ICE in verto apparently
  99. }
  100. elsif ($event->{type} eq 'm.call.candidates') {
  101. # XXX: compare call IDs
  102. if (!$bridgestate->{$room_id}->{gathered_candidates}) {
  103. $bridgestate->{$room_id}->{gathered_candidates} = 1;
  104. my $offer = $bridgestate->{$room_id}->{offer};
  105. my $candidate_block = {
  106. audio => '',
  107. video => '',
  108. };
  109. foreach (@{$event->{content}->{candidates}}) {
  110. if ($_->{sdpMid}) {
  111. $candidate_block->{$_->{sdpMid}} .= "a=" . $_->{candidate} . "\r\n";
  112. }
  113. else {
  114. $candidate_block->{audio} .= "a=" . $_->{candidate} . "\r\n";
  115. $candidate_block->{video} .= "a=" . $_->{candidate} . "\r\n";
  116. }
  117. }
  118. # XXX: assumes audio comes first
  119. #$offer =~ s/(a=rtcp-mux[\r\n]+)/$1$candidate_block->{audio}/;
  120. #$offer =~ s/(a=rtcp-mux[\r\n]+)/$1$candidate_block->{video}/;
  121. $offer =~ s/(m=video)/$candidate_block->{audio}$1/;
  122. $offer =~ s/(.$)/$1\n$candidate_block->{video}$1/;
  123. my $f = send_verto_json_request("verto.invite", {
  124. "sdp" => $offer,
  125. "dialogParams" => \%dp,
  126. "sessid" => $bridgestate->{$room_id}->{sessid},
  127. });
  128. $matrix->adopt_future($f);
  129. }
  130. else {
  131. # ignore them, as no trickle ICE, although we might as well
  132. # batch them up
  133. # foreach (@{$event->{content}->{candidates}}) {
  134. # push @{$bridgestate->{$room_id}->{candidates}}, $_;
  135. # }
  136. }
  137. }
  138. elsif ($event->{type} eq 'm.call.hangup') {
  139. if ($bridgestate->{$room_id}->{matrix_callid} eq $event->{content}->{call_id}) {
  140. my $f = send_verto_json_request("verto.bye", {
  141. "dialogParams" => \%dp,
  142. "sessid" => $bridgestate->{$room_id}->{sessid},
  143. });
  144. $matrix->adopt_future($f);
  145. }
  146. else {
  147. warn "Ignoring unrecognised callid: ".$event->{content}->{call_id};
  148. }
  149. }
  150. else {
  151. warn "Unhandled event: $event->{type}";
  152. }
  153. }
  154. sub on_room_message
  155. {
  156. my ($room, $from, $content) = @_;
  157. my $room_id = $room->room_id;
  158. warn "[Matrix] in $room_id: $from: " . $content->{body} . "\n";
  159. }
  160. Future->needs_all(
  161. $bot_matrix->login( %{ $CONFIG{"matrix-bot"} } )->then( sub {
  162. $bot_matrix->start;
  163. }),
  164. $bot_verto->connect(
  165. %{ $CONFIG{"verto-bot"} },
  166. on_connect_error => sub { die "Cannot connect to verto - $_[-1]" },
  167. on_resolve_error => sub { die "Cannot resolve to verto - $_[-1]" },
  168. )->on_done( sub {
  169. warn("[Verto] connected to websocket");
  170. }),
  171. )->get;
  172. $loop->attach_signal(
  173. PIPE => sub { warn "pipe\n" }
  174. );
  175. $loop->attach_signal(
  176. INT => sub { $loop->stop },
  177. );
  178. $loop->attach_signal(
  179. TERM => sub { $loop->stop },
  180. );
  181. eval {
  182. $loop->run;
  183. } or my $e = $@;
  184. # When the bot gets shut down, have it leave the rooms so it's clear to observers
  185. # that it is no longer running.
  186. # if( $CONFIG{"leave-on-shutdown"} // 1 ) {
  187. # print STDERR "Removing bot from Matrix rooms...\n";
  188. # Future->wait_all( map { $_->leave->else_done() } values %bot_matrix_rooms )->get;
  189. # }
  190. # else {
  191. # print STDERR "Leaving bot users in Matrix rooms.\n";
  192. # }
  193. die $e if $e;
  194. exit 0;
  195. {
  196. my $json_id;
  197. my $requests;
  198. sub send_verto_json_request
  199. {
  200. $json_id ||= 1;
  201. my ($method, $params) = @_;
  202. my $json = {
  203. jsonrpc => "2.0",
  204. method => $method,
  205. params => $params,
  206. id => $json_id,
  207. };
  208. my $text = JSON->new->encode( $json );
  209. warn "[Verto] sending $text";
  210. $bot_verto->send_frame ( $text );
  211. my $request = $loop->new_future;
  212. $requests->{$json_id} = $request;
  213. $json_id++;
  214. return $request;
  215. }
  216. sub send_verto_json_response
  217. {
  218. my ($result, $id) = @_;
  219. my $json = {
  220. jsonrpc => "2.0",
  221. result => $result,
  222. id => $id,
  223. };
  224. my $text = JSON->new->encode( $json );
  225. warn "[Verto] sending $text";
  226. $bot_verto->send_frame ( $text );
  227. }
  228. sub on_verto_json
  229. {
  230. my $json = JSON->new->decode( $_[0] );
  231. if ($json->{method}) {
  232. if (($json->{method} eq 'verto.answer' && $json->{params}->{sdp}) ||
  233. $json->{method} eq 'verto.media') {
  234. my $room_id = $roomid_by_callid->{$json->{params}->{callID}};
  235. my $room = $bot_matrix_rooms{$room_id};
  236. if ($json->{params}->{sdp}) {
  237. # HACK HACK HACK HACK
  238. $room->_do_POST_json( "/send/m.call.answer", {
  239. call_id => $bridgestate->{$room_id}->{matrix_callid},
  240. version => 0,
  241. answer => {
  242. sdp => $json->{params}->{sdp},
  243. type => "answer",
  244. },
  245. })->then( sub {
  246. send_verto_json_response( {
  247. method => $json->{method},
  248. }, $json->{id});
  249. })->get;
  250. }
  251. }
  252. else {
  253. warn ("[Verto] unhandled method: " . $json->{method});
  254. send_verto_json_response( {
  255. method => $json->{method},
  256. }, $json->{id});
  257. }
  258. }
  259. elsif ($json->{result}) {
  260. $requests->{$json->{id}}->done($json->{result});
  261. }
  262. elsif ($json->{error}) {
  263. $requests->{$json->{id}}->fail($json->{error}->{message}, $json->{error});
  264. }
  265. }
  266. }