GeoIP: Add lookup function for convenience
[ipfire-2.x.git] / config / cfgroot / geoip-functions.pl
1 #!/usr/bin/perl -w
2 ############################################################################
3 #                                                                          #
4 # This file is part of the IPFire Firewall.                                #
5 #                                                                          #
6 # IPFire is free software; you can redistribute it and/or modify           #
7 # it under the terms of the GNU General Public License as published by     #
8 # the Free Software Foundation; either version 2 of the License, or        #
9 # (at your option) any later version.                                      #
10 #                                                                          #
11 # IPFire is distributed in the hope that it will be useful,                #
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of           #
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            #
14 # GNU General Public License for more details.                             #
15 #                                                                          #
16 # You should have received a copy of the GNU General Public License        #
17 # along with IPFire; if not, write to the Free Software                    #
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA #
19 #                                                                          #
20 # Copyright (C) 2015 IPFire Team <info@ipfire.org>.                        #
21 #                                                                          #
22 ############################################################################
23
24 package GeoIP;
25
26 use Geo::IP::PurePerl;
27 use Locale::Codes::Country;
28
29 my $database;
30
31 sub lookup($) {
32         my $address = shift;
33
34         # Load the database into memory if not already done
35         if (!$database) {
36                 $database = Geo::IP::PurePerl->new(GEOIP_MEMORY_CACHE);
37         }
38
39         # Return the name of the country
40         return $database->country_code_by_name($address);
41 }
42
43 # Function to get the flag icon for a specified country code.
44 sub get_flag_icon($) {
45         my ($input) = @_;
46
47         # Webserver's root dir. (Required for generating full path)
48         my $webroot = "/srv/web/ipfire/html";
49
50         # Directory which contains the flag icons.
51         my $flagdir = "/images/flags";
52
53         # File extension of the country flags.
54         my $ext = "png";
55
56         # Remove whitespaces.
57         chomp($input);
58
59         # Convert given country code to upper case.
60         my $ccode = uc($input);
61
62         # Generate filename, based on the contry code in lower case
63         # and the defined file extension.
64         my $file = join('.', $ccode,$ext);
65
66         # Generate path inside webroot to the previously generated file.
67         my $flag_icon = join('/', $flagdir,$file);
68
69         # Generate absolute path to the icon file.
70         my $absolute_path = join('', $webroot,$flag_icon);
71  
72         # Check if the a icon file exists.
73         if (-e "$absolute_path") {
74                 # Return content of flag_icon.
75                 return $flag_icon;
76         } else {
77                 # If no icon for the specified country exists, try to use
78                 # the icon for "unknown".
79                 my $ccode = "unknown";
80
81                 # Redoing all the stuff from above for the "unknown" icon.
82                 my $file = join('.', $ccode, $ext);
83                 my $flag_icon = join('/', $flagdir, $file);
84                 my $absolute_path = join('', $webroot, $flag_icon);
85
86                 # Check if the icon is present.
87                 if (-e "$absolute_path") {
88                         # Return "unknown" icon.
89                         return $flag_icon;
90                 }
91         }
92 }
93
94 # Function to get the county name by a given country code.
95 sub get_full_country_name($) {
96         my ($input) = @_;
97         my $name;
98
99         # Remove whitespaces.
100         chomp($input);
101
102         # Convert input into lower case format.
103         my $code = lc($input);
104
105         # Handle country codes which are not in the list.
106         if ($code eq "a1") { $name = "Anonymous Proxy" }
107         elsif ($code eq "a2") { $name = "Satellite Provider" }
108         elsif ($code eq "o1") { $name = "Other Country" }
109         elsif ($code eq "ap") { $name = "Asia/Pacific Region" }
110         elsif ($code eq "eu") { $name = "Europe" }
111         elsif ($code eq "yu") { $name = "Yugoslavia" }
112         else {
113                 # Use perl built-in module to get the country code.
114                 $name = &Locale::Codes::Country::code2country($code);
115         }
116
117         return $name;
118 }
119
120 1;