bin/httpdwho

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         $RCSfile: httpdwho,v $
   5 # Revision:     $Revision: 1.2 $
   6 # Description:  Parse Apache access.log and produce a report on the locations
   7 #               of the visitors to the site
   8 # Author:       Andrew@DeFaria.com
   9 # Created:      Thu Dec 21 21:49:54 CST 2006
  10 # Modified:     $Date: 2010/06/08 15:03:27 $
  11 # Dependencies: GEOLite
  12 # Language:     Perl
  13 #
  14 # This product includes GeoLite data created by MaxMind, available from
  15 # http://www.maxmind.com
  16 #
  17 # (C) Copyright 2006, ClearSCM, Inc., all rights reserved.
  18 #
  19 ################################################################################
  20 use strict;
  21 use warnings;
  22
  23 use FindBin;
  24 use Getopt::Long;
  25
  26 use lib "$FindBin::Bin/../lib";
  27
  28 use Display;
  29 use Utils;
  30
  31 use Geo::IP::PurePerl;
  32
  33 sub Usage (;$) {
  34   my $msg = shift;
  35
  36   dipslay $msg if $msg;
  37   display "Usage: $FindBin::Script: [ -verbose | -v ] <filename>";
  38   display "\nWhere:";
  39   display "  -verbose | -v\tTurn on verbose mode (Default: verbose off)";
  40   display "  <filename>\tIs the Apache formated access logfile";
  41   exit 1;
  42 } # usage
  43
  44 sub GetIPs ($) {
  45   my $filename = shift;
  46
  47   my %ipaddrs;
  48
  49   verbose_nolf "Processing $filename";
  50
  51   foreach (ReadFile ($filename)) {
  52     verbose_nolf ".";
  53
  54     my @fields  = split;
  55     my @ipaddrs = gethostbyname $fields [0];
  56
  57     next if !@ipaddrs; # Skip errors
  58
  59     my ($a, $b, $c, $d) = unpack "C4", $ipaddrs [4];
  60     my $ipaddr = "$a.$b.$c.$d";
  61
  62     debug "Host: ${fields [0]} IP: $ipaddr";
  63
  64     if ($ipaddrs {$ipaddr}) {
  65       $ipaddrs {$ipaddr}[1]++;
  66     } else {
  67       my @domain_info;
  68       $domain_info [0] = $ipaddrs [0];
  69       $domain_info [1] = 1;
  70       $ipaddrs {$ipaddr} = \@domain_info;
  71     } # if
  72   } # foreach
  73
  74   verbose "\nFinished processing $filename";
  75   return %ipaddrs;
  76 } # GetIPs
  77
  78 my $logfile = "/var/log/httpd/access_log";
  79
  80 my $result = GetOptions (
  81   "file=s"      => \$logfile,
  82   "usage"       => sub { Usage },
  83   "verbose"     => sub { set_verbose },
  84   "debug"       => sub { set_debug },
  85 ) or Usage "Invalid option specified";
  86
  87 # Instantiate a new Geo::IP object
  88 my $gi = Geo::IP::PurePerl->new (
  89   "/usr/local/share/GeoIP/GeoIPCity.dat",
  90   GEOIP_STANDARD
  91 );
  92
  93 # Turn off buffering
  94 $| = 1;
  95
  96 error "Unable to open $logfile", 1 if !-f $logfile;
  97
  98 my %ip_records = GetIPs $logfile;
  99
 100 foreach (sort keys %ip_records) {
 101   my (
 102     $country_code,
 103     $country_code3,
 104     $country_name,
 105     $region,
 106     $city,
 107     $postal_code,
 108     $latitude,
 109     $longitude,
 110     $dma_code,
 111     $area_code)
 112   = $gi->get_city_record ($_);
 113
 114   my @domain_info = @{$ip_records {$_}};
 115
 116   display_nolf "$_\t";
 117   display_nolf $city            ? "$city\t"             : "*Unknown*\t";
 118   display_nolf $postal_code     ? "$postal_code\t"      : "*Unknown*\t";
 119   display_nolf $country_name    ? "$country_name\t"     : "*Unknown*\t";
 120   display $domain_info [0] . " (" . $domain_info [1] . ")";
 121 #   print $country_code . "\n";
 122 #   print $country_code3 . "\n";
 123 #   print $country_name . "\n";
 124 #   print $region . "\n";
 125 #   print $city . "\n";
 126 #   print $postal_code . "\n";
 127 #   print $latitude . "\n";
 128 #   print $longitude . "\n";
 129 #   print $dma_code . "\n";
 130 #   print $area_code . "\n";
 131 } # foreach