2014-04-03 17:42:54 +02:00
#!/usr/bin/env perl
# This file is part of the VROOM project
# released under the MIT licence
# Copyright 2014 Firewall Services
2014-06-12 18:56:54 +02:00
# Daniel Berteaud <daniel@firewall-services.com>
2014-04-03 17:42:54 +02:00
use lib '../lib' ;
use Mojolicious::Lite ;
use Mojolicious::Plugin::Mailer ;
use Mojo::JSON ;
use DBI ;
use Data::GUID qw( guid_string ) ;
use Digest::MD5 qw( md5_hex ) ;
2014-05-13 19:22:47 +02:00
use Crypt::SaltedHash ;
2014-04-03 17:42:54 +02:00
use MIME::Base64 ;
use Email::Sender::Transport::Sendmail ;
2014-05-02 23:42:48 +02:00
use Encode ;
2014-05-10 18:37:15 +02:00
use File::stat ;
2014-05-23 19:15:42 +02:00
use File::Basename ;
2014-06-12 22:52:53 +02:00
use Etherpad::API ;
2014-04-03 17:42:54 +02:00
2014-05-15 13:41:01 +02:00
# List The different components we rely on.
2014-04-03 17:42:54 +02:00
# Used to generate thanks on the about template
our $ components = {
"SimpleWebRTC" = > {
url = > 'http://simplewebrtc.com/'
} ,
"Mojolicious" = > {
url = > 'http://mojolicio.us/'
} ,
"Jquery" = > {
url = > 'http://jquery.com/'
} ,
"notify.js" = > {
url = > 'http://notifyjs.com/'
} ,
"jquery-browser-plugin" = > {
url = > 'https://github.com/gabceb/jquery-browser-plugin'
} ,
2014-05-30 16:41:23 +02:00
"jquery-tinytimer" = > {
url = > 'https://github.com/odyniec/jQuery-tinyTimer'
} ,
2014-04-03 17:42:54 +02:00
"sprintf.js" = > {
url = > 'http://hexmen.com/blog/2007/03/printf-sprintf/'
} ,
"node.js" = > {
url = > 'http://nodejs.org/'
} ,
"bootstrap" = > {
url = > 'http://getbootstrap.com/'
} ,
"MariaDB" = > {
url = > 'https://mariadb.org/'
} ,
"SignalMaster" = > {
url = > 'https://github.com/andyet/signalmaster/'
} ,
"rfc5766-turn-server" = > {
url = > 'https://code.google.com/p/rfc5766-turn-server/'
2014-05-04 14:32:48 +02:00
} ,
"FileSaver" = > {
url = > 'https://github.com/eligrey/FileSaver.js'
2014-05-23 13:20:04 +02:00
} ,
"WPZOOM Developer Icon Set" = > {
url = > 'https://www.iconfinder.com/search/?q=iconset%3Awpzoom-developer-icon-set'
2014-04-03 17:42:54 +02:00
}
} ;
2014-05-23 19:15:42 +02:00
# MOH authors for credits
our $ musics = {
"Papel Secante" = > {
author = > "Angel Gaitan" ,
author_url = > "http://angelgaitan.bandcamp.com/" ,
licence = > "Creative Commons BY-SA" ,
licence_url = > "http://creativecommons.org/licenses/by-sa/3.0"
} ,
"Overjazz" = > {
author = > "Funkyproject" ,
author_url = > "http://www.funkyproject.fr" ,
licence = > "Creative Commons BY-SA" ,
licence_url = > "http://creativecommons.org/licenses/by-sa/3.0"
} ,
"Polar Express" = > {
author = > "Koteen" ,
author_url = > "http://?.?" ,
licence = > "Creative Commons BY-SA" ,
licence_url = > "http://creativecommons.org/licenses/by-sa/3.0"
} ,
"Funky Goose" = > {
author = > "Pepe Frias" ,
author_url = > "http://www.pepefrias.tk/" ,
licence = > "Creative Commons BY-SA" ,
licence_url = > "http://creativecommons.org/licenses/by-sa/3.0"
} ,
"I got my own" = > {
author = > "Reole" ,
author_url = > "http://www.reolemusic.com/" ,
licence = > "Creative Commons BY-SA" ,
licence_url = > "http://creativecommons.org/licenses/by-sa/3.0"
}
} ;
2014-04-03 17:42:54 +02:00
app - > log - > level ( 'info' ) ;
2014-05-15 13:41:01 +02:00
# Read conf file, and set default values
2014-04-04 11:42:59 +02:00
our $ config = plugin Config = > {
file = > '../conf/vroom.conf' ,
default = > {
2014-05-15 10:30:03 +02:00
dbi = > 'DBI:mysql:database=vroom;host=localhost' ,
dbUser = > 'vroom' ,
dbPassword = > 'vroom' ,
signalingServer = > 'https://vroom.example.com/' ,
stunServer = > 'stun.l.google.com:19302' ,
realm = > 'vroom' ,
emailFrom = > 'vroom@example.com' ,
feedbackRecipient = > 'admin@example.com' ,
2014-05-15 16:16:05 +02:00
poweredBy = > '<a href="http://www.firewall-services.com" target="_blank">Firewall Services</a>' ,
2014-05-15 10:30:03 +02:00
template = > 'default' ,
inactivityTimeout = > 3600 ,
persistentInactivityTimeout = > 0 ,
2014-05-25 01:12:49 +02:00
commonRoomNames = > [ qw( ) ] ,
2014-05-15 10:30:03 +02:00
logLevel = > 'info' ,
chromeExtensionId = > 'ecicdpoejfllflombfanbhfpgcimjddn' ,
2014-06-12 21:34:18 +02:00
etherpadUri = > '' ,
etherpadApiKey = > '' ,
2014-05-15 10:30:03 +02:00
sendmail = > '/sbin/sendmail'
2014-04-04 11:42:59 +02:00
}
} ;
2014-06-12 22:52:53 +02:00
# Create etherpad api client if required
our $ ec = undef ;
if ( $ config - > { etherpadUri } =~ m/https?:\/\/.*/ && $ config - > { etherpadApiKey } ne '' ) {
$ ec = Etherpad::API - > new ( {
url = > $ config - > { etherpadUri } ,
apikey = > $ config - > { etherpadApiKey }
} ) ;
}
2014-04-03 17:42:54 +02:00
app - > log - > level ( $ config - > { logLevel } ) ;
2014-05-15 13:41:01 +02:00
# Load I18N, and declare supported languages
2014-04-03 17:42:54 +02:00
plugin I18N = > {
namespace = > 'Vroom::I18N' ,
support_url_langs = > [ qw( en fr ) ]
} ;
2014-05-15 13:41:01 +02:00
# Load mailer plugin with its default values
2014-04-03 17:42:54 +02:00
plugin Mailer = > {
from = > $ config - > { emailFrom } ,
transport = > Email::Sender::Transport::Sendmail - > new ( { sendmail = > $ config - > { sendmail } } ) ,
} ;
2014-05-15 13:41:01 +02:00
# Wrapper arround DBI
2014-04-03 17:42:54 +02:00
helper db = > sub {
2014-05-28 13:22:15 +02:00
my $ dbh = DBI - > connect ( $ config - > { dbi } ,
$ config - > { dbUser } ,
$ config - > { dbPassword } ,
{
mysql_enable_utf8 = > 1 ,
}
) || die "Could not connect" ;
2014-04-03 17:42:54 +02:00
$ dbh
} ;
2014-05-15 13:41:01 +02:00
# Create a cookie based session
2014-04-03 17:42:54 +02:00
helper login = > sub {
my $ self = shift ;
return if $ self - > session ( 'name' ) ;
my $ login = $ ENV { 'REMOTE_USER' } || lc guid_string ( ) ;
$ self - > session ( name = > $ login ,
ip = > $ self - > tx - > remote_address ) ;
$ self - > app - > log - > info ( $ self - > session ( 'name' ) . " logged in from " . $ self - > tx - > remote_address ) ;
} ;
2014-05-15 13:41:01 +02:00
# Expire the cookie
2014-04-03 17:42:54 +02:00
helper logout = > sub {
my $ self = shift ;
2014-06-12 22:52:53 +02:00
my ( $ room ) = @ _ ;
# Logout from etherpad
if ( $ ec && $ self - > session ( $ room ) - > { etherpadSessionId } ) {
$ ec - > delete_session ( $ self - > session ( $ room ) - > { etherpadSessionId } ) ;
}
2014-05-12 18:53:16 +02:00
$ self - > session ( expires = > 1 ) ;
2014-04-03 17:42:54 +02:00
$ self - > app - > log - > info ( $ self - > session ( 'name' ) . " logged out" ) ;
} ;
2014-05-15 13:41:01 +02:00
# Create a new room in the DB
# Requires two args: the name of the room and the session name of the creator
2014-04-03 17:42:54 +02:00
helper create_room = > sub {
my $ self = shift ;
my ( $ name , $ owner ) = @ _ ;
2014-05-15 13:41:01 +02:00
# Exit if the name isn't valid or already taken
2014-04-03 17:42:54 +02:00
return undef if ( $ self - > get_room ( $ name ) || ! $ self - > valid_room_name ( $ name ) ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "INSERT INTO `rooms` (`name`,`create_timestamp`,`activity_timestamp`,`owner`,`token`,`realm`) VALUES (?,?,?,?,?,?);" ) } || return undef ;
2014-05-15 13:41:01 +02:00
# Gen a random token. Will be used as a turnPassword
2014-05-28 15:16:49 +02:00
my $ tp = $ self - > get_random ( 49 ) ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ name , time ( ) , time ( ) , $ owner , $ tp , $ config - > { realm } ) || return undef ;
2014-05-28 15:40:14 +02:00
$ self - > app - > log - > info ( "Room $name created by " . $ self - > session ( 'name' ) ) ;
2014-06-12 22:52:53 +02:00
# therpad integration ?
if ( $ ec ) {
my $ group = $ ec - > create_group ( ) || undef ;
return undef unless ( $ group ) ;
$ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `etherpad_group`=? WHERE `name`='$name';" ) } || return undef ;
$ sth - > execute ( $ group ) ;
$ ec - > create_group_pad ( $ group , $ name ) || return undef ;
$ self - > app - > log - > debug ( "Etherpad group $group created for room $name" ) ;
}
2014-04-03 17:42:54 +02:00
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Read room param in the DB and return a perl hash
2014-04-03 17:42:54 +02:00
helper get_room = > sub {
my $ self = shift ;
my ( $ name ) = @ _ ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `rooms` WHERE `name`=?;" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ name ) || return undef ;
return $ sth - > fetchall_hashref ( 'name' ) - > { $ name } ;
} ;
2014-05-28 09:39:38 +02:00
# Get room param by ID instead of name
helper get_room_by_id = > sub {
my $ self = shift ;
my ( $ id ) = @ _ ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `rooms` WHERE `id`=?;" ) } || return undef ;
2014-05-28 09:39:38 +02:00
$ sth - > execute ( $ id ) || return undef ;
return $ sth - > fetchall_hashref ( 'id' ) - > { $ id } ;
} ;
2014-05-15 13:41:01 +02:00
# Lock/unlock a room, to prevent new participants
# Takes two arg: room name and 1 for lock, 0 for unlock
2014-04-03 17:42:54 +02:00
helper lock_room = > sub {
my $ self = shift ;
my ( $ name , $ lock ) = @ _ ;
return undef unless ( % { $ self - > get_room ( $ name ) } ) ;
return undef unless ( $ lock =~ m/^0|1$/ ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `locked`=? WHERE `name`=?;" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ lock , $ name ) || return undef ;
my $ action = ( $ lock eq '1' ) ? 'locked' : 'unlocked' ;
$ self - > app - > log - > info ( "room $name $action by " . $ self - > session ( 'name' ) ) ;
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Add a participant in the database. Used by the signaling server to check
# if user is allowed
2014-04-03 17:42:54 +02:00
helper add_participant = > sub {
my $ self = shift ;
my ( $ name , $ participant ) = @ _ ;
my $ room = $ self - > get_room ( $ name ) || return undef ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "INSERT IGNORE INTO `participants` (`id`,`participant`) VALUES (?,?);" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ room - > { id } , $ participant ) || return undef ;
$ self - > app - > log - > info ( $ self - > session ( 'name' ) . " joined the room $name" ) ;
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Remove participant from the DB
2014-04-03 17:42:54 +02:00
helper remove_participant = > sub {
my $ self = shift ;
my ( $ name , $ participant ) = @ _ ;
my $ room = $ self - > get_room ( $ name ) || return undef ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "DELETE FROM `participants` WHERE `id`=? AND `participant`=?;" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ room - > { id } , $ participant ) || return undef ;
$ self - > app - > log - > info ( $ self - > session ( 'name' ) . " leaved the room $name" ) ;
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Get a list of participants of a room
2014-04-03 17:42:54 +02:00
helper get_participants = > sub {
my $ self = shift ;
my ( $ name ) = @ _ ;
my $ room = $ self - > get_room ( $ name ) || return undef ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT `participant` FROM `participants` WHERE `id`=?;" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ room - > { id } ) || return undef ;
my @ res ;
while ( my @ row = $ sth - > fetchrow_array ) {
push @ res , $ row [ 0 ] ;
}
return @ res ;
} ;
2014-05-16 17:57:33 +02:00
# Set the role of a peer
helper set_peer_role = > sub {
my $ self = shift ;
my ( $ room , $ name , $ id , $ role ) = @ _ ;
# Check if this ID isn't the one from another peer first
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `participants` WHERE `peer_id`=? AND `participant`!=? AND `id` IN (SELECT `id` FROM `rooms` WHERE `name`=?)" ) } || return undef ;
2014-05-16 17:57:33 +02:00
$ sth - > execute ( $ id , $ name , $ room ) || return undef ;
return undef if ( $ sth - > rows > 0 ) ;
2014-05-28 15:40:14 +02:00
$ sth = eval { $ self - > db - > prepare ( "UPDATE `participants` SET `peer_id`=?,`role`=? WHERE `participant`=? AND `id` IN (SELECT `id` FROM `rooms` WHERE `name`=?)" ) } || return undef ;
2014-05-16 17:57:33 +02:00
$ sth - > execute ( $ id , $ role , $ name , $ room ) || return undef ;
2014-05-28 15:40:14 +02:00
$ self - > app - > log - > info ( "User $id has now the $role role in room $name" ) ;
2014-05-16 17:57:33 +02:00
return 1 ;
} ;
# Return the role of a peer, from it's signaling ID
helper get_peer_role = > sub {
my $ self = shift ;
my ( $ room , $ id ) = @ _ ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT `role` FROM `participants` WHERE `peer_id`=? AND `id` IN (SELECT `id` FROM `rooms` WHERE `name`=?)" ) } || return undef ;
2014-05-16 17:57:33 +02:00
$ sth - > execute ( $ id , $ room ) || return undef ;
if ( $ sth - > rows == 1 ) {
my ( $ role ) = $ sth - > fetchrow_array ( ) ;
return $ role ;
}
else {
return 'participant' ;
}
} ;
2014-06-04 16:00:29 +02:00
# Promote a peer to owner
helper promote_peer = > sub {
my $ self = shift ;
my ( $ room , $ id ) = @ _ ;
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `participants` WHERE `peer_id`=? AND `id` IN (SELECT `id` FROM `rooms` WHERE `name`=?)" ) } || return undef ;
$ sth - > execute ( $ id , $ room ) || return undef ;
return undef if ( $ sth - > rows != 1 ) ;
$ sth = eval { $ self - > db - > prepare ( "UPDATE `participants` SET `role`='owner' WHERE `peer_id`=? AND `id` IN (SELECT `id` FROM `rooms` WHERE `name`=?)" ) } || return undef ;
$ sth - > execute ( $ id , $ room ) || return undef ;
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Check if a participant has joined a room
# Takes two args: the session name, and the room name
2014-04-03 17:42:54 +02:00
helper has_joined = > sub {
my $ self = shift ;
my ( $ session , $ name ) = @ _ ;
my $ ret = 0 ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `rooms` WHERE `name`=? AND `id` IN (SELECT `id` FROM `participants` WHERE `participant`=?)" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( $ name , $ session ) || return undef ;
$ ret = 1 if ( $ sth - > rows > 0 ) ;
return $ ret ;
} ;
2014-05-15 13:41:01 +02:00
# Purge unused rooms
2014-04-03 17:42:54 +02:00
helper delete_rooms = > sub {
my $ self = shift ;
$ self - > app - > log - > debug ( 'Removing unused rooms' ) ;
eval {
my $ timeout = time ( ) - $ config - > { inactivityTimeout } ;
2014-05-28 15:40:14 +02:00
$ self - > db - > do ( "DELETE FROM `participants` WHERE `id` IN (SELECT `id` FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='0');" ) ;
$ self - > db - > do ( "DELETE FROM `notifications` WHERE `id` IN (SELECT `id` FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='0');" ) ;
$ self - > db - > do ( "DELETE FROM `invitations` WHERE `id` IN (SELECT `id` FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='0');" ) ;
$ self - > db - > do ( "DELETE FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='0';" ) ;
2014-04-03 17:42:54 +02:00
} || return undef ;
2014-05-15 10:30:03 +02:00
if ( $ config - > { persistentInactivityTimeout } && $ config - > { persistentInactivityTimeout } > 0 ) {
eval {
my $ timeout = time ( ) - $ config - > { persistentInactivityTimeout } ;
2014-05-28 15:40:14 +02:00
$ self - > db - > do ( "DELETE FROM `participants` WHERE `id` IN (SELECT `id` FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='1');" ) ;
$ self - > db - > do ( "DELETE FROM `notifications` WHERE `id` IN (SELECT `id` FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='1');" ) ;
$ self - > db - > do ( "DELETE FROM `invitations` WHERE `id` IN (SELECT `id` FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='1');" ) ;
$ self - > db - > do ( "DELETE FROM `rooms` WHERE `activity_timestamp` < $timeout AND `persistent`='1';" ) ;
2014-05-15 10:30:03 +02:00
} || return undef ;
}
2014-04-03 17:42:54 +02:00
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Just update the activity timestamp
# so we can detect unused rooms
2014-04-03 17:42:54 +02:00
helper ping_room = > sub {
my $ self = shift ;
my ( $ name ) = @ _ ;
return undef unless ( % { $ self - > get_room ( $ name ) } ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `activity_timestamp`=? WHERE `name`=?;" ) } || return undef ;
2014-04-03 17:42:54 +02:00
$ sth - > execute ( time ( ) , $ name ) || return undef ;
$ self - > app - > log - > debug ( $ self - > session ( 'name' ) . " pinged the room $name" ) ;
return 1 ;
} ;
# Check if this name is a valid room name
helper valid_room_name = > sub {
my $ self = shift ;
my ( $ name ) = @ _ ;
my $ ret = undef ;
2014-05-09 13:37:36 +02:00
# A few names are reserved
2014-06-09 12:59:10 +02:00
my @ reserved = qw( about help feedback feedback_thanks goodbye admin create localize action
missing dies password kicked invitation js css img fonts snd ) ;
2014-05-15 13:41:01 +02:00
if ( $ name =~ m/^[\w\-]{1,49}$/ && ! grep { $ name eq $ _ } @ reserved ) {
2014-04-03 17:42:54 +02:00
$ ret = 1 ;
}
return $ ret ;
} ;
2014-05-27 19:09:30 +02:00
# Generate a random token
helper get_random = > sub {
my $ self = shift ;
my ( $ size ) = @ _ ;
2014-05-28 15:16:49 +02:00
return join '' = > map { ( 'a' .. 'z' , 'A' .. 'Z' , '0' .. '9' , '0' .. '9' ) [ rand 72 ] } 0 .. $ size ;
2014-05-27 19:09:30 +02:00
} ;
2014-05-09 18:56:43 +02:00
# Generate a random name
helper get_random_name = > sub {
my $ self = shift ;
2014-05-28 15:16:49 +02:00
my $ name = lc $ self - > get_random ( 9 ) ;
2014-05-09 18:56:43 +02:00
# Get another one if already taken
while ( $ self - > get_room ( $ name ) ) {
$ name = $ self - > get_random_name ( ) ;
}
return $ name ;
} ;
2014-05-15 13:41:01 +02:00
# Return the mtime of a file
# Used to append the timestamp to JS and CSS files
# So client can get new version immediatly
2014-05-10 18:37:15 +02:00
helper get_mtime = > sub {
my $ self = shift ;
my ( $ file ) = @ _ ;
return stat ( $ file ) - > mtime ;
} ;
2014-05-15 16:56:14 +02:00
# Wrapper arround url_for which adds a trailing / if needed
helper get_url = > sub {
my $ self = shift ;
my $ url = $ self - > url_for ( shift ) ;
$ url . = ( $ url =~ m/\/$/ ) ? '' : '/' ;
return $ url ;
} ;
2014-05-15 13:41:01 +02:00
# Password protect a room
# Takes two args: room name and password
# If password is undef: remove the password
# Password is hashed and salted before being stored
2014-05-11 22:29:40 +02:00
helper set_join_pass = > sub {
my $ self = shift ;
my ( $ room , $ pass ) = @ _ ;
return undef unless ( % { $ self - > get_room ( $ room ) } ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `join_password`=? WHERE `name`=?;" ) } || return undef ;
2014-05-14 09:05:00 +02:00
$ pass = ( $ pass ) ? Crypt::SaltedHash - > new ( algorithm = > 'SHA-256' ) - > add ( $ pass ) - > generate : undef ;
2014-05-11 22:29:40 +02:00
$ sth - > execute ( $ pass , $ room ) || return undef ;
if ( $ pass ) {
$ self - > app - > log - > debug ( $ self - > session ( 'name' ) . " has set a password on room $room" ) ;
}
else {
$ self - > app - > log - > debug ( $ self - > session ( 'name' ) . " has removed password on room $room" ) ;
}
return 1 ;
} ;
2014-05-15 13:41:01 +02:00
# Set owner password. Not needed to join a room
# but needed to prove you're the owner, and access the configuration menu
2014-05-13 19:22:47 +02:00
helper set_owner_pass = > sub {
my $ self = shift ;
my ( $ room , $ pass ) = @ _ ;
return undef unless ( % { $ self - > get_room ( $ room ) } ) ;
2014-05-15 13:41:01 +02:00
# For now, setting an owner password makes the room persistant
# Might be separated in the future
2014-05-13 19:22:47 +02:00
if ( $ pass ) {
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `owner_password`=?,`persistent`='1' WHERE `name`=?;" ) } || return undef ;
2014-05-14 09:05:00 +02:00
my $ pass = Crypt::SaltedHash - > new ( algorithm = > 'SHA-256' ) - > add ( $ pass ) - > generate ;
$ sth - > execute ( $ pass , $ room ) || return undef ;
2014-05-13 19:22:47 +02:00
$ self - > app - > log - > debug ( $ self - > session ( 'name' ) . " has set an owner password on room $room, which is now persistent" ) ;
}
else {
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `owner_password`=?,`persistent`='0' WHERE `name`=?;" ) } || return undef ;
2014-05-13 19:22:47 +02:00
$ sth - > execute ( undef , $ room ) || return undef ;
$ self - > app - > log - > debug ( $ self - > session ( 'name' ) . " has removed the owner password on room $room, which is not persistent anymore" ) ;
}
} ;
2014-05-20 09:34:28 +02:00
# Add an email address to the list of notifications
helper add_notification = > sub {
my $ self = shift ;
my ( $ room , $ email ) = @ _ ;
my $ data = $ self - > get_room ( $ room ) ;
return undef unless ( $ data ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "INSERT INTO `notifications` (`id`,`email`) VALUES (?,?)" ) } || return undef ;
2014-05-20 09:34:28 +02:00
$ sth - > execute ( $ data - > { id } , $ email ) || return undef ;
return 1 ;
} ;
# Return the list of email addresses
helper get_notification = > sub {
my $ self = shift ;
my ( $ room ) = @ _ ;
$ room = $ self - > get_room ( $ room ) || return undef ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT `email` FROM `notifications` WHERE `id`=?;" ) } || return undef ;
2014-05-20 09:34:28 +02:00
$ sth - > execute ( $ room - > { id } ) || return undef ;
my @ res ;
while ( my @ row = $ sth - > fetchrow_array ) {
push @ res , $ row [ 0 ] ;
}
return @ res ;
} ;
# Remove an email from notification list
helper remove_notification = > sub {
my $ self = shift ;
my ( $ room , $ email ) = @ _ ;
my $ data = $ self - > get_room ( $ room ) ;
return undef unless ( $ data ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "DELETE FROM `notifications` WHERE `id`=? AND `email`=?" ) } || return undef ;
2014-05-20 09:34:28 +02:00
$ sth - > execute ( $ data - > { id } , $ email ) || return undef ;
return 1 ;
} ;
2014-05-21 14:16:17 +02:00
# Set/unset ask for name
helper ask_for_name = > sub {
my $ self = shift ;
my ( $ room , $ set ) = @ _ ;
my $ data = $ self - > get_room ( $ room ) ;
return undef unless ( $ data ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `rooms` SET `ask_for_name`=? WHERE `name`=?" ) } || return undef ;
2014-05-21 14:16:17 +02:00
$ sth - > execute ( $ set , $ room ) || return undef ;
return 1 ;
} ;
2014-05-23 19:15:42 +02:00
# Randomly choose a music on hold
helper choose_moh = > sub {
my $ self = shift ;
my @ files = ( <snd/moh/*.*> ) ;
return basename ( $ files [ rand @ files ] ) ;
} ;
2014-05-27 19:09:30 +02:00
# Add a invitation
helper add_invitation = > sub {
my $ self = shift ;
my ( $ room , $ email ) = @ _ ;
my $ from = $ self - > session ( 'name' ) || return undef ;
my $ data = $ self - > get_room ( $ room ) ;
2014-06-03 09:43:11 +02:00
my $ id = $ self - > get_random ( 30 ) ;
2014-05-27 19:09:30 +02:00
return undef unless ( $ data ) ;
2014-05-28 15:40:14 +02:00
my $ sth = eval { $ self - > db - > prepare ( "INSERT INTO `invitations` (`id`,`from`,`token`,`email`,`timestamp`) VALUES (?,?,?,?,?)" ) } || return undef ;
2014-05-28 14:35:25 +02:00
$ sth - > execute ( $ data - > { id } , $ from , $ id , $ email , time ( ) ) || return undef ;
2014-05-28 09:39:38 +02:00
return $ id ;
} ;
2014-05-28 12:41:21 +02:00
# return a hash with all the invitation param
# just like get_room
2014-05-28 09:39:38 +02:00
helper get_invitation = > sub {
my $ self = shift ;
my ( $ id ) = @ _ ;
2014-05-28 14:55:50 +02:00
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `invitations` WHERE `token`=? AND `processed`='0';" ) } || return undef ;
2014-05-28 09:39:38 +02:00
$ sth - > execute ( $ id ) || return undef ;
return $ sth - > fetchall_hashref ( 'token' ) - > { $ id } ;
} ;
2014-05-28 12:41:21 +02:00
# Find invitations which have a unprocessed repsponse
helper find_invitations = > sub {
my $ self = shift ;
my $ sth = eval { $ self - > db - > prepare ( "SELECT `token` FROM `invitations` WHERE `from`=? AND `response` IS NOT NULL AND `processed`='0';" ) } || return undef ;
$ sth - > execute ( $ self - > session ( 'name' ) ) || return undef ;
my @ res ;
while ( my @ row = $ sth - > fetchrow_array ) {
push @ res , $ row [ 0 ] ;
}
return @ res ;
} ;
2014-05-28 09:39:38 +02:00
helper respond_invitation = > sub {
my $ self = shift ;
my ( $ id , $ response , $ message ) = @ _ ;
2014-05-28 12:41:21 +02:00
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `invitations` SET `response`=?,`message`=? WHERE `token`=?;" ) } || return undef ;
2014-05-28 09:39:38 +02:00
$ sth - > execute ( $ response , $ message , $ id ) || return undef ;
2014-05-27 19:09:30 +02:00
return 1 ;
} ;
2014-05-28 12:41:21 +02:00
# Mark a invitation response as processed
helper processed_invitation = > sub {
my $ self = shift ;
my ( $ id ) = @ _ ;
my $ sth = eval { $ self - > db - > prepare ( "UPDATE `invitations` SET `processed`='1' WHERE `token`=?;" ) } || return undef ;
$ sth - > execute ( $ id ) || return undef ;
return 1 ;
} ;
2014-05-28 14:35:25 +02:00
# Purge expired invitation links
helper delete_invitations = > sub {
my $ self = shift ;
$ self - > app - > log - > debug ( 'Removing expired invitations' ) ;
# Invitation older than 2 hours doesn't make much sense
my $ timeout = time ( ) - 7200 ;
my $ sth = eval { $ self - > db - > prepare ( "DELETE FROM `invitations` WHERE `timestamp` < $timeout;" ) } || return undef ;
$ sth - > execute ( ) || return undef ;
return 1 ;
} ;
2014-06-03 09:09:52 +02:00
# Check an invitation token is valid
helper check_invite_token = > sub {
my $ self = shift ;
my ( $ room , $ token ) = @ _ ;
2014-06-05 18:57:07 +02:00
# Expire invitations before checking if it's valid
$ self - > delete_invitations ;
2014-06-03 09:09:52 +02:00
my $ ret = 0 ;
my $ data = $ self - > get_room ( $ room ) ;
if ( ! $ data || ! $ token ) {
return undef ;
}
my $ sth = eval { $ self - > db - > prepare ( "SELECT * FROM `invitations` WHERE id=? AND token=? AND (`response` IS NULL OR `response`='later');" ) } || return undef ;
$ sth - > execute ( $ data - > { id } , $ token ) || return undef ;
$ ret = 1 if ( $ sth - > rows == 1 ) ;
return $ ret ;
} ;
2014-05-15 13:41:01 +02:00
# Route / to the index page
2014-04-03 17:42:54 +02:00
any '/' = > 'index' ;
2014-05-15 13:41:01 +02:00
# Route for the about page
2014-04-03 17:42:54 +02:00
get '/about' = > sub {
my $ self = shift ;
2014-05-23 19:15:42 +02:00
$ self - > stash ( components = > $ components ,
musics = > $ musics
) ;
2014-04-03 17:42:54 +02:00
} = > 'about' ;
2014-05-15 13:41:01 +02:00
# Route for the help page
2014-04-03 17:42:54 +02:00
get '/help' = > 'help' ;
2014-05-15 13:41:01 +02:00
# Routes for feedback. One get to display the form
# and one post to get data from it
2014-05-07 19:07:32 +02:00
get '/feedback' = > 'feedback' ;
post '/feedback' = > sub {
my $ self = shift ;
my $ email = $ self - > param ( 'email' ) || '' ;
my $ comment = $ self - > param ( 'comment' ) ;
$ self - > email (
header = > [
Subject = > encode ( "MIME-Header" , $ self - > l ( "FEEDBACK_FROM_VROOM" ) ) ,
To = > $ config - > { feedbackRecipient }
] ,
data = > [
template = > 'feedback' ,
email = > $ email ,
comment = > $ comment
] ,
) ;
2014-05-15 16:56:14 +02:00
$ self - > redirect_to ( $ self - > get_url ( 'feedback_thanks' ) ) ;
2014-05-07 19:07:32 +02:00
} ;
2014-05-15 13:41:01 +02:00
# Route for the thanks after feedback form
2014-05-09 19:15:30 +02:00
get 'feedback_thanks' = > 'feedback_thanks' ;
2014-05-15 13:41:01 +02:00
# Route for the goodbye page, displayed when someone leaves a room
2014-04-03 17:42:54 +02:00
get '/goodby/(:room)' = > sub {
my $ self = shift ;
my $ room = $ self - > stash ( 'room' ) ;
2014-05-14 17:46:18 +02:00
if ( ! $ self - > get_room ( $ room ) ) {
return $ self - > render ( 'error' ,
err = > 'ERROR_ROOM_s_DOESNT_EXIST' ,
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_DOESNT_EXIST" ) , $ room ) ,
room = > $ room
) ;
}
2014-04-03 17:42:54 +02:00
$ self - > remove_participant ( $ room , $ self - > session ( 'name' ) ) ;
2014-06-12 22:52:53 +02:00
$ self - > logout ( $ room ) ;
2014-04-03 17:42:54 +02:00
} = > 'goodby' ;
2014-05-18 19:22:44 +02:00
# Route for the kicked page
# Should be merged with the goodby route
get '/kicked/(:room)' = > sub {
my $ self = shift ;
my $ room = $ self - > stash ( 'room' ) ;
if ( ! $ self - > get_room ( $ room ) ) {
return $ self - > render ( 'error' ,
err = > 'ERROR_ROOM_s_DOESNT_EXIST' ,
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_DOESNT_EXIST" ) , $ room ) ,
room = > $ room
) ;
}
$ self - > remove_participant ( $ room , $ self - > session ( 'name' ) ) ;
2014-06-12 22:52:53 +02:00
$ self - > logout ( $ room ) ;
2014-05-18 19:22:44 +02:00
} = > 'kicked' ;
2014-05-28 09:39:38 +02:00
# Route for invitition response
get '/invitation' = > sub {
my $ self = shift ;
2014-06-03 09:43:11 +02:00
my $ inviteId = $ self - > param ( 'token' ) || '' ;
# Delecte expired invitation now
$ self - > delete_invitations ;
2014-05-28 09:39:38 +02:00
my $ invite = $ self - > get_invitation ( $ inviteId ) ;
my $ room = $ self - > get_room_by_id ( $ invite - > { id } ) ;
2014-06-03 09:43:11 +02:00
if ( ! $ invite || ! $ room ) {
2014-05-28 09:39:38 +02:00
return $ self - > render ( 'error' ,
err = > 'ERROR_INVITATION_INVALID' ,
msg = > $ self - > l ( 'ERROR_INVITATION_INVALID' ) ,
room = > $ room
) ;
}
$ self - > render ( 'invitation' ,
inviteId = > $ inviteId ,
room = > $ room - > { name } ,
) ;
} ;
post '/invitation' = > sub {
my $ self = shift ;
2014-06-03 09:43:11 +02:00
my $ id = $ self - > param ( 'token' ) || '' ;
2014-05-28 09:39:38 +02:00
my $ response = $ self - > param ( 'response' ) || 'decline' ;
my $ message = $ self - > param ( 'message' ) || '' ;
if ( $ response !~ m/^(later|decline)$/ || ! $ self - > respond_invitation ( $ id , $ response , $ message ) ) {
return $ self - > render ( 'error' ) ;
}
$ self - > render ( 'invitation_thanks' ) ;
} ;
2014-04-03 17:42:54 +02:00
# This handler creates a new room
post '/create' = > sub {
my $ self = shift ;
2014-05-15 13:41:01 +02:00
# No name provided ? Lets generate one
2014-05-09 18:56:43 +02:00
my $ name = $ self - > param ( 'roomName' ) || $ self - > get_random_name ( ) ;
2014-05-15 13:41:01 +02:00
# Create a session for this user, but don't set a role for now
2014-04-03 17:42:54 +02:00
$ self - > login ;
2014-06-03 22:30:19 +02:00
my $ status = 'error' ;
my $ err = '' ;
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-05-15 13:41:01 +02:00
# Cleanup unused rooms before trying to create it
2014-05-06 22:05:59 +02:00
$ self - > delete_rooms ;
2014-06-03 22:30:19 +02:00
if ( ! $ self - > valid_room_name ( $ name ) ) {
$ err = 'ERROR_NAME_INVALID' ;
$ msg = $ self - > l ( 'ERROR_NAME_INVALID' ) ;
2014-04-03 17:42:54 +02:00
}
2014-06-03 22:30:19 +02:00
elsif ( $ self - > get_room ( $ name ) ) {
$ err = 'ERROR_NAME_CONFLICT' ;
$ msg = $ self - > l ( 'ERROR_NAME_CONFLICT' ) ;
}
elsif ( $ self - > create_room ( $ name , $ self - > session ( 'name' ) ) ) {
$ status = 'success' ;
2014-05-13 23:23:02 +02:00
$ self - > session ( $ name = > { role = > 'owner' } ) ;
2014-04-03 17:42:54 +02:00
}
2014-06-03 22:30:19 +02:00
$ self - > render ( json = > {
status = > $ status ,
err = > $ err ,
msg = > $ msg ,
room = > $ name
} ) ;
2014-04-03 17:42:54 +02:00
} ;
# Translation for JS resources
# As there's no way to list all the available translated strings
# JS sends us the list it wants as a JSON object
# and we sent it back once localized
post '/localize' = > sub {
my $ self = shift ;
my $ strings = Mojo::JSON - > new - > decode ( $ self - > param ( 'strings' ) ) ;
foreach my $ string ( keys %$ strings ) {
$ strings - > { $ string } = $ self - > l ( $ string ) ;
}
return $ self - > render ( json = > $ strings ) ;
} ;
2014-05-15 13:41:01 +02:00
# Route for the password page
2014-05-12 18:53:16 +02:00
get '/password/(:room)' = > sub {
my $ self = shift ;
my $ room = $ self - > stash ( 'room' ) || '' ;
my $ data = $ self - > get_room ( $ room ) ;
unless ( $ data ) {
return $ self - > render ( 'error' ,
err = > 'ERROR_ROOM_s_DOESNT_EXIST' ,
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_DOESNT_EXIST" ) , $ room ) ,
room = > $ room
) ;
}
$ self - > render ( 'password' , room = > $ room ) ;
} ;
2014-05-15 13:41:01 +02:00
# Route for password submiting
2014-05-12 18:53:16 +02:00
post '/password/(:room)' = > sub {
my $ self = shift ;
my $ room = $ self - > stash ( 'room' ) || '' ;
my $ data = $ self - > get_room ( $ room ) ;
unless ( $ data ) {
return $ self - > render ( 'error' ,
err = > 'ERROR_ROOM_s_DOESNT_EXIST' ,
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_DOESNT_EXIST" ) , $ room ) ,
room = > $ room
) ;
}
my $ pass = $ self - > param ( 'password' ) ;
2014-05-15 13:41:01 +02:00
# First check if we got the owner password, and if so, mark this user as owner
2014-05-13 19:22:47 +02:00
if ( $ data - > { owner_password } && Crypt::SaltedHash - > validate ( $ data - > { owner_password } , $ pass ) ) {
$ self - > session ( $ room = > { role = > 'owner' } ) ;
2014-05-15 16:56:14 +02:00
$ self - > redirect_to ( $ self - > get_url ( '/' ) . $ room ) ;
2014-05-13 19:22:47 +02:00
}
2014-05-15 13:41:01 +02:00
# Then, check if it's the join password
2014-05-14 09:05:00 +02:00
elsif ( $ data - > { join_password } && Crypt::SaltedHash - > validate ( $ data - > { join_password } , $ pass ) ) {
2014-05-12 18:53:16 +02:00
$ self - > session ( $ room = > { role = > 'participant' } ) ;
2014-05-15 16:56:14 +02:00
$ self - > redirect_to ( $ self - > get_url ( '/' ) . $ room ) ;
2014-05-12 18:53:16 +02:00
}
2014-05-15 13:41:01 +02:00
# Else, it's a wrong password, display an error page
2014-05-12 18:53:16 +02:00
else {
$ self - > render ( 'error' ,
err = > 'WRONG_PASSWORD' ,
msg = > sprintf ( $ self - > l ( "WRONG_PASSWORD" ) , $ room ) ,
room = > $ room
) ;
}
} ;
2014-05-15 13:41:01 +02:00
# Catch all route: if nothing else match, it's the name of a room
2014-04-03 17:42:54 +02:00
get '/(*room)' = > sub {
my $ self = shift ;
my $ room = $ self - > stash ( 'room' ) ;
2014-05-30 18:01:44 +02:00
my $ video = $ self - > param ( 'video' ) || '1' ;
2014-06-03 09:09:52 +02:00
my $ token = $ self - > param ( 'token' ) || undef ;
2014-05-07 17:17:22 +02:00
# Redirect to lower case
if ( $ room ne lc $ room ) {
2014-05-15 16:56:14 +02:00
$ self - > redirect_to ( $ self - > get_url ( '/' ) . lc $ room ) ;
2014-05-07 17:17:22 +02:00
}
2014-04-03 17:42:54 +02:00
$ self - > delete_rooms ;
2014-06-03 09:43:11 +02:00
$ self - > delete_invitations ;
2014-04-03 17:42:54 +02:00
unless ( $ self - > valid_room_name ( $ room ) ) {
2014-05-07 16:55:39 +02:00
return $ self - > render ( 'error' ,
msg = > $ self - > l ( 'ERROR_NAME_INVALID' ) ,
err = > 'ERROR_NAME_INVALID' ,
room = > $ room
) ;
2014-04-03 17:42:54 +02:00
}
my $ data = $ self - > get_room ( $ room ) ;
unless ( $ data ) {
2014-05-07 16:55:39 +02:00
return $ self - > render ( 'error' ,
err = > 'ERROR_ROOM_s_DOESNT_EXIST' ,
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_DOESNT_EXIST" ) , $ room ) ,
room = > $ room
) ;
2014-04-03 17:42:54 +02:00
}
2014-05-15 13:41:01 +02:00
# Create a session if not already done
$ self - > login ;
# If the room is locked and we're not the owner, we cannot join it !
2014-05-19 11:04:44 +02:00
if ( $ data - > { 'locked' } && ( ! $ self - > session ( $ room ) || ! $ self - > session ( $ room ) - > { role } || $ self - > session ( $ room ) - > { role } ne 'owner' ) ) {
2014-05-14 21:09:09 +02:00
return $ self - > render ( 'error' ,
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_LOCKED" ) , $ room ) ,
err = > 'ERROR_ROOM_s_LOCKED' ,
2014-05-19 11:10:12 +02:00
room = > $ room ,
ownerPass = > ( $ data - > { owner_password } ) ? '1' : '0'
2014-05-14 21:09:09 +02:00
) ;
2014-04-03 17:42:54 +02:00
}
2014-05-15 13:41:01 +02:00
# Now, if the room is password protected and we're not a participant, nor the owner, lets prompt for the password
2014-06-03 09:43:11 +02:00
# Email invitation have a token which can be used instead of password
2014-06-03 09:09:52 +02:00
if ( $ data - > { join_password } &&
( ! $ self - > session ( $ room ) || $ self - > session ( $ room ) - > { role } !~ m/^participant|owner$/ ) &&
! $ self - > check_invite_token ( $ room , $ token ) ) {
2014-05-15 16:56:14 +02:00
return $ self - > redirect_to ( $ self - > get_url ( '/password' ) . $ room ) ;
2014-05-12 18:53:16 +02:00
}
2014-05-15 13:41:01 +02:00
# Set this peer as a simple participant if he has no role yet (shouldn't happen)
2014-05-12 23:21:06 +02:00
$ self - > session ( $ room = > { role = > 'participant' } ) if ( ! $ self - > session ( $ room ) || ! $ self - > session ( $ room ) - > { role } ) ;
2014-06-12 22:52:53 +02:00
# Create etherpad session if needed
if ( $ ec && ! $ self - > session ( $ room ) - > { etherpadSession } ) {
my $ id = $ ec - > create_author_if_not_exists_for ( $ self - > session ( 'name' ) ) ;
$ self - > session ( $ room = > { etherpadAuthorId = > $ id } ) ;
my $ etherpadSession = $ ec - > create_session ( $ data - > { etherpad_group } , $ id , time + 86400 ) ;
$ self - > session ( $ room = > { etherpadSessionId = > $ etherpadSession } ) ;
$ self - > cookie ( sessionID = > $ etherpadSession ) ;
}
2014-05-15 13:41:01 +02:00
# Short life cookie to negociate a session with the signaling server
2014-05-15 16:56:14 +02:00
$ self - > cookie ( vroomsession = > encode_base64 ( $ self - > session ( 'name' ) . ':' . $ data - > { name } . ':' . $ data - > { token } , '' ) , { expires = > time + 60 , path = > '/' } ) ;
2014-04-03 17:42:54 +02:00
# Add this user to the participants table
unless ( $ self - > add_participant ( $ room , $ self - > session ( 'name' ) ) ) {
2014-05-07 16:55:39 +02:00
return $ self - > render ( 'error' ,
2014-06-02 10:40:51 +02:00
msg = > $ self - > l ( 'ERROR_OCCURRED' ) ,
err = > 'ERROR_OCCURRED' ,
2014-05-07 16:55:39 +02:00
room = > $ room
) ;
2014-04-03 17:42:54 +02:00
}
2014-05-15 13:41:01 +02:00
# Now display the room page
$ self - > render ( 'join' ,
2014-05-30 18:01:44 +02:00
moh = > $ self - > choose_moh ( ) ,
turnPassword = > $ data - > { token } ,
2014-06-08 15:38:11 +02:00
video = > $ video ,
ua = > $ self - > req - > headers - > user_agent
2014-05-15 13:41:01 +02:00
) ;
2014-04-03 17:42:54 +02:00
} ;
2014-05-15 13:41:01 +02:00
# Route for various room actions
2014-04-03 17:42:54 +02:00
post '/action' = > sub {
my $ self = shift ;
my $ action = $ self - > param ( 'action' ) ;
my $ room = $ self - > param ( 'room' ) || "" ;
2014-05-15 13:41:01 +02:00
# Refuse any action from non members of the room
2014-05-13 14:26:15 +02:00
if ( ! $ self - > session ( 'name' ) || ! $ self - > has_joined ( $ self - > session ( 'name' ) , $ room ) || ! $ self - > session ( $ room ) || ! $ self - > session ( $ room ) - > { role } ) {
2014-04-03 17:42:54 +02:00
return $ self - > render (
json = > {
2014-05-14 13:52:36 +02:00
msg = > $ self - > l ( 'ERROR_NOT_LOGGED_IN' ) ,
status = > 'error'
2014-04-03 17:42:54 +02:00
} ,
) ;
}
2014-05-15 13:41:01 +02:00
# Sanity check on the room name
return $ self - > render (
json = > {
msg = > sprintf ( $ self - > l ( "ERROR_NAME_INVALID" ) , $ room ) ,
status = > 'error'
} ,
) unless ( $ self - > valid_room_name ( $ room ) ) ;
# Push the room name to the stash, just in case
2014-04-03 17:42:54 +02:00
$ self - > stash ( room = > $ room ) ;
2014-05-15 13:41:01 +02:00
# Gather room info from the DB
2014-05-13 17:52:03 +02:00
my $ data = $ self - > get_room ( $ room ) ;
2014-05-15 13:41:01 +02:00
# Stop here if the room doesn't exist
2014-04-03 17:42:54 +02:00
return $ self - > render (
json = > {
2014-05-14 13:52:36 +02:00
msg = > sprintf ( $ self - > l ( "ERROR_ROOM_s_DOESNT_EXIST" ) , $ room ) ,
2014-05-19 11:37:40 +02:00
err = > 'ERROR_ROOM_s_DOESNT_EXIST' ,
2014-05-14 13:52:36 +02:00
status = > 'error'
2014-04-03 17:42:54 +02:00
} ,
2014-05-13 17:52:03 +02:00
) unless ( $ data ) ;
2014-04-03 17:42:54 +02:00
2014-05-15 13:41:01 +02:00
# Handle email invitation
2014-04-03 17:42:54 +02:00
if ( $ action eq 'invite' ) {
2014-05-14 13:42:40 +02:00
my $ rcpt = $ self - > param ( 'recipient' ) ;
my $ message = $ self - > param ( 'message' ) ;
2014-05-20 14:10:32 +02:00
my $ status = 'error' ;
2014-06-02 10:40:51 +02:00
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-05-22 10:23:26 +02:00
if ( ! $ self - > session ( $ room ) || $ self - > session ( $ room ) - > { role } ne 'owner' ) {
$ msg = 'NOT_ALLOWED' ;
}
elsif ( $ rcpt !~ m/\S+@\S+\.\S+$/ ) {
2014-05-20 14:10:32 +02:00
$ msg = $ self - > l ( 'ERROR_MAIL_INVALID' ) ;
}
2014-05-28 09:39:38 +02:00
else {
my $ inviteId = $ self - > add_invitation ( $ room , $ rcpt ) ;
if ( $ inviteId && $ self - > email (
header = > [
Subject = > encode ( "MIME-Header" , $ self - > l ( "EMAIL_INVITATION" ) ) ,
To = > $ rcpt
] ,
data = > [
template = > 'invite' ,
room = > $ room ,
message = > $ message ,
2014-06-03 09:43:11 +02:00
inviteId = > $ inviteId ,
joinPass = > ( $ data - > { join_password } ) ? 'yes' : 'no'
2014-05-28 09:39:38 +02:00
] ,
) ) {
$ self - > app - > log - > info ( $ self - > session ( 'name' ) . " sent an invitation for room $room to $rcpt" ) ;
$ status = 'success' ;
$ msg = sprintf ( $ self - > l ( 'INVITE_SENT_TO_s' ) , $ rcpt ) ;
}
2014-05-20 14:10:32 +02:00
}
2014-04-03 17:42:54 +02:00
$ self - > render (
json = > {
2014-05-20 14:10:32 +02:00
msg = > $ msg ,
status = > $ status
2014-04-03 17:42:54 +02:00
}
) ;
}
2014-05-15 13:41:01 +02:00
# Handle room lock/unlock
2014-05-14 20:44:52 +02:00
if ( $ action =~ m/(un)?lock/ ) {
my ( $ lock , $ success ) ;
2014-06-02 10:40:51 +02:00
my $ msg = 'ERROR_OCCURRED' ;
2014-05-14 22:14:25 +02:00
my $ status = 'error' ;
2014-05-15 13:41:01 +02:00
# Only the owner can lock or unlock a room
2014-05-14 22:14:25 +02:00
if ( ! $ self - > session ( $ room ) || $ self - > session ( $ room ) - > { role } ne 'owner' ) {
2014-05-25 01:21:14 +02:00
$ msg = $ self - > l ( 'NOT_ALLOWED' ) ;
2014-05-14 20:44:52 +02:00
}
2014-05-14 22:14:25 +02:00
elsif ( $ self - > lock_room ( $ room , ( $ action eq 'lock' ) ? '1' : '0' ) ) {
$ status = 'success' ;
2014-05-25 01:21:14 +02:00
$ msg = ( $ action eq 'lock' ) ? $ self - > l ( 'ROOM_LOCKED' ) : $ self - > l ( 'ROOM_UNLOCKED' ) ;
2014-05-14 20:44:52 +02:00
}
return $ self - > render (
json = > {
2014-05-25 01:21:14 +02:00
msg = > $ msg ,
2014-05-14 22:14:25 +02:00
status = > $ status
2014-05-14 20:44:52 +02:00
}
) ;
}
2014-05-15 13:41:01 +02:00
# Handle activity pings sent every minute by each participant
2014-04-03 17:42:54 +02:00
elsif ( $ action eq 'ping' ) {
2014-05-15 10:40:40 +02:00
my $ status = 'error' ;
2014-06-02 10:40:51 +02:00
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-04-03 17:42:54 +02:00
my $ res = $ self - > ping_room ( $ room ) ;
# Cleanup expired rooms every ~10 pings
if ( ( int ( rand 100 ) ) <= 10 ) {
$ self - > delete_rooms ;
}
2014-05-28 14:35:25 +02:00
# And same for expired invitation links
if ( ( int ( rand 100 ) ) <= 10 ) {
$ self - > delete_invitations ;
}
2014-05-15 10:40:40 +02:00
if ( $ res ) {
$ status = 'success' ;
$ msg = '' ;
2014-04-03 17:42:54 +02:00
}
2014-05-28 12:41:21 +02:00
my @ invitations = $ self - > find_invitations ( ) ;
if ( scalar @ invitations > 0 ) {
$ msg = '' ;
foreach my $ id ( @ invitations ) {
my $ invit = $ self - > get_invitation ( $ id ) ;
$ msg . = sprintf ( $ self - > l ( 'INVITE_REPONSE_FROM_s' ) , $ invit - > { email } ) . "\n" ;
if ( $ invit - > { response } && $ invit - > { response } eq 'later' ) {
$ msg . = $ self - > l ( 'HE_WILL_TRY_TO_JOIN_LATER' ) ;
}
else {
$ msg . = $ self - > l ( 'HE_WONT_JOIN' ) ;
}
if ( $ invit - > { message } && $ invit - > { message } ne '' ) {
2014-05-28 15:16:49 +02:00
$ msg . = "\n" . $ self - > l ( 'MESSAGE' ) . ":\n" . $ invit - > { message } . "\n" ;
2014-05-28 12:41:21 +02:00
}
2014-05-28 15:16:49 +02:00
$ msg . = "\n" ;
2014-05-28 12:41:21 +02:00
$ self - > processed_invitation ( $ id ) ;
}
}
2014-05-15 10:40:40 +02:00
return $ self - > render (
json = > {
2014-05-25 01:21:14 +02:00
msg = > $ msg ,
2014-05-15 10:40:40 +02:00
status = > $ status
}
) ;
2014-04-03 17:42:54 +02:00
}
2014-05-15 13:41:01 +02:00
# Handle password (join and owner)
2014-05-13 19:22:47 +02:00
elsif ( $ action eq 'setPassword' ) {
2014-05-11 22:29:40 +02:00
my $ pass = $ self - > param ( 'password' ) ;
2014-05-13 19:22:47 +02:00
my $ type = $ self - > param ( 'type' ) || 'join' ;
2014-05-15 13:41:01 +02:00
# Empty password is equivalent to no password at all
2014-05-12 22:57:15 +02:00
$ pass = undef if ( $ pass && $ pass eq '' ) ;
my $ res = undef ;
2014-06-02 10:40:51 +02:00
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-05-15 10:58:35 +02:00
my $ status = 'error' ;
2014-05-15 13:41:01 +02:00
# Once again, only the owner can do this
2014-05-12 22:57:15 +02:00
if ( $ self - > session ( $ room ) - > { role } eq 'owner' ) {
2014-05-13 19:22:47 +02:00
if ( $ type eq 'owner' ) {
2014-05-25 01:12:49 +02:00
# Forbid a few common room names to be reserved
if ( grep { $ room eq $ _ } @ { $ config - > { commonRoomNames } } ) {
2014-05-25 01:21:14 +02:00
$ msg = $ self - > l ( 'ERROR_COMMON_ROOM_NAME' ) ;
2014-05-25 01:12:49 +02:00
}
2014-05-30 13:07:12 +02:00
elsif ( $ self - > set_owner_pass ( $ room , $ pass ) ) {
$ msg = ( $ pass ) ? $ self - > l ( 'ROOM_NOW_PERSISTENT' ) : $ self - > l ( 'ROOM_NO_MORE_PERSISTENT' ) ;
$ status = 'success' ;
2014-05-25 01:12:49 +02:00
}
2014-05-13 19:22:47 +02:00
}
2014-05-30 13:07:12 +02:00
elsif ( $ type eq 'join' && $ self - > set_join_pass ( $ room , $ pass ) ) {
$ msg = ( $ pass ) ? $ self - > l ( 'PASSWORD_PROTECT_SET' ) : $ self - > l ( 'PASSWORD_PROTECT_UNSET' ) ;
2014-05-15 10:58:35 +02:00
$ status = 'success' ;
}
2014-05-12 22:57:15 +02:00
}
2014-05-15 13:41:01 +02:00
# Simple participants will get an error
2014-05-12 22:57:15 +02:00
else {
2014-05-25 01:21:14 +02:00
$ msg = $ self - > l ( 'NOT_ALLOWED' ) ;
2014-05-11 22:29:40 +02:00
}
2014-05-15 10:58:35 +02:00
return $ self - > render (
json = > {
msg = > $ msg ,
status = > $ status
}
) ;
2014-05-11 22:29:40 +02:00
}
2014-05-15 13:41:01 +02:00
# A participant is trying to auth as an owner, lets check that
2014-05-13 20:26:09 +02:00
elsif ( $ action eq 'authenticate' ) {
my $ pass = $ self - > param ( 'password' ) ;
my $ res = undef ;
2014-06-02 10:40:51 +02:00
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-05-13 20:26:09 +02:00
my $ status = 'error' ;
2014-05-15 13:41:01 +02:00
# Auth succeed ? lets promote him to owner of the room
2014-05-13 20:26:09 +02:00
if ( $ data - > { owner_password } && Crypt::SaltedHash - > validate ( $ data - > { owner_password } , $ pass ) ) {
$ self - > session ( $ room , { role = > 'owner' } ) ;
2014-05-25 01:21:14 +02:00
$ msg = $ self - > l ( 'AUTH_SUCCESS' ) ;
2014-05-13 20:26:09 +02:00
$ status = 'success' ;
}
elsif ( $ data - > { owner_password } ) {
2014-05-25 01:21:14 +02:00
$ msg = $ self - > l ( 'WRONG_PASSWORD' ) ;
2014-05-13 20:26:09 +02:00
}
2014-05-15 13:41:01 +02:00
# There's no owner password, so you cannot auth
2014-05-13 20:26:09 +02:00
else {
2014-05-25 01:21:14 +02:00
$ msg = $ self - > l ( 'NOT_ALLOWED' ) ;
2014-05-13 20:26:09 +02:00
}
return $ self - > render (
json = > {
2014-05-25 01:21:14 +02:00
msg = > $ msg ,
2014-05-13 20:26:09 +02:00
status = > $ status
} ,
) ;
}
2014-05-15 13:41:01 +02:00
# Return your role and various info about the room
2014-05-16 17:57:33 +02:00
elsif ( $ action eq 'getRoomInfo' ) {
my $ id = $ self - > param ( 'id' ) ;
my $ res = 'error' ;
2014-05-20 09:34:28 +02:00
my % emailNotif ;
2014-05-16 17:57:33 +02:00
if ( $ self - > session ( $ room ) && $ self - > session ( $ room ) - > { role } ) {
2014-06-04 16:00:29 +02:00
if ( $ self - > session ( $ room ) - > { role } ne 'owner' && $ self - > get_peer_role ( $ room , $ id ) eq 'owner' ) {
$ self - > session ( $ room ) - > { role } = 'owner' ;
}
2014-05-16 17:57:33 +02:00
$ res = ( $ self - > set_peer_role ( $ room , $ self - > session ( 'name' ) , $ id , $ self - > session ( $ room ) - > { role } ) ) ? 'success' : $ res ;
}
2014-05-20 09:34:28 +02:00
if ( $ self - > session ( $ room ) - > { role } eq 'owner' ) {
my $ i = 0 ;
my @ email = $ self - > get_notification ( $ room ) ;
% emailNotif = map { $ i = > $ email [ $ i + + ] } @ email ;
}
2014-05-13 14:26:15 +02:00
return $ self - > render (
json = > {
2014-05-14 13:42:40 +02:00
role = > $ self - > session ( $ room ) - > { role } ,
owner_auth = > ( $ data - > { owner_password } ) ? 'yes' : 'no' ,
join_auth = > ( $ data - > { join_password } ) ? 'yes' : 'no' ,
2014-05-20 09:34:28 +02:00
locked = > ( $ data - > { locked } ) ? 'yes' : 'no' ,
2014-05-21 13:52:43 +02:00
ask_for_name = > ( $ data - > { ask_for_name } ) ? 'yes' : 'no' ,
2014-05-20 09:34:28 +02:00
notif = > Mojo::JSON - > new - > encode ( { email = > { % emailNotif } } ) ,
2014-05-16 17:57:33 +02:00
status = > $ res
2014-05-13 14:26:15 +02:00
} ,
) ;
}
2014-05-16 17:57:33 +02:00
# Return the role of a peer
elsif ( $ action eq 'getPeerRole' ) {
my $ id = $ self - > param ( 'id' ) ;
my $ role = $ self - > get_peer_role ( $ room , $ id ) ;
return $ self - > render (
json = > {
role = > $ role ,
status = > 'success'
}
) ;
}
2014-05-20 09:34:28 +02:00
# Add a new email for notifications when someone joins
elsif ( $ action eq 'emailNotification' ) {
my $ email = $ self - > param ( 'email' ) ;
my $ type = $ self - > param ( 'type' ) ;
my $ status = 'error' ;
2014-06-02 10:40:51 +02:00
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-05-20 09:34:28 +02:00
if ( $ self - > session ( $ room ) - > { role } ne 'owner' ) {
2014-05-20 11:17:38 +02:00
$ msg = $ self - > l ( 'NOT_ALLOWED' ) ;
2014-05-20 09:34:28 +02:00
}
elsif ( $ email !~ m/^\S+@\S+\.\S+$/ ) {
2014-05-20 11:17:38 +02:00
$ msg = $ self - > l ( 'ERROR_MAIL_INVALID' ) ;
2014-05-20 09:34:28 +02:00
}
elsif ( $ type eq 'add' && $ self - > add_notification ( $ room , $ email ) ) {
$ status = 'success' ;
2014-05-20 11:17:38 +02:00
$ msg = sprintf ( $ self - > l ( 's_WILL_BE_NOTIFIED' ) , $ email ) ;
2014-05-20 09:34:28 +02:00
}
elsif ( $ type eq 'remove' && $ self - > remove_notification ( $ room , $ email ) ) {
$ status = 'success' ;
2014-05-20 11:17:38 +02:00
$ msg = sprintf ( $ self - > l ( 's_WONT_BE_NOTIFIED_ANYMORE' ) , $ email ) ;
2014-05-20 09:34:28 +02:00
}
return $ self - > render (
json = > {
2014-05-20 11:17:38 +02:00
msg = > $ msg ,
2014-05-20 09:34:28 +02:00
status = > $ status
}
) ;
}
2014-05-21 14:16:17 +02:00
# Set/unset askForName
elsif ( $ action eq 'askForName' ) {
my $ type = $ self - > param ( 'type' ) ;
my $ status = 'error' ;
2014-06-02 10:40:51 +02:00
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
2014-05-21 14:16:17 +02:00
if ( $ self - > session ( $ room ) - > { role } ne 'owner' ) {
$ msg = $ self - > l ( 'NOT_ALLOWED' ) ;
}
elsif ( $ type eq 'set' && $ self - > ask_for_name ( $ room , '1' ) ) {
$ status = 'success' ;
2014-05-21 17:40:25 +02:00
$ msg = $ self - > l ( 'FORCE_DISPLAY_NAME' ) ;
2014-05-21 14:16:17 +02:00
}
elsif ( $ type eq 'unset' && $ self - > ask_for_name ( $ room , '0' ) ) {
$ status = 'success' ;
$ msg = $ self - > l ( 'NAME_WONT_BE_ASKED' ) ;
}
return $ self - > render (
json = > {
msg = > $ msg ,
status = > $ status
}
) ;
}
2014-05-21 18:08:43 +02:00
# New participant joined the room
elsif ( $ action eq 'join' ) {
my $ name = $ self - > param ( 'name' ) || '' ;
2014-06-02 12:03:32 +02:00
my $ subj = ( $ name eq '' ) ? sprintf ( $ self - > l ( 's_JOINED_ROOM_s' ) , $ self - > l ( 'SOMEONE' ) , $ room ) : sprintf ( $ self - > l ( 's_JOINED_ROOM_s' ) , $ name , $ room ) ;
2014-05-21 18:08:43 +02:00
# Send notifications
foreach my $ rcpt ( $ self - > get_notification ( $ room ) ) {
$ self - > email (
header = > [
2014-06-02 12:03:32 +02:00
Subject = > encode ( "MIME-Header" , $ subj ) ,
2014-05-21 18:08:43 +02:00
To = > $ rcpt
] ,
data = > [
template = > 'notification' ,
room = > $ room ,
name = > $ name
] ,
) ;
}
return $ self - > render (
json = > {
status = > 'success'
}
) ;
}
2014-06-04 16:00:29 +02:00
# A participant is being promoted to the owner status
elsif ( $ action eq 'promote' ) {
my $ peer = $ self - > param ( 'peer' ) ;
my $ status = 'error' ;
my $ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
if ( ! $ peer ) {
$ msg = $ self - > l ( 'ERROR_OCCURRED' ) ;
}
elsif ( $ self - > session ( $ room ) - > { role } ne 'owner' ) {
$ msg = $ self - > l ( 'NOT_ALLOWED' ) ;
}
elsif ( $ self - > promote_peer ( $ room , $ peer ) ) {
$ status = 'success' ;
$ msg = $ self - > l ( 'PEER_PROMOTED' ) ;
}
return $ self - > render (
json = > {
msg = > $ msg ,
status = > $ status
}
) ;
}
2014-04-03 17:42:54 +02:00
} ;
2014-05-15 13:41:01 +02:00
# use the templates defined in the config
2014-04-03 17:42:54 +02:00
push @ { app - > renderer - > paths } , '../templates/' . $ config - > { template } ;
2014-05-15 13:41:01 +02:00
# Set the secret used to sign cookies
2014-04-03 17:42:54 +02:00
app - > secret ( $ config - > { secret } ) ;
app - > sessions - > secure ( 1 ) ;
app - > sessions - > cookie_name ( 'vroom' ) ;
2014-05-15 13:41:01 +02:00
# And start, lets VROOM !!
2014-04-03 17:42:54 +02:00
app - > start ;