#!/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;
}

audio/x-raw-int,rate=44100,channels=2 ! lame name=enc preset=1001 ! xingmux ! id3v2mux

#!/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;
}

create table linksdb (
    urlname        varchar(512),
    recursionlevel smallint not null,
    parentname     varchar(256),
    baseref        varchar(256),
    result         varchar(256),
    warning        varchar(512),
    info           varchar(512),
    valid          smallint not null,
    url            varchar(1024) not null,
    line           int not null,
    col            int not null,
    name           varchar(256),
    checktime      int not null,
    dltime         smallint not null,
    dlsize         smallint not null,
    cached         smallint not null
);

SELECT LAST_INSERT_ID();