[app-fonbot-daemon.git] / lib / App / FonBot / Plugin / HTTPD.pm

package App::FonBot::Plugin::HTTPD;

our $VERSION = '0.000_5';

use v5.14;
use strict;
use warnings;

use Apache2::Authen::Passphrase qw/pwcheck/;
use HTTP::Status qw/HTTP_BAD_REQUEST HTTP_OK HTTP_NO_CONTENT HTTP_FORBIDDEN HTTP_UNAUTHORIZED/;
use JSON qw/encode_json/;
use Log::Log4perl;
use POE::Component::Server::HTTP qw/RC_OK RC_DENY RC_WAIT/;

use DB_File;
use MIME::Base64 qw/decode_base64/;
use Storable qw/freeze thaw/;
use Text::ParseWords qw/shellwords/;

use App::FonBot::Plugin::Config qw/$httpd_port/;
use App::FonBot::Plugin::Common;

##################################################

my $log=Log::Log4perl->get_logger(__PACKAGE__);

my $httpd;
my %waiting_userrequests;
my %responses;

sub init{
	$log->info('initializing '.__PACKAGE__);
	%waiting_requests = ();
	%waiting_userrequests = ();
	$httpd = POE::Component::Server::HTTP->new(
		Port => 8888,
		PreHandler => { '/' => [\&pre_auth, \&pre_get, \&pre_userget], },
		ContentHandler =>{ '/send' => \&on_send, '/get' => \&on_get, '/ok' => \&on_ok, '/userget' => \&on_userget, '/usersend' => \&on_usersend },
		ErrorHandler => { '/' => sub { RC_OK }},
		Headers => { 'Cache-Control' => 'no-cache' },
	);
}

sub fini{
	$log->info('finishing '.__PACKAGE__);
	POE::Kernel->call($httpd, 'shutdown');
}

##################################################

sub httpdie (\$$;$){
	my ($response,$errstr,$errcode)=@_;

	$$response->code($errcode // HTTP_BAD_REQUEST);
	$$response->header(Content_Type => 'text/plain');
	$$response->message($errstr);

	die 'Bad Request';
}

sub pre_auth{
	my ($request, $response)=@_;

	eval {
		my $authorization=$request->header('Authorization') // die 'No Authorization header';
		$authorization =~ /^Basic (.+)$/ or die 'Invalid Authorization header';
		my ($user, $password) = decode_base64($1) =~ /^(.+):(.*)$/ or die 'Invalid Authorization header';
		eval { pwcheck $user, $password; 1 } or die 'Invalid user/password combination';
		$request->header(Username => $user);
		$log->debug("HTTP request from $user to url ".$request->url);
	};
	if (my $error = $@) {
		$response->code(HTTP_UNAUTHORIZED);
		$response->message('Bad username or password');
		$response->header(Content_Type => 'text/plain');
		$response->header(WWW_Authenticate => 'Basic realm="fonbotd"');
		$response->content('Unauthorized');
		$log->debug("Request denied: $error");
		return RC_DENY
	}

	$response->content('');
	RC_OK
}

sub pre_get{
	my ($request, $response)=@_;
	my $user=$request->header('Username');
	return RC_OK if $response->code;
	return RC_OK unless $user;
	return RC_OK unless $request->uri =~ m,/get,;

	unless (exists $commands{$user}) {
		$log->debug("No pending commands for $user, entering RC_WAIT");
		$waiting_requests{$user}->continue if exists $waiting_requests{$user};
		$waiting_requests{$user}=$response;
		return RC_WAIT
	}

	RC_OK
}

sub pre_userget{
	my ($request, $response)=@_;
	my $user=$request->header('Username');
	return RC_OK if $response->code;
	return RC_OK unless $user;
	return RC_OK unless $request->uri =~ m,/userget,;

	unless (exists $responses{$user}) {
		$log->debug("No pending responses for $user, entering RC_WAIT");
		$waiting_userrequests{$user}->continue if exists $waiting_userrequests{$user};
		$waiting_userrequests{$user}=$response;
		return RC_WAIT
	}

	RC_OK
}

sub on_ok{
	my ($request, $response)=@_;
	return RC_OK if $response->code;

	$response->code(HTTP_OK);
	RC_OK
}

sub on_get{
	my ($request, $response)=@_;
	return RC_OK if $response->code;

	eval {
		my $user=$request->header('Username');
		$log->debug("on_get from user $user");

		if (exists $commands{$user}) {
			my $json=encode_json thaw $commands{$user};
			$log->debug("Sending JSON: $json to $user");
			$response->content($json);
			$response->code(HTTP_OK);
			$response->message('Commands sent');
		} else {
			$log->debug("Sending back 204 No Content");
			$response->code(HTTP_NO_CONTENT);
			$response->message('No pending commands');
		}

		delete $commands{$user}
	};

	$log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;

	RC_OK
}

sub on_userget{
	my ($request, $response)=@_;
	return RC_OK if $response->code;

	eval {
		my $user=$request->header('Username');
		$log->debug("on_userget from user $user");

		if (exists $responses{$user}) {
			my $json=encode_json $responses{$user};
			$log->debug("Sending JSON: $json to $user");
			$response->content($json);
			$response->code(HTTP_OK);
			$response->message('Responses sent');
		} else {
			$log->debug("Sending back 204 No Content");
			$response->code(HTTP_NO_CONTENT);
			$response->message('No pending responses');
		}

		delete $responses{$user}
	};

	$log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;

	RC_OK
}

sub on_send{
	my ($request, $response)=@_;
	return RC_OK if $response->code;

	eval {
		httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
		my $user=$request->header('Username');

		my $destination=$request->header('X-Destination') // httpdie $response, 'Missing destination address';
		my ($driver, $address)=shellwords $destination;

		my $content=$request->content // httpdie $response, 'Content is undef';

		if ($driver eq 'HTTP') {
			$responses{$user}//=[];
			push @{$responses{$user}}, $content;
			if (exists $waiting_userrequests{$user}) {
				$waiting_userrequests{$user}->continue;
				delete $waiting_userrequests{$user}
			}
		} else {
			unless ($ok_user_addresses{"$user $driver $address"}) {
				$response->code(HTTP_FORBIDDEN);
				$response->message("$user is not allowed to send messages to $address");
				return
			}

			POE::Kernel->post($driver, 'send_message', $address, $content) or $log->error("Driver not found: $driver");
		}

		$response->code(HTTP_NO_CONTENT);
		$response->message('Message sent');
	};

	$log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
	$log->debug('Responding to send from $user with '.$response->code.' '.$response->message);
	RC_OK
}

sub on_usersend{
	my ($request, $response)=@_;
	$log->debug("asdasd asd");
	return RC_OK if $response->code;

	eval{
		httpdie $response, 'All requests must use the POST http method' unless $request->method eq 'POST';
		my $user=$request->header('Username');

		my $content=$request->content // httpdie $response, 'Content is undef';

		sendmsg $user, $request->header('X-Requestid'), HTTP => shellwords $_ for split '\n', $content;

		$response->code(HTTP_NO_CONTENT);
		$response->message('Command sent');
	};

	$log->error("ERROR: $@") if $@ && $@ !~ /^Bad Request /;
	$log->debug('Responding to usersend from $user with '.$response->code.' '.$response->message);
	RC_OK
}

1;
__END__

=encoding utf-8

=head1 NAME

App::FonBot::Plugin::HTTPD - FonBot webserver plugin, used for communication with phones

=head1 SYNOPSIS

	use App::FonBot::Plugin::HTTPD;
	App::FonBot::Plugin::HTTPD->init;
	...
	App::FonBot::Plugin::HTTPD->fini;

=head1 DESCRIPTION

This FonBot plugin provides a webserver for interacting with fonbotd. All requests use Basic access authentication.

The available calls are:

=over

=item GET C</get>

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.

=item GET C</ok>

Returns a 200 OK.

=item POST C</send>

Sends a message to an address. The address is given in the C<X-Destination> header. The message is in the POST data.

=item GET C</userget>

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.

=item POST C</usersend>

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

=back

=head1 CONFIGURATION VARIABLES

=over

=item C<$httpd_port>

The HTTPD listens on this port.

=back

=head1 AUTHOR

Marius Gavrilescu C<< marius@ieval.ro >>

=head1 COPYRIGHT AND LICENSE

Copyright 2013 Marius Gavrilescu

This file is part of fonbotd.

fonbotd is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

fonbotd is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public License
along with fonbotd.  If not, see <http://www.gnu.org/licenses/>


=cut
Commit	Line	Data
	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