diff options
| author | Darkelarious <darkelarious@333networks.com> | 2021-09-05 20:35:44 +0200 |
|---|---|---|
| committer | Darkelarious <darkelarious@333networks.com> | 2021-09-05 20:35:44 +0200 |
| commit | 3470e2605595bf52b3ba07bf0b3886e5a61d3e06 (patch) | |
| tree | 36e7fcf008183b464aca47b7eeba0953dd36feef /lib | |
| download | WebInterface-Perl-3470e2605595bf52b3ba07bf0b3886e5a61d3e06.tar.gz WebInterface-Perl-3470e2605595bf52b3ba07bf0b3886e5a61d3e06.zip | |
first version of masterinterface
Diffstat (limited to 'lib')
| -rwxr-xr-x | lib/MasterWebInterface/Database/Games.pm | 61 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Database/ServerInfo.pm | 40 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Database/Servers.pm | 61 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/ErrorPages.pm | 72 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/Games.pm | 142 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/Json/ApiDoc.pm | 437 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/Json/JsonServerInfo.pm | 99 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/Json/JsonServerList.pm | 95 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/Json/Motd.pm | 51 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/ServInfo.pm | 550 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Handler/Servers.pm | 180 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Util/AddressFormat.pm | 54 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Util/BrowseHTML.pm | 201 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Util/Layout.pm | 116 | ||||
| -rwxr-xr-x | lib/MasterWebInterface/Util/Misc.pm | 43 |
15 files changed, 2202 insertions, 0 deletions
diff --git a/lib/MasterWebInterface/Database/Games.pm b/lib/MasterWebInterface/Database/Games.pm new file mode 100755 index 0000000..02b6ad9 --- /dev/null +++ b/lib/MasterWebInterface/Database/Games.pm @@ -0,0 +1,61 @@ +package MasterWebInterface::Database::Games; +use strict; +use warnings; +use Exporter 'import'; +our @EXPORT = qw| dbGameListGet dbGetGameDesc |; + +# Get list of games +sub dbGameListGet +{ + my $s = shift; + my %o = ( + page => 1, + results => 50, + sort => '', + @_ + ); + + # search criteria + my %where = ( + $o{search} ? ('lower(label) LIKE lower(?)' => "%$o{search}%") : (), + !$o{all} ? ( 'num_total > ?' => 0) : (), + ); + + # what to get from db + my @select = ( + qw| label gamename num_direct num_total | + ); + + # sort order + my $order = sprintf { + label => 'label %s', + gamename => 'gamename %s', + num_total => 'num_total %s', + }->{ $o{sort}||'num_total' }, $o{reverse} ? 'DESC' : 'ASC'; + + # query + my($r, $np) = $s->dbPage( + \%o, + q| SELECT !s FROM gameinfo !W ORDER BY !s|, + join(', ', @select), + \%where, + $order + ); + + # page numbering + my $p = $s->dbAll( + q| SELECT COUNT(*) AS num FROM gameinfo !W|, + \%where, + )->[0]{num}; + + return wantarray ? ($r, $np, $p) : $r; +} + +# Get description for a game by gamename +sub dbGetGameDesc +{ + my ($self, $gn) = @_; + return $self->dbAll("SELECT label FROM gameinfo WHERE gamename = ?", $gn)->[0]{label}; +} + +1; diff --git a/lib/MasterWebInterface/Database/ServerInfo.pm b/lib/MasterWebInterface/Database/ServerInfo.pm new file mode 100755 index 0000000..6aeddd4 --- /dev/null +++ b/lib/MasterWebInterface/Database/ServerInfo.pm @@ -0,0 +1,40 @@ +package MasterWebInterface::Database::ServerInfo; +use strict; +use warnings; +use Exporter 'import'; +our @EXPORT = qw| dbGetServerInfo dbGetPlayerInfoList |; + +## get server details for list of servers (gamename/all/recent) +sub dbGetServerInfo +{ + my $s = shift; + my %o = @_; + + my %where = ( + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{port} ? ( 'queryport = ?' => $o{port}) : (), + $o{hostport} ? ( 'hostport = ?' => $o{hostport}) : (), + ); + + return $s->dbAll( q|SELECT * FROM serverlist + LEFT JOIN serverinfo ON serverlist.id = serverinfo.sid + !W LIMIT 1|, \%where ); +} + + +## get player details for one particular server +sub dbGetPlayerInfoList +{ + my $s = shift; + my %o = (sort => '', @_ ); + + my %where = ( + $o{sid} ? ( 'sid = ?' => $o{sid}) : (), + ); + + my @select = ( qw| name team frags mesh skin face ping | ); + + return $s->dbAll( q|SELECT * FROM playerinfo !W ORDER BY team, name|, \%where ); +} + +1; diff --git a/lib/MasterWebInterface/Database/Servers.pm b/lib/MasterWebInterface/Database/Servers.pm new file mode 100755 index 0000000..d02bcd7 --- /dev/null +++ b/lib/MasterWebInterface/Database/Servers.pm @@ -0,0 +1,61 @@ +package MasterWebInterface::Database::Servers; +use strict; +use warnings; +use Exporter 'import'; +our @EXPORT = qw| dbServerListGet |; + +################################################################################ +## get the serverlist +################################################################################ +sub dbServerListGet { + my $s = shift; + my %o = ( page => 1, + results => 50, + gamename => "all", + @_ + ); + + my %where = ( + # gamename and char are "all" or value + $o{gamename} !~ /all/ ? ('serverlist.gamename = ?' => $o{gamename}) : (), + $o{nolist} ? ('serverlist.gamename <> ?' => $o{nolist}) : (), + $o{search} ? ('LOWER(hostname) LIKE LOWER(?)' => "%$o{search}%") : (), + $o{gametype} ? ('LOWER(gametype) LIKE LOWER(?)' => $o{gametype}) : (), + $o{updated} ? ('dt_updated > ?' => (time-$o{updated})) : (), + ('hostport >= ?' => 0), # sanity check + ); + + my @select = ( qw| id ip hostport hostname serverlist.gamename country numplayers maxplayers maptitle mapname gametype dt_added label dt_updated| ); + + my $order = sprintf { + hostname => 'hostname %s', + gamename => 'serverlist.gamename %s, gametype', + country => 'country %s', + dt_added => 'dt_added %s', + gametype => 'gametype %s, mapname', + numplayers => 'numplayers %s, maxplayers', + maptitle => 'maptitle %s', + mapname => 'mapname %s', + }->{ $o{sort} // 'dt_added' }, $o{reverse} ? 'DESC' : 'ASC'; + + my($r, $np) = $s->dbPage(\%o, q| + SELECT !s FROM serverlist + LEFT JOIN serverinfo ON serverlist.id = serverinfo.sid + LEFT JOIN gameinfo ON serverlist.gamename = gameinfo.gamename + !W + ORDER BY !s |, + join(', ', @select), \%where, $order + ); + + my $p = $s->dbAll( q| + SELECT COUNT(*) AS num + FROM serverlist + LEFT JOIN serverinfo ON serverlist.id = serverinfo.sid + !W|, \%where, + )->[0]{num}; + return wantarray ? ($r, $np, $p) : $r; + +} + + +1; diff --git a/lib/MasterWebInterface/Handler/ErrorPages.pm b/lib/MasterWebInterface/Handler/ErrorPages.pm new file mode 100755 index 0000000..dc386fc --- /dev/null +++ b/lib/MasterWebInterface/Handler/ErrorPages.pm @@ -0,0 +1,72 @@ +package MasterWebInterface::Handler::ErrorPages; +use strict; +use TUWF ':html'; + +# handle 404 and 500 +TUWF::set( + error_404_handler => \&handle404, + error_500_handler => \&handle500, +); + +TUWF::register( + qr{500} => sub {die "Process died on purpose, but with a lot of text to test if the whole error is correctly displayed on the screen when debug information is enabled in the website configuration, "}, +); + +sub handle404 +{ + my $self = shift; + + $self->resStatus(404); + $self->htmlHeader(title => '404 - Not Found'); + $self->htmlSearchBox(title => "Servers", action => "/s", sel => 's', fq => ''); + + div class => "mainbox warning"; + div class => "header"; + h1 'Page not found'; + p "Error 404: the page could not be found."; + end; + + div class => "description"; + p; + txt 'It seems the page you were looking for does not exist,'; + br; + txt 'perhaps our search function may yield results?'; + end; + end; + end; + $self->htmlFooter; +} + +sub handle500 +{ + my($self, $error) = @_; + + $self->resStatus(500); + $self->htmlHeader(title => '500 - Internal Server Error'); + $self->htmlSearchBox(title => "Servers", action => "/s", sel => 's', fq => ''); + + div class => "mainbox warning"; + div class => "header"; + h1 'Internal Server Error'; + p "Error 500: loading this page caused an internal error."; + end; + + div class => "description"; + p; + txt 'Something went wrong on our side. The problem was logged '; + br; + txt 'and will be fixed shortly. Please try again later.'; + end; + end; + + if ($self->debug) + { + div class => "code warning"; + txt $error; + end; + } + end; + $self->htmlFooter; +} + +1; diff --git a/lib/MasterWebInterface/Handler/Games.pm b/lib/MasterWebInterface/Handler/Games.pm new file mode 100755 index 0000000..bf50655 --- /dev/null +++ b/lib/MasterWebInterface/Handler/Games.pm @@ -0,0 +1,142 @@ +package MasterWebInterface::Handler::Games; + +use strict; +use utf8; + +use TUWF ':html'; +use Exporter 'import'; + +TUWF::register( + qr{g} => \&gamelist, + qr{g(|/all)} => \&gamelist, +); + +################################################################################ +# LIST GAMES +# Generate a list of games in the database (arg: gamename) +################################################################################ +sub gamelist +{ + my ($self, $all) = @_; + + # process additional query information, such as order, sorting, page, etc + my $f = $self->formValidate( + { + get => 's', + required => 0, + default => 'num_total', + enum => [ qw| label gamename num_total | ] + }, + { + get => 'o', + required => 0, + default => 'd', + enum => [ 'a','d' ] + }, + { + get => 'p', + required => 0, + default => 1, + template => 'page' + }, + { + get => 'q', + required => 0, + default => '', + maxlength => 30 + }, + { + get => 'r', + required => 0, + default => 50, + template => 'page' + } + ); + return $self->resNotFound if $f->{_err}; + + # load server list from database + my($list, $np, $p) = $self->dbGameListGet( + sort => $f->{s}, + reverse => $f->{o} eq 'd', + page => $f->{p}, + search => $f->{q}, + results => $f->{r}, + all => $all, + + ); + + # + # page + # + + $self->htmlHeader(title => "Browse Games"); + $self->htmlSearchBox(title => "Games", action => "/g/all", sel => 'g', fq => $f->{q}); + + # + # game list + # + + # table url (full table or only active servers?) + my $url = ($all) ? "/g/all" : "/g"; + $self->htmlBrowse( + items => $list, + options => $f, + total => $p, + nextpage => [$p,$f->{r}], + pageurl => "$url?o=$f->{o};s=$f->{s};q=$f->{q}", + sorturl => "$url?q=$f->{q}", + class => "gamelist", + (! $np and ! $all or $p <= 0) ? (footer => sub + { + Tr $p % $f->{r} ? (class => 'odd') : (); + td colspan => 3, class => 'tc2'; + txt "No (more) games with active servers. Browse "; + a class => "link", href => "/g/all", "all game titles"; + txt " instead."; + end; + end 'tr'; + }) : (), + header => [ + ['Release Title', 'label' ], + ['Game', ''], + ['Servers', 'num_total' ], + ], + row => sub + { + my($s, $n, $l) = @_; + + my $gn = $l->{gamename} // ""; + my $lb = $l->{label} // ""; + + + Tr $n % 2 ? (class => 's odd') : (class => 's'); + + # label + link + td class => "tc1"; + a href => "/s/$gn", $lb; + end; + + # icon or gamename + if (-e "$self->{root}/s/icon32/$gn.png" ) + { + td class => "tc2 icon", + style => "background-image: url(/icon32/$gn.png);", + title => $gn, + ''; + } + else + { + td $gn; + } + + # number of beacons / servers + td title => ($l->{num_direct} // 0) . "/" . ($l->{num_total} // 0), + $l->{num_total} // 0; + end; + }, + ); + + $self->htmlFooter; +} + +1; diff --git a/lib/MasterWebInterface/Handler/Json/ApiDoc.pm b/lib/MasterWebInterface/Handler/Json/ApiDoc.pm new file mode 100755 index 0000000..bbfe620 --- /dev/null +++ b/lib/MasterWebInterface/Handler/Json/ApiDoc.pm @@ -0,0 +1,437 @@ +package MasterWebInterface::Handler::Json::ApiDoc; +use strict; +use TUWF ':html'; +use Exporter 'import'; +use JSON; + +TUWF::register( + qr{json} => \&json_docs, +); + +################################################################################ +# Json Documentation +# Documentation about the Json API +################################################################################ +sub json_docs +{ + my $self = shift; + $self->htmlHeader(title => "Json API"); + $self->htmlSearchBox(title => "Servers", action => "/s", sel => 'j', fq => ''); + + div class => "mainbox apidoc"; + div class => "header"; + h1 "Json API"; + p "333networks has a Json API. With this API, it is possible to obtain server lists and specific server information for your own banners, ubrowser or other application."; + end; + + # + # ToS + # + + h2 "Permission & Terms of Use"; + p; + txt "The following permissions and conditions are in effect for making use of the Json API: "; + end; + + p "You are allowed to access our API with any application and/or script, self-made or not, to obtain our server lists and server information on the condition that somewhere, anywhere in your application or script you mention that the information is obtained from 333networks."; + + p "You are not allowed to flood the API with requests or query our API continuously or with a short interval. If you draw too much network traffic from 333networks, we consider this flooding and will terminate your ability to query our API. Server information is updated every 15 minutes, there is no point in requesting information at a faster rate as there will be no new information available."; + + p "Intended use: use the serverlist request to get show a list of all servers. After loading the list, your visitors/users can select a single server to display detailed information. Do NOT use the serverlist to immediately show detailed information for ALL servers, this causes a ludicrous amount of information requests and will get you excluded from our API. Not sure whether you are doing it right? Contact us!"; + + # + # use + # + h2 "Use"; + p "The Json API consists of three functions to query for information. The methods occur over HTTP and are presented as Json data. The first function requests the \"Message of the Day\", often used to make announcements about the game. The second method returns a list of servers and can be manipulated by gamename. The third method returns detailed server information for an individual server."; + + + h2 "Message of the Day"; + p; + txt "It is possible to pull announcements from the 333networks Json API with the "; + span class => "code", "motd"; + txt " command. This command returns an html string with the current 333networks announcements for the selected "; + span class => "code", "gamename"; + txt ". This string is suitable for direct JQuery's "; + span class => "code", ".html()"; + txt " function. Additionally, it contains the amount of servers and players as described for the serverlist. This method can be used to announce service messages."; + end; + + div class => "code"; + txt "$self->{site_url}/json/(.[\\w]{1,20})/motd"; + end; + + + h2 "Serverlist"; + p "With the API you can pull a serverlist directly from the masterserver. The API applies the following regex to process your request:"; + div class => "code"; + txt "$self->{site_url}/json/(.[\\w]{1,20})"; + end; + p; + txt "In this regex, "; + span class => "code", "(.[\\w]{1,20})"; + txt " refers to the "; + span class => "ext", "gamename"; + txt ". This is the abbreviation that every game specifies in their masterserver protocol. A comprehensive list of gamenames is found on the "; + a href => "/g/all", "games"; + txt " page by looking at the last part of the URL."; + end; + + p; + txt "It is also possible to provide "; + span class => "code", "GET"; + txt " information in the url. Allowed options are:"; + end; + + ul; + li; + span class => "code", "s"; + txt " - sort by country, hostname, gametype, ip, hostport, numplayers and mapname."; + end; + li; + span class => "code", "o"; + txt " - sorting order: 'a' for ascending and 'd' for descending."; + end; + li; + span class => "code", "r"; + txt " - number of results. Defaults to 50 if not specified. Minimum 1, maximum 1000."; + end; + li; + span class => "code", "p"; + txt " - page. Show the specified page with results. Total number of entries is included in the result."; + end; + li; + span class => "code", "q"; + txt " - search query. Identical to the search query on the "; + a href => "/s", "servers"; + txt " page. Maximum query length is 90 characters."; + end; + end; + + # + # list request format + # + + h2 "Serverlist request examples:"; + p; + txt "The following examples have different outcomes. In the first example, we request a serverlist of "; + span class => "code", "all"; + txt " servers, regardless of type and/or name. The second example requests only servers of the game "; + span class => "code", "Unreal"; + txt ". In the last example, we request a serverlist with the gamename "; + span class => "code", "333networks"; + txt ", with only "; + span class => "code", "2"; + txt " results per page, page "; + span class => "code", "1"; + txt " and with the search word "; + span class => "code", "master"; + txt "."; + end; + + div class => "code"; + txt "$self->{site_url}/json/"; + span class => "ext", "all"; + br; + txt "$self->{site_url}/json/"; + span class => "ext", "unreal"; + br; + txt "$self->{site_url}/json/"; + span class => "ext", "333networks"; + txt "?r="; + span class => "ext", "2"; + txt "&p="; + span class => "ext", "1"; + txt "&q="; + span class => "ext", "master"; + end; + + h2 "Serverlist result examples:"; + p "The API returns Json data in the following format, using the third request as an example. This is example data and may vary from what you receive when performing the same query."; + + div class => "code"; + pre json_result_1(); + end; + + p; + txt "The result contains an array of server entries and the "; + span class => "code", "total"; + txt " amount of entries. In this case, that is "; + span class => "code", "2"; + txt " entries listed and "; + span class => "code", "5"; + txt " total entries, implying that there is one more server not shown or on a next page. With the specified number of results specified by the user and the total amount of servers provided by the API, you can calculate how many pages there are to be specified. If applicable, it also shows the current number of "; + span class => "code", "players"; + txt " that are currently in the selected servers. Every server entry has a number of unsorted keywords. Timestamps are linux epoch, in UTC."; + end; + + p "The available keywords that are returned by the API are: "; + div class => "code", join (" ", qw| id ip hostport hostname gamename label country numplayers maxplayers maptitle mapname gametype dt_added dt_updated|); + + p "There are more keywords available for individual servers. Detailed information about a server is obtained with the individual request as described below. Keywords of both requests are described in the tables below. "; + + + h2 "Server details"; + p "Your application or script can also request detailed information for a single server. This is done in a similar way as requesting a server list. The following general regex is used by 333networks:"; + + div class => "code"; + txt "$self->{site_url}/json/(.[\\w]{1,20})/([\\:\\.\\w]{9,35})"; + end; + + p; + txt "This restricts requests to the correct url with a gamename "; + span class => "code", "(.[\\w]{1,20})"; + txt " and an IP:port "; + span class => "code", "([\\:\\.\\w]{9,35})"; + txt " for IPv4 and IPv6 addresses and numerical port number. There are no additional query options or GET options. It is possible that the gamename specified does not match the "; + txt "gamename"; + txt " as stored in our database. The result will include the correct gamename that was specified in our database."; + end; + + p "The following example requests detailed information by IP address and hostport."; + + # + # individual server details request format + # + + h3 "Server details request:"; + div class => "code"; + txt "$self->{site_url}/json/"; + span class => "ext", "333networks"; + txt "/"; + span class => "ext", "84.83.176.234"; + txt ":"; + span class => "ext", "28900"; + end; + + h3 "Server details result:"; + p "The API returns Json data in the following format, using the requests above as an example. This is example data and may vary from what you receive when performing the same query."; + + div class => "code"; + # snippet 1, below + pre json_result_2(); + end; + + p "The result has a single entry of parameters with a number of unsorted keywords. The available keywords are in addition to the keywords are specified in multiple tables below."; + + p; + txt "The player object "; + span class => "code", "player_n"; + txt " represent the players in the server. This is a Json object as part of the larger object above. The available keywords are specified in the table below."; + end; + + h2 "Keyword reference"; + p "Values, type and descriptions of fields that are returned by the Json API:"; + + # generate reference tables + json_database_ref(); + + h2 "Feedback"; + p; + txt "We wrote the Json API with the intention to make the 333networks masterserver data as accessible as possible. If you feel like any functionality is missing or incorrectly shared, do not hesitate to contact us to provide feedback. Additionally, we request that you follow the advise on usage as we described under the Terms of Use on top of this page, so we can keep providing this API."; + end; + + end; # mainbox + $self->htmlFooter(last_change => "May 2021"); +} + +# list of value / type / descriptions directly from database +sub json_database_ref +{ + my @keyval = ( + { title => "Server identifier information", + table => [ + ["id", "int", "gameserver ID in list database"], + ["sid", "int", "reference ID for detailed information"], + ["ip", "text", "server IP address (in IPv6 format)"], + ["queryport", "int", "UDP status query port"], + ["hostport", "int", "hostport to join the server"], + ["hostname", "text", "name of the specific server"], + ["country", "text", "2-letter country code where the server is hosted"], + ["location", "text", "GameSpy regional indication (continent index or 0 for world)"], + ], + }, + { title => "Server flags \& datetime", + table => [ + ["f_protocol", "int", "protocol index to distinguish between GameSpy v0 and others"], + ["f_blacklist", "int", "server blacklisted?"], + ["f_auth", "int", "authenticated response to the secure/validate challenge?"], + ["f_direct", "int", "direct beacon to the masterserver?"], + ["dt_added", "long", "UTC epoch time that the server was added"], + ["dt_beacon", "long", "UTC epoch time that the server sent a heartbeat"], + ["dt_sync", "long", "UTC epoch time that the server was last synced from another masterserver"], + ["dt_updated", "long", "UTC epoch time that the server information was updated"], + ["dt_serverinfo", "long", "UTC epoch time that the detailed server information was updated"], + ], + }, + { title => "Gamedata", + table => [ + # gamedata + ["gamename", "text", "gamename of the server"], + ["label", "text", "comprehensible game title associated with gamename"], + ["gamever", "text", "game version of the server"], + ["minnetver", "text", "minimal required game version to join"], + ], + }, + { title => "Game settings (detailed information)", + table => [ + ["listenserver", "text", "dedicated server indication"], + ["adminname", "text", "server administrator's name"], + ["adminemail", "text", "server administrator's contact information"], + ["password", "text", "passworded or non-public server"], + ["gametype", "text", "type of game: capture the flag, deathmatch, assault and more"], + ["gamestyle", "text", "in-game playing style"], + ["changelevels", "text", "automatically change levels after match end"], + ["mapurl", "text", "direct url of the map thumbnail relative from this site's domain"], + ["mapname", "text", "filename of current map"], + ["maptitle", "text", "title or description of current map"], + ["minplayers", "int", "minimum number of players to start the game"], + ["numplayers", "int", "current number of players"], + ["maxplayers", "int", "maximum number of players simultaneously allowed on the server"], + ["botskill", "text", "skill level of bots"], + ["balanceteams", "text", "team balancing on join"], + ["playersbalanceteams", "text", "players can toggle automatic team balancing"], + ["friendlyfire", "text", "friendly fire rate"], + ["maxteams", "text", "maximum number of teams"], + ["timelimit", "text", "time limit per match"], + ["goalteamscore", "text", "score limit per match"], + ["fraglimit", "text", "score limit per deathmatch"], + ["mutators", "text", "comma-separated mutator/mod list"], + ["misc", "text", "miscellaneous server attributes (reserved)"], + ["player_#", "text", "player information as Json object for player #, see table below"], + ], + }, + { title => "Player information", + table => [ + ["sid", "int", "associated server ID (per player)"], + ["name", "text", "player display name"], + ["team", "text", "player indication as team number, color code or text string"], + ["frags", "int", "number of frags or points"], + ["mesh", "text", "player model / mesh"], + ["skin", "text", "player body texture"], + ["face", "text", "player facial texture"], + ["ping", "int", "player ping"], + ["misc", "text", "miscellaneous player attributes (reserved)"], + ["dt_player", "long", "UTC epoch time that the player information was updated"], + ], + }, + ); + + + use Data::Dumper 'Dumper'; + + for my $keytype (@keyval) + { + h3 $keytype->{title}; + table class => "keyval"; + Tr; + th class => "tc1", "Value"; + th class => "tc2", "Type"; + th "Description"; + end; + + for my $r (@{$keytype->{table}}) + { + my @tr = @{$r}; + Tr; + td class => "tc1"; + span class => "code", $tr[0]; + end; + td class => "tc2", $tr[1]; + td $tr[2]; + end; + } + end; + } +} + +# json output for example 1 +sub json_result_1 +{ + return '[ + [ + { + "id":1990, + "ip":"::ffff:84.83.176.234" + "hostport":28900, + "hostname":"master.333networks.com (333networks MasterServer)", + "gamename":"333networks", + "gametype":"MasterServer", + "label":"333networks Masterserver", + "country":"NL", + "numplayers":15, + "maxplayers":2966, + "maptitle":null, + "mapname":"333networks", + "dt_added":1616895602, + "dt_updated":1621019250, + }, + { + "id":1117, + "ip":"::ffff:162.154.33.129", + "hostport":28900 + "hostname":"master.gonespy.com", + "gamename":"333networks", + "gametype":"Masterserver", + "label":"333networks Masterserver", + "country":"US", + "numplayers":5, + "maxplayers":847, + "maptitle":"", + "mapname":"333networks", + "dt_added":1616593343, + "dt_updated":1621019247, + } + ], + { + "players":20, + "total":5 + } +]'; +} + +sub json_result_2 +{ + return '{ + "id":3, + "ip":"::ffff:45.74.100.250", + "hostport":10205, + "mapname":"DXMP_iceworld2", + "adminname":"Canna the visionary l Disciple Derp191 and RoninMastaFX", + "hostname":"~Canna\'s Buddhist Server~", + "mapurl":"/map/default/333networks.jpg", + "gamever":"1100", + "gametype":"CDX BDM", + "gamename":"deusex", + "country":"CA", + "dt_updated":1621022768, + "player_0": + { + "sid":3, + "name":"Dark191", + "team":"0", + "frags":8, + "mesh":"cmJCDenton", + "skin":"None", + "face":"" + "ping":63, + "dt_player":1621022768, + "misc":"", + }, + "player_1": + { + "sid":3, + "name":"Anya", + "team":"0", + "frags":12, + "mesh":"cmJCDenton", + "skin":"None", + "face":"" + "ping":54, + "dt_player":1621022768, + "misc":"", + }, + }'; +} + +1; diff --git a/lib/MasterWebInterface/Handler/Json/JsonServerInfo.pm b/lib/MasterWebInterface/Handler/Json/JsonServerInfo.pm new file mode 100755 index 0000000..e6f5b44 --- /dev/null +++ b/lib/MasterWebInterface/Handler/Json/JsonServerInfo.pm @@ -0,0 +1,99 @@ +package MasterWebInterface::Handler::Json::JsonServerInfo; +use strict; +use TUWF ':html'; +use Exporter 'import'; +use JSON; + +TUWF::register( + qr{json/(.[\w]{1,20})/([\:\.\w]{9,35})} => \&json_serverinfo, +); + +################################################################################ +# Server Info +# Show server info for an individual server +# Same as &server_info, but with json output. +# returns "error:1" if errors occurred +################################################################################ +sub json_serverinfo +{ + my ($self, $gamename, $s_addr, $s_port) = @_; + + # parse from ipv4/6 and soft sanity check + my ($ip, $port) = $self->from_addr_str($s_addr); + + # select server from database + my $info = $self->dbGetServerInfo( + ip => $ip, + hostport => $port, + limit => 1, + )->[0] if ($ip && $port); + + # display an error in case of an invalid IP or port + unless ($info) + { + my %err = (error => 1, ip => $ip, port => $port); + my $e = \%err; + my $json_data = encode_json $e; + my $json_data_size = keys %$e; + + # return json data as the response + print { $self->resFd() } $json_data; + + # set content type at the end + $self->resHeader("Access-Control-Allow-Origin", "*"); + $self->resHeader("Content-Type", "application/json; charset=UTF-8"); + return; + } + + # load player data if available + my %players = (); + my $pl_list = $self->dbGetPlayerInfoList(sid => $info->{id}); + + for (my $i=0; defined $pl_list->[$i]->{name}; $i++) + { + $players{"player_$i"} = $pl_list->[$i]; + } + + use Data::Dumper 'Dumper'; + my $str = Dumper $pl_list; + + # merge + #$info = { %$info, %$details } if $details; + $info = { %$info, %players } if %players; + + + # find the correct thumbnail, otherwise game default, otherwise 333 default + my $mapname = lc $info->{mapname}; + + # if map figure exists, use it + if (-e "$self->{root}/s/map/$info->{gamename}/$mapname.jpg") + { + # map image + $info->{mapurl} = "/map/$info->{gamename}/$mapname.jpg"; + } + # if not, game default image + elsif (-e "$self->{root}/s/map/default/$info->{gamename}.jpg") + { + # game image + $info->{mapurl} = "/map/default/$info->{gamename}.jpg"; + } + # otherwise 333networks default + else + { + # 333networks default + $info->{mapurl} = "/map/default/333networks.jpg"; + } + + # encode + my $json_data = encode_json $info; + my $json_data_size = keys %$info; + + # return json data as the response + print { $self->resFd() } $json_data; + + # set content type and allow off-domain access (for example jQuery) + $self->resHeader("Access-Control-Allow-Origin", "*"); + $self->resHeader("Content-Type", "application/json; charset=UTF-8"); +} + +1; diff --git a/lib/MasterWebInterface/Handler/Json/JsonServerList.pm b/lib/MasterWebInterface/Handler/Json/JsonServerList.pm new file mode 100755 index 0000000..ecd6c36 --- /dev/null +++ b/lib/MasterWebInterface/Handler/Json/JsonServerList.pm @@ -0,0 +1,95 @@ +package MasterWebInterface::Handler::Json::JsonServerList; +use strict; +use TUWF ':html'; +use Exporter 'import'; +use JSON; + +TUWF::register( + qr{json/(.[\w]{1,20})} => \&serverlist_json, + qr{json/(.[\w]{1,20})/(all|[0a-z])} => \&serverlist_json, +); + +################################################################################ +# LIST SERVERS +# Generate a list of selected games in the database per game (arg: gamename) +# Same as &serverlist, but with json output. +################################################################################ +sub serverlist_json +{ + my($self, $gamename, $char) = @_; + $gamename = "all" unless $gamename; + + # TODO DEPRECATE $char + + # sorting, page + my $f = $self->formValidate( + { + get => 's', + required => 0, + default => 'gamename', + enum => [ qw| hostname gamename country added gametype numplayers mapname | ] + }, + { + get => 'o', + required => 0, + default => 'a', + enum => [ 'a','d' ] + }, + { + get => 'p', + required => 0, + default => 1, + template => 'page', + }, + { + get => 'q', + required => 0, + default => '', + maxlength => 90 + }, + { + get => 'r', + required => 0, + default => 100, + template => 'page' + }, + { + get => 'g', + required => 0, + default => '', + maxlength => 90 + }, + ); + return $self->resNotFound if $f->{_err}; + + # load server list from database + my ( $list, $np, $p ) = $self->dbServerListGet( + sort => $f->{s}, + reverse => $f->{o} eq 'd', + gamename => $gamename, + search => $f->{q}, + page => $f->{p}, + results => $f->{r}, + updated => $self->{window_time}, + gametype => $f->{g}, # TODO: implement in DB query + ); + + # get total number of players + my $pl = 0; + for (@{$list}) + { + $pl += $_->{numplayers} + } + + # return json data as the response + my $json_data = encode_json [$list, {total => $p, players => $pl}]; + print { + $self->resFd() + } $json_data; + + # set content type and allow off-domain access (for example jQuery) + $self->resHeader("Access-Control-Allow-Origin", "*"); + $self->resHeader("Content-Type", "application/json; charset=UTF-8"); +} + +1; diff --git a/lib/MasterWebInterface/Handler/Json/Motd.pm b/lib/MasterWebInterface/Handler/Json/Motd.pm new file mode 100755 index 0000000..c473f12 --- /dev/null +++ b/lib/MasterWebInterface/Handler/Json/Motd.pm @@ -0,0 +1,51 @@ +package MasterWebInterface::Handler::Json::Motd; + +use strict; +use utf8; +use JSON; +use TUWF ':html'; +use Exporter 'import'; +our @EXPORT = qw| motd_static |; + +TUWF::register( + qr{json/(.[\w]{1,20})/motd} => \&json_motd, +); + +# Message of the Day for things like the JSON API or updateserver page +sub motd_static +{ + my ($self, $gamedesc) = @_; + return "<h1>$gamedesc</h1><p>Thank you for using the $self->{site_name} masterserver. For more information, visit <a href=\"$self->{site_url}\">$self->{site_url}</a>.</p>"; +} + +# MOTD for json api +sub json_motd +{ + my ($self, $gamename) = @_; + + # gamename defined + my $gn_desc = $self->dbGetGameDesc($gamename) || $gamename; + my $html = $self->motd_static($gn_desc); + + # get numServers + my ($l,$x,$s) = $self->dbServerListGet( + gamename => $gamename, + results => 100, + ); + + my $p = 0; + for (@{$l}) + { + $p += $_->{numplayers} + } + + # return json data as the response + my $json_data = encode_json [{motd => $html}, {total => $s, players => $p}]; + print { $self->resFd() } $json_data; + + # set content type and allow off-domain access (for example jQuery) + $self->resHeader("Access-Control-Allow-Origin", "*"); + $self->resHeader("Content-Type", "application/json; charset=UTF-8"); +} + +1; diff --git a/lib/MasterWebInterface/Handler/ServInfo.pm b/lib/MasterWebInterface/Handler/ServInfo.pm new file mode 100755 index 0000000..be30fd0 --- /dev/null +++ b/lib/MasterWebInterface/Handler/ServInfo.pm @@ -0,0 +1,550 @@ +package MasterWebInterface::Handler::ServInfo; +use strict; +use warnings; +use utf8; +use TUWF ':html'; +use POSIX 'strftime'; +use Exporter 'import'; + +TUWF::register( + qr{(.[\w]{1,20})/([\:\.\w]{9,35})} => \&show_server, +); + +################################################################################ +# Display server information +# Verify if game and server (ip:hostport) exist. Display as many available +# values as possible. +# Display error pages if not found or incorrect. +################################################################################ +sub show_server +{ + my ($self, $gamename, $s_addr) = @_; + + # parse from ipv4/6 and soft sanity check + my ($ip, $port) = $self->from_addr_str($s_addr); + + # select server from database + my $info = $self->dbGetServerInfo( + ip => $ip, + hostport => $port, + limit => 1, + )->[0]; + + # either redirect or show error when no info was found + if (!defined $info) + { + # try if query port was provided instead + my $attempt = $self->dbGetServerInfo( + ip => $ip, + port => $port, + limit => 1 + )->[0]; + + # if it exists now, automatically redirect to this page (don't show info here) + if (defined $attempt && defined $attempt->{gamename} && defined $attempt->{hostport} ) + { + $self->resRedirect("/$attempt->{gamename}/$ip:$attempt->{hostport}"); + return; + } + + # otherwise not found in database, soft error page (no 404 status) + $self->htmlHeader(title => 'Server not found'); + $self->htmlSearchBox(title => "Servers", action => "/s", sel => 's', fq => ''); + + div class => "mainbox warning"; + div class => "header"; + h1 'Server not found'; + p "The requested information is not in our database."; + end; + + div class => "description"; + p; + txt 'It seems the server you were looking for does not exist in our database,'; + br; + txt 'perhaps our search function may yield results?'; + end; + + p; + txt "You tried to access "; + span class => "hilit", $self->to_ipv4_str($s_addr) // "[no ip]"; + txt " in "; + span class => "hilit", $gamename; + txt "."; + end; + end; + end; + $self->htmlFooter; + + return; + } + + + # + # info exists. sanity checks + $gamename = $info->{gamename} // $gamename; + my $gamedescription = $self->dbGetGameDesc($info->{gamename}) // $info->{gamename}; + + # + # generate info page + $self->htmlHeader(title => $info->{hostname} // "Server"); + $self->htmlSearchBox( + title => "$gamedescription Servers", + action => "/s/$gamename", + sel => 's', + fq => '' + ); + + # serverinfo box + div class => "mainbox detail"; + + div class => "header"; + h1 title => $info->{hostname} // "[unnamed $gamename server]", + $info->{hostname} // "[unnamed $gamename server]"; + end; + + # + # Map thumbnail and bot info + # + div class => "container"; + + # find the correct thumbnail, otherwise game default, otherwise 333 default + div class => "thumbnail"; + my $mapfig = "/map/default/333networks.jpg"; + my $mapfile = lc ($info->{mapname} // ""); + + # if map figure exists, use it + if (-e "$self->{root}/s/map/$gamename/$mapfile.jpg") + { + # map image + $mapfig = "/map/$gamename/$mapfile.jpg"; + } + # if not, game default image + elsif (-e "$self->{root}/s/map/default/$gamename.jpg") + { + # game image + $mapfig = "/map/default/$gamename.jpg"; + } + # otherwise 333networks default + else + { + # 333networks default + $mapfig = "/map/default/333networks.jpg"; + } + + # map title/name (not lowercase) + my $mapname = $info->{mapname} // $info->{maptitle} // "Untitled"; + my $maptitle = ( $info->{maptitle} && lc $info->{maptitle} ne "untitled" ) + ? $info->{maptitle} + : $mapname; + + img src => $mapfig, + alt => $mapfig, + title => $mapname; + span $maptitle; + end; + + table class => "mapinfo"; + # numplayer field + Tr; + td class => "wc1", "Players:"; + td; + txt $info->{numplayers} // 0; + txt "/"; + txt $info->{maxplayers} // 0; + end; + end; + + + Tr; + td "Bots:"; + td; + if ($info->{botskill} or $info->{minplayers}) + { + txt $info->{minplayers} // 0; + txt " "; + txt $info->{botskill} // ""; + txt " bot"; + txt ($info->{minplayers} && $info->{minplayers} == 1 ? "" : "s"); + } + else + { + txt "No"; + } + end; + end; + end; #table + end; # container + + # + # specific server entry information + table class => "serverinfo"; + Tr; + th class => "wc1", title => "Server ID: " . ($info->{id} // "-1"), "Server Info"; + th ""; + end; + + # server address + Tr; + td "Address:"; + td title => $info->{queryport} // 0; + txt $self->to_ipv4_str($info->{ip}) // "0.0.0.0"; + txt ":"; + txt $info->{hostport} // 0; + end; + end; + + # contact + if ($info->{adminname}) + { + Tr; + td "Admin:"; + td $info->{adminname}; + end; + } + + # always display contact + Tr; + td class => "wc1", "Contact:"; + td; + if ($info->{adminemail}) + { + txt $info->{adminemail} + } + else + { + i; + txt "This server has no contact information listed "; + a href => "https://ut99.org/viewtopic.php?f=33&t=6660", "[?]"; + end; + } + end; + end; + + # location data + Tr; + td class => "wc1", "Location:"; + + my ($flag, $country) = $self->countryflag($info->{country} // ""); + td; + img class => "flag", src => "/flag/$flag.svg"; + txt " ". $country; + end; + end; + + # added / updated + Tr; + { + td "Added:"; + my @t = gmtime( time - ( $info->{dt_added} // 0 ) ); + my $sig = 0; + my $diff = ""; + if ($t[5]-70) + { + $diff .= $t[5]-70 + . " year" + . ( ($t[5]-70==1) ? "" : "s" ); + $sig++; + } + if ($t[7]) + { + $diff .= ($sig?", ":"") + . $t[7] + . " day" + . ( ($t[7]==1) ? "" : "s") + } + + if ($diff eq "") + { + $diff = "Less than one day"; + } + td $diff . " ago (" . (strftime "%e %b %Y", gmtime ($info->{dt_added} // 0) ) .")"; + } + end; + + Tr; + { + td "Last seen:"; + td; + my @t = gmtime( time - ( $info->{dt_updated} // 0 ) ); + if ($t[5]-70 // $t[7]) + { + # more than 1 day? show date + span class => "r", (strftime "%e %b %Y", gmtime ($info->{dt_updated} // 0) ); + } + else + { + # less than 1 day? show "time ago" + my $diff = ""; + $diff .= ($t[2] ? $t[2]." hour" . ( $t[2]>1 ? "s, " : ", ") : ""); + $diff .= ($t[1] ? $t[1]." minute". ( $t[1]>1 ? "s, " : ", ") : ""); + $diff .= ($t[0] ? $t[0]." second". ( $t[0]>1 ? "s" : " " ) : "0 seconds"); + $diff .= " ago"; + span $diff; + } + end; + } + end; + + + # TODO: move flags to header + Tr; + td "Flags: "; + td; + # uplink/sync + span title => "direct uplink or manually added?", + ($info->{f_direct} ? "💻 uplink" : "🤚 manual"); + + txt ", "; + + span title => "authenticated game server?", + ($info->{f_auth} ? "✅ authed" : "❌ insecure"); + txt ", "; + + span title => "server blacklisted for violating 333networks policy?", + ($info->{f_blacklist} ? "blacklisted" : "compliant"); + + txt ", "; + span title => "does the server require a password to join?", + ($info->{passworded} ? + ($info->{passworded} =~ /(true|1)/i ? "🔒 password" : "🔓 open") + : "🔓 open"); + end; + end; + end; # table serverinfo + + # + # Specific game and version information + table class => "gameinfo"; + Tr; + th class => "wc1", "Game Info"; + th ""; + end; + + Tr; + td "Game:"; + td; + a href => "/s/$gamename", $gamedescription; + end; + end; + if ($info->{gametype}) + { + Tr; + td "Type:"; + td $info->{gametype}; + end; + } + if ($info->{gamestyle}) + { + Tr; + td "Style:"; + td $info->{gamestyle}; + end; + } + if ($info->{gamever}) + { + Tr; + td "Version:"; + td $info->{gamever}; + end; + } + end; #gameinfo + + # + # Mutator list + table class => "mutators"; + Tr; + th "Mutators"; + end; + Tr; + td; + if (defined $info->{mutators} && $info->{mutators} ne "None") + { + txt $info->{mutators}; + } + else + { + i "This server does not have any mutators listed."; + } + end; + end; + end; #mutators + + # + # Player info + table class => "players"; + my $player = $self->dbGetPlayerInfoList(sid => $info->{id}); + my %team = (0 => "#e66", + 1 => "#66e", + 2 => "#6e6", + 3 => "#ee6", + 4 => "#fe6", + 255 => "#aaa"); + + # iterate players and colors + Tr; + th class => "wc1", 'Player Info'; + th class => "frags", 'Frags'; + th class => "mesh", 'Mesh'; + th class => "skin", 'Skin'; + th class => "ping", 'Ping'; + end; + + for (my $i = 0; defined $player->[$i]->{name}; $i++) + { + # determine teamcolor + my $teamcolor = ( defined $player->[$i]->{team} && + $player->[$i]->{team} =~ m/^([0-4]|255)$/i) + ? $team{$player->[$i]->{team}} + : "#aaa"; + + Tr $i % 2 ? (class => 'odd') : (), style => 'color:'.$teamcolor; + td class => "wc1", title => $player->[$i]->{team} // "None"; + txt $player->[$i]->{name} // "[no name]"; + if ($player->[$i]->{ngsecret} && $player->[$i]->{ngsecret} =~ m/^bot$/i) + { + txt " (bot)"; + } + end; + td class => "frags", $player->[$i]->{frags} // 0; + td class => "mesh", $player->[$i]->{mesh} // ""; + td class => "skin", $player->[$i]->{skin} // ""; + td class => "ping", $player->[$i]->{ping} // 0; + end; + } + if ( ! defined $player->[0]->{name}) + { + Tr; + td colspan => 5; + i "There is no player information available."; + end; + end; + } + end; # playerinfo + + # + # Team info + table class => "teaminfo"; + Tr; + th class => "wc1", "Team Info"; + th ""; + end; + Tr; + td "Balance Teams:"; + td ( (defined $info->{balanceteams} && + $info->{balanceteams} =~ m/true/i ) ? "Yes" : "No"); + end; + Tr; + td "Players Balance Teams:"; + td ( defined $info->{playersbalanceteams} && + $info->{playersbalanceteams} ? "Yes" : "No"); + end; + Tr; + td "Friendly Fire:"; + td ($info->{friendlyfire} // "0%"); + end; + Tr; + td "Max Teams:"; + td ($info->{maxteams} // 1); + end; + end; + + # + # Game Limits + table class => "limits"; + Tr; + th class => "wc1", "Limits"; + th ""; + end; + Tr; + td "Time Limit:"; + td (($info->{timelimit} // 0). " min"); + end; + Tr; + td "Score Limit:"; + td ($info->{goalteamscore} // 0); + end; + Tr; + td "Frag Limit:"; + td ($info->{fraglimit} // 0); + end; + end; + + # + # Share options (copy fields) + my $url = $self->{site_url} + . "/" + . $gamename + . "/" + . ( $self->to_ipv4_str($info->{ip}) // "0.0.0.0" ) + . ":" + . ($info->{hostport} // 0); + + table class => "shareopts"; + Tr; + th class => "wc1", "Share"; + th ""; + end; + Tr; + td class => "tc1", "Link"; + td class => "tc2"; + input type => 'text', + class => 'text', + name => 'url', + value => $url; + end; + end; + Tr; + td class => "tc1"; + a href => "/json", + title => "The url to access this server over the 333networks Json API", + "Json API"; + end; + td class => "tc2"; + input type => 'text', + class => 'text', + name => 'url', + value => $self->{site_url} + . "/json/" + . $gamename + . "/" + . ( $self->to_ipv4_str($info->{ip}) // "0.0.0.0" ) + . ":" + . ($info->{hostport} // 0); + end; + end; + Tr; + td "Forum Link"; + td; + textarea type => 'textarea', + class => 'text', + rows => 3, + name => 'paste'; + txt "\[url=$url\]";lit "\n"; + txt $info->{hostname} // "[unnamed $gamename server]"; + lit "\n"; + txt "\[/url\]"; + end; + end; + end; + Tr; + td "HTML Code"; + td; + textarea type => 'textarea', + class => 'text', + rows => 3, + name => 'paste'; + txt "<a href=\"$url\">"; + lit "\n"; + txt $info->{hostname} // "[unnamed $gamename server]"; + lit "\n"; + txt "</a>"; + end; + end; + end; + end; # share options + + end; # mainbox details + $self->htmlFooter; +} + +1; diff --git a/lib/MasterWebInterface/Handler/Servers.pm b/lib/MasterWebInterface/Handler/Servers.pm new file mode 100755 index 0000000..374cddf --- /dev/null +++ b/lib/MasterWebInterface/Handler/Servers.pm @@ -0,0 +1,180 @@ +package MasterWebInterface::Handler::Servers; +use strict; +use utf8; +use TUWF ':html'; +use Exporter 'import'; + +TUWF::register( + qr{} => \&serverlist, + qr{s} => \&serverlist, + qr{s/(.[\w]{1,20})} => \&serverlist, +); + +################################################################################ +# List servers +# Generate a list of selected games in the database per game (arg: gamename) +################################################################################ +sub serverlist +{ + my($self, $gamename) = @_; + $gamename = "all" unless $gamename; + + # sorting, page + my $f = $self->formValidate( + { + get => 's', + required => 0, + default => 'gamename', + enum => [ qw| hostname gamename country dt_added gametype numplayers mapname | ] + }, + { + get => 'o', + required => 0, + default => 'a', + enum => [ 'a','d' ] + }, + { + get => 'p', + required => 0, + default => 1, + template => 'page', + }, + { + get => 'q', + required => 0, + default => '', + maxlength => 90 + }, + { + get => 'r', + required => 0, + default => 50, + template => 'page' + }, + { + get => 'g', + required => 0, + default => '', + maxlength => 90 + }, + ); + return $self->resNotFound if $f->{_err}; + + # load server list from database + my ( $list, $np, $p ) = $self->dbServerListGet( + sort => $f->{s}, + reverse => $f->{o} eq 'd', + gamename => $gamename, + search => $f->{q}, + page => $f->{p}, + updated => $self->{window_time}, + results => $f->{r}, + gametype => $f->{g}, + # don't show 333networks in default list + $gamename ne "333networks" ? ( nolist => "333networks") : (), + ); + + # game name description in title + my $gn_desc = $self->dbGetGameDesc($gamename) // $gamename; + + # + # page + # + + # Write page + $self->htmlHeader(title => "Browse $gn_desc game servers"); + $self->htmlSearchBox( + title => "$gn_desc Servers", + action => "/s/$gamename", + sel => 's', + fq => $f->{q} + ); + + + # + # server list + $self->htmlBrowse( + items => $list, + options => $f, + total => $p, + nextpage => [$p,$f->{r}], + pageurl => "/s/$gamename?o=$f->{o};s=$f->{s};q=$f->{q}", + sorturl => "/s/$gamename?q=$f->{q}", + class => "serverlist", + ($p <= 0) ? (footer => sub + { + Tr; + td colspan => 6, class => 'tc2', 'No online servers found'; + end 'tr'; + }) : (), + header => [ + [ '', 'country' ], + [ 'Server Name', 'hostname' ], + [ 'Game', 'gamename' ], + [ 'Gametype', 'gametype' ], + [ 'Players', 'numplayers' ], + [ 'Map', 'mapname' ], + ], + row => sub + { + + my($s, $n, $l) = @_; + Tr $n % 2 ? (class => 's odd') : (class => 's'); + + # country flag + my ($flag, $country) = $self->countryflag($l->{country}); + td class => "tc1", + style => "background-image: url(/flag/$flag.svg);", + title => $country, + ''; + + # server name + my $ip = $self->to_ipv4_str($l->{ip}); + my $hp = $l->{hostport} // 0; + my $gn = $l->{gamename} // ""; + td class => "tc2"; + a href => "/$gn/$ip:$hp", + title => $l->{hostname} // "[unnamed $gn server]", + $l->{hostname} // "[unnamed $gn server]"; + end; + + # gamename + icon + if (-e "$self->{root}/s/icon32/$gn.png" ) + { + td class => "tc3 icon", + style => "background-image: url(/icon32/$gn.png);", + title => $l->{label}; + a href => "/s/$gn", ""; + end; + } + else + { + td $gn; + } + + # game type (CTF, DM, Masterserver, CoopGame) + td class => "tc4", + title => $l->{gametype} // "", + $l->{gametype} // ""; + + # number of players / maximum players + td class => "tc5"; + txt $l->{numplayers} // 0; + txt "/"; + txt $l->{maxplayers} // 0; + end; + + # map title/name + my $mapname = $l->{mapname} // $l->{maptitle} // ""; + my $maptitle = ( $l->{maptitle} && lc $l->{maptitle} ne "untitled" ) + ? $l->{maptitle} + : $mapname; + td class => "tc6", title => $mapname, $maptitle; + end; + }, + ); + + $self->htmlFooter; +} + +1; diff --git a/lib/MasterWebInterface/Util/AddressFormat.pm b/lib/MasterWebInterface/Util/AddressFormat.pm new file mode 100755 index 0000000..68cf82c --- /dev/null +++ b/lib/MasterWebInterface/Util/AddressFormat.pm @@ -0,0 +1,54 @@ +package MasterWebInterface::Util::AddressFormat; +use strict; +use warnings; +use TUWF ':html'; +use Exporter 'import'; +our @EXPORT = qw| from_addr_str + to_ipv4_str |; + +################################################################################ +# parse incoming addresses to IPv6 type used by MasterServer-Qt5 and port +# parses IPv4 to ::ffff:0.0.0.0 and port +# this is only a semi-sanity check -- invalid values (like port > 65535) +# are ignored since they will simply not be found in the database. +################################################################################ +sub from_addr_str { + my ($self, $str_addr) = @_; + my ($ip, $port); + + # ::ffff:127.0.0.1:7778 + if ($str_addr =~ /^::ffff:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{1,5}$/) + { + # ipv4 in ipv6 format is already in the correct format + return ($ip, $port) = $str_addr =~ m/^(::ffff:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(\d{1,5})$/; + } + + # ipv6 (without leading ::) and trailing :7778 / port + if ($str_addr =~ /^\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\d{1,5}$/) + { + # ipv6 already in the correct format + return ($ip, $port) = $str_addr =~ m/^(\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}):(\d{1,5})$/; + } + + # ipv4 (127.0.0.1:7778) + if ($str_addr =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{1,5}$/) + { + # rewrite to ::ffff:127.0.0.1 + ($ip, $port) = $str_addr =~ m/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(\d{1,5})$/; + return ("::ffff:".$ip, $port); + } + + # failure + return ("0.0.0.0", 0); +} + +# write ::ffff:0.0.0.0 to 0.0.0.0 format if possible +# return ipv6 addresses untouched +sub to_ipv4_str +{ + my ($self, $str_addr) = @_; + $str_addr =~ s/^::ffff://; + return $str_addr; +} + +1; diff --git a/lib/MasterWebInterface/Util/BrowseHTML.pm b/lib/MasterWebInterface/Util/BrowseHTML.pm new file mode 100755 index 0000000..f32e088 --- /dev/null +++ b/lib/MasterWebInterface/Util/BrowseHTML.pm @@ -0,0 +1,201 @@ +package MasterWebInterface::Util::BrowseHTML; +use strict; +use warnings; +use utf8; +use TUWF ':html', 'xml_escape'; +use Exporter 'import'; +use POSIX 'ceil'; +our @EXPORT = qw| htmlSearchBox htmlBrowse htmlBrowseNavigate |; + +# generates a search box, arguments: +# title => games/ (game) servers +# action => form action +# sel => g or s selected +# fq => form query string +sub htmlSearchBox +{ + my($self, %opt) = @_; + + div class => 'mainbox'; + div class => "header"; + h1 "Browse $opt{title}"; + p class => "alttitle", "An overview of games titles and servers that are currently online."; + end; + + # search box + form action => $opt{action}, 'accept-charset' => 'UTF-8', method => 'get'; + fieldset class => 'search'; + a href => '/g', $opt{sel} eq 'g' ? (class => 'sel') : (), 'Games'; + a href => '/s', $opt{sel} eq 's' ? (class => 'sel') : (), 'Servers'; + #a href => '/json', $opt{sel} eq 'j' ? (class => 'sel') : (), 'Json API'; + input type => 'text', name => 'q', id => 'q', class => 'text', + value => $opt{fq} || 'search...'; + input type => 'submit', class => 'submit', value => 'submit'; + end 'fieldset'; + + div class => "dropdown"; + a href => "#", onclick => "toggleAdvanced()"; + txt "advanced search "; + lit "\x{25BE}"; + end; + end; + + fieldset id => 'advancedsearch'; + #input type => 'text', name => 'aq', class => 'text', value => ''; + #input type => 'submit', class => 'submit', value => 'submit'; + txt "Patience, young one. With time, advanced search options will become available to you."; + end; + end; + + end 'div'; # mainbox +} + +# generates a browse box, arguments: +# items => arrayref with the list items +# options => hashref containing at least the keys s (sort key), o (order) and p (page) +# nextpage => whether there's a next page or not +# sorturl => base URL to append the sort options to (if there are any sortable columns) +# pageurl => base URL to append the page option to +# class => classname of the mainbox +# header => +# can be either an arrayref or subroutine reference, +# in the case of a subroutine, it will be called when the header should be written, +# in the case of an arrayref, the array should contain the header items. Each item +# can again be either an arrayref or subroutine ref. The arrayref would consist of +# two elements: the name of the header, and the name of the sorting column if it can +# be sorted +# row => subroutine ref, which is called for each item in $list, arguments will be +# $self, $item_number (starting from 0), $item_value +# footer => subroutine ref, called after all rows have been processed +# Mostly written by Yorhel --> https://g.blicky.net/vndb.git/tree/COPYING +sub htmlBrowse +{ + my($self, %opt) = @_; + + # get options + $opt{sorturl} .= $opt{sorturl} =~ /\?/ ? ';' : '?' if $opt{sorturl}; + + # top navigation + $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 't') if $opt{pageurl}; + + div class => 'mainbox browse'.($opt{class} ? ' '.$opt{class} : ''); + table class => 'stripe'; + + # header + thead; + Tr; + if(ref $opt{header} eq 'CODE') + { + $opt{header}->($self); + } + else + { + for(0..$#{$opt{header}}) + { + if(ref $opt{header}[$_] eq 'CODE') + { + $opt{header}[$_]->($self, $_+1); + } + elsif ($opt{simple}) + { + td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : (); + if($opt{header}[$_][1]) + { + lit qq|<a href="$opt{sorturl}o=d;s=$opt{header}[$_][1]">$opt{header}[$_][0]</a>|; + } + else + { + txt $opt{header}[$_][0]; + } + end; + } + else + { + td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : (); + if ( $opt{options}{s} eq $opt{header}[$_][1] ) + { # active sort + if ( $opt{options}{o} eq 'a' ) + { + a href => "$opt{sorturl}o=d;s=$opt{header}[$_][1]"; + lit $opt{header}[$_][0]; + lit " \x{25B4}"; + end; + } + else + { # eq 'd' + a href => "$opt{sorturl}o=a;s=$opt{header}[$_][1]"; + lit $opt{header}[$_][0]; + lit " \x{25BE}"; + end; + } + } + else + { # passive sort options + a href => "$opt{sorturl}o=d;s=$opt{header}[$_][1]"; + lit $opt{header}[$_][0]; + end; + } + end; + } + } + } + end; + end 'thead'; + + # footer + if($opt{footer}) + { + tfoot; + $opt{footer}->($self); + end; + } + + # rows + $opt{row}->($self, $_+1, $opt{items}[$_]) for 0..$#{$opt{items}}; + + end 'table'; + end 'div'; + + # bottom navigation + $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 'b') if $opt{pageurl}; +} + + +# creates next/previous buttons (tabs), if needed +# Arguments: page url, current page (1..n), nextpage (0/1 or [$total, $perpage]), alignment (t/b), noappend (0/1) +# Mostly written by Yorhel --> https://g.blicky.net/vndb.git/tree/COPYING +sub htmlBrowseNavigate { + my($self, $url, $p, $np, $al, $na) = @_; + my($cnt, $pp) = ref($np) ? @$np : ($p+$np, 1); + return if $p == 1 && $cnt <= $pp; + + $url .= $url =~ /\?/ ? ';p=' : '?p=' unless $na; + + my $tab = sub { + my($left, $page, $label) = @_; + li $left ? (class => 'left') : (); + a href => $url.$page; lit $label; end; + end; + }; + my $ell = sub { + li class => 'ellipsis'.(shift() ? ' left' : ''); + b '⋯'; + end; + }; + my $nc = 5; # max. number of buttons on each side + + ul class => 'maintabs browsetabs ' . ($al eq 't' ? 'notfirst' : 'bottom'); + $p > $nc and ref $np and $tab->(1, 1, '« first'); + $p > $nc and ref $np and $ell->(1); + $p > $_ and ref $np and $tab->(1, $p-$_, $p-$_) for (reverse 1..($nc>$p-1?$p-1:$nc-1)); + $p > 1 and $tab->(1, $p-1, '‹ previous'); + + my $l = ceil($cnt/$pp)-$p+1; + $l > $nc and $tab->(0, $l+$p-1, ('last').' »'); + $l > $nc and $ell->(0); + $l > $_ and $tab->(0, $p+$_, $p+$_) for (reverse 1..($nc>$l-1?$l-1:$nc-1)); + $l > 1 and $tab->(0, $p+1, ('next').' ›'); + end 'ul'; +} + +1; diff --git a/lib/MasterWebInterface/Util/Layout.pm b/lib/MasterWebInterface/Util/Layout.pm new file mode 100755 index 0000000..bf401c2 --- /dev/null +++ b/lib/MasterWebInterface/Util/Layout.pm @@ -0,0 +1,116 @@ +package MasterWebInterface::Util::Layout; +use strict; +use warnings; +use TUWF ':html'; +use Exporter 'import'; +our @EXPORT = qw| htmlHeader htmlFooter |; + +################################################################################ +# page header +# options: title, noindex +################################################################################ +sub htmlHeader +{ + my($self, %o) = @_; + + # CSS override: allow passing of style from GET --> ?style=classic + my $style = $self->{style}; + if (my $overrideStyle = $self->reqParam("style") ) + { + # default to custom style if specified option doesn't exist + $style = ( -e "$self->{root}/s/style/$overrideStyle" ) ? $overrideStyle : "basic"; + } + + html lang => "en"; + head; + title "$o{title} :: $self->{site_name} masterserver"; + Link type => 'image/x-icon', rel => 'shortcut icon', href => "/favicon.ico"; + Link type => "text/css", rel => 'stylesheet', href => "/style/$style/style.css", media => "all"; + if ( $o{noindex} ) + { + meta name => 'robots', content => 'noindex,nofollow,nosnippet,noodp,noarchive,noimageindex';end; + } + end 'head'; + + body; + + my $topbar = $self->reqParam("topbar"); + if ($topbar && lc $topbar eq "true" ) + { + # games, servers, search bar + div class => 'nav'; + # search box + form action => "/g", 'accept-charset' => 'UTF-8', method => 'get'; + fieldset class => 'search'; + p id => 'searchtabs'; + a href => '/g', class => 'sel', 'Games'; + a href => '/s', 'Servers'; + input type => 'text', name => 'q', id => 'q', class => 'text', value => ''; + input type => 'submit', class => 'submit', value => '', style => "display:none"; + end; + a style => "font-size:x-small", href => "#", "advanced search"; + end 'fieldset'; + end; + end; + } + + div id => "body"; + + # start the page content with a header logo box + div class => "titlebox"; + end; + + my $overrideStyle = $self->reqParam("style"); + if ($overrideStyle) { + # debug feature: force list of styles on floaty-box + div class => "mainbox", + style => "position:absolute; left: 20px; top: 20px; width:200px"; + + div class => "header"; + h1 "Development"; + p class => "alttitle"; + txt "This site is under development. Find "; + a href => "http://333networks.com", "333networks.com here!"; + br; + txt "Use the list below to test different house styles."; + end; + end; + + ul style => "margin: 3px 20px 10pt 40px"; + opendir(DIR, "$self->{root}/s/style") or die $!; + while (my $file = readdir(DIR)) + { + next if ($file =~ m/^\./); + li; + a href => "?style=$file", $file; + end; + } + closedir(DIR); + end; + end; + } +} + +################################################################################ +# page footer +# options: last_edited +################################################################################ +sub htmlFooter +{ + my ($self, %o) = @_; + + br style => "clear:both"; + + div id => 'footer'; + txt "$self->{site_name} | Powered by "; + a href => "http://333networks.com", "333networks"; + txt " | "; + txt $o{last_edited} || "2021"; + end; + end 'div'; # body + script type => 'text/javascript', src => "/masterscript.js", ''; + end 'body'; + end 'html'; +} + +1; diff --git a/lib/MasterWebInterface/Util/Misc.pm b/lib/MasterWebInterface/Util/Misc.pm new file mode 100755 index 0000000..f2979ea --- /dev/null +++ b/lib/MasterWebInterface/Util/Misc.pm @@ -0,0 +1,43 @@ +package MasterWebInterface::Util::Misc; +use strict; +use warnings; +use TUWF ':html'; +use POSIX 'strftime'; +use Exporter 'import'; +use Geography::Countries; +use Unicode::Normalize 'NFKD'; +our @EXPORT = qw| date_new timeformat countryflag |; + +# time formatting for when a server was added +sub date_new +{ + my ($s, $d) = @_; + return (strftime "%a %H:%M", gmtime $d); # no seconds +} + +# time formatting for when a server was added / last updated +sub timeformat +{ + my ($self, $time) = @_; + my @t = gmtime($time); + my $r = ""; + + # parse into d HH:mm:SS format + if ($t[7]){$r .= $t[7]."d "} + if ($t[2]){$r .= ($t[2] > 9) ? $t[2].":" : "0".$t[2].":" } + if ($t[1]){$r .= ($t[1] > 9) ? $t[1].":" : "0".$t[1].":" } else {$r .= "00:";} + if ($t[0]){$r .= ($t[0] > 9) ? $t[0] : "0".$t[0] } else {$r .= "00";} + + return $r; +} + +# returns flag, country name +sub countryflag +{ + my ($self, $c) = @_; + my $flag = ($c ? lc $c : 'earth'); + my $coun = $c ? ( $c eq 'EU' ? 'Europe' : country $c ) : 'Earth' ; + return $flag, $coun; +} + +1; |
