lib/App/FonBot/Plugin/HTTPD.pm

   1 package App::FonBot::Plugin::HTTPD;
   2
   3 our $VERSION = '0.000_5';
   4
   5 use v5.14;
   6 use strict;
   7 use warnings;
   8
   9 use Apache2::Authen::Passphrase qw/pwcheck/;
  10 use HTTP::Status qw/HTTP_BAD_REQUEST HTTP_OK HTTP_NO_CONTENT HTTP_FORBIDDEN HTTP_UNAUTHORIZED/;
  11 use JSON qw/encode_json/;
  12 use Log::Log4perl;
  13 use POE::Component::Server::HTTP qw/RC_OK RC_DENY RC_WAIT/;
  14
  15 use DB_File;
  16 use MIME::Base64 qw/decode_base64/;
  17 use Storable qw/freeze thaw/;
  18 use Text::ParseWords qw/shellwords/;
  19
  20 use App::FonBot::Plugin::Config qw/$httpd_port/;
  21 use App::FonBot::Plugin::Common;
  22
  23 ##################################################
  24
  25 my $log=Log::Log4perl->get_logger(__PACKAGE__);
  26
  27 my $httpd;
  28 my %waiting_userrequests;
  29 my %responses;
  30
  31 sub init{
  32         $log->info('initializing '.__PACKAGE__);
  33         %waiting_requests = ();
  34         %waiting_userrequests = ();
  35         $httpd = POE::Component::Server::HTTP->new(
  36                 Port => 8888,
  37                 PreHandler => { '/' => [\&pre_auth, \&pre_get, \&pre_userget], },
  38                 ContentHandler =>{ '/send' => \&on_send, '/get' => \&on_get, '/ok' => \&on_ok, '/userget' => \&on_userget, '/usersend' => \&on_usersend },
  39                 ErrorHandler => { '/' => sub { RC_OK }},
  40                 Headers => { 'Cache-Control' => 'no-cache' },
  41         );
  42 }
  43
  44 sub fini{
  45         $log->info('finishing '.__PACKAGE__);
  46         POE::Kernel->call($httpd, 'shutdown');
  47 }
  48
  49 ##################################################
  50
  51 sub httpdie (\$$;$){
  52         my ($response,$errstr,$errcode)=@_;
  53
  54         $$response->code($errcode // HTTP_BAD_REQUEST);
  55         $$response->header(Content_Type => 'text/plain');
  56         $$response->message($errstr);
  57
  58         die 'Bad Request';
  59 }
  60
  61 sub pre_auth{
  62         my ($request, $response)=@_;
  63
  64         eval {
  65                 my $authorization=$request->header('Authorization') // die 'No Authorization header';
  66                 $authorization =~ /^Basic (.+)$/ or die 'Invalid Authorization header';
  67                 my ($user, $password) = decode_base64($1) =~ /^(.+):(.*)$/ or die 'Invalid Authorization header';
  68                 eval { pwcheck $user, $password; 1 } or die 'Invalid user/password combination';
  69                 $request->header(Username => $user);
  70                 $log->debug("HTTP request from $user to url ".$request->url);
  71         };
  72         if (my $error = $@) {
  73                 $response->code(HTTP_UNAUTHORIZED);
  74                 $response->message('Bad username or password');
  75                 $response->header(Content_Type => 'text/plain');
  76                 $response->header(WWW_Authenticate => 'Basic realm="fonbotd"');
  77                 $response->content('Unauthorized');
  78                 $log->debug("Request denied: $error");
  79                 return RC_DENY
  80         }
  81
  82         $response->content('');
  83         RC_OK
  84 }
  85
  86 sub pre_get{
  87         my ($request, $response)=@_;
  88         my $user=$request->header('Username');
  89         return RC_OK if $response->code;
  90         return RC_OK unless $user;
  91         return RC_OK unless $request->uri =~ m,/get,;
  92
  93         unless (exists $commands{$user}) {
  94                 $log->debug("No pending commands for $user, entering RC_WAIT");
  95                 $waiting_requests{$user}->continue if exists $waiting_requests{$user};
  96                 $waiting_requests{$user}=$response;
  97                 return RC_WAIT
  98         }
  99
 100         RC_OK
 101 }
 102
 103 sub pre_userget{
 104         my ($request, $response)=@_;
 105         my $user=$request->header('Username');
 106         return RC_OK if $response->code;
 107         return RC_OK unless $user;
 108         return RC_OK unless $request->uri =~ m,/userget,;
 109
 110         unless (exists $responses{$user}) {
 111                 $log->debug("No pending responses for $user, entering RC_WAIT");
 112                 $waiting_userrequests{$user}->continue if exists $waiting_userrequests{$user};
 113                 $waiting_userrequests{$user}=$response;
 114                 return RC_WAIT
 115         }
 116
 117         RC_OK
 118 }
 119
 120 sub on_ok{
 121         my ($request, $response)=@_;
 122         return RC_OK if $response->code;
 123
 124         $response->code(HTTP_OK);
 125         RC_OK
 126 }
 127
 128 sub on_get{
 129         my ($request, $response)=@_;
 130         return RC_OK if $response->code;
 131
 132         eval {
 133                 my $user=$request->header('Username');
 134                 $log->debug("on_get from user $user");
 135
 136                 if (exists $commands{$user}) {
 137                         my $json=encode_json thaw $commands{$user};
 138                         $log->debug("Sending JSON: $json to $user");
 139                         $response->content($json);
 140                         $response->code(HTTP_OK);
 141                         $response->message('Commands sent');
 142                 } else {
 143                         $log->debug("Sending back 204 No Content");
 144                         $response->code(HTTP_NO_CONTENT);
 145                         $response->message('No pending commands');
 146                 }
 147
 148                 delete $commands{$user}
 149         };
 150
 151         $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
 152
 153         RC_OK
 154 }
 155
 156 sub on_userget{
 157         my ($request, $response)=@_;
 158         return RC_OK if $response->code;
 159
 160         eval {
 161                 my $user=$request->header('Username');
 162                 $log->debug("on_userget from user $user");
 163
 164                 if (exists $responses{$user}) {
 165                         my $json=encode_json $responses{$user};
 166                         $log->debug("Sending JSON: $json to $user");
 167                         $response->content($json);
 168                         $response->code(HTTP_OK);
 169                         $response->message('Responses sent');
 170                 } else {
 171                         $log->debug("Sending back 204 No Content");
 172                         $response->code(HTTP_NO_CONTENT);
 173                         $response->message('No pending responses');
 174                 }
 175
 176                 delete $responses{$user}
 177         };
 178
 179         $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
 180
 181         RC_OK
 182 }
 183
 184 sub on_send{
 185         my ($request, $response)=@_;
 186         return RC_OK if $response->code;
 187
 188         eval {
 189                 httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
 190                 my $user=$request->header('Username');
 191
 192                 my $destination=$request->header('X-Destination') // httpdie $response, 'Missing destination address';
 193                 my ($driver, $address)=shellwords $destination;
 194
 195                 my $content=$request->content // httpdie $response, 'Content is undef';
 196
 197                 if ($driver eq 'HTTP') {
 198                         $responses{$user}//=[];
 199                         push $responses{$user}, $content;
 200                         if (exists $waiting_userrequests{$user}) {
 201                                 $waiting_userrequests{$user}->continue;
 202                                 delete $waiting_userrequests{$user}
 203                         }
 204                 } else {
 205                         unless ($ok_user_addresses{"$user $driver $address"}) {
 206                                 $response->code(HTTP_FORBIDDEN);
 207                                 $response->message("$user is not allowed to send messages to $address");
 208                                 return
 209                         }
 210
 211                         POE::Kernel->post($driver, 'send_message', $address, $content) or $log->error("Driver not found: $driver");
 212                 }
 213
 214                 $response->code(HTTP_NO_CONTENT);
 215                 $response->message('Message sent');
 216         };
 217
 218         $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
 219         $log->debug('Responding to send from $user with '.$response->code.' '.$response->message);
 220         RC_OK
 221 }
 222
 223 sub on_usersend{
 224         my ($request, $response)=@_;
 225         $log->debug("asdasd asd");
 226         return RC_OK if $response->code;
 227
 228         eval{
 229                 httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
 230                 my $user=$request->header('Username');
 231
 232                 my $content=$request->content // httpdie $response, 'Content is undef';
 233
 234                 sendmsg $user, $request->header('X-Requestid'), HTTP => shellwords $_ for split '\n', $content;
 235
 236                 $response->code(HTTP_NO_CONTENT);
 237                 $response->message('Command sent');
 238         };
 239
 240         $log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
 241         $log->debug('Responding to usersend from $user with '.$response->code.' '.$response->message);
 242         RC_OK
 243 }
 244
 245 1;
 246 __END__
 247
 248 =encoding utf-8
 249
 250 =head1 NAME
 251
 252 App::FonBot::Plugin::HTTPD - FonBot webserver plugin, used for communication with phones
 253
 254 =head1 SYNOPSIS
 255
 256         use App::FonBot::Plugin::HTTPD;
 257         App::FonBot::Plugin::HTTPD->init;
 258         ...
 259         App::FonBot::Plugin::HTTPD->fini;
 260
 261 =head1 DESCRIPTION
 262
 263 This FonBot plugin provides a webserver for interacting with fonbotd. All requests use Basic access authentication.
 264
 265 The available calls are:
 266
 267 =over
 268
 269 =item GET C</get>
 270
 271 Returns a JSON array of pending commands for the current user. Uses long polling — the server does not respond immediately if there are no pending commands.
 272
 273 =item GET C</ok>
 274
 275 Returns a 200 OK.
 276
 277 =item POST C</send>
 278
 279 Sends a message to an address. The address is given in the C<X-Destination> header. The message is in the POST data.
 280
 281 =item GET C</userget>
 282
 283 Returns a JSON array of pending messages for the current user. Uses long polling — the server does not respond immediately if there are no pending commands.
 284
 285 =item POST C</usersend>
 286
 287 Sends a command to the sender's phone. The optional C<X-Requestid> header sets the request ID. The command is in the POST data
 288
 289 =back
 290
 291 =head1 CONFIGURATION VARIABLES
 292
 293 =over
 294
 295 =item C<$httpd_port>
 296
 297 The HTTPD listens on this port.
 298
 299 =back
 300
 301 =head1 AUTHOR
 302
 303 Marius Gavrilescu C<< marius@ieval.ro >>
 304
 305 =head1 COPYRIGHT AND LICENSE
 306
 307 Copyright 2013 Marius Gavrilescu
 308
 309 This file is part of fonbotd.
 310
 311 fonbotd is free software: you can redistribute it and/or modify
 312 it under the terms of the GNU Affero General Public License as published by
 313 the Free Software Foundation, either version 3 of the License, or
 314 (at your option) any later version.
 315
 316 fonbotd is distributed in the hope that it will be useful,
 317 but WITHOUT ANY WARRANTY; without even the implied warranty of
 318 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 319 GNU Affero General Public License for more details.
 320
 321 You should have received a copy of the GNU Affero General Public License
 322 along with fonbotd.  If not, see <http://www.gnu.org/licenses/>
 323
 324
 325 =cut