#!/usr/bin/perl

# Copyright (c) 2022 Thomas Frohwein <mail@mail.thfr.info>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;

use Fcntl qw( :flock );
use File::Spec::Functions qw( splitpath );
use IP::Country::Fast;

my ( undef, $directories, $this_script ) = splitpath( $ENV{'SCRIPT_NAME'} );
my $users_file = '/cgi-data/popcat/users.txt';
my $country_code_regex = '[A-Z]{2}';
my $gem_header_success = "20 text/gemini";

my $popcat_closed = <<"END_CLOSED";
    XX                           XX
   XXXX                         XXXX
  XXXXXX                       XXXXXX
 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
XXXX   XXXXXXXXXXXXXXXXXXXXXXX   XXXXXX
XXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXX XXX XXX XXXXXXXXXXXXXXXX 
 XXXXXXXXXXXXX       XXXXXXXXXXXXXXXX  
  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
      XXXXXXXXXXXXXXXXXXXXXXXXX
END_CLOSED

my $popcat_open = <<"END_OPEN";
    XX                           XX
   XXXX                         XXXX
 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
XXXX   XXXXXXXXXX XXXXXXXXXXXX   XXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXX           XXXXXXXXXXXXXX 
 XXXXXXXXX                XXXXXXXXXXX  
  XXXXXXX                  XXXXXXXXX
   XXXXXX                  XXXXXXXX
      XXXXX              XXXXXX
        XXXXXXXXXXXXXXXXXXXXX
END_OPEN

my ($cert_country, $prompt_country, $stored_country, $user_country);

my %country_codes = (
# A
	'AF' => 'Afghanistan',
	'AX' => 'Aland Islands',
	'AL' => 'Albania',
	'DZ' => 'Algeria',
	'AS' => 'American Samoa',
	'AD' => 'Andorra',
	'AO' => 'Angola',
	'AI' => 'Anguilla',
	'AQ' => 'Antarctica',
	'AG' => 'Antigua and Barbuda',
	'AR' => 'Argentina',
	'AM' => 'Armenia',
	'AW' => 'Aruba',
	'AU' => 'Australia',
	'AT' => 'Austria',
	'AZ' => 'Azerbaijan',
# B
	'BS' => 'Bahamas',
	'BH' => 'Bahrain',
	'BD' => 'Bangladesh',
	'BB' => 'Barbados',
	'BE' => 'Belgium',
	'BZ' => 'Belize',
	'BJ' => 'Benin',
	'BM' => 'Bermuda',
	'BT' => 'Bhutan',
	'BO' => 'Bolivia',
	'BQ' => 'Bonaire',
	'BA' => 'Bosnia and Herzegovina',
	'BW' => 'Botswana',
	'BV' => 'Bouvet Island',
	'BR' => 'Brazil',
	'IO' => 'British Indian Ocean Territory',
	'BN' => 'Brunei Darussalam',
	'BG' => 'Bulgaria',
	'BF' => 'Burkina Faso',
	'BI' => 'Burundi',
# C
	'KH' => 'Cambodia',
	'CM' => 'Cameroon',
	'CA' => 'Canada',
	'CV' => 'Cape Verde',
	'KY' => 'Cayman Islands',
	'CF' => 'Central African Republic',
	'TD' => 'Chad',
	'CL' => 'Chile',
	'CN' => 'China',
	'CX' => 'Christmas Island',
	'CC' => 'Cocos (Keeling) Islands',
	'CO' => 'Colombia',
	'KM' => 'Comoros',
	'CG' => 'Congo',
	'CD' => 'Congo, Democratic Republic of the',
	'CK' => 'Cook Islands',
	'CR' => 'Costa Rica',
	'HR' => 'Croatia',
	'CW' => 'Curacao',
	'CY' => 'Cyprus',
	'CZ' => 'Czech Republic',
# D
	'DK' => 'Denmark',
	'DJ' => 'Djibouti',
	'DM' => 'Dominica',
	'DO' => 'Dominican Republic',
# E
	'EC' => 'Ecuador',
	'EG' => 'Egypt',
	'SV' => 'El Salvador',
	'GQ' => 'Equatorial Guinea',
	'ER' => 'Eritrea',
	'EE' => 'Estonia',
	'ET' => 'Ethiopia',
# F
	'FK' => 'Falkland Islands (Malvinas)',
	'FO' => 'Faroe Islands',
	'FJ' => 'Fiji',
	'FI' => 'Finland',
	'FR' => 'France',
	'GF' => 'French Guiana',
	'PF' => 'French Polynesia',
	'TF' => 'French Southern Territories',
# G
	'GA' => 'Gabon',
	'GM' => 'Gambia',
	'GE' => 'Georgia',
	'DE' => 'Germany',
	'GH' => 'Ghana',
	'GI' => 'Gibraltar',
	'GR' => 'Greece',
	'GL' => 'Greenland',
	'GD' => 'Grenada',
	'GP' => 'Guadeloupe',
	'GU' => 'Guam',
	'GT' => 'Guatemala',
	'GG' => 'Guernsey',
	'GN' => 'Guinea',
	'GW' => 'Guinea-Bissau',
	'GY' => 'Guyana',
# H
	'HT' => 'Haiti',
	'HM' => 'Heard Island and McDonald Islands',
	'VA' => 'Holy See (Vatican City State)',
	'HN' => 'Honduras',
	'HK' => 'Hong Kong',
	'HU' => 'Hungary',
# I
	'IS' => 'Iceland',
	'IN' => 'India',
	'ID' => 'Indonesia',
	'IQ' => 'Iraq',
	'IE' => 'Ireland',
	'IM' => 'Isle of Man',
	'IL' => 'Israel',
	'IT' => 'Italy',
# J
	'JM' => 'Jamaica',
	'JP' => 'Japan',
	'JE' => 'Jersey',
	'JO' => 'Jordan',
# K
	'KZ' => 'Kazakhstan',
	'KE' => 'Kenya',
	'KI' => 'Kiribati',
	'KR' => 'Korea, Republic of',
	'KW' => 'Kuwait',
	'KG' => 'Kyrgyzstan',
# L
	'LA' => 'Lao People\'s Democratic Republic',
	'LV' => 'Latvia',
	'LB' => 'Lebanon',
	'LS' => 'Lesotho',
	'LR' => 'Liberia',
	'LY' => 'Libya',
	'LI' => 'Liechtenstein',
	'LT' => 'Lithuania',
	'LU' => 'Luxembourg',
# M
	'MO' => 'Macao',
	'MG' => 'Madagascar',
	'MW' => 'Malawi',
	'MY' => 'Malaysia',
	'MV' => 'Maldives',
	'ML' => 'Mali',
	'MT' => 'Malta',
	'MH' => 'Marshall Islands',
	'MQ' => 'Martinique',
	'MR' => 'Mauritania',
	'MU' => 'Mauritius',
	'YT' => 'Mayotte',
	'MX' => 'Mexico',
	'FM' => 'Micronesia (Federated States of)',
	'MD' => 'Moldova, Republic of',
	'MC' => 'Monaco',
	'MN' => 'Mongolia',
	'ME' => 'Montenegro',
	'MS' => 'Montserrat',
	'MA' => 'Morocco',
	'MZ' => 'Mozambique',
	'MM' => 'Myanmar',
# N
	'NA' => 'Namibia',
	'NR' => 'Nauru',
	'NP' => 'Nepal',
	'NL' => 'Netherlands',
	'NC' => 'New Caledonia',
	'NZ' => 'New Zealand',
	'NI' => 'Nicaragua',
	'NE' => 'Niger',
	'NG' => 'Nigeria',
	'NU' => 'Niue',
	'NF' => 'Norfolk Island',
	'MK' => 'North Macedonia',
	'MP' => 'Northern Mariana Islands',
	'NO' => 'Norway',
# O
	'OM' => 'Oman',
# P
	'PK' => 'Pakistan',
	'PW' => 'Palau',
	'PS' => 'Palestine, State of',
	'PA' => 'Panama',
	'PG' => 'Papua New Guinea',
	'PY' => 'Paraguay',
	'PE' => 'Peru',
	'PH' => 'Philippines',
	'PN' => 'Pitcairn',
	'PL' => 'Poland',
	'PT' => 'Portugal',
	'PR' => 'Puerto Rico',
# Q
	'QA' => 'Qatar',
# R
	'RE' => 'Reunion',
	'RO' => 'Romania',
	'RU' => 'Russion Federation',
	'RW' => 'Rwanda',
# S
	'BL' => 'Saint Barthelemy',
	'SH' => 'Saint Helena, Ascension and Tristan da Cunha',
	'KN' => 'Saint Kitts and Nevis',
	'LC' => 'Saint Lucia',
	'MF' => 'Saint Martin (French part)',
	'PM' => 'Saint Pierre and Miquelon',
	'VC' => 'Saint Vincent and the Grenadines',
	'WS' => 'Samoa',
	'SM' => 'San Marino',
	'SA' => 'Saudi Arabia',
	'SN' => 'Senegal',
	'RS' => 'Serbia',
	'SC' => 'Seychelles',
	'SL' => 'Sierra Leone',
	'SG' => 'Singapore',
	'SX' => 'Sint Maarten (Dutch part)',
	'SK' => 'Slovakia',
	'SI' => 'Slovenia',
	'SB' => 'Solomon Islands',
	'SO' => 'Somalia',
	'ZA' => 'South Africa',
	'GS' => 'South Georgia and the South Sandwich Islands',
	'SS' => 'South Sudan',
	'ES' => 'Spain',
	'LK' => 'Sri Lanka',
	'SR' => 'Suriname',
	'SJ' => 'Svalbard and Jan Mayen',
	'SE' => 'Sweden',
	'CH' => 'Switzerland',
	'ST' => 'Sao Tome and Principe',
# T
	'TW' => 'Taiwan',
	'TJ' => 'Tajikistan',
	'TZ' => 'Tanzania, United Republic of',
	'TH' => 'Thailand',
	'TG' => 'Togo',
	'TK' => 'Tokelau',
	'TO' => 'Tonga',
	'TT' => 'Trinidad and Tobago',
	'TN' => 'Tunisia',
	'TM' => 'Turkmenistan',
	'TC' => 'Turks and Caicos Islands',
	'TV' => 'Tuvalu',
# U
	'UG' => 'Uganda',
	'UA' => 'Ukraine',
	'AE' => 'United Arab Emirates',
	'GB' => 'United Kingdom',
	'US' => 'United States',
	'UM' => 'United States Minor Outlying Islands',
	'UY' => 'Uruguay',
	'UZ' => 'Uzbekistan',
# V
	'VU' => 'Vanuatu',
	'VE' => 'Venezuela',
	'VN' => 'Vietnam',
	'VG' => 'Virgin Islands, British',
	'VI' => 'Virgin Islands, U.S.',
# W
	'WF' => 'Wallis and Futuna',
	'EH' => 'Western Sahara',
# Y
	'YE' => 'Yemen',
# Z
	'ZM' => 'Zambia',
	'ZW' => 'Zimbabwe',
# Restricted (https://www.ssl.com/country-codes/)
	'CU' => 'Cuba',
	'IR' => 'Iran, Islamic Republic of',
	'KP' => 'Korea, Democratic People\'s Republic of',
	'SD' => 'Sudan',
	'SY' => 'Syrian Arab Republic',
);

sub update_file_counts {
	my ($key, $file, $array_ref) = @_;
	unless ( defined( $array_ref ) ) {	# if no array passed; define a throwaway one
		my @sub_array;
		$array_ref = \@sub_array;
	}
	my $count;

	# Lock, then read count from $file or set to 1
	open(my $fh, '+<', $file) or die "Open: $!";
	flock($fh, LOCK_EX) or die "Locking: $!";
	@$array_ref = <$fh>;
	if ( my ( $target_line ) = grep( /^\Q$key\E/, @$array_ref ) ) {
		my ($old_count) = $target_line =~ /(\d+)$/;
		($stored_country) = $target_line =~ / ($country_code_regex) /;
		$count = $old_count + 1;
		foreach (@$array_ref) {
			# update entry; add the country by selecting the appropriate one
			my $country_entry = $prompt_country || $stored_country || $cert_country || '';
			s/^\Q$key \E.*/$key $country_entry $count/;
		}
	}
	else {
		push( @$array_ref, $key . " 1\n" );	# new entry
		$count = 1;
	}

	# Write updated table to file and close
	seek($fh, 0, 0)			or die "Seeking: $!";
	print $fh @$array_ref		or die "Printing: $!";
	truncate($fh, tell($fh))	or die "Truncating: $!";
	flock($fh, LOCK_UN)		or die "Cannot unlock file - $!";
	close $fh			or die "Closing: $!";

	return $count;
}

# If no client certificate, prompt for one.
unless ( $ENV{'TLS_CLIENT_HASH'} ) {
	print "60 Enter country code when generating the client certificate to participate in country statistics\r\n";
	exit;
}

# if "$this_script?country_list", list countries with link to prompt
if ( $ENV{'QUERY_STRING'} eq 'country_list' ) {
	print "$gem_header_success\r\n";
	print "# Select country for POPCAT statistics\n";
	foreach my $c (sort { $country_codes{$a} cmp $country_codes{$b} } keys %country_codes) {
		print "=> $this_script?country=$c $country_codes{$c} ($c)\n";
	}
	exit;
}

# if "$this_script?country=XX", set $prompt_country
# check if country code is valid, otherwise don't set $prompt_country
my ($country_candidate) = $ENV{'QUERY_STRING'} =~ /^country=($country_code_regex)$/;
if ( $country_candidate and $country_codes{$country_candidate} ) {
	$prompt_country = $country_candidate;
}

($cert_country) = ( $ENV{'TLS_CLIENT_ISSUER'} =~ m|/C=($country_code_regex)| );

# get counts
my @users;
my $user_count = update_file_counts( $ENV{'TLS_CLIENT_HASH'}, $users_file, \@users );

$user_country = $prompt_country || $stored_country || $cert_country || '<None>';;

# calculate country counts
my %country_counts;
foreach my $user_line ( @users ) {
	my ($country) = $user_line =~ / ($country_code_regex) /;
	my ($count) = $user_line =~ /(\d+)$/;
	unless ($country) { $country = '<None>'; }

	# update count for $country (initialize if doesn't exist)
	unless ( $country_counts{$country} ) {
		$country_counts{$country} = 0;
	}
	$country_counts{$country} += $count;
}
my $user_country_count = $country_counts{$user_country};

print "$gem_header_success\r\n";
print '# ' . uc( $this_script ) . "\n";
print "```\n";

my $line_length = 39;		# longest line in the ascii art popcat_open/closed
my $count_length = length($user_count);
my $padding = int( ( $line_length - $count_length ) / 2 );
print ' ' x $padding . "$user_count\n\n";
if ( $user_count % 2 ) {
	print $popcat_closed;
}
else {
	print $popcat_open;
}

print "```\n";


if ( $user_country eq '<None>' ) {
	my $ip_country = IP::Country::Fast->new()->inet_atocc( $ENV{'REMOTE_ADDR'} );

	print "\n### Select your country to continue\n";
	if ( $country_codes{$ip_country} ) {
		print "=> $this_script?country=$ip_country POP! for $country_codes{$ip_country}!\n";
	}
	print "=> $this_script?country_list POP! and choose country...\n";
}
else {
	print "=> $this_script POP!\n";
}
print "\n";

# Statistics
my $worldwide = 0;
foreach my $c (values %country_counts) {
	$worldwide += $c;
}
print "Worldwide: $worldwide\n";
if ( $user_country eq '<None>' ) {
	print "$user_country: $user_country_count\n";
}
else{
	print "$country_codes{$user_country}: $user_country_count\n";
	print "=> $this_script?country_list (change country)\n";
}

print "## Country Leaderboard\n";

foreach my $cc (sort { $country_counts{$b} <=> $country_counts{$a} } keys %country_counts) {
	if ( $cc eq '<None>' ) {
		print "$cc: $country_counts{$cc}\n";
	}
	else {
		print "$country_codes{$cc}: $country_counts{$cc}\n";
	}
}

print "\n=> /cgi-source/$this_script View $this_script Source Code\n";