#!/usr/bin/perl # Copyright (c) 2022 Thomas Frohwein # # 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 || '';; # 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 = ''; } # 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 '' ) { 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 '' ) { 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 '' ) { 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"; gemini://thfr.info/cgi-source/popcat.cgi

-- Leo's gemini proxy

-- Connecting to thfr.info:1965...

-- Connected

-- Sending request

-- Meta line: 20 text/plain

-- Response ended

-- Page fetched on Sat May 18 17:13:12 2024