1  
   2  #!/usr/bin/perl
   3  
   4  # $Id$
   5  
   6  # Split Apache logs according to GeoIP country
   7  
   8  use strict;
   9  use warnings;
  10  
  11  ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
  12  our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
  13  ## use critic
  14  
  15  use Geo::IP;
  16  
  17  my $gi = Geo::IP->open('/usr/local/share/GeoIP/GeoIPCity.dat', GEOIP_STANDARD);
  18  
  19  my @logs = @ARGV;
  20  
  21  my %record_for;
  22  
  23  foreach my $log (@logs) {
  24      die "Can't read $log\n" if !-r $log;
  25      
  26      my %fh_for;
  27      my $num_lines_parsed = 0;
  28      
  29      my $log_fh;
  30      if ($log =~ m/ \.gz \z /xms) {
  31          open $log_fh, "gzip -cd $log |" or die "Can't open gzip pipe\n";
  32      }
  33      else {
  34          open $log_fh, '<', $log or die "Can't open $log\n";
  35      }
  36      
  37      my $log_base = $log;
  38      $log_base =~ s/ \.gz \z //xms;
  39      
  40      while (my $line = <$log_fh>) {
  41          $num_lines_parsed++;
  42          if (!($num_lines_parsed % 1000)) {
  43              print STDERR "Parsed $num_lines_parsed lines of $log\n";
  44          }
  45          
  46          my ($host) = $line =~ m/ \A (\S+) \s /xms;
  47          
  48          if (!exists $record_for{$host}) {
  49              my $record = $gi->record_by_name($host);
  50              $record_for{$host} = $record || 0;
  51          }
  52          
  53          my $country = 'unknown';
  54          if (exists $record_for{$host} && $record_for{$host}) {
  55              $country = lc($record_for{$host}->country_name());
  56              $country =~ s/\W+/_/gxms;
  57          }
  58          
  59          if (!exists $fh_for{$country}) {
  60              open $fh_for{$country}, '>', "$log_base.$country.out"
  61                  or die "Can't write to $log_base.$country.out\n";
  62          }
  63          
  64          print {$fh_for{$country}} $line;
  65      }
  66      
  67      foreach my $fh (values %fh_for) {
  68          close $fh;
  69      }
  70      
  71      close $log_fh;
  72  }

   1  
   2  audio/x-raw-int,rate=44100,channels=2 ! lame name=enc vbr=4 vbr-quality=2 ! xingmux ! id3v2mux

   1  
   2  #!/usr/bin/perl
   3  
   4  # $Id$
   5  
   6  # CGI script for collecting username and password and storing them in a database
   7  # table. The password is encrypted with Crypt::PasswdMD5 ready for passing to
   8  # useradd.
   9  
  10  use strict;
  11  use warnings;
  12  
  13  ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
  14  our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
  15  ## use critic
  16  
  17  use CGI::Pretty qw(:standard -nosticky);
  18  use DBI;
  19  use Crypt::PasswdMD5;
  20  
  21  # Schema for database table to store account details:
  22  # 
  23  # CREATE TABLE account (
  24  #     username varchar(50) NOT NULL,
  25  #     password varchar(50) NOT NULL,
  26  #     date_created datetime NOT NULL
  27  # );
  28  
  29  my $DBNAME = 'database';
  30  my $DBHOST = 'localhost';
  31  my $DBPORT = 3306;
  32  my $DBUSER = 'username';
  33  my $DBPASS = 'password';
  34  
  35  # Header
  36  my $q = new CGI;
  37  print $q->header(),
  38        $q->start_html(
  39            -title => 'New Account',
  40            -lang  => 'en',
  41        ),
  42        $q->h1('New Account');
  43  
  44  my $submit    = $q->param('submit')    || q{};
  45  my $username  = $q->param('username')  || q{};
  46  my $password1 = $q->param('password1') || q{};
  47  my $password2 = $q->param('password2') || q{};
  48  
  49  my %ERROR = (
  50      no_username         => 'You must specify a username.',
  51      no_password         => 'You must specify a password.',
  52      password_not_twice  => 'You must specify your password twice.',
  53      passwords_not_match => 'Both passwords must match.',
  54  );
  55  
  56  my $error = (!$submit)                   ? undef                       :
  57              (!$username)                 ? $ERROR{no_username}         :
  58              (!$password1 && !$password2) ? $ERROR{no_password}         :
  59              (!$password1 || !$password2) ? $ERROR{password_not_twice}  :
  60              ( $password1 ne  $password2) ? $ERROR{passwords_not_match} :
  61                                             undef
  62              ;
  63  
  64  if (!$submit) {
  65      # Form not submitted, so display empty form
  66      form($q);
  67  }
  68  elsif ($error) {
  69      # Show error and redisplay form
  70      print $q->p($error);
  71      form($q, $username);
  72  }
  73  else {
  74      # Enter account details into database
  75      my $dsn = "DBI:mysql:database=$DBNAME;host=$DBHOST;port=$DBPORT";
  76      my $dbh = DBI->connect($dsn, $DBUSER, $DBPASS);
  77      
  78      my $username_quoted = $dbh->quote(param('username'));
  79      my $password_quoted = $dbh->quote(unix_md5_crypt(param('password1')));
  80      
  81      $dbh->do("
  82          INSERT INTO account
  83          (username, password, date_created)
  84          VALUES ($username_quoted, $password_quoted, NOW())
  85      ");
  86      
  87      print $q->p('Your username and password have been recorded.');
  88  }
  89  
  90  # Footer
  91  print $q->end_html();
  92  
  93  sub form {
  94      my $q = shift;
  95      my $username = shift || q{};
  96      
  97      print start_form(),
  98            p('Username:', br(), textfield(
  99                -name  => 'username',
 100                -value => $username,
 101            )),
 102            p('Password:', br(), password_field(
 103                -name => 'password1',
 104            )),
 105            p('Password (again):', br(), password_field(
 106                -name => 'password2',
 107            )),
 108            p(submit(
 109                -name  => 'submit',
 110                -value => 'Submit',
 111            )),
 112            end_form();
 113      
 114      return;
 115  }

   1  
   2  #!/usr/bin/perl
   3  
   4  # $Id$
   5  
   6  use strict;
   7  use warnings;
   8  
   9  ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
  10  our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
  11  ## use critic
  12  
  13  use English qw( -no_match_vars );
  14  use Getopt::Long;
  15  use POSIX qw( WIFEXITED );
  16  
  17  my @ANALOG_CMD = qw(/usr/bin/nice /usr/local/packages/analog/analog -G);
  18  
  19  my $config = get_config();
  20  
  21  do_months($config);
  22  do_years($config);
  23  
  24  exit;
  25  
  26  # Run yearly Analog reports
  27  sub do_years {
  28      my ($config) = @_;
  29      
  30      my ($year)         = $config->{ startmonth   } =~ m/ \A (\d{4}) /xms;
  31      my ($current_year) = $config->{ currentmonth } =~ m/ \A (\d{4}) /xms;
  32      
  33      # Run Analog for all years except current year (if not already run)
  34      while ($year != $current_year) {
  35          run_cmd($config, $year);
  36          $year++;
  37      }
  38      
  39      return;
  40  }
  41  
  42  # Run monthly Analog reports
  43  sub do_months {
  44      my ($config) = @_;
  45      
  46      my $month = $config->{startmonth};
  47      
  48      while ($month != $config->{currentmonth}) {
  49          # Run Analog for this month if not already run
  50          if ( ! -e $config->{outputdir} . q{/} . $month . '.html' ) {
  51              run_cmd($config, $month);
  52          }
  53          
  54          # Get next month
  55          my ($y, $m) = $month =~ m/ \A (\d{4}) (\d{2}) \z /xms;
  56          $m++;
  57          if ($m == 13) {
  58              $m = 1;
  59              $y++;
  60          }
  61          $month = sprintf '%04d%02d', $y, $m;
  62      }
  63      
  64      run_cmd($config, $month);
  65      
  66      return;
  67  }
  68  
  69  # Run Analog 
  70  sub run_cmd {
  71      my ($config, $date) = @_;
  72      
  73      my @cmd;
  74      
  75      push @cmd, @ANALOG_CMD;
  76      
  77      # Config files
  78      foreach my $configfile ( @{$config->{configfiles}} ) {
  79          my $file = $config->{configdir} . "/$configfile";
  80          push @cmd, "+g$file";
  81      }
  82      
  83      # Year or month config file
  84      push @cmd, '+g' . $config->{configdir} . q{/}
  85                 . ( length $date == 4 ? 'year.cfg' : 'month.cfg' );
  86      
  87      # Output options
  88      my $prefix = $date;
  89      if ($date == $config->{currentmonth}) {
  90          $prefix = 'current';
  91      }
  92      push @cmd, '+O' . $config->{outputdir} . q{/} . $prefix . '.html';
  93      push @cmd, "+CCHARTDIR $prefix-";
  94      push @cmd, '+CLOCALCHARTDIR ' . $config->{outputdir} . "/$prefix-";
  95      
  96      # Date range
  97      my $from;
  98      my $to;
  99      if (length $date == 4) {
 100          # Year
 101          $from = $date . '0101';
 102          $to   = $date . '1231';
 103      }
 104      elsif (length $date == 6) {
 105          # Month
 106          $from = $date . '01';
 107          $to   = $date . '31';
 108      }
 109      # Year needs to be in two digit format
 110      substr $from, 0, 2, q{};
 111      substr $to,   0, 2, q{};
 112      push @cmd, "+F$from";
 113      push @cmd, "+T$to";
 114      
 115      # Get logs
 116      my $need_prev = 1;
 117      my $got_log = 0;
 118      # Iterate over all logs
 119      LOG:
 120      for my $i ( 0 .. $#{$config->{logs}} ) {
 121          if ( $config->{logs}->[$i] =~ m/\D$date/xms ) {
 122              # Got a matching log
 123              $got_log = 1;
 124              if ($need_prev) {
 125                  # Get the previous log(s)
 126                  my $j = $i - 1;
 127                  my $prev_date;
 128                  while ( $j >= 0 ) {
 129                      if (!defined $prev_date) {
 130                          # Get previous log
 131                          push @cmd, $config->{logs}->[$j];
 132                          ($prev_date) = $config->{logs}->[$j] =~ m/(\d+)/xms;
 133                      }
 134                      else {
 135                          # Get other previous logs with the same date
 136                          my ($prev_date2) = $config->{logs}->[$j] =~ m/(\d+)/xms;
 137                          if ($prev_date == $prev_date2) {
 138                              push @cmd, $config->{logs}->[$j];
 139                          }
 140                          else {
 141                              $need_prev = 0;
 142                              last;
 143                          }
 144                      }
 145                      $j--;
 146                  }
 147              }
 148              push @cmd, $config->{logs}->[$i];
 149          }
 150          else {
 151              if ($got_log) {
 152                  # Get the next log(s)
 153                  push @cmd, $config->{logs}->[$i];
 154                  my ($next_date) = $config->{logs}->[$i] =~ m/(\d+)/xms;
 155                  # Get other next logs with the same date
 156                  my $j = $i + 1;
 157                  while ( $j <= $#{$config->{logs}} ) {
 158                      my ($next_date2) = $config->{logs}->[$j] =~ m/(\d+)/xms;
 159                      if ($next_date == $next_date2) {
 160                          push @cmd, $config->{logs}->[$j];
 161                      }
 162                      else {
 163                          last LOG;
 164                      }
 165                      $j++;
 166                  }
 167              }
 168          }
 169      }
 170      
 171      WIFEXITED(system @cmd) or die "Couldn't run: @cmd ($OS_ERROR)\n";
 172      
 173      return;
 174  }
 175  
 176  # Get command line options, check them and get all logs
 177  sub get_config {
 178      my $config = {};
 179      
 180      $config->{ startmonth   } = q{};
 181      $config->{ currentmonth } = q{};
 182      $config->{ outputdir    } = q{};
 183      $config->{ configdir    } = q{};
 184      $config->{ configfiles  } = [];
 185      $config->{ logglobs     } = [];
 186      
 187      GetOptions(
 188            'startmonth=s' => \$config->{ startmonth   },
 189          'currentmonth=s' => \$config->{ currentmonth },
 190             'outputdir=s' => \$config->{ outputdir    },
 191             'configdir=s' => \$config->{ configdir    },
 192            'configfile=s' =>  $config->{ configfiles  },
 193               'logglob=s' =>  $config->{ logglobs     },
 194      );
 195      
 196      # Check config
 197      foreach my $configfile ( @{$config->{configfiles}} ) {
 198          my $file = $config->{configdir} . "/$configfile";
 199          die "$file does not exist\n" if ! -e $file;
 200          die "$file cannot be read\n" if ! -r $file;
 201      }
 202      if ( ! -w $config->{outputdir} ) {
 203          die $config->{outputdir} . " cannot be written to\n";
 204      }
 205      if ($config->{startmonth}   !~ m/ \A \d{6} \z /xms) {
 206          die "--startmonth should be YYYYMM\n";
 207      }
 208      if ($config->{currentmonth} !~ m/ \A \d{6} \z /xms) {
 209          die "--currentmonth should be YYYYMM\n";
 210      }
 211      
 212      # Get logs from globs
 213      $config->{logs} = [];
 214      foreach my $logglob ( @{$config->{logglobs}} ) {
 215          my @logs = glob $logglob;
 216          push @{$config->{logs}}, @logs;
 217      }
 218      die "No logs found\n" if !@{$config->{logs}};
 219      
 220      # Sort logs by date
 221      @{$config->{logs}} = sort sort_logs @{$config->{logs}};
 222      
 223      return $config;
 224  }
 225  
 226  # Sort logs by date then alphabetically
 227  sub sort_logs {
 228      my ($a_date) = $a =~ m/(\d+)/xms;
 229      my ($b_date) = $b =~ m/(\d+)/xms;
 230      return $a_date <=> $b_date || $a cmp $b;
 231  }

   1  
   2  #!/usr/bin/perl
   3  
   4  # $Id$
   5  
   6  # Rewrite Apache logs that have incorrect dates.
   7  # Example usage: $0 '28/May/2006:01:17:14 +0200' '19/Jan/2007:08:49:14 +0100' \
   8  #                access_log.* error_log.*
   9  
  10  use strict;
  11  use warnings;
  12  
  13  ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
  14  our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
  15  ## use critic
  16  
  17  use HTTP::Date;
  18  
  19  my @DAYS   = qw(Sun Mon Tue Wed Thu Fri Sat);
  20  my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  21  
  22  my $wrong_datetime = shift @ARGV;
  23  my $right_datetime = shift @ARGV;
  24  
  25  my ($timezone) = $right_datetime =~ m/ ([+-]\d\d\d\d)\z/xms;
  26  
  27  my $seconds_diff = str2time($right_datetime) - str2time($wrong_datetime);
  28  
  29  foreach my $file (@ARGV) {
  30      print "Rewriting $file\n";
  31      open my $IN,  '<', $file
  32          or die "Can't open $file: $!\n";
  33      open my $OUT, '>', "$file.rewritten"
  34          or die "Can't write to $file.rewritten: $!\n";
  35      while (<$IN>) {
  36          if (m{
  37                 \A
  38                 (.+\s+) # Before date and time (if any)
  39                 \[
  40                 (
  41                     \d\d/\w\w\w/\d\d\d\d # Date
  42                     :\d\d:\d\d:\d\d      # Time
  43                     \s
  44                     [\+\-]\d\d\d\d       # Time zone
  45                 )
  46                 \]
  47                 (\s+.+) # After date and time
  48                 \z
  49               }xms) {
  50              print {$OUT} 
  51                $1, q{[},
  52                rewrite_access_datetime($2, $seconds_diff, $timezone),
  53                q{]}, $3;
  54          }
  55          elsif (m{
  56                 \A
  57                 \[
  58                 (
  59                     \w\w\w \s \w\w\w \s \d\d \s # Date
  60                     \d\d:\d\d:\d\d \s           # Time
  61                     \d\d\d\d                    # Year
  62                 )
  63                 \]
  64                 (\s+.+) # After date and time
  65                 \z
  66               }xms) {
  67              print {$OUT} 
  68                q{[},
  69                rewrite_error_datetime($1, $seconds_diff),
  70                q{]}, $2;
  71          }
  72          else {
  73              print {$OUT} $_;
  74          }
  75      }
  76  }
  77  
  78  sub rewrite_access_datetime {
  79      my ($datetime, $seconds_diff, $timezone) = @_;
  80      
  81      my ($sign, $hours, $minutes) = $timezone =~ m/\A([+-])(\d\d)(\d\d)\z/xms;
  82      my $seconds_offset = ($hours * 60 + $minutes) * 60;
  83      
  84      $datetime = str2time($datetime) + $seconds_diff;
  85      if    ($sign eq q{+}) {
  86          $datetime = $datetime + $seconds_offset;
  87      }
  88      elsif ($sign eq q{-}) {
  89          $datetime = $datetime - $seconds_offset;
  90      }
  91      
  92      my ($sec, $min, $hour, $mday, $mon, $year) = gmtime $datetime;
  93      return sprintf '%02d/%s/%04d:%02d:%02d:%02d %s',
  94          $mday, $MONTHS[$mon], $year + 1900, $hour, $min, $sec, $timezone;
  95  }
  96  
  97  sub rewrite_error_datetime {
  98      my ($datetime, $seconds_diff) = @_;
  99      
 100      $datetime = str2time($datetime) + $seconds_diff;
 101      
 102      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime $datetime;
 103      return sprintf '%s %s %02d %02d:%02d:%02d %04d',
 104          $DAYS[$wday], $MONTHS[$mon], $mday, $hour, $min, $sec, $year + 1900;
 105  }

   1  
   2  create table linksdb (
   3      urlname        varchar(512),
   4      recursionlevel smallint not null,
   5      parentname     varchar(256),
   6      baseref        varchar(256),
   7      result         varchar(256),
   8      warning        varchar(512),
   9      info           varchar(512),
  10      valid          smallint not null,
  11      url            varchar(1024) not null,
  12      line           int not null,
  13      col            int not null,
  14      name           varchar(256),
  15      checktime      int not null,
  16      dltime         smallint not null,
  17      dlsize         smallint not null,
  18      cached         smallint not null
  19  );

   1  
   2  SELECT LAST_INSERT_ID();