lib/Yaala/Data/Convert.pm

   1 package Yaala::Data::Convert;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7 use Socket;
   8 use Yaala::Config qw#get_config#;
   9 use Yaala::Data::Setup qw#%DATAFIELDS#;
  10
  11 @Yaala::Data::Convert::ISA = ('Exporter');
  12 @Yaala::Data::Convert::EXPORT_OK = qw#convert#;
  13
  14 my $VERSION = '$Id: Convert.pm,v 1.7 2003/12/07 14:52:22 octo Exp $';
  15 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  16
  17 our $CACHE = {};
  18 our $DO_REV_LOOKUP = 0;
  19 our $HOST_WIDTH = 1;
  20 our $URL_FORMAT = 'host';
  21
  22 if (get_config ('reverse_lookup'))
  23 {
  24         my $conf = get_config ('reverse_lookup');
  25         if ($conf =~ m/^(true|yes|on)$/i)
  26         {
  27                 print STDERR $/, __FILE__, ': Will try to do reverse lookups' if ($::DEBUG & 0x40);
  28                 $DO_REV_LOOKUP = 1;
  29         }
  30 }
  31
  32 {
  33         my $conf = get_config ('host_width');
  34         $conf =~ s/\D//g;
  35         if ($conf ne '')
  36         {
  37                 $HOST_WIDTH = $conf;
  38         }
  39 }
  40
  41 if (get_config ('url_format'))
  42 {
  43          my $conf = get_config ('url_format');
  44          if ($conf =~ m/url/i)
  45          {
  46                  $URL_FORMAT = 'url';
  47          }
  48          elsif ($conf =~ m/full/)
  49          {
  50                  $URL_FORMAT = 'full';
  51          }
  52  }
  53
  54
  55 return (1);
  56
  57 sub convert
  58 {
  59         my $key = shift;
  60         my $val = shift;
  61         my $retval = $val;
  62
  63         if (defined ($CACHE->{$key}{$val}))
  64         {
  65                 return ($CACHE->{$key}{$val});
  66         }
  67
  68         if (defined ($DATAFIELDS{$key}))
  69         {
  70                 my ($class, $type) = split (m/:/, $DATAFIELDS{$key});
  71
  72                 if (!defined ($type) or !$type)
  73                 {
  74                         $CACHE->{$key}{$val} = $retval if ($class eq 'key');
  75                         return ($retval);
  76                 }
  77
  78                 if ($type eq 'bytes')
  79                 {
  80                         $retval = sprintf ("%.1f kByte", $val / 1024) if ($val)
  81                 }
  82 #               elsif ($type eq 'numeric')
  83 #               {
  84 #                       $val =~ s/\D//g;
  85 #                       if ($val)
  86 #                       {
  87 #                               $retval = int ($val);
  88 #                       }
  89 #                       else
  90 #                       {
  91 #                               $retval = 0;
  92 #                       }
  93 #               }
  94                 elsif ($type eq 'host')
  95                 {
  96                         if ($DO_REV_LOOKUP and $val =~ m/^[\d\.]+$/)
  97                         {
  98                                 $retval = do_reverse_lookup ($val);
  99                         }
 100
 101                         if ($HOST_WIDTH)
 102                         {
 103                                 if ($retval =~ m/^[\d\.]+$/)
 104                                 {
 105                                         if ($DO_REV_LOOKUP)
 106                                         {
 107                                                 $retval = '*UNRESOLVED*';
 108                                         }
 109                                         else
 110                                         {
 111                                                 my ($c, $d, $e, $f) = split (m/\./, $retval, 4);
 112                                                 if ($HOST_WIDTH == 1)
 113                                                 {
 114                                                         $retval = "$c.0.0.0/8";
 115                                                 }
 116                                                 elsif ($HOST_WIDTH == 2)
 117                                                 {
 118                                                         $retval = "$c.$d.0.0/16";
 119                                                 }
 120                                                 elsif ($HOST_WIDTH == 3)
 121                                                 {
 122                                                         $retval = "$c.$d.$e.0/24";
 123                                                 }
 124                                                 else
 125                                                 {
 126                                                         $retval = "$c.$d.$e.$f/32";
 127                                                 }
 128                                         }
 129                                 }
 130                                 else
 131                                 {
 132                                         my @parts = split (m/\./, $retval);
 133                                         while (scalar (@parts) > ($HOST_WIDTH + 1))
 134                                         {
 135                                                 shift (@parts);
 136                                         }
 137                                         $retval = join ('.', @parts);
 138                                 }
 139                         }
 140                 }
 141                 elsif ($type eq 'url')
 142                 {
 143                         my $tmpval = $val;
 144                         $tmpval =~ s#^[a-z]+://##i;
 145
 146                         if ($tmpval =~ m#^([^:/]+)(?::\d+)?(/[^\?]*)(.*)#)
 147                         {
 148                                 my $host = $1;
 149                                 my $path = $2;
 150                                 my $params = $3;
 151
 152                                 if ($DO_REV_LOOKUP and $host =~ m/^[\d\.]+$/)
 153                                 {
 154                                         $host = do_reverse_lookup ($host);
 155                                 }
 156
 157                                 if ($HOST_WIDTH and $host =~ m/[^\d\.]/)
 158                                 {
 159                                         my @parts = split (m/\./, $host);
 160                                         while (scalar (@parts) > ($HOST_WIDTH + 1))
 161                                         {
 162                                                 shift (@parts);
 163                                         }
 164                                         $host = join ('.', @parts);
 165                                 }
 166
 167                                 if ($URL_FORMAT eq 'host')
 168                                 {
 169                                         $retval = $host;
 170                                 }
 171                                 elsif ($URL_FORMAT eq 'url')
 172                                 {
 173                                         $retval = $host . $path;
 174                                 }
 175                                 elsif ($URL_FORMAT eq 'full')
 176                                 {
 177                                         $retval = $host . $path . $params;
 178                                 }
 179                         }
 180                         elsif ($::DEBUG)
 181                         {
 182                                 print STDERR $/, __FILE__, ": Unable to parse URL: '$val'";
 183                         }
 184                 }
 185                 elsif ($type eq 'date')
 186                 {
 187                         # for later use
 188                 }
 189                 elsif ($type eq 'time' and $class eq 'agg')
 190                 {
 191                         my $hour   = 0;
 192                         my $minute = 0;
 193                         my $second = 0;
 194
 195                         $hour   = int ($val / 3600000); $val %= 3600000;
 196                         $minute = int ($val /   60000); $val %=   60000;
 197                         $second = $val / 1000;
 198
 199                         $retval = sprintf ("%02u:%02u:%02.1f", $hour, $minute, $second);
 200                 }
 201
 202                 if ($class eq 'key')
 203                 {
 204                         $CACHE->{$key}{$val} = $retval;
 205                 }
 206         }
 207
 208         return ($retval);
 209 }
 210
 211 sub do_reverse_lookup
 212 {
 213         my $ip = shift;
 214
 215         return ($ip) if ($ip !~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/);
 216
 217         print STDERR $/, __FILE__, ": Reverse lookup for $ip" if ($::DEBUG & 0x40);
 218
 219         my $iaddr = inet_aton ($ip);
 220         if (!defined ($iaddr))
 221         {
 222                 print STDERR ': Failed (not a valid IP)' if ($::DEBUG & 0x40);
 223                 return ($ip);
 224         }
 225
 226         my $host = gethostbyaddr ($iaddr, AF_INET ());
 227
 228         if ($host)
 229         {
 230                 print STDERR ": Success ($host)" if ($::DEBUG & 0x40);
 231                 return ($host);
 232         }
 233         else
 234         {
 235                 print STDERR ': Failed (unknown)' if ($::DEBUG & 0x40);
 236                 return ($ip);
 237         }
 238 }