From 87ec28a2e973dced42da81efa7624bcf0ff0cc85 Mon Sep 17 00:00:00 2001 From: pabloconcepcion Date: Thu, 4 Mar 2010 09:24:52 +0000 Subject: [PATCH] =?UTF-8?q?2010-03-04=20=20Pablo=20de=20la=20Concepci?= =?UTF-8?q?=C3=B3n=20?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lib/PandoraFMS/Server.pm: Added spaces between server name and server type on the event generation string. * lib/PandoraFMS/GeoIP.pm: MaxMind GeoIP PurePerl GPL library to access reverse geoip data. * lib/PandoraFMS/GIS.pm: Modified to use GeoIP.pm * lib/PandoraFMS/DataServer.pm: Moved log line in case parent_agent_name is not defined git-svn-id: https://svn.code.sf.net/p/pandora/code/trunk@2463 c3f86ba8-e40f-0410-aaad-9ba5e7f4b01f --- pandora_server/ChangeLog | 13 + pandora_server/lib/PandoraFMS/DataServer.pm | 2 +- pandora_server/lib/PandoraFMS/GIS.pm | 7 +- pandora_server/lib/PandoraFMS/GeoIP.pm | 891 ++++++++++++++++++++ pandora_server/lib/PandoraFMS/Server.pm | 4 +- 5 files changed, 912 insertions(+), 5 deletions(-) create mode 100644 pandora_server/lib/PandoraFMS/GeoIP.pm diff --git a/pandora_server/ChangeLog b/pandora_server/ChangeLog index 71e0e4c332..8a62fb09dd 100644 --- a/pandora_server/ChangeLog +++ b/pandora_server/ChangeLog @@ -1,3 +1,16 @@ +2010-03-04 Pablo de la Concepción + + * lib/PandoraFMS/Server.pm: Added spaces between server name and server + type on the event generation string. + + * lib/PandoraFMS/GeoIP.pm: MaxMind GeoIP PurePerl GPL library to access + reverse geoip data. + + * lib/PandoraFMS/GIS.pm: Modified to use GeoIP.pm + + * lib/PandoraFMS/DataServer.pm: Moved log line in case parent_agent_name + is not defined + 2010-03-03 Ramon Novoa * lib/PandoraFMS/Core.pm: Added 'matches_value' support to 'onchange' diff --git a/pandora_server/lib/PandoraFMS/DataServer.pm b/pandora_server/lib/PandoraFMS/DataServer.pm index d078ba4c44..55671dbeb3 100644 --- a/pandora_server/lib/PandoraFMS/DataServer.pm +++ b/pandora_server/lib/PandoraFMS/DataServer.pm @@ -170,8 +170,8 @@ sub process_xml_data ($$$$$) { if ($parent_id < 1) { # Unknown parent $parent_id = 0; } - } logger($pa_config,"Parent_agent_name: $parent_agent_name parent_id: $parent_id",10); + } my $valid_position_data = 1; diff --git a/pandora_server/lib/PandoraFMS/GIS.pm b/pandora_server/lib/PandoraFMS/GIS.pm index dd5cc1c6b6..b34bd90af3 100644 --- a/pandora_server/lib/PandoraFMS/GIS.pm +++ b/pandora_server/lib/PandoraFMS/GIS.pm @@ -59,7 +59,7 @@ use PandoraFMS::DB; use PandoraFMS::Tools; # TODO:Test if is instaled -my $geoIPPurePerlavilable= (eval 'use Geo::IP::PurePerl; 1') ? 1 : 0; +my $geoIPPurePerlavilable= (eval 'use PandoraFMS::GeoIP; 1') ? 1 : 0; require Exporter; @@ -180,9 +180,12 @@ sub get_reverse_geoip_file($$) { my $geoipdb = Geo::IP::PurePerl->open( $pa_config->{'recon_reverse_geolocation_file'}); if (defined($geoipdb)) { my $region_info = $geoipdb->get_city_record_as_hash($ip_addr); - logger($pa_config, "Region info found for IP '$ip_addr' is: country:".$region_info->{'country_name'}." region:".$region_info->{'region'}." city:".$region_info->{'city'}." longitude:".$region_info->{'longitude'}." latitude:".$region_info->{'longitude'}, 8); + logger($pa_config, "Region info found for IP '$ip_addr' is: country:".$region_info->{'country_name'}." region:".$region_info->{'region'}." city:".$region_info->{'city'}." longitude:".$region_info->{'longitude'}." latitude:".$region_info->{'latitude'}, 8); return $region_info; } + else { + logger($pa_config, "WARNING: Can't open reverse geolocation file ($pa_config->{'recon_reverse_geolocation_file'}) :$!",8); + } } return undef; diff --git a/pandora_server/lib/PandoraFMS/GeoIP.pm b/pandora_server/lib/PandoraFMS/GeoIP.pm new file mode 100644 index 0000000000..c8547ef367 --- /dev/null +++ b/pandora_server/lib/PandoraFMS/GeoIP.pm @@ -0,0 +1,891 @@ +package Geo::IP::PurePerl; + +use strict; +use FileHandle; +use File::Spec; + +BEGIN { + if ( $] >= 5.008 ) { + require Encode; + Encode->import(qw/ decode /); + } + else { + *decode = sub { + local $_ = $_[1]; + use bytes; + s/([\x80-\xff])/my $c = ord($1); + my $p = $c >= 192 ? 1 : 0; + pack ( 'CC' => 0xc2 + $p , $c & ~0x40 ); /ge; + return $_; + }; + } +}; + + +use vars qw( @ISA $VERSION @EXPORT $OPEN_TYPE_PATH ); + +use constant GEOIP_CHARSET_ISO_8859_1 => 0; +use constant GEOIP_CHARSET_UTF8 => 1; + +use constant FULL_RECORD_LENGTH => 50; +use constant GEOIP_COUNTRY_BEGIN => 16776960; +use constant RECORD_LENGTH => 3; +use constant GEOIP_STATE_BEGIN_REV0 => 16700000; +use constant GEOIP_STATE_BEGIN_REV1 => 16000000; +use constant STRUCTURE_INFO_MAX_SIZE => 20; +use constant DATABASE_INFO_MAX_SIZE => 100; +use constant GEOIP_COUNTRY_EDITION => 1; +use constant GEOIP_REGION_EDITION_REV0 => 7; +use constant GEOIP_REGION_EDITION_REV1 => 3; +use constant GEOIP_CITY_EDITION_REV0 => 6; +use constant GEOIP_CITY_EDITION_REV1 => 2; +use constant GEOIP_ORG_EDITION => 5; +use constant GEOIP_ISP_EDITION => 4; +use constant GEOIP_PROXY_EDITION => 8; +use constant GEOIP_ASNUM_EDITION => 9; +use constant GEOIP_NETSPEED_EDITION => 10; +use constant GEOIP_DOMAIN_EDITION => 11; +use constant SEGMENT_RECORD_LENGTH => 3; +use constant STANDARD_RECORD_LENGTH => 3; +use constant ORG_RECORD_LENGTH => 4; +use constant MAX_RECORD_LENGTH => 4; +use constant MAX_ORG_RECORD_LENGTH => 300; +use constant US_OFFSET => 1; +use constant CANADA_OFFSET => 677; +use constant WORLD_OFFSET => 1353; +use constant FIPS_RANGE => 360; + +$VERSION = '1.24'; + +require Exporter; +@ISA = qw(Exporter); + +# cheat --- try to load Sys::Mmap +BEGIN { + eval { + # wrap into eval again, as workaround for centos / mod_perl issue + # seems they use $@ without eval somewhere + + eval "require Sys::Mmap" + ? Sys::Mmap->import + : do { + for (qw/ PROT_READ MAP_PRIVATE MAP_SHARED /) { + no strict 'refs'; + my $unused_stub = $_; # we must use a copy + *$unused_stub = sub { die 'Sys::Mmap required for mmap support' }; + } # for + }; # do + 1; + }; # eval +} # begin + + +sub GEOIP_STANDARD(){0;} +sub GEOIP_MEMORY_CACHE(){1;} + +#sub GEOIP_CHECK_CACHE(){2;} +#sub GEOIP_INDEX_CACHE(){4;} +sub GEOIP_MMAP_CACHE(){8;} + +sub GEOIP_UNKNOWN_SPEED(){0;} +sub GEOIP_DIALUP_SPEED(){1;} +sub GEOIP_CABLEDSL_SPEED(){2;} +sub GEOIP_CORPORATE_SPEED(){3;} + +@EXPORT = qw( GEOIP_STANDARD GEOIP_MEMORY_CACHE GEOIP_MMAP_CACHE + GEOIP_UNKNOWN_SPEED GEOIP_DIALUP_SPEED GEOIP_CABLEDSL_SPEED GEOIP_CORPORATE_SPEED ); +my @countries = +(undef,"AP","EU","AD","AE","AF","AG","AI","AL","AM","AN","AO","AQ","AR","AS","AT","AU","AW","AZ","BA","BB","BD","BE","BF","BG","BH","BI","BJ","BM","BN","BO","BR","BS","BT","BV","BW","BY","BZ","CA","CC","CD","CF","CG","CH","CI","CK","CL","CM","CN","CO","CR","CU","CV","CX","CY","CZ","DE","DJ","DK","DM","DO","DZ","EC","EE","EG","EH","ER","ES","ET","FI","FJ","FK","FM","FO","FR","FX","GA","GB","GD","GE","GF","GH","GI","GL","GM","GN","GP","GQ","GR","GS","GT","GU","GW","GY","HK","HM","HN","HR","HT","HU","ID","IE","IL","IN","IO","IQ","IR","IS","IT","JM","JO","JP","KE","KG","KH","KI","KM","KN","KP","KR","KW","KY","KZ","LA","LB","LC","LI","LK","LR","LS","LT","LU","LV","LY","MA","MC","MD","MG","MH","MK","ML","MM","MN","MO","MP","MQ","MR","MS","MT","MU","MV","MW","MX","MY","MZ","NA","NC","NE","NF","NG","NI","NL","NO","NP","NR","NU","NZ","OM","PA","PE","PF","PG","PH","PK","PL","PM","PN","PR","PS","PT","PW","PY","QA","RE","RO","RU","RW","SA","SB","SC","SD","SE","SG","SH","SI","SJ","SK","SL","SM","SN","SO","SR","ST","SV","SY","SZ","TC","TD","TF","TG","TH","TJ","TK","TM","TN","TO","TL","TR","TT","TV","TW","TZ","UA","UG","UM","US","UY","UZ","VA","VC","VE","VG","VI","VN","VU","WF","WS","YE","YT","RS","ZA","ZM","ME","ZW","A1","A2","O1","AX","GG","IM","JE","BL","MF"); +my @code3s = ( undef,"AP","EU","AND","ARE","AFG","ATG","AIA","ALB","ARM","ANT","AGO","AQ","ARG","ASM","AUT","AUS","ABW","AZE","BIH","BRB","BGD","BEL","BFA","BGR","BHR","BDI","BEN","BMU","BRN","BOL","BRA","BHS","BTN","BV","BWA","BLR","BLZ","CAN","CC","COD","CAF","COG","CHE","CIV","COK","CHL","CMR","CHN","COL","CRI","CUB","CPV","CX","CYP","CZE","DEU","DJI","DNK","DMA","DOM","DZA","ECU","EST","EGY","ESH","ERI","ESP","ETH","FIN","FJI","FLK","FSM","FRO","FRA","FX","GAB","GBR","GRD","GEO","GUF","GHA","GIB","GRL","GMB","GIN","GLP","GNQ","GRC","GS","GTM","GUM","GNB","GUY","HKG","HM","HND","HRV","HTI","HUN","IDN","IRL","ISR","IND","IO","IRQ","IRN","ISL","ITA","JAM","JOR","JPN","KEN","KGZ","KHM","KIR","COM","KNA","PRK","KOR","KWT","CYM","KAZ","LAO","LBN","LCA","LIE","LKA","LBR","LSO","LTU","LUX","LVA","LBY","MAR","MCO","MDA","MDG","MHL","MKD","MLI","MMR","MNG","MAC","MNP","MTQ","MRT","MSR","MLT","MUS","MDV","MWI","MEX","MYS","MOZ","NAM","NCL","NER","NFK","NGA","NIC","NLD","NOR","NPL","NRU","NIU","NZL","OMN","PAN","PER","PYF","PNG","PHL","PAK","POL","SPM","PCN","PRI","PSE","PRT","PLW","PRY","QAT","REU","ROU","RUS","RWA","SAU","SLB","SYC","SDN","SWE","SGP","SHN","SVN","SJM","SVK","SLE","SMR","SEN","SOM","SUR","STP","SLV","SYR","SWZ","TCA","TCD","TF","TGO","THA","TJK","TKL","TKM","TUN","TON","TLS","TUR","TTO","TUV","TWN","TZA","UKR","UGA","UM","USA","URY","UZB","VAT","VCT","VEN","VGB","VIR","VNM","VUT","WLF","WSM","YEM","YT","SRB","ZAF","ZMB","MNE","ZWE","A1","A2","O1","ALA","GGY","IMN","JEY","BLM","MAF"); +my @names = (undef,"Asia/Pacific Region","Europe","Andorra","United Arab Emirates","Afghanistan","Antigua and Barbuda", + "Anguilla","Albania","Armenia","Netherlands Antilles","Angola","Antarctica","Argentina","American Samoa", + "Austria","Australia","Aruba","Azerbaijan","Bosnia and Herzegovina","Barbados","Bangladesh","Belgium","Burkina Faso", + "Bulgaria","Bahrain","Burundi","Benin","Bermuda","Brunei Darussalam","Bolivia","Brazil","Bahamas","Bhutan","Bouvet Island", + "Botswana","Belarus","Belize","Canada","Cocos (Keeling) Islands","Congo, The Democratic Republic of the","Central African Republic", + "Congo","Switzerland","Cote D'Ivoire","Cook Islands","Chile","Cameroon","China","Colombia","Costa Rica","Cuba","Cape Verde", + "Christmas Island","Cyprus","Czech Republic","Germany","Djibouti","Denmark","Dominica","Dominican Republic","Algeria","Ecuador", + "Estonia","Egypt","Western Sahara","Eritrea","Spain","Ethiopia","Finland","Fiji","Falkland Islands (Malvinas)", + "Micronesia, Federated States of","Faroe Islands","France","France, Metropolitan","Gabon","United Kingdom","Grenada","Georgia", + "French Guiana","Ghana","Gibraltar","Greenland","Gambia","Guinea","Guadeloupe","Equatorial Guinea","Greece", + "South Georgia and the South Sandwich Islands","Guatemala","Guam","Guinea-Bissau","Guyana","Hong Kong", + "Heard Island and McDonald Islands","Honduras","Croatia","Haiti","Hungary","Indonesia","Ireland","Israel","India", + "British Indian Ocean Territory","Iraq","Iran, Islamic Republic of","Iceland","Italy","Jamaica","Jordan","Japan","Kenya", + "Kyrgyzstan","Cambodia","Kiribati","Comoros","Saint Kitts and Nevis","Korea, Democratic People's Republic of","Korea, Republic of", + "Kuwait","Cayman Islands","Kazakhstan","Lao People's Democratic Republic","Lebanon","Saint Lucia","Liechtenstein","Sri Lanka", + "Liberia","Lesotho","Lithuania","Luxembourg","Latvia","Libyan Arab Jamahiriya","Morocco","Monaco","Moldova, Republic of", + "Madagascar","Marshall Islands","Macedonia","Mali","Myanmar","Mongolia","Macau","Northern Mariana Islands","Martinique", + "Mauritania","Montserrat","Malta","Mauritius","Maldives","Malawi","Mexico","Malaysia","Mozambique","Namibia","New Caledonia", + "Niger","Norfolk Island","Nigeria","Nicaragua","Netherlands","Norway","Nepal","Nauru","Niue","New Zealand","Oman","Panama","Peru", + "French Polynesia","Papua New Guinea","Philippines","Pakistan","Poland","Saint Pierre and Miquelon","Pitcairn Islands","Puerto Rico", + "Palestinian Territory","Portugal","Palau","Paraguay","Qatar","Reunion","Romania","Russian Federation","Rwanda","Saudi Arabia", + "Solomon Islands","Seychelles","Sudan","Sweden","Singapore","Saint Helena","Slovenia","Svalbard and Jan Mayen","Slovakia","Sierra Leone", + "San Marino","Senegal","Somalia","Suriname","Sao Tome and Principe","El Salvador","Syrian Arab Republic","Swaziland", + "Turks and Caicos Islands","Chad","French Southern Territories","Togo","Thailand","Tajikistan","Tokelau","Turkmenistan","Tunisia", + "Tonga","Timor-Leste","Turkey","Trinidad and Tobago","Tuvalu","Taiwan","Tanzania, United Republic of","Ukraine","Uganda", + "United States Minor Outlying Islands","United States","Uruguay","Uzbekistan","Holy See (Vatican City State)", + "Saint Vincent and the Grenadines","Venezuela","Virgin Islands, British","Virgin Islands, U.S.","Vietnam","Vanuatu", + "Wallis and Futuna","Samoa","Yemen","Mayotte","Serbia","South Africa","Zambia","Montenegro","Zimbabwe","Anonymous Proxy", + "Satellite Provider","Other","Aland Islands","Guernsey","Isle of Man","Jersey","Saint Barthelemy","Saint Martin"); + + +# --- unfortunately we do not know the path so we assume the +# default path /usr/local/share/GeoIP +# if thats not true, you can set $Geo::IP::PurePerl::OPEN_TYPE_PATH +# +sub open_type { + my ( $class, $type, $flags ) = @_; + my %type_dat_name_mapper = ( + GEOIP_COUNTRY_EDITION() => 'GeoIP', + GEOIP_REGION_EDITION_REV0() => 'GeoIPRegion', + GEOIP_REGION_EDITION_REV1() => 'GeoIPRegion', + GEOIP_CITY_EDITION_REV0() => 'GeoIPCity', + GEOIP_CITY_EDITION_REV1() => 'GeoIPCity', + GEOIP_ISP_EDITION() => 'GeoIPISP', + GEOIP_ORG_EDITION() => 'GeoIPOrg', + GEOIP_PROXY_EDITION() => 'GeoIPProxy', + GEOIP_ASNUM_EDITION() => 'GeoIPASNum', + GEOIP_NETSPEED_EDITION() => 'GeoIPNetSpeed', + GEOIP_DOMAIN_EDITION() => 'GeoIPDomain', + ); + + # backward compatibility for 2003 databases. + $type -= 105 if $type >= 106; + + my $name = $type_dat_name_mapper{$type}; + die("Invalid database type $type\n") unless $name; + + my $mkpath = sub { File::Spec->catfile( File::Spec->rootdir, @_ ) }; + + my $path = + defined $Geo::IP::PurePerl::OPEN_TYPE_PATH + ? $Geo::IP::PurePerl::OPEN_TYPE_PATH + : do { + $^O eq 'NetWare' + ? $mkpath->(qw/ etc GeoIP /) + : do { + $^O eq 'MSWin32' + ? $mkpath->(qw/ GeoIP /) + : $mkpath->(qw/ usr local share GeoIP /); + } + }; + + my $filename = File::Spec->catfile( $path, $name . '.dat' ); + return $class->open( $filename, $flags ); +} + + +sub open { + die "Geo::IP::PurePerl::open() requires a path name" + unless( @_ > 1 and $_[1] ); + my ($class, $db_file, $flags) = @_; + my $fh = FileHandle->new; + my $gi; + CORE::open $fh, $db_file or die "Error opening $db_file"; + binmode($fh); + if ( $flags && ( $flags & ( GEOIP_MEMORY_CACHE | GEOIP_MMAP_CACHE ) ) ) { + my %self; + + if ( $flags & GEOIP_MMAP_CACHE ) { + die "Sys::Mmap required for MMAP support" + unless defined $Sys::Mmap::VERSION; + mmap( $self{buf} = undef, 0, PROT_READ, MAP_PRIVATE, $fh ) + or die "mmap: $!"; + } + else { + local $/ = undef; + $self{buf} = <$fh>; + } + $self{fh} = $fh; + $gi = bless \%self, $class; + } + else { + $gi = bless { fh => $fh }, $class; + } + $gi->_setup_segments(); + return $gi; +} + +sub new { + my ($class, $db_file, $flags) = @_; + # this will be less messy once deprecated new( $path, [$flags] ) + # is no longer supported (that's what open() is for) + + my $def_db_file = '/usr/local/share/GeoIP/GeoIP.dat'; + if ($^O eq 'NetWare') { + $def_db_file = 'sys:/etc/GeoIP/GeoIP.dat'; + } elsif ($^O eq 'MSWin32') { + $def_db_file = 'c:/GeoIP/GeoIP.dat'; + } + if ( !defined $db_file ) { + # called as new() + $db_file = $def_db_file; + } elsif ( $db_file =~ /^\d+$/ ) { + # db_file is GEOIP_MEMORY_CACHE or GEOIP_STANDARD + # called as new( $flags ) + $flags = $db_file; + $db_file = $def_db_file; + } # else called as new( $database_filename, [$flags] ); + + $class->open( $db_file, $flags ); +} + +#this function setups the database segments +sub _setup_segments { + my ($gi) = @_; + my $a = 0; + my $i = 0; + my $j = 0; + my $delim; + my $buf; + $gi->{_charset} = GEOIP_CHARSET_ISO_8859_1; + $gi->{"databaseType"} = GEOIP_COUNTRY_EDITION; + $gi->{"record_length"} = STANDARD_RECORD_LENGTH; + + my $filepos = tell($gi->{fh}); + seek($gi->{fh}, -3, 2); + for ($i = 0; $i < STRUCTURE_INFO_MAX_SIZE; $i++) { + read($gi->{fh},$delim,3); + + #find the delim + if ($delim eq (chr(255).chr(255).chr(255))) { + read($gi->{fh},$a,1); + + #read the databasetype + $gi->{"databaseType"} = ord($a); + + # backward compatibility for 2003 databases. + $gi->{databaseType} -= 105 if $gi->{databaseType} >= 106; + + #chose the database segment for the database type + #if database Type is GEOIP_REGION_EDITION then use database segment GEOIP_STATE_BEGIN + if ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV0) { + $gi->{"databaseSegments"} = GEOIP_STATE_BEGIN_REV0; + } elsif ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV1) { + $gi->{"databaseSegments"} = GEOIP_STATE_BEGIN_REV1; + } + + #if database Type is GEOIP_CITY_EDITION, GEOIP_ISP_EDITION or GEOIP_ORG_EDITION then + #read in the database segment + elsif (($gi->{"databaseType"} == GEOIP_CITY_EDITION_REV0) || + ($gi->{"databaseType"} == GEOIP_CITY_EDITION_REV1) || + ($gi->{"databaseType"} == GEOIP_ORG_EDITION) || + ($gi->{"databaseType"} == GEOIP_ASNUM_EDITION) || + ($gi->{"databaseType"} == GEOIP_ISP_EDITION)) { + $gi->{"databaseSegments"} = 0; + + #read in the database segment for the database type + read($gi->{fh},$buf,SEGMENT_RECORD_LENGTH); + for ($j = 0;$j < SEGMENT_RECORD_LENGTH;$j++) { + $gi->{"databaseSegments"} += (ord(substr($buf,$j,1)) << ($j * 8)); + } + + #record length is four for ISP databases and ORG databases + #record length is three for country databases, region database and city databases + if ($gi->{"databaseType"} == GEOIP_ORG_EDITION || + $gi->{"databaseType"} == GEOIP_ISP_EDITION) { + $gi->{"record_length"} = ORG_RECORD_LENGTH; + } + } + last; + } else { + seek($gi->{fh}, -4 , 1); + } + } + #if database Type is GEOIP_COUNTY_EDITION then use database segment GEOIP_COUNTRY_BEGIN + if ($gi->{"databaseType"} == GEOIP_COUNTRY_EDITION || + $gi->{"databaseType"} == GEOIP_NETSPEED_EDITION) { + $gi->{"databaseSegments"} = GEOIP_COUNTRY_BEGIN; + } + seek($gi->{fh},$filepos,0); + return $gi; +} + +sub _seek_country { + my ($gi, $ipnum) = @_; + + my $fh = $gi->{fh}; + my $offset = 0; + + my ($x0, $x1); + + my $reclen = $gi->{"record_length"}; + + for (my $depth = 31; $depth >= 0; $depth--) { + unless ( exists $gi->{buf} ) { + seek $fh, $offset * 2 * $reclen, 0; + read $fh, $x0, $reclen; + read $fh, $x1, $reclen; + } else { + + $x0 = substr($gi->{buf}, $offset * 2 * $reclen, $reclen); + $x1 = substr($gi->{buf}, $offset * 2 * $reclen + $reclen, $reclen); + } + + $x0 = unpack("V1", $x0."\0"); + $x1 = unpack("V1", $x1."\0"); + + if ($ipnum & (1 << $depth)) { + if ($x1 >= $gi->{"databaseSegments"}) { + $gi->{last_netmask} = 32 - $depth; + return $x1; + } + $offset = $x1; + } else { + if ($x0 >= $gi->{"databaseSegments"}) { + $gi->{last_netmask} = 32 - $depth; + return $x0; + } + $offset = $x0; + } + } + + print STDERR "Error Traversing Database for ipnum = $ipnum - Perhaps database is corrupt?"; +} +sub charset { + return $_[0]->{_charset}; +} + +sub set_charset{ + my ( $gi, $charset ) = @_; + my $old_charset = $gi->{_charset}; + $gi->{_charset} = $charset; + + return $old_charset; +} + +#this function returns the country code of ip address +sub country_code_by_addr { + my ($gi, $ip_address) = @_; + return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; + return $countries[$gi->id_by_addr($ip_address)]; +} + +#this function returns the country code3 of ip address +sub country_code3_by_addr { + my ($gi, $ip_address) = @_; + return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; + return $code3s[$gi->id_by_addr($ip_address)]; +} + +#this function returns the name of ip address +sub country_name_by_addr { + my ($gi, $ip_address) = @_; + return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; + return $names[$gi->id_by_addr($ip_address)]; +} + +sub id_by_addr { + my ($gi, $ip_address) = @_; + return unless $ip_address =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!; + return $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_COUNTRY_BEGIN; +} + +#this function returns the country code of domain name +sub country_code_by_name { + my ($gi, $host) = @_; + my $country_id = $gi->id_by_name($host); + return $countries[$country_id]; +} + +#this function returns the country code3 of domain name +sub country_code3_by_name { + my ($gi, $host) = @_; + my $country_id = $gi->id_by_name($host); + return $code3s[$country_id]; +} + +#this function returns the country name of domain name +sub country_name_by_name { + my ($gi, $host) = @_; + my $country_id = $gi->id_by_name($host); + return $names[$country_id]; +} + +sub id_by_name { + my ($gi, $host) = @_; + my $ip_address; + if ($host =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!) { + $ip_address = $host; + } else { + $ip_address = join('.',unpack('C4',(gethostbyname($host))[4])); + } + return unless $ip_address; + return $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_COUNTRY_BEGIN; +} + +#this function returns the city record as a array +sub get_city_record { + my ($gi, $host) = @_; + my $ip_address = $gi->get_ip_address($host); + return unless $ip_address; + my $record_buf; + my $record_buf_pos; + my $char; + my $metroarea_combo; + my $record_country_code = ""; + my $record_country_code3 = ""; + my $record_country_name = ""; + my $record_region = ""; + my $record_city = ""; + my $record_postal_code = ""; + my $record_latitude = ""; + my $record_longitude = ""; + my $record_metro_code = ""; + my $record_area_code = ""; + my $str_length = 0; + my $i; + my $j; + + #lookup the city + my $seek_country = $gi->_seek_country(addr_to_num($ip_address)); + if ($seek_country == $gi->{"databaseSegments"}) { + return; + } + #set the record pointer to location of the city record + my $record_pointer = $seek_country + (2 * $gi->{"record_length"} - 1) * $gi->{"databaseSegments"}; + + unless ( exists $gi->{buf} ) { + seek( $gi->{"fh"}, $record_pointer, 0 ); + read( $gi->{"fh"}, $record_buf, FULL_RECORD_LENGTH ); + $record_buf_pos = 0; + } + else { + $record_buf = substr($gi->{buf}, $record_pointer, FULL_RECORD_LENGTH); + $record_buf_pos = 0; + } + + #get the country + $char = ord(substr($record_buf,$record_buf_pos,1)); + $record_country_code = $countries[$char];#get the country code + $record_country_code3 = $code3s[$char];#get the country code with 3 letters + $record_country_name = $names[$char];#get the country name + $record_buf_pos++; + + #get the region + $char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); + while ($char != 0) { + $str_length++;#get the length of string + $char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); + } + if ($str_length > 0) { + $record_region = substr($record_buf,$record_buf_pos,$str_length); + } + $record_buf_pos += $str_length + 1; + $str_length = 0; + + #get the city + $char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); + while ($char != 0) { + $str_length++;#get the length of string + $char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); + } + if ($str_length > 0) { + $record_city = substr($record_buf,$record_buf_pos,$str_length); + } + $record_buf_pos += $str_length + 1; + $str_length = 0; + + #get the postal code + $char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); + while ($char != 0) { + $str_length++;#get the length of string + $char = ord(substr($record_buf,$record_buf_pos+$str_length,1)); + } + if ($str_length > 0) { + $record_postal_code = substr($record_buf,$record_buf_pos,$str_length); + } + $record_buf_pos += $str_length + 1; + $str_length = 0; + my $latitude = 0; + my $longitude = 0; + + #get the latitude + for ($j = 0;$j < 3; ++$j) { + $char = ord(substr($record_buf,$record_buf_pos++,1)); + $latitude += ($char << ($j * 8)); + } + $record_latitude = ($latitude/10000) - 180; + + #get the longitude + for ($j = 0;$j < 3; ++$j) { + $char = ord(substr($record_buf,$record_buf_pos++,1)); + $longitude += ($char << ($j * 8)); + } + $record_longitude = ($longitude/10000) - 180; + + #get the metro code and the area code + if (GEOIP_CITY_EDITION_REV1 == $gi->{"databaseType"}) { + $metroarea_combo = 0; + if ($record_country_code eq "US") { + #if the country is US then read the metro area combo + for ($j = 0;$j < 3;++$j) { + $char = ord(substr($record_buf,$record_buf_pos++,1)); + $metroarea_combo += ($char << ($j * 8)); + } + #split the metro area combo into the metro code and the area code + $record_metro_code = int($metroarea_combo/1000); + $record_area_code = $metroarea_combo%1000; + } + } + + # the pureperl API must convert the string by themself to UTF8 + # using Encode for perl >= 5.008 otherwise use it's own iso-8859-1 to utf8 converter + $record_city = decode( 'iso-8859-1' => $record_city ) + if $gi->charset == GEOIP_CHARSET_UTF8; + + return ($record_country_code,$record_country_code3,$record_country_name,$record_region,$record_city,$record_postal_code,$record_latitude,$record_longitude,$record_metro_code,$record_area_code); +} + +#this function returns the city record as a hash ref +sub get_city_record_as_hash { + my ($gi, $host) = @_; + my %h; + @h{qw/ country_code country_code3 country_name + region city postal_code + latitude longitude metro_code + area_code /} + = $gi->get_city_record($host); + $h{dma_code} = $h{metro_code}; # alias for depreciated dma_code + return \%h; +} + +#this function returns isp or org of the domain name +sub org_by_name { + my ($gi, $host) = @_; + my $ip_address = $gi->get_ip_address($host); + my $seek_org = $gi->_seek_country(addr_to_num($ip_address)); + my $char; + my $org_buf; + my $org_buf_length = 0; + my $record_pointer; + + if ($seek_org == $gi->{"databaseSegments"}) { + return undef; + } + + $record_pointer = $seek_org + (2 * $gi->{"record_length"} - 1) * $gi->{"databaseSegments"}; + + unless ( exists $gi->{buf} ) { + seek( $gi->{"fh"}, $record_pointer, 0 ); + read( $gi->{"fh"}, $org_buf, MAX_ORG_RECORD_LENGTH ); + } + else { + $org_buf = substr($gi->{buf}, $record_pointer, MAX_ORG_RECORD_LENGTH ); + } + + $char = ord(substr($org_buf,0,1)); + while ($char != 0) { + $org_buf_length++; + $char = ord(substr($org_buf,$org_buf_length,1)); + } + + $org_buf = substr($org_buf, 0, $org_buf_length); + return $org_buf; +} + +#this function returns isp or org of the domain name +*isp_by_name = \*org_by_name; + +*org_by_addr = \*org_by_name; +*isp_by_addr = \*org_by_name; + +#this function returns the region +sub region_by_name { + my ($gi, $host) = @_; + my $ip_address = $gi->get_ip_address($host); + return unless $ip_address; + if ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV0) { + my $seek_region = $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_STATE_BEGIN_REV0; + if ($seek_region >= 1000) { + return ("US",chr(($seek_region - 1000)/26 + 65) . chr(($seek_region - 1000)%26 + 65)); + } else { + return ($countries[$seek_region],""); + } + } elsif ($gi->{"databaseType"} == GEOIP_REGION_EDITION_REV1) { + my $seek_region = $gi->_seek_country(addr_to_num($ip_address)) - GEOIP_STATE_BEGIN_REV1; + if ($seek_region < US_OFFSET) { + return ("",""); + } elsif ($seek_region < CANADA_OFFSET) { + # return a us state + return ("US",chr(($seek_region - US_OFFSET)/26 + 65) . chr(($seek_region - US_OFFSET)%26 + 65)); + } elsif ($seek_region < WORLD_OFFSET) { + # return a canada province + return ("CA",chr(($seek_region - CANADA_OFFSET)/26 + 65) . chr(($seek_region - CANADA_OFFSET)%26 + 65)); + } else { + # return a country of the world + my $c = $countries[($seek_region - WORLD_OFFSET) / FIPS_RANGE]; + my $a2 = ($seek_region - WORLD_OFFSET) % FIPS_RANGE; + my $r = chr(($a2 / 100)+48) . chr((($a2 / 10) % 10)+48) . chr(($a2 % 10)+48); + return ($c,$r); + } + } +} + +sub get_ip_address { + my ($gi, $host) = @_; + my $ip_address; + #check if host is ip address + if ($host =~ m!^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$!) { + #host is ip address + $ip_address = $host; + } else { + #host is domain name do a dns lookup + $ip_address = join('.',unpack('C4',(gethostbyname($host))[4])); + } + return $ip_address; +} + +sub addr_to_num { unpack( N => pack( C4 => split( /\./, $_[0] ) ) ) } +sub num_to_addr { join q{.}, unpack( C4 => pack( N => $_[0] ) ) } + +sub database_info { + my $gi = shift; + my $i = 0; + my $buf; + my $retval; + my $hasStructureInfo; + seek($gi->{fh},-3,2); + for (my $i = 0;$i < STRUCTURE_INFO_MAX_SIZE;$i++) { + read($gi->{fh},$buf,3); + if ($buf eq (chr(255) . chr(255) . chr(255))) { + $hasStructureInfo = 1; + last; + } + seek($gi->{fh},-4,1); + } + if ($hasStructureInfo == 1) { + seek($gi->{fh},-6,1); + } else { + # no structure info, must be pre Sep 2002 database, go back to + seek($gi->{fh},-3,2); + } + for (my $i = 0;$i < DATABASE_INFO_MAX_SIZE;$i++){ + read($gi->{fh},$buf,3); + if ($buf eq (chr(0). chr(0). chr(0))){ + read($gi->{fh},$retval,$i); + return $retval; + } + seek($gi->{fh},-4,1); + } + return ""; +} + +sub range_by_ip { + my $gi = shift; + my $ipnum = addr_to_num( shift ); + my $c = $gi->_seek_country( $ipnum ); + my $nm = $gi->last_netmask; + my $m = 0xffffffff << 32 - $nm; + my $left_seek_num = $ipnum & $m; + my $right_seek_num = $left_seek_num + ( 0xffffffff & ~$m ); + + while ( $left_seek_num != 0 + and $c == $gi->_seek_country( $left_seek_num - 1) ) { + my $lm = 0xffffffff << 32 - $gi->last_netmask; + $left_seek_num = ( $left_seek_num - 1 ) & $lm; + } + while ( $right_seek_num != 0xffffffff + and $c == $gi->_seek_country( $right_seek_num + 1 ) ) { + my $rm = 0xffffffff << 32 - $gi->last_netmask; + $right_seek_num = ( $right_seek_num + 1 ) & $rm; + $right_seek_num += ( 0xffffffff & ~$rm ); + } + return ( num_to_addr($left_seek_num), num_to_addr($right_seek_num) ); +} + +sub netmask { $_[0]->{last_netmask} = $_[1] } + +sub last_netmask { + return $_[0]->{last_netmask}; +} + +sub DESTROY { + my $gi = shift; + + if ( exists $gi->{buf} && $gi->{flags} && ( $gi->{flags} & GEOIP_MMAP_CACHE ) ) { + munmap( $gi->{buf} ) or die "munmap: $!"; + delete $gi->{buf}; + } +} +1; +__END__ + +=head1 NAME + +Geo::IP::PurePerl - Look up country by IP Address + +=head1 SYNOPSIS + + use Geo::IP::PurePerl; + + my $gi = Geo::IP::PurePerl->new(GEOIP_STANDARD); + + # look up IP address '24.24.24.24' + my $country = $gi->country_code_by_addr('24.24.24.24'); + $country = $gi->country_code_by_name('yahoo.com'); + # $country is equal to "US" + +=head1 DESCRIPTION + +This module uses a file based database. This database simply contains +IP blocks as keys, and countries as values. This database is more +complete and accurate than reverse DNS lookups. + +This module can be used to automatically select the geographically closest mirror, +to analyze your web server logs +to determine the countries of your visiters, for credit card fraud +detection, and for software export controls. + +=head1 IP ADDRESS TO COUNTRY DATABASES + +The database is available for free, updated monthly: + + http://www.maxmind.com/download/geoip/database/ + +This free database is similar to the database contained in IP::Country, +as well as many paid databases. It uses ARIN, RIPE, APNIC, and LACNIC +whois to obtain the IP->Country mappings. + +If you require greater accuracy, MaxMind offers a paid database +on a paid subscription basis from http://www.maxmind.com/app/country + +=head1 CLASS METHODS + +=over 4 + +=item $gi = Geo::IP->new( [$flags] ); + +Constructs a new Geo::IP object with the default database located inside your system's +I, typically I. + +Flags can be set to either GEOIP_STANDARD, or for faster performance +(at a cost of using more memory), GEOIP_MEMORY_CACHE. +The default flag is GEOIP_STANDARD (uses less memory, but runs slower). + +=item $gi = Geo::IP->new( $database_filename ); + +Calling the C constructor in this fashion was was deprecated after version +0.26 in order to make the XS and pure perl interfaces more similar. Use the +C constructor (below) if you need to specify a path. Eventually, this +means of calling C will no longer be supported. + +Flags can be set to either GEOIP_STANDARD, or for faster performance +(at a cost of using more memory), GEOIP_MEMORY_CACHE. + +=item $gi = Geo::IP->open( $database_filename, [$flags] ); + +Constructs a new Geo::IP object with the database located at C<$database_filename>. +The default flag is GEOIP_STANDARD (uses less memory, but runs slower). + +=back + +=head1 OBJECT METHODS + +=over 4 + +=item $code = $gi->country_code_by_addr( $ipaddr ); + +Returns the ISO 3166 country code for an IP address. + +=item $code = $gi->country_code_by_name( $ipname ); + +Returns the ISO 3166 country code for a hostname. + +=item $code = $gi->country_code3_by_addr( $ipaddr ); + +Returns the 3 letter country code for an IP address. + +=item $code = $gi->country_code3_by_name( $ipname ); + +Returns the 3 letter country code for a hostname. + +=item $name = $gi->country_name_by_addr( $ipaddr ); + +Returns the full country name for an IP address. + +=item $name = $gi->country_name_by_name( $ipname ); + +Returns the full country name for a hostname. + +=item $info = $gi->database_info; + +Returns database string, includes version, date, build number and copyright notice. + +=item $old_charset = $gi->set_charset( $charset ); + +Set the charset for the city name - defaults to GEOIP_CHARSET_ISO_8859_1. To +set UTF8, pass GEOIP_CHARSET_UTF8 to set_charset. + +=item $charset = $gi->charset; + +Gets the currently used charset. + +=item $netmask = $gi->last_netmask; + +Gets netmask of network block from last lookup. + +=item $gi->netmask(12); + +Sets netmask for the last lookup + +=item my ( $from, $to ) = $gi->range_by_ip('24.24.24.24'); + +Returns the start and end of the current network block. The method tries to join several continous netblocks. + +=item @data = $gi->get_city_record( $addr ); + + Returns a array filled with information about the city. + + my ($country_code,$country_code3,$country_name,$region,$city,$postal_code,$latitude,$longitude,$metro_code,$area_code ) = $gi->get_city_record($addr); + +=item $href = get_city_record_as_hash( $addr ); + + Returns a hashref filled with information about the city. + + my $href = $gi->get_city_record_as_hash($addr); + +The hash include the following keys: +country_code, country_code3, country_name, region, city, postal_code, latitude, longitude, metro_code, area_code + +=item $gi->isp_by_addr($addr) + + Returns the isp name for an ipaddress + +=item $gi->isp_by_name($name) + + Returns the isp name for a hostname + +=item $gi->org_by_addr($addr) + + Returns the organisation name for an ipaddress + +=item $gi->org_by_name($name) + + Returns the organisation name for a hostname + +=back + +=head1 MAILING LISTS AND CVS + +Are available from SourceForge, see +http://sourceforge.net/projects/geoip/ + +=head1 VERSION + +1.23 + +=head1 SEE ALSO + +Geo::IP - this now has the PurePerl code merged it, so it supports +both XS and Pure Perl implementations. The XS implementation is +a wrapper around the GeoIP C API, which is much faster than the +Pure Perl API. + +=head1 AUTHOR + +Copyright (c) 2008 MaxMind Inc + +All rights reserved. This package is free software; it is licensed +under the GPL. + +=cut diff --git a/pandora_server/lib/PandoraFMS/Server.pm b/pandora_server/lib/PandoraFMS/Server.pm index b9176cfaf9..d20929ca1c 100644 --- a/pandora_server/lib/PandoraFMS/Server.pm +++ b/pandora_server/lib/PandoraFMS/Server.pm @@ -217,7 +217,7 @@ sub upEvent ($) { my $self = shift; return unless defined ($self->{'_dbh'}); - pandora_event ($self->{'_pa_config'}, $self->{'_pa_config'}->{'servername'} . + pandora_event ($self->{'_pa_config'}, $self->{'_pa_config'}->{'servername'} .' '. $ServerTypes[$self->{'_server_type'}] . ' going UP', 0, 0, 3, 0, 0, 'system', 0, $self->{'_dbh'}); } @@ -229,7 +229,7 @@ sub downEvent ($) { my $self = shift; return unless defined ($self->{'_dbh'}); - pandora_event ($self->{'_pa_config'}, $self->{'_pa_config'}->{'servername'} . + pandora_event ($self->{'_pa_config'}, $self->{'_pa_config'}->{'servername'} .' '. $ServerTypes[$self->{'_server_type'}] . ' going DOWN', 0, 0, 4, 0, 0, 'system', 0, $self->{'_dbh'}); }