#!/usr/bin/perl

# $Id$

# Split Apache logs according to GeoIP country

use strict;
use warnings;

## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
## use critic

use Geo::IP;

my $gi = Geo::IP->open('/usr/local/share/GeoIP/GeoIPCity.dat', GEOIP_STANDARD);

my @logs = @ARGV;

my %record_for;

foreach my $log (@logs) {
    die "Can't read $log\n" if !-r $log;
    
    my %fh_for;
    my $num_lines_parsed = 0;
    
    my $log_fh;
    if ($log =~ m/ \.gz \z /xms) {
        open $log_fh, "gzip -cd $log |" or die "Can't open gzip pipe\n";
    }
    else {
        open $log_fh, '<', $log or die "Can't open $log\n";
    }
    
    my $log_base = $log;
    $log_base =~ s/ \.gz \z //xms;
    
    while (my $line = <$log_fh>) {
        $num_lines_parsed++;
        if (!($num_lines_parsed % 1000)) {
            print STDERR "Parsed $num_lines_parsed lines of $log\n";
        }
        
        my ($host) = $line =~ m/ \A (\S+) \s /xms;
        
        if (!exists $record_for{$host}) {
            my $record = $gi->record_by_name($host);
            $record_for{$host} = $record || 0;
        }
        
        my $country = 'unknown';
        if (exists $record_for{$host} && $record_for{$host}) {
            $country = lc($record_for{$host}->country_name());
            $country =~ s/\W+/_/gxms;
        }
        
        if (!exists $fh_for{$country}) {
            open $fh_for{$country}, '>', "$log_base.$country.out"
                or die "Can't write to $log_base.$country.out\n";
        }
        
        print {$fh_for{$country}} $line;
    }
    
    foreach my $fh (values %fh_for) {
        close $fh;
    }
    
    close $log_fh;
}

#!/usr/bin/perl

# $Id$

# CGI script for collecting username and password and storing them in a database
# table. The password is encrypted with Crypt::PasswdMD5 ready for passing to
# useradd.

use strict;
use warnings;

## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
## use critic

use CGI::Pretty qw(:standard -nosticky);
use DBI;
use Crypt::PasswdMD5;

# Schema for database table to store account details:
# 
# CREATE TABLE account (
#     username varchar(50) NOT NULL,
#     password varchar(50) NOT NULL,
#     date_created datetime NOT NULL
# );

my $DBNAME = 'database';
my $DBHOST = 'localhost';
my $DBPORT = 3306;
my $DBUSER = 'username';
my $DBPASS = 'password';

# Header
my $q = new CGI;
print $q->header(),
      $q->start_html(
          -title => 'New Account',
          -lang  => 'en',
      ),
      $q->h1('New Account');

my $submit    = $q->param('submit')    || q{};
my $username  = $q->param('username')  || q{};
my $password1 = $q->param('password1') || q{};
my $password2 = $q->param('password2') || q{};

my %ERROR = (
    no_username         => 'You must specify a username.',
    no_password         => 'You must specify a password.',
    password_not_twice  => 'You must specify your password twice.',
    passwords_not_match => 'Both passwords must match.',
);

my $error = (!$submit)                   ? undef                       :
            (!$username)                 ? $ERROR{no_username}         :
            (!$password1 && !$password2) ? $ERROR{no_password}         :
            (!$password1 || !$password2) ? $ERROR{password_not_twice}  :
            ( $password1 ne  $password2) ? $ERROR{passwords_not_match} :
                                           undef
            ;

if (!$submit) {
    # Form not submitted, so display empty form
    form($q);
}
elsif ($error) {
    # Show error and redisplay form
    print $q->p($error);
    form($q, $username);
}
else {
    # Enter account details into database
    my $dsn = "DBI:mysql:database=$DBNAME;host=$DBHOST;port=$DBPORT";
    my $dbh = DBI->connect($dsn, $DBUSER, $DBPASS);
    
    my $username_quoted = $dbh->quote(param('username'));
    my $password_quoted = $dbh->quote(unix_md5_crypt(param('password1')));
    
    $dbh->do("
        INSERT INTO account
        (username, password, date_created)
        VALUES ($username_quoted, $password_quoted, NOW())
    ");
    
    print $q->p('Your username and password have been recorded.');
}

# Footer
print $q->end_html();

sub form {
    my $q = shift;
    my $username = shift || q{};
    
    print start_form(),
          p('Username:', br(), textfield(
              -name  => 'username',
              -value => $username,
          )),
          p('Password:', br(), password_field(
              -name => 'password1',
          )),
          p('Password (again):', br(), password_field(
              -name => 'password2',
          )),
          p(submit(
              -name  => 'submit',
              -value => 'Submit',
          )),
          end_form();
    
    return;
}

#!/usr/bin/perl

# $Id$

use strict;
use warnings;

## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
## use critic

use English qw( -no_match_vars );
use Getopt::Long;
use POSIX qw( WIFEXITED );

my @ANALOG_CMD = qw(/usr/bin/nice /usr/local/packages/analog/analog -G);

my $config = get_config();

do_months($config);
do_years($config);

exit;

# Run yearly Analog reports
sub do_years {
    my ($config) = @_;
    
    my ($year)         = $config->{ startmonth   } =~ m/ \A (\d{4}) /xms;
    my ($current_year) = $config->{ currentmonth } =~ m/ \A (\d{4}) /xms;
    
    # Run Analog for all years except current year (if not already run)
    while ($year != $current_year) {
        run_cmd($config, $year);
        $year++;
    }
    
    return;
}

# Run monthly Analog reports
sub do_months {
    my ($config) = @_;
    
    my $month = $config->{startmonth};
    
    while ($month != $config->{currentmonth}) {
        # Run Analog for this month if not already run
        if ( ! -e $config->{outputdir} . q{/} . $month . '.html' ) {
            run_cmd($config, $month);
        }
        
        # Get next month
        my ($y, $m) = $month =~ m/ \A (\d{4}) (\d{2}) \z /xms;
        $m++;
        if ($m == 13) {
            $m = 1;
            $y++;
        }
        $month = sprintf '%04d%02d', $y, $m;
    }
    
    run_cmd($config, $month);
    
    return;
}

# Run Analog 
sub run_cmd {
    my ($config, $date) = @_;
    
    my @cmd;
    
    push @cmd, @ANALOG_CMD;
    
    # Config files
    foreach my $configfile ( @{$config->{configfiles}} ) {
        my $file = $config->{configdir} . "/$configfile";
        push @cmd, "+g$file";
    }
    
    # Year or month config file
    push @cmd, '+g' . $config->{configdir} . q{/}
               . ( length $date == 4 ? 'year.cfg' : 'month.cfg' );
    
    # Output options
    my $prefix = $date;
    if ($date == $config->{currentmonth}) {
        $prefix = 'current';
    }
    push @cmd, '+O' . $config->{outputdir} . q{/} . $prefix . '.html';
    push @cmd, "+CCHARTDIR $prefix-";
    push @cmd, '+CLOCALCHARTDIR ' . $config->{outputdir} . "/$prefix-";
    
    # Date range
    my $from;
    my $to;
    if (length $date == 4) {
        # Year
        $from = $date . '0101';
        $to   = $date . '1231';
    }
    elsif (length $date == 6) {
        # Month
        $from = $date . '01';
        $to   = $date . '31';
    }
    # Year needs to be in two digit format
    substr $from, 0, 2, q{};
    substr $to,   0, 2, q{};
    push @cmd, "+F$from";
    push @cmd, "+T$to";
    
    # Get logs
    my $need_prev = 1;
    my $got_log = 0;
    # Iterate over all logs
    LOG:
    for my $i ( 0 .. $#{$config->{logs}} ) {
        if ( $config->{logs}->[$i] =~ m/\D$date/xms ) {
            # Got a matching log
            $got_log = 1;
            if ($need_prev) {
                # Get the previous log(s)
                my $j = $i - 1;
                my $prev_date;
                while ( $j >= 0 ) {
                    if (!defined $prev_date) {
                        # Get previous log
                        push @cmd, $config->{logs}->[$j];
                        ($prev_date) = $config->{logs}->[$j] =~ m/(\d+)/xms;
                    }
                    else {
                        # Get other previous logs with the same date
                        my ($prev_date2) = $config->{logs}->[$j] =~ m/(\d+)/xms;
                        if ($prev_date == $prev_date2) {
                            push @cmd, $config->{logs}->[$j];
                        }
                        else {
                            $need_prev = 0;
                            last;
                        }
                    }
                    $j--;
                }
            }
            push @cmd, $config->{logs}->[$i];
        }
        else {
            if ($got_log) {
                # Get the next log(s)
                push @cmd, $config->{logs}->[$i];
                my ($next_date) = $config->{logs}->[$i] =~ m/(\d+)/xms;
                # Get other next logs with the same date
                my $j = $i + 1;
                while ( $j <= $#{$config->{logs}} ) {
                    my ($next_date2) = $config->{logs}->[$j] =~ m/(\d+)/xms;
                    if ($next_date == $next_date2) {
                        push @cmd, $config->{logs}->[$j];
                    }
                    else {
                        last LOG;
                    }
                    $j++;
                }
            }
        }
    }
    
    WIFEXITED(system @cmd) or die "Couldn't run: @cmd ($OS_ERROR)\n";
    
    return;
}

# Get command line options, check them and get all logs
sub get_config {
    my $config = {};
    
    $config->{ startmonth   } = q{};
    $config->{ currentmonth } = q{};
    $config->{ outputdir    } = q{};
    $config->{ configdir    } = q{};
    $config->{ configfiles  } = [];
    $config->{ logglobs     } = [];
    
    GetOptions(
          'startmonth=s' => \$config->{ startmonth   },
        'currentmonth=s' => \$config->{ currentmonth },
           'outputdir=s' => \$config->{ outputdir    },
           'configdir=s' => \$config->{ configdir    },
          'configfile=s' =>  $config->{ configfiles  },
             'logglob=s' =>  $config->{ logglobs     },
    );
    
    # Check config
    foreach my $configfile ( @{$config->{configfiles}} ) {
        my $file = $config->{configdir} . "/$configfile";
        die "$file does not exist\n" if ! -e $file;
        die "$file cannot be read\n" if ! -r $file;
    }
    if ( ! -w $config->{outputdir} ) {
        die $config->{outputdir} . " cannot be written to\n";
    }
    if ($config->{startmonth}   !~ m/ \A \d{6} \z /xms) {
        die "--startmonth should be YYYYMM\n";
    }
    if ($config->{currentmonth} !~ m/ \A \d{6} \z /xms) {
        die "--currentmonth should be YYYYMM\n";
    }
    
    # Get logs from globs
    $config->{logs} = [];
    foreach my $logglob ( @{$config->{logglobs}} ) {
        my @logs = glob $logglob;
        push @{$config->{logs}}, @logs;
    }
    die "No logs found\n" if !@{$config->{logs}};
    
    # Sort logs by date
    @{$config->{logs}} = sort sort_logs @{$config->{logs}};
    
    return $config;
}

# Sort logs by date then alphabetically
sub sort_logs {
    my ($a_date) = $a =~ m/(\d+)/xms;
    my ($b_date) = $b =~ m/(\d+)/xms;
    return $a_date <=> $b_date || $a cmp $b;
}

#!/usr/bin/perl

# $Id$

# Rewrite Apache logs that have incorrect dates.
# Example usage: $0 '28/May/2006:01:17:14 +0200' '19/Jan/2007:08:49:14 +0100' \
#                access_log.* error_log.*

use strict;
use warnings;

## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;
## use critic

use HTTP::Date;

my @DAYS   = qw(Sun Mon Tue Wed Thu Fri Sat);
my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

my $wrong_datetime = shift @ARGV;
my $right_datetime = shift @ARGV;

my ($timezone) = $right_datetime =~ m/ ([+-]\d\d\d\d)\z/xms;

my $seconds_diff = str2time($right_datetime) - str2time($wrong_datetime);

foreach my $file (@ARGV) {
    print "Rewriting $file\n";
    open my $IN,  '<', $file
        or die "Can't open $file: $!\n";
    open my $OUT, '>', "$file.rewritten"
        or die "Can't write to $file.rewritten: $!\n";
    while (<$IN>) {
        if (m{
               \A
               (.+\s+) # Before date and time (if any)
               \[
               (
                   \d\d/\w\w\w/\d\d\d\d # Date
                   :\d\d:\d\d:\d\d      # Time
                   \s
                   [\+\-]\d\d\d\d       # Time zone
               )
               \]
               (\s+.+) # After date and time
               \z
             }xms) {
            print {$OUT} 
              $1, q{[},
              rewrite_access_datetime($2, $seconds_diff, $timezone),
              q{]}, $3;
        }
        elsif (m{
               \A
               \[
               (
                   \w\w\w \s \w\w\w \s \d\d \s # Date
                   \d\d:\d\d:\d\d \s           # Time
                   \d\d\d\d                    # Year
               )
               \]
               (\s+.+) # After date and time
               \z
             }xms) {
            print {$OUT} 
              q{[},
              rewrite_error_datetime($1, $seconds_diff),
              q{]}, $2;
        }
        else {
            print {$OUT} $_;
        }
    }
}

sub rewrite_access_datetime {
    my ($datetime, $seconds_diff, $timezone) = @_;
    
    my ($sign, $hours, $minutes) = $timezone =~ m/\A([+-])(\d\d)(\d\d)\z/xms;
    my $seconds_offset = ($hours * 60 + $minutes) * 60;
    
    $datetime = str2time($datetime) + $seconds_diff;
    if    ($sign eq q{+}) {
        $datetime = $datetime + $seconds_offset;
    }
    elsif ($sign eq q{-}) {
        $datetime = $datetime - $seconds_offset;
    }
    
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime $datetime;
    return sprintf '%02d/%s/%04d:%02d:%02d:%02d %s',
        $mday, $MONTHS[$mon], $year + 1900, $hour, $min, $sec, $timezone;
}

sub rewrite_error_datetime {
    my ($datetime, $seconds_diff) = @_;
    
    $datetime = str2time($datetime) + $seconds_diff;
    
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime $datetime;
    return sprintf '%s %s %02d %02d:%02d:%02d %04d',
        $DAYS[$wday], $MONTHS[$mon], $mday, $hour, $min, $sec, $year + 1900;
}