source: perl/modules/Zulip/lib/BarnOwl/Module/Zulip.pm @ e5f5e2c

Last change on this file since e5f5e2c was e5f5e2c, checked in by Adam Glasgall <glasgall@mit.edu>, 7 years ago
Make -c and -s options to zulip:write required Zulip requires them anyway and making them required fixes some obnoxious quoting-related behavior.
  • Property mode set to 100644
File size: 18.6 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Module::Zulip;
5
6our $VERSION=0.1;
7our $queue_id;
8our $last_event_id;
9our %cfg;
10our $max_retries = 1000;
11our $retry_timer;
12our $tls_ctx;
13our %msg_id_map;
14our $presence_timer;
15
16use AnyEvent;
17use AnyEvent::HTTP;
18use AnyEvent::TLS;
19use JSON;
20use MIME::Base64;
21use URI;
22use URI::Encode;
23use BarnOwl::Hooks;
24use BarnOwl::Message::Zulip;
25use HTTP::Request::Common;
26use Getopt::Long qw(GetOptionsFromArray);
27
28sub fail {
29    my $msg = shift;
30    undef %cfg;
31    undef $queue_id;
32    undef $last_event_id;
33
34    BarnOwl::admin_message('Zulip Error', $msg);
35    die("Zulip Error: $msg\n");
36}
37
38
39sub initialize {
40    my $conffile = BarnOwl::get_config_dir() . "/zulip";
41
42    if (open(my $fh, "<", "$conffile")) {
43        read_config($fh);
44        close($fh);
45    }
46    if ($cfg{'api_url'} =~ /^https/) {
47        if (exists $cfg{'ssl_key_file'}) {
48            $tls_ctx = new AnyEvent::TLS(verify => $cfg{'ssl_verify'}, 
49                                         sslv3 => 0, verify_peername => "http",
50                                         ca_file => $cfg{'ssl_ca_file'},
51                                         cert_file => $cfg{'ssl_cert_file'},
52                                         key_file => $cfg{'ssl_key_file'});
53        } else {
54            $tls_ctx = new AnyEvent::TLS(verify => $cfg{'ssl_verify'}, 
55                                         sslv3 => 0, verify_peername => "http",
56                                         ca_file => $cfg{'ssl_ca_file'});
57        }           
58    } else {
59        # we still want it for a unique id
60        $tls_ctx = int(rand(1024));
61    }
62}
63
64
65sub authorization {
66    return "Basic " . encode_base64($cfg{'user'} . ':' . $cfg{'apikey'}, "")
67}
68
69sub read_config {
70    my $fh = shift;
71
72    my $raw_cfg = do {local $/; <$fh>};
73    close($fh);
74    eval {
75        $raw_cfg = from_json($raw_cfg);
76    };
77    if($@) {
78        fail("Unable to parse config file: $@");
79    }
80
81    if(! exists $raw_cfg->{user}) {
82        fail("Account has no username set.");
83    }
84    my $user = $raw_cfg->{user};
85    if(! exists $raw_cfg->{apikey}) {
86        fail("Account has no api key set.");
87    }
88    my $apikey = $raw_cfg->{apikey};
89    if(! exists $raw_cfg->{api_url}) {
90        fail("Account has no API url set.");
91    }
92    my $api_url = $raw_cfg->{api_url};
93
94    if(! exists $raw_cfg->{default_realm}) {
95        fail("Account has no default realm set.");
96    }
97    my $default_realm = $raw_cfg->{default_realm};
98
99    if( exists $raw_cfg->{ssl}) {
100        # mandatory parameters
101        if (! exists $raw_cfg->{ssl}->{ca_file}) {
102            fail("SSL parameters specified, but no CA file set");
103        }
104        $cfg{'ssl_ca_file'} = $raw_cfg->{ssl}->{ca_file};
105        $cfg{'ssl_verify'} = 1;
106        # optional parameters
107        if ( (exists $raw_cfg->{ssl}->{cert_file}) && exists $raw_cfg->{ssl}->{key_file}) {
108            $cfg{'ssl_cert_file'} = $raw_cfg->{ssl}->{cert_file};
109            $cfg{'ssl_key_file'} = $raw_cfg->{ssl}->{key_file};
110        }  else {
111            warn "SSL parameters specified, but no client credentials set.";
112        }
113    } else {
114        $cfg{'ssl_verify'} = 0;
115        my $msg = "SSL parameters not specified. WILL NOT VERIFY SERVER CERTIFICATE. See README for details.";
116        BarnOwl::admin_message('Zulip Warning', "Zulip: $msg");
117        warn $msg;
118    }
119   
120    $cfg{'user'} = $user;
121    $cfg{'apikey'} = $apikey;
122    $cfg{'api_url'} = $api_url;
123    $cfg{'realm'} = $default_realm;
124}
125
126sub register {
127    my $retry_count = 0;
128    my $callback;
129
130    if(!exists $cfg{'api_url'}) {
131        die("Zulip not configured, cannot poll for events");
132    }
133    $callback = sub {
134        BarnOwl::debug("In register callback");
135        my ($body, $headers) = @_;
136        if($headers->{Status} > 399) {
137            warn "Failed to make event queue registration request ($headers->{Status})";
138            if($retry_count >= $max_retries) {
139                fail("Giving up");
140            } else {
141                $retry_count++;                       
142                http_post($cfg{'api_url'} . "/register", "",
143                          session => $tls_ctx,
144                          sessionid => $tls_ctx,
145                          tls_ctx => $tls_ctx,
146                          headers => { "Authorization" => authorization }, 
147                          $callback);
148                return;
149            }
150        } else {
151            my $response = decode_json($body);
152            if($response->{result} ne "success") {
153                fail("Failed to register event queue; error was $response->{msg}");
154            } else {
155                $last_event_id = $response->{last_event_id};
156                $queue_id = $response->{queue_id};
157                $presence_timer = AnyEvent->timer(after => 1, interval => 60, cb => sub {
158                    my $presence_url = $cfg{'api_url'} . "/users/me/presence";
159                    my %presence_params = (status => "active", new_user_input => "true");
160                    my $presence_body = POST($presence_url, \%presence_params)->content;
161                    http_post($presence_url, $presence_body, headers => { "Authorization" => authorization,
162                                                                          "Content-Type" => "application/x-www-form-urlencoded" },
163                              session => $tls_ctx,
164                              sessionid => $tls_ctx,
165                              tls_ctx => $tls_ctx,
166                              sub {
167                                  my ($body, $headers) = @_;
168                                  if($headers->{Status} > 399) {
169                                      warn("Error sending presence");
170                                      warn(encode_json($headers));
171                                      warn($body);
172                                  }});
173                    return;});
174                do_poll();
175                return;
176            }
177        }
178    };
179   
180    http_post($cfg{'api_url'} . "/register", "",
181              headers => { "Authorization" => authorization }, 
182              session => $tls_ctx,
183              sessionid => $tls_ctx,
184              tls_ctx => $tls_ctx,
185              $callback);
186    return;
187}
188
189sub parse_response {
190    my ($body, $headers) = @_;
191    if($headers->{Status} > 399) {
192        return 0;
193    }
194    my $response = decode_json($body);
195    if($response->{result} ne "success") {
196        return 0;
197    }
198    return $response;
199}
200sub do_poll {
201    my $uri = URI->new($cfg{'api_url'} . "/events");
202    $uri->query_form("queue_id" => $queue_id, 
203                     "last_event_id" => $last_event_id);
204    my $retry_count = 0;
205    my $callback;
206    $callback = sub {
207        my ($body, $headers) = @_;
208        my $response = parse_response($body, $headers);
209        if(!$response) {
210            warn "Failed to poll for events in do_poll: $headers->{Reason}";
211            if($retry_count >= $max_retries) {
212                warn "Retry count exceeded in do_poll, giving up";
213                fail("do_poll: Giving up");
214                $presence_timer->cancel;
215            } else {
216                warn "Retrying";
217                $retry_count++;       
218                $retry_timer = AnyEvent->timer(after => 10, cb => sub { warn "retry number $retry_count"; 
219                                                         http_get($uri->as_string, 
220                                                                  "headers" => { "Authorization" => authorization },
221                                                                  session => $tls_ctx,
222                                                                  sessionid => $tls_ctx,
223                                                                  tls_ctx => $tls_ctx, 
224                                                                  $callback);
225                                                         return;
226                                });
227                return;
228            }
229        } else {
230            event_cb($response);
231        }
232    };
233    http_get($uri->as_string, "headers" => { "Authorization" => authorization }, 
234             session => $tls_ctx,
235             sessionid => $tls_ctx,
236             tls_ctx => $tls_ctx,$callback);
237    return;
238}
239
240sub event_cb {
241    my $response = $_[0];
242    if($response->{result} ne "success") {
243        fail("event_cb: Failed to poll for events; error was $response->{msg}");
244    } else {
245        for my $event (@{$response->{events}}) {
246            if($event->{type} eq "message") {
247                my $msg = $event->{message};
248                my %msghash = (
249                    type => 'Zulip',
250                    sender => $msg->{sender_email},
251                    recipient => $msg->{recipient_id},
252                    direction => 'in',
253                    class => $msg->{display_recipient},
254                    instance => $msg->{subject},
255                    unix_time => $msg->{timestamp},
256                    source => "zulip",
257                    location => "zulip",
258                    body => $msg->{content},
259                    zid => $msg->{id},
260                    sender_full_name => $msg->{sender_full_name},
261                    opcode => "");
262                $msghash{'body'} =~ s/\r//gm;
263                if($msg->{type} eq "private") {
264                    $msghash{private} = 1;
265                    my @raw_recipients = @{$msg->{display_recipient}};
266                    my @display_recipients;
267                    if (scalar(@raw_recipients) > 1) {
268                        my $recip;
269                        for $recip (@raw_recipients) {
270                            unless ($recip->{email} eq $cfg{user}) {
271                                push @display_recipients, $recip->{email};
272                            }
273                        }
274                        $msghash{recipient} = join " ", @display_recipients;
275                    } else {
276                        $msghash{recipient} = $msg->{display_recipient}->[0]->{email};
277                    }
278                    $msghash{class} = "message";
279                    if($msg->{sender_email} eq $cfg{user}) {
280                        $msghash{direction} = 'out';
281                    }
282                }
283                my $bomsg = BarnOwl::Message->new(%msghash);
284                # queue_message returns the message round-tripped
285                # through owl_message. In particular, this means it
286                # has a meaningful id.
287                my $rtmsg = BarnOwl::queue_message($bomsg);
288                # note that only base messages, not edits, end up in
289                # here. Tim promises me that we will never see an
290                # update to an update, so we shouldn't need to
291                # retrieve updated messages via this
292                $msg_id_map{$rtmsg->zid} = $rtmsg->id;
293            } elsif($event->{type} eq "update_message") {
294                my $id = $event->{message_id};
295                if(!exists $msg_id_map{$id}) {
296                    BarnOwl::debug("Got update for unknown message $id, discarding");
297                } else {
298                    my $base_msg = BarnOwl::get_message_by_id($msg_id_map{$id});
299                    my %new_msghash = (
300                        type => 'Zulip',
301                        sender => $base_msg->sender,
302                        recipient => $base_msg->recipient,
303                        direction => $base_msg->direction,
304                        class => $base_msg->class,
305                        # instance needs to be potentially determined from new message
306                        unix_time => $event->{edit_timestamp},
307                        source => "zulip",
308                        location => "zulip",
309                        # content needs to be potentially determined from new message
310                        zid => $base_msg->id,
311                        sender_full_name => $base_msg->long_sender,
312                        opcode => "EDIT");
313                    if (exists $$event{'subject'}) {
314                        $new_msghash{'instance'} = $event->{subject};
315                    } else {
316                        $new_msghash{'instance'} = $base_msg->instance;
317                    }
318                    if (exists $$event{'content'}) {
319                        $new_msghash{'body'} = $event->{content};
320                    } else {
321                        $new_msghash{'body'} = $base_msg->body;
322                    }
323                    my $bomsg = BarnOwl::Message->new(%new_msghash);
324                    BarnOwl::queue_message($bomsg);
325                }
326               
327            } else {
328                BarnOwl::debug("Got unknown message");
329                BarnOwl::debug(encode_json($event));
330            }
331            $last_event_id = $event->{id};
332            do_poll();
333            return;
334        }
335    }
336   
337}
338
339sub zulip {
340    my ($type, $recipient, $subject, $msg) = @_;
341    # only care about it for its url encoding
342    my $builder = URI->new("http://www.example.com");
343    my %params = ("type" => $type, "to" => $recipient,  "content" => $msg);
344    if ($subject ne "") {
345        $params{"subject"} = $subject;
346    }
347    my $url = $cfg{'api_url'} . "/messages";
348    my $req = POST($url, \%params); 
349    http_post($url, $req->content, "headers" => {"Authorization" => authorization, "Content-Type" => "application/x-www-form-urlencoded"}, 
350              session => $tls_ctx,
351              sessionid => $tls_ctx,
352              tls_ctx => $tls_ctx,sub { 
353                  my ($body, $headers) = @_;
354                  if($headers->{Status} < 400) {
355                      BarnOwl::message("Zulipgram sent");
356                  } else {
357                      BarnOwl::message("Error sending zulipgram: $headers->{Reason}!");
358                      BarnOwl::debug($body);
359                  }});
360    return;
361}
362
363
364sub update_subs {
365    my ($add_list, $remove_list, $cb) = @_;
366    my @add_param = ();
367    my @remove_param = ();
368    for my $add (@$add_list) {
369        push @add_param, {name => $add};
370    }
371    my $url = $cfg{'api_url'} . "/users/me/subscriptions";
372    my %params = ("add" => encode_json(\@add_param), "delete" => encode_json($remove_list));
373    my $req = POST($url, \%params);
374    http_request('PATCH' => $url,
375                 "body" => $req->content,
376                 "headers" => {"Authorization" => authorization, "Content-Type" => "application/x-www-form-urlencoded"},
377              session => $tls_ctx,
378              sessionid => $tls_ctx,
379              tls_ctx => $tls_ctx,sub { 
380                  my ($body, $headers) = @_;
381                  if($headers->{Status} < 400) {
382                      &$cb();
383                  } else {
384                      BarnOwl::message("Error updating subscriptions: $headers->{Reason}!");
385                      BarnOwl::debug($body);
386                  }});
387    return;
388}
389
390sub get_subs {
391    my $url = $cfg{'api_url'} . "/users/me/subscriptions";
392    http_get($url, headers => { "Authorization" => authorization },
393             session => $tls_ctx, sessionid => $tls_ctx,
394             tls_ctx => $tls_ctx, sub {
395                 my ($body, $headers) = @_;
396                 if ($headers->{Status} > 399) {
397                     BarnOwl::message("Error retrieving subscription list: $headers->{Reason}");
398                     BarnOwl::debug($body);
399                 }
400                 my $data = decode_json($body);
401                 my @subs;
402                 for my $s (@{$data->{subscriptions}}) {
403                     push @subs, $s->{name};
404                 }
405                 BarnOwl::popless_text(join "\n", @subs);
406             });
407    return;
408}
409
410sub cmd_zulip_sub {
411    my ($cmd, $stream) = @_;
412    update_subs([$stream], [], sub {
413        BarnOwl::message("Subscribed to $stream");});
414   
415}
416
417sub cmd_zulip_unsub {
418    my ($cmd, $stream) = @_;
419    update_subs([], [$stream], sub {
420        BarnOwl::message("Unsubscribed from $stream");});
421   
422}
423
424sub cmd_zulip_getsubs {
425    get_subs();
426}
427
428sub cmd_zulip_login {
429    register();
430}
431
432sub cmd_zulip_write {
433    my $cmdline = join " ", @_;
434    my $cmd = shift;
435    my $stream;
436    my $subject;
437    my $type;
438    my $to;
439    my $ret = GetOptionsFromArray(\@_,
440                               "c=s" => \$stream,
441                               "i=s" => \$subject);
442    unless($ret) {
443        die("Usage: zulip:write [-c stream] [-i subject] [recipient] ...");
444    }
445    # anything left is a recipient
446    if (scalar(@_) > 0) {
447        my @addresses = map {
448            if(/@/) {
449                $_;
450            } else {
451                $_ . "\@$cfg{'realm'}";
452            }} @_;
453        $to = encode_json(\@addresses);
454        $type = "private";
455           
456    } else {
457        $type = "stream";
458        $to = $stream
459    }
460    BarnOwl::start_edit(prompt => $cmdline, type => 'edit_win', 
461                        callback => sub {
462                            my ($text, $should_send) = @_;
463                            unless ($should_send) {
464                                BarnOwl::message("zulip:write cancelled");
465                                return;
466                            }
467                            zulip($type, $to, $subject, $text);
468                        });
469   
470}
471
472BarnOwl::new_command('zulip:login' => sub { cmd_zulip_login(@_); },
473                     {
474                         summary => "Log in to Zulip",
475                         usage => "zulip:login",
476                         description => "Start receiving Zulip messages"
477                     });
478
479BarnOwl::new_command('zulip:write' => sub { cmd_zulip_write(@_); },
480                     {
481                         summary => "Send a zulipgram",
482                         usage => "zulip:login [-c stream] [-i subject] [recipient(s)]",
483                         description => "Send a zulipgram to a stream, person, or set of people"
484                     });
485
486BarnOwl::new_command('zulip:subscribe' => sub { cmd_zulip_sub(@_); },
487                     {
488                         summary => "Subscribe to a Zulip stream",
489                         usage => "zulip:subscribe <stream name>",
490                         description => "Subscribe to a Zulip stream"
491                     });
492
493BarnOwl::new_command('zulip:unsubscribe' => sub { cmd_zulip_unsub(@_); },
494                     {
495                         summary => "Unsubscribe from a Zulip stream",
496                         usage => "zulip:unsubscribe <stream name>",
497                         description => "Unsubscribe to a Zulip stream"
498                     });
499
500BarnOwl::new_command('zulip:getsubs' => sub { cmd_zulip_getsubs(@_); },
501                     {
502                         summary => "Display the list of subscribed Zulip streams",
503                         usage => "zulip:getsubs",
504                         description => "Display the list of Zulip streams you're subscribed to in a popup window"
505                     });
506
507
508sub user {
509  return $cfg{'user'};
510}
511
512sub default_realm {
513  return $cfg{'realm'};
514}
515
516initialize();
517
5181;
519
520# Local Variables:
521# indent-tabs-mode: nil
522# End:
Note: See TracBrowser for help on using the repository browser.