# _helper.pm - A simple test suite helper

# Copyright (c) 2007 imacat
# 
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

package _helper;
use 5.005;
use strict;
use warnings;
use base qw(Exporter);
use vars qw($VERSION @EXPORT);
$VERSION = "0.01";
@EXPORT = qw();
push @EXPORT, qw(fread frread fwrite frwrite);
push @EXPORT, qw(runcmd whereis ftype flist prsrvsrc cleanup);
push @EXPORT, qw(nofile nogzip nobzip2);
push @EXPORT, qw(mkrndlog_existing);
push @EXPORT, qw(mkrndlog_apache mkrndlog_syslog);
push @EXPORT, qw(mkrndlog_ntp mkrndlog_apachessl mkrndlog_modfiso);
push @EXPORT, qw(randword);
push @EXPORT, qw(TYPE_PLAIN TYPE_GZIP TYPE_BZIP2);
push @EXPORT, qw(@LOGFMTS @SRCTYPES @RESTYPES @KEEPTYPES @OVERTYPES);
# Prototype declaration
sub thisfile();
sub fread($);
sub frread($);
sub fwrite($$);
sub frwrite($$);
sub runcmd($@);
sub whereis($);
sub ftype($);
sub flist($);
sub prsrvsrc($);
sub cleanup($$$);
sub nofile();
sub nogzip();
sub nobzip2();
sub mkrndlog_existing($$$@);
sub mkrndlog_apache($;$);
sub mkrndlog_syslog($;$);
sub mkrndlog_ntp($;$);
sub mkrndlog_apachessl($;$);
sub mkrndlog_modfiso($;$);
sub monrng_one($);
sub monrng_rand();
sub split_months(\@);
sub insert_malformed(\@);
sub randword();
sub randip();
sub randdomain();

use Data::Dumper;
use ExtUtils::MakeMaker qw();
use Fcntl qw(:seek);
use File::Basename qw(basename);
use File::Copy qw(copy);
use File::Path qw(mkpath rmtree);
use File::Spec::Functions qw(splitdir catdir catfile path);
use File::Temp qw(tempfile);
use Time::Local qw(timelocal);
$Data::Dumper::Indent = 1;

use vars qw(%WHEREIS $NOFILE $NOGZIP $NOBZIP2);
%WHEREIS = qw();
undef $NOFILE;
undef $NOGZIP;
undef $NOBZIP2;

use constant TYPE_PLAIN => "text/plain";
use constant TYPE_GZIP => "application/x-gzip";
use constant TYPE_BZIP2 => "application/x-bzip2";

use vars qw(@LOGFMTS @SRCTYPES @RESTYPES @KEEPTYPES @OVERTYPES);
# All the log format information
@LOGFMTS = (    {   "title" => "Apache acecss log",
                    "sub"   => \&mkrndlog_apache, },
                {   "title" => "Syslog",
                    "sub"   => \&mkrndlog_syslog, },
                {   "title" => "NTP",
                    "sub"   => \&mkrndlog_ntp, },
                {   "title" => "Apache SSL engine log",
                    "sub"   => \&mkrndlog_apachessl, },
                {   "title" => "modified ISO 8601 date/time",
                    "sub"   => \&mkrndlog_modfiso, }, );
# All the source type information
@SRCTYPES = (   {   "title" => "plain text source",
                    "type"  => TYPE_PLAIN,
                    "suf"   => "",
                    "skip"  => 0, },
                {   "title" => "gzip source",
                    "type"  => TYPE_GZIP,
                    "suf"   => ".gz",
                    "skip"  => nogzip, },
                {   "title" => "bzip2 source",
                    "type"  => TYPE_BZIP2,
                    "suf"   => ".bz2",
                    "skip"  => nobzip2, }, );
# All the result type information
@RESTYPES = (   {   "title" => "default compress",
                    "type"  => TYPE_GZIP,
                    "suf"   => ".gz",
                    "skip"  => nogzip,
                    "opts"  => [], },
                {   "title" => "gzip compress",
                    "type"  => TYPE_GZIP,
                    "suf"   => ".gz",
                    "skip"  => nogzip,
                    "opts"  => [qw(-c g)], },
                {   "title" => "bzip2 compress",
                    "type"  => TYPE_BZIP2,
                    "suf"   => ".bz2",
                    "skip"  => nobzip2,
                    "opts"  => [qw(-c b)], },
                {   "title" => "no compress",
                    "type"  => TYPE_PLAIN,
                    "suf"   => "",
                    "skip"  => 0,
                    "opts"  => [qw(-c n)], }, );
# All the keep type information
@KEEPTYPES = (  {   "title" => "keep default",
                    "opts"  => [],
                    "tm"    => 1,
                    "del"   => 0,
                    "tmp"   => 1,
                    "stdin" => 0, },
                {   "title" => "keep all",
                    "opts"  => [qw(-k a)],
                    "tm"    => 0,
                    "del"   => 0,
                    "tmp"   => 0,
                    "stdin" => 0, },
                {   "title" => "keep delete",
                    "opts"  => [qw(-k d)],
                    "tm"    => 0,
                    "del"   => 1,
                    "tmp"   => 1,
                    "stdin" => 0, },
                {   "title" => "keep restart",
                    "opts"  => [qw(-k r)],
                    "tm"    => 0,
                    "del"   => 0,
                    "tmp"   => 1,
                    "stdin" => 0, },
                {   "title" => "keep this month",
                    "opts"  => [qw(-k t)],
                    "tm"    => 1,
                    "del"   => 0,
                    "tmp"   => 1,
                    "stdin" => 0, },
                {   "title" => "keep STDIN",
                    "opts"  => [],
                    "tm"    => 0,
                    "del"   => 0,
                    "tmp"   => 0,
                    "stdin" => 1, }, );
# All the override type information
@OVERTYPES = (  {   "title" => "override no existing",
                    "opts"  => [],
                    "mkex"  => 0,
                    "ok"    => 1,
                    "ce"    => sub { $_[1]; }, },
                {   "title" => "override default",
                    "opts"  => [],
                    "mkex"  => 1,
                    "ok"    => 0,
                    "ce"    => sub { $_[0]; }, },
                {   "title" => "override overwrite",
                    "opts"  => [qw(-o o)],
                    "mkex"  => 1,
                    "ok"    => 1,
                    "ce"    => sub { $_[1]; }, },
                {   "title" => "override append",
                    "opts"  => [qw(-o a)],
                    "mkex"  => 1,
                    "ok"    => 1,
                    "ce"    => sub { $_[0] . $_[1]; }, },
                {   "title" => "override ignore",
                    "opts"  => [qw(-o i)],
                    "mkex"  => 1,
                    "ok"    => 1,
                    "ce"    => sub { $_[0] || $_[1]; }, },
                {   "title" => "override fail",
                    "opts"  => [qw(-o f)],
                    "mkex"  => 1,
                    "ok"    => 0,
                    "ce"    => sub { $_[0]; }, }, );

# thisfile: Return the name of this file
sub thisfile() { basename($0); }

# fread: A simple reader to read a log file in any supported format
sub fread($) {
    local ($_, %_);
    my ($file, $content);
    $file = $_[0];
    
    # non-existing file
    return undef if !-e $file;
    
    # a gzip compressed file
    if ($file =~ /\.gz$/) {
        # Compress::Zlib
        if (eval {  require Compress::Zlib;
                    import Compress::Zlib qw(gzopen);
                    1; }) {
            my ($FH, $gz);
            $content = "";
            open $FH, $file             or die thisfile . ": $file: $!";
            $gz = gzopen($FH, "rb")     or die thisfile . ": $file: $!";
            while (1) {
                ($gz->gzread($_, 10240) != -1)
                                        or die thisfile . ": $file: " . $gz->gzerror;
                $content .= $_;
                last if length $_ < 10240;
            }
            $gz->gzclose                and die thisfile . ": $file: " . $gz->gzerror;
            return $content;
        
        # gzip executable
        } else {
            my ($PH, $CMD);
            $CMD = whereis "gzip";
            $CMD = "\"$CMD\" -cd \"$file\"";
            open $PH, "$CMD |"          or die thisfile . ": $CMD: $!";
            $content = join "", <$PH>;
            close $PH                   or die thisfile . ": $CMD: $!";
            return $content;
        }
    
    # a bzip compressed file
    } elsif ($file =~ /\.bz2$/) {
        # Compress::Bzip2
        if (eval {  require Compress::Bzip2;
                    import Compress::Bzip2 2.00;
                    import Compress::Bzip2 qw(bzopen);
                    1; }) {
            my ($FH, $bz);
            $content = "";
            open $FH, $file             or die thisfile . ": $file: $!";
            $bz = bzopen($FH, "rb")     or die thisfile . ": $file: $!";
            while (1) {
                ($bz->bzread($_, 10240) != -1)
                                        or die thisfile . ": $file: " . $bz->bzerror;
                $content .= $_;
                last if length $_ < 10240;
            }
            $bz->bzclose                and die thisfile . ": $file: " . $bz->bzerror;
            return $content;
        
        # bzip2 executable
        } else {
            my ($PH, $CMD);
            $CMD = whereis "bzip2";
            $CMD = "bzip2 -cd \"$file\"";
            open $PH, "$CMD |"          or die thisfile . ": $CMD: $!";
            $content = join "", <$PH>;
            close $PH                   or die thisfile . ": $CMD: $!";
            return $content;
        }
    
    # a plain text file
    } else {
        my $FH;
        open $FH, $file                 or die thisfile . ": $file: $!";
        $content = join "", <$FH>;
        close $FH                       or die thisfile . ": $file: $!";
        return $content;
    }
}

# frread: A raw file reader
sub frread($) {
    local ($_, %_);
    my ($file, $content, $FH, $size);
    $file = $_[0];
    
    # non-existing file
    return undef if !-e $file;
    
    $size = (stat $file)[7];
    open $FH, $file                     or die thisfile . ": $file: $!";
    binmode $FH                         or die thisfile . ": $file: $!";
    (read($FH, $content, $size) == $size)
                                        or die thisfile . ": $file: $!";
    close $FH                           or die thisfile . ": $file: $!";
    return $content;
}

# fwrite: A simple writer to write a log file in any supported format
sub fwrite($$) {
    local ($_, %_);
    my ($file, $content);
    ($file, $content) = @_;
    
    # a gzip compressed file
    if ($file =~ /\.gz$/) {
        # Compress::Zlib
        if (eval {  require Compress::Zlib;
                    import Compress::Zlib qw(gzopen);
                    1; }) {
            my ($FH, $gz);
            open $FH, ">$file"          or die thisfile . ": $file: $!";
            $gz = gzopen($FH, "wb9")    or die thisfile . ": $file: $!";
            ($gz->gzwrite($content) == length $content)
                                        or die thisfile . ": $file: " . $gz->gzerror;
            $gz->gzclose                and die thisfile . ": $file: " . $gz->gzerror;
            return;
        
        # gzip executable
        } else {
            my ($PH, $CMD);
            $CMD = whereis "gzip";
            $CMD = "\"$CMD\" -c9f > \"$file\"";
            open $PH, "| $CMD"          or die thisfile . ": $CMD: $!";
            print $PH $content          or die thisfile . ": $CMD: $!";
            close $PH                   or die thisfile . ": $CMD: $!";
            return;
        }
    
    # a bzip compressed file
    } elsif ($file =~ /\.bz2$/) {
        # Compress::Bzip2
        if (eval {  require Compress::Bzip2;
                    import Compress::Bzip2 2.00;
                    import Compress::Bzip2 qw(bzopen);
                    1; }) {
            my ($FH, $bz);
            open $FH, ">$file"          or die thisfile . ": $file: $!";
            $bz = bzopen($FH, "wb9")    or die thisfile . ": $file: $!";
            ($bz->bzwrite($content, length $content) == length $content)
                                        or die thisfile . ": $file: " . $bz->bzerror;
            $bz->bzclose                and die thisfile . ": $file: " . $bz->bzerror;
            return;
        
        # bzip2 executable
        } else {
            my ($PH, $CMD);
            $CMD = whereis "bzip2";
            $CMD = "\"$CMD\" -9f > \"$file\"";
            open $PH, "| $CMD"        or die thisfile . ": $CMD: $!";
            print $PH $content        or die thisfile . ": $CMD: $!";
            close $PH                 or die thisfile . ": $CMD: $!";
            return;
        }
    
    # a plain text file
    } else {
        my $FH;
        open $FH, ">$file"              or die thisfile . ": $file: $!";
        print $FH $content              or die thisfile . ": $file: $!";
        close $FH                       or die thisfile . ": $file: $!";
        return;
    }
}

# frwrite: A raw file writer
sub frwrite($$) {
    local ($_, %_);
    my ($file, $content, $FH);
    ($file, $content) = @_;
    
    open $FH, ">$file"                  or die thisfile . ": $file: $!";
    binmode $FH                         or die thisfile . ": $file: $!";
    print $FH $content                  or die thisfile . ": $file: $!";
    close $FH                           or die thisfile . ": $file: $!";
    return;
}

# runcmd: Run a command and return the result
sub runcmd($@) {
    local ($_, %_);
    my ($retno, $out, $err, $in, @cmd, $cmd, $OUT, $ERR, $STDOUT, $STDERR, $PH);
    ($in, @cmd) = @_;
    
    $err = "Running " . join(" ", map "\"$_\"", @cmd) . "\n";
    $out = "";
    
    open $STDOUT, ">&", \*STDOUT        or die thisfile . ": STDOUT: $!";
    open $STDERR, ">&", \*STDERR        or die thisfile . ": STDERR: $!";
    $OUT = tempfile                     or die thisfile . ": tempfile: $!";
    binmode $OUT                        or die thisfile . ": tempfile: $!";
    $ERR = tempfile                     or die thisfile . ": tempfile: $!";
    binmode $ERR                        or die thisfile . ": tempfile: $!";
    open STDOUT, ">&", $OUT             or die thisfile . ": tempfile: $!";
    binmode STDOUT                      or die thisfile . ": tempfile: $!";
    open STDERR, ">&", $ERR             or die thisfile . ": tempfile: $!";
    binmode STDERR                      or die thisfile . ": tempfile: $!";
    
    $cmd = join " ", map "\"$_\"", @cmd;
    if ($^O eq "MSWin32") {
        open $PH, "| $cmd"              or die thisfile . ": $cmd: $!";
    } else {
        open $PH, "|-", @cmd            or die thisfile . ": $cmd: $!";
    }
    binmode $PH                         or die thisfile . ": $cmd: $!";
    print $PH $in                       or die thisfile . ": $cmd: $!";
    close $PH;
    $retno = $?;
    
    open STDOUT, ">&", $STDOUT          or die thisfile . ": tempfile: $!";
    open STDERR, ">&", $STDERR          or die thisfile . ": tempfile: $!";
    
    seek $OUT, 0, SEEK_SET              or die thisfile . ": tempfile: $!";
    $out = join "", <$OUT>;
    close $OUT                          or die thisfile . ": tempfile: $!";
    seek $ERR, 0, SEEK_SET              or die thisfile . ": tempfile: $!";
    $err = join "", <$ERR>;
    close $ERR                          or die thisfile . ": tempfile: $!";
    
    return ($retno, $out, $err);
}

# whereis: Find an executable
#   Code inspired from CPAN::FirstTime
sub whereis($) {
    local ($_, %_);
    my ($file, $path);
    $file = $_[0];
    return $WHEREIS{$file} if exists $WHEREIS{$file};
    foreach my $dir (path) {
        return ($WHEREIS{$file} = $path)
            if defined($path = MM->maybe_command(catfile($dir, $file)));
    }
    return ($WHEREIS{$file} = undef);
}

# ftype: Find the file type
sub ftype($) {
    local ($_, %_);
    my $file;
    $file = $_[0];
    return undef unless -e $file;
    # Use File::MMagic
    if (eval { require File::MMagic; 1; }) {
        $_ = new File::MMagic->checktype_filename($file);
        return "application/x-gzip" if /gzip/;
        return "application/x-bzip2" if /bzip2/;
        # All else are text/plain
        return "text/plain";
    }
    # Use file executable
    if (defined($_ = whereis "file")) {
        $_ = join "", `"$_" "$file"`;
        return "application/x-gzip" if /gzip/;
        return "application/x-bzip2" if /bzip2/;
        # All else are text/plain
        return "text/plain";
    }
    # No type checker available
    return undef;
}

# flist: Obtain the files list in a directory
sub flist($) {
    local ($_, %_);
    my ($dir, $DH);
    $dir = $_[0];
    @_ = qw();
    opendir $DH, $dir                   or die thisfile . ": $dir: $!";
    while (defined($_ = readdir $DH)) {
        next if $_ eq "." || $_ eq ".." || !-f "$dir/$_";
        push @_, $_;
    }
    closedir $DH                        or die thisfile . ": $dir: $!";
    return join " ", sort @_;
}

# prsrvsrc: Preserve the source test files
sub prsrvsrc($) {
    local ($_, %_);
    my ($dir, $DH);
    $dir = $_[0];
    @_ = qw();
    opendir $DH, $dir                   or die thisfile . ": $dir: $!";
    while (defined($_ = readdir $DH)) {
        next if $_ eq "." || $_ eq ".." || !-f "$dir/$_";
        push @_, $_;
    }
    closedir $DH                        or die thisfile . ": $dir: $!";
    rmtree "$dir/source";
    mkpath "$dir/source";
    frwrite "$dir/source/$_", frread "$dir/$_"
        foreach @_;
    return;
}

# cleanup: Clean up the test files
sub cleanup($$$) {
    local ($_, %_);
    my ($r, $dir, $testno, $testname, $c);
    ($r, $dir, $testno) = @_;
    # Nothing to clean up
    return unless -e $dir;
    # Success
    if ($r) {
        rmtree $dir;
        return;
    }
    # Fail - keep the test files for failure investigation
    $testname = basename((caller)[1]);
    $testname =~ s/\.t$//;
    $c = 1;
    $c++ while -e ($_ = "$dir.$testname.$testno.$c");
    rename $dir, $_                     or die thisfile . ": $dir, $_: $!";
    return;
}

# nofile: If we have the file type checker somewhere
sub nofile() {
    $NOFILE = eval { require File::MMagic; 1; }
                || defined whereis "file"?
            0: "File::MMagic or file executable not available"
        if !defined $NOFILE;
    return $NOFILE;
}

# nogzip: If we have gzip support somewhere
sub nogzip() {
    $NOGZIP = eval { require Compress::Zlib; 1; }
                || defined whereis "gzip"?
            0: "Compress::Zlib or gzip executable not available"
        if !defined $NOGZIP;
    return $NOGZIP;
}

# nobzip2: If we have bzip2 support somewhere
sub nobzip2() {
    $NOBZIP2 = eval { require Compress::Bzip2; import Compress::Bzip2 2.00; 1; }
                || defined whereis "bzip2"?
            0: "Compress::Bzip2 v2 or bzip2 executable not available"
        if !defined $NOBZIP2;
    return $NOBZIP2;
}

# mkrndlog_existing: Create a random existing log file
sub mkrndlog_existing($$$@) {
    local ($_, %_);
    my ($mkrndlog, $dir, $filepat, @months, %contents);
    ($mkrndlog, $dir, $filepat, @months) = @_;
    
    # Find a non-decided month and have an existing log
    $_{$_[int rand @_]} = 1 if (@_ = grep !exists $_{$_}, @months) > 0;
    # Find a non-decided month and not have an existing log
    $_{$_[int rand @_]} = 0 if (@_ = grep !exists $_{$_}, @months) > 0;
    # Decide the remain months randomly
    $_{$_} = int rand 2 foreach grep !exists $_{$_}, @months;
    %contents = qw();
    foreach my $m (@months) {
        my ($file, $path);
        $file = sprintf($filepat, $m);
        $path = catfile($dir, $file);
        if ($_{$m}) {
            $contents{$file} = (&$mkrndlog($path, $m))[0];
        } else {
            $contents{$file} = "";
        }
    }
    
    return %contents;
}

# mkrndlog_apache: Create a random Apache access log file
sub mkrndlog_apache($;$) {
    local ($_, %_);
    my ($file, $month, @logs, $content, @monrng, %months, $vardump, $tz);
    ($file, $month) = @_;
    
    @logs = qw();
    
    # Time zone
    $tz = (-12 + (int rand 53) / 2) * 3600;
    # To be removed
    #$tz = -12 + (int rand 53) / 2;
    #$tz = sprintf "%+05d", int($tz) * 100 + ($tz - int($tz)) * 60;
    
    # Get the range of a month
    if (defined $month) {
        @monrng = monrng_one $month;
    # Get the range of some previous months
    } else {
        @monrng = monrng_rand;
    }
    for (my $i = 0; $i + 1 < @monrng; $i++) {
        my $hosts;
        # 2-5 hosts
        $hosts = 2 + int rand 4;
        # Generate the visit time of each host
        for (my $j = 0; $j < $hosts; $j++) {
            my ($host, $t, $user, $htver, @hlogs, $hlogs);
            # Host type: 1: IP, 0: domain name
            $host = int rand 2? randip: randdomain;
            $t = $monrng[$i] + int rand($monrng[$i + 1] - $monrng[$i]);
            $user = (0, 0, 1)[int rand 3]? "-": randword;
            $htver = (qw(HTTP/1.1 HTTP/1.1 HTTP/1.1 HTTP/1.0))[int rand 4];
            # 3-5 log records for each host
            $hlogs = 3 + int rand 3;
            @hlogs = qw();
            while (@hlogs < $hlogs) {
                my ($ttxt, $method, $url, $dirs, @dirs, $type, $status, $size);
                # Time text
                @_ = gmtime($t + $tz);
                $_[5] += 1900;
                $_[4] = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$_[4]];
                $ttxt = sprintf "%02d/%s/%04d:%02d:%02d:%02d %+05d",
                    @_[3,4,5,2,1,0],
                    int($tz / 3600) * 100 + ($tz - int($tz / 3600) * 3600) / 60;
                
                $method = (qw(GET GET GET HEAD POST))[int rand 5];
                
                # Generate a random URL
                # 0-3 levels of directories
                $dirs = int rand 4;
                @dirs = qw();
                push @dirs, "/" . randword while @dirs < $dirs;
                $type = ("", qw(html html txt css png jpg))[int rand 7];
                if ($type eq "") {
                    $url = join("", @dirs) . "/";
                } else {
                    $url = join("", @dirs) . "/" . randword . ".$type";
                }
                
                $status = (200, 200, 200, 200, 304, 400, 403, 404)[int rand 8];
                if ($status == 304) {
                    $size = 0;
                } else {
                    $size = 200 + int rand 35000;
                }
                push @hlogs, {
                        "time"      => $t,
                        "record"    => sprintf("%s - %s [%s] \"%s %s %s\" %d %d\n",
                            $host, $user, $ttxt,
                            $method, $url, $htver, $status, $size),
                    };
                
                # 0-2 seconds later
                $t += int rand 3;
            }
            push @logs, @hlogs;
            # 0-5 seconds later
            $t += int rand 6;
        }
    }
    
    # Sort by time
    # A series of requests from a same host may run cross the next host
    # So we need to sort again
    @logs = sort { $$a{"time"} <=> $$b{"time"} } @logs;
    
    # Variables used, for failure investigation
    $vardump = Data::Dumper->Dump([\@logs, $tz], [qw($logs $tz)]);
    
    # Split by months
    %months = split_months @logs;
    # Drop the time and keep the records
    @logs = map $$_{"record"}, @logs;
    # Insert 1-2 malformed lines
    insert_malformed @logs;
    
    # Compose the content
    $content = join "", @logs;
    # Output the file
    fwrite($file, $content);
    # Return the content
    return $content, $vardump, %months;
}

# mkrndlog_syslog: Create a random Syslog log file
sub mkrndlog_syslog($;$) {
    local ($_, %_);
    my ($file, $month, @logs, $content, @monrng, %months, $vardump);
    my (@hosts, $hosts);
    ($file, $month) = @_;
    
    @logs = qw();
    
    # 3-5 hosts
    $hosts = 3 + int rand 3;
    @hosts = qw();
    push @hosts, randword while @hosts < $hosts;
    
    # Get the range of a month
    if (defined $month) {
        @monrng = monrng_one $month;
    # Get the range of some previous months
    } else {
        @monrng = monrng_rand;
    }
    for (my $i = 0; $i + 1 < @monrng; $i++) {
        my (@mlogs, $mlogs, @t);
        # 5-12 log records for each month
        $mlogs = 5 + int rand 8;
        @mlogs = qw();
        # Generate the time of each record
        @t = qw();
        push @t, $monrng[$i] + int rand($monrng[$i + 1] - $monrng[$i])
            while @t < $mlogs;
        foreach my $t (sort @t) {
            my ($ttxt, $host, $app, $pid, $msg);
            # Time text
            @_ = localtime $t;
            $_[5] += 1900;
            $_[4] = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$_[4]];
            $ttxt = sprintf "%s %2d %02d:%02d:%02d", @_[4,3,2,1,0];
            $host = $hosts[int rand scalar @hosts];
            $app = (qw(kernel sendmail sshd su CRON), randword, randword)[int rand 5];
            # PID 2-65535 (PID 1 is init)
            $pid = 2 + int rand 65533;
            # 3-12 words for each message
            $_ = 3 + int rand 10;
            @_ = qw();
            push @_, randword while @_ < $_;
            $msg = join " ", @_;
            
            push @mlogs, {
                    "time"      => $t,
                    "record"    => sprintf("%s %s %s[%d] %s\n",
                        $ttxt, $host, $app, $pid, $msg),
                };
        }
        push @logs, @mlogs;
    }
    
    # Variables used, for failure investigation
    $vardump = Data::Dumper->Dump([\@logs], [qw($logs)]);
    
    # Split by months
    %months = split_months @logs;
    # Drop the time and keep the records
    @logs = map $$_{"record"}, @logs;
    # Insert 1-2 malformed lines
    insert_malformed @logs;
    
    # Compose the content
    $content = join "", @logs;
    # Output the file
    fwrite($file, $content);
    # Return the content
    return $content, $vardump, %months;
}

# mkrndlog_ntp: Create a random NTP log file
sub mkrndlog_ntp($;$) {
    local ($_, %_);
    my ($file, $month, @logs, $content, @monrng, %months, $vardump);
    my ($pid, $peers, @peers, $refs, @refs);
    ($file, $month) = @_;
    
    @logs = qw();
    
    # PID 2-65535 (PID 1 is init)
    $pid = 2 + int rand 65533;
    # 3-5 peers
    $peers = 3 + int rand 3;
    @peers = qw();
    push @peers, randip while @peers < $peers;
    # 2-3 references
    $refs = 2 + int rand 2;
    push @refs, randip while @refs < $refs;
    
    # Get the range of a month
    if (defined $month) {
        @monrng = monrng_one $month;
    # Get the range of some previous months
    } else {
        @monrng = monrng_rand;
    }
    for (my $i = 0; $i + 1 < @monrng; $i++) {
        my (@mlogs, $mlogs, @t);
        # 5-12 log records for each month
        $mlogs = 5 + int rand 8;
        @mlogs = qw();
        # Generate the time of each record
        @t = qw();
        push @t, $monrng[$i] + int rand($monrng[$i + 1] - $monrng[$i])
            while @t < $mlogs;
        foreach my $t (sort @t) {
            my ($ttxt, $type, $msg);
            # Time text
            @_ = localtime $t;
            $_[5] += 1900;
            $_[4] = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$_[4]];
            $ttxt = sprintf "%2d %s %02d:%02d:%02d", @_[3,4,2,1,0];
            # PID change - chance 2.73%, 50% change to total 25 records
            $pid = 2 + int rand 65533
                if rand() < 0.0273;
            $type = int rand 3;
            # Type 0 - peer reachability
            if ($type == 0) {
                my ($peer, $events);
                # 1-15 events
                $events = 1 + int rand 15;
                $peer = $peers[int rand @peers];
                # Reachable
                if (int rand 5 > 1) {
                    $msg = "peer $peer event 'event_reach' (0x84) status 'unreach, conf, auth, $events events, event_reach' (0xe0f4)";
                # Unreachable
                } else {
                    $msg = "peer $peer event 'event_unreach' (0x83) status 'unreach, conf, auth, $events events, event_unreach' (0xe0f3)";
                }
            # Type 1 - reference host
            } elsif ($type == 1) {
                my ($refhost, $stratum);
                $refhost = $refs[int rand @refs];
                # Stratum 2-4
                $stratum = 2 + int rand 2;
                $msg = "synchronized to $refhost, stratum $stratum";
            # Type 2 - clock set
            } elsif ($type == 2) {
                my ($off, $freq, $err, $poll);
                $off = (rand() - 0.5) / 10;
                $freq = rand() * -10;
                $err = rand() / 20;
                # poll 4-10
                $poll = 4 + int rand 7;
                $msg = sprintf "offset %8.6f sec freq %6.3f ppm error %8.6f poll %d",
                    $off, $freq, $err, $poll;
            }
            
            push @mlogs, {
                    "time"      => $t,
                    "record"    => sprintf("%s ntpd[%d] %s\n",
                        $ttxt, $pid, $msg),
                };
        }
        push @logs, @mlogs;
    }
    
    # Variables used, for failure investigation
    $vardump = Data::Dumper->Dump([\@logs], [qw($logs)]);
    
    # Split by months
    %months = split_months @logs;
    # Drop the time and keep the records
    @logs = map $$_{"record"}, @logs;
    # Insert 1-2 malformed lines
    insert_malformed @logs;
    
    # Compose the content
    $content = join "", @logs;
    # Output the file
    fwrite($file, $content);
    # Return the content
    return $content, $vardump, %months;
}

# mkrndlog_apachessl: Create a random Apache SSL engine log file
sub mkrndlog_apachessl($;$) {
    local ($_, %_);
    my ($file, $month, @logs, $content, @monrng, %months, $vardump);
    my $host;
    ($file, $month) = @_;
    
    @logs = qw();
    
    $host = randdomain;
    
    # Get the range of a month
    if (defined $month) {
        @monrng = monrng_one $month;
    # Get the range of some previous months
    } else {
        @monrng = monrng_rand;
    }
    for (my $i = 0; $i + 1 < @monrng; $i++) {
        my (@mlogs, $mlogs, @t);
        # 3-5 visitors for each month
        $mlogs = 3 + int rand 3;
        @mlogs = qw();
        # Generate the time of each record
        @t = qw();
        push @t, $monrng[$i] + int rand($monrng[$i + 1] - $monrng[$i])
            while @t < $mlogs;
        foreach my $t (sort @t) {
            my ($ttxt, $pid, $remote, $priority, $child, $msg);
            # Time text
            @_ = localtime $t;
            $_[5] += 1900;
            $_[4] = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$_[4]];
            $ttxt = sprintf "%02d/%s/%04d %02d:%02d:%02d", @_[3,4,5,2,1,0];
            # PID 2-65535 (PID 1 is init)
            $pid = 2 + int rand 65533;
            # Remote client
            $remote = randip;
            # Child number
            $child = int rand 15;
            
            # Error
            if (int rand 5 == 1) {
                $priority = "error";
                $msg = "SSL handshake failed (server $host:443, client $remote) (OpenSSL library error follows)";
                push @mlogs, {
                        "time"      => $t,
                        "record"    => sprintf("[%s %05d] [%s]  %s\n",
                            $ttxt, $pid, $priority, $msg),
                    };
                $msg = "OpenSSL: error:1408E0F4:SSL routines:SSL3_GET_MESSAGE:unexpected message";
                push @mlogs, {
                        "time"      => $t,
                        "record"    => sprintf("[%s %05d] [%s]  %s\n",
                            $ttxt, $pid, $priority, $msg),
                    };
            
            # Info
            } else {
                $priority = "info";
                $msg = "Connection to child $child established (server $host:443, client $remote)";
                push @mlogs, {
                        "time"      => $t,
                        "record"    => sprintf("[%s %05d] [%s]  %s\n",
                            $ttxt, $pid, $priority, $msg),
                    };
                $msg = "Seeding PRNG with 1164 bytes of entropy";
                push @mlogs, {
                        "time"      => $t,
                        "record"    => sprintf("[%s %05d] [%s]  %s\n",
                            $ttxt, $pid, $priority, $msg),
                    };
                # 1: bad
                if (int rand 2) {
                    $msg = "Spurious SSL handshake interrupt[Hint: Usually just one of those OpenSSL confusions!?]";
                    push @mlogs, {
                            "time"      => $t,
                            "record"    => sprintf("[%s %05d] [%s]  %s\n",
                                $ttxt, $pid, $priority, $msg),
                        };
                # 2: success
                } else {
                    my $reqs;
                    # 1-5 requests
                    $reqs = 1 + int rand 5;
                    for (my $j = 1; $j <= $reqs; $j++) {
                        if ($j == 1) {
                            $msg = "Initial (No.$j) HTTPS request received for child $child ($host:443)"
                        } else {
                            $msg = "Subsequent (No.$j) HTTPS request received for child $child ($host:443)"
                        }
                        push @mlogs, {
                                "time"      => $t,
                                "record"    => sprintf("[%s %05d] [%s]  %s\n",
                                    $ttxt, $pid, $priority, $msg),
                            };
                    }
                    $msg = "Connection to child $child closed with standard shutdown (server $host:443, client $remote)";
                    push @mlogs, {
                            "time"      => $t,
                            "record"    => sprintf("[%s %05d] [%s]  %s\n",
                                $ttxt, $pid, $priority, $msg),
                        };
                }
            }
        }
        push @logs, @mlogs;
    }
    
    # Variables used, for failure investigation
    $vardump = Data::Dumper->Dump([\@logs], [qw($logs)]);
    
    # Split by months
    %months = split_months @logs;
    # Drop the time and keep the records
    @logs = map $$_{"record"}, @logs;
    # Insert 1-2 malformed lines
    insert_malformed @logs;
    
    # Compose the content
    $content = join "", @logs;
    # Output the file
    fwrite($file, $content);
    # Return the content
    return $content, $vardump, %months;
}

# mkrndlog_modfiso: Create a random modified ISO 8861 date/time log file
sub mkrndlog_modfiso($;$) {
    local ($_, %_);
    my ($file, $month, @logs, $content, @monrng, %months, $vardump, $tz);
    ($file, $month) = @_;
    
    @logs = qw();
    
    # Time zone
    $tz = (-12 + (int rand 53) / 2) * 3600;
    # To be removed
    #$tz = -12 + (int rand 53) / 2;
    #$tz = sprintf "%+05d", int($tz) * 100 + ($tz - int($tz)) * 60;
    
    # Get the range of a month
    if (defined $month) {
        @monrng = monrng_one $month;
    # Get the range of some previous months
    } else {
        @monrng = monrng_rand;
    }
    for (my $i = 0; $i + 1 < @monrng; $i++) {
        my (@mlogs, $mlogs, @t);
        # 5-12 log records for each month
        $mlogs = 3 + int rand 3;
        @mlogs = qw();
        # Generate the time of each record
        @t = qw();
        push @t, $monrng[$i] + int rand($monrng[$i + 1] - $monrng[$i])
            while @t < $mlogs;
        foreach my $t (sort @t) {
            my ($ttxt, $id, $msg);
            # Time text
            @_ = gmtime($t + $tz);
            $_[5] += 1900;
            $_[4]++;
            $ttxt = sprintf "%04d-%02d-%02d %02d:%02d:%02d %+05d",
                @_[5,4,3,2,1,0], 
                int($tz / 3600) * 100 + ($tz - int($tz / 3600) * 3600) / 60;
            # identity
            $id = randword;
            # 3-12 words for each message
            $_ = 3 + int rand 10;
            @_ = qw();
            push @_, randword while @_ < $_;
            $msg = join " ", @_;
            push @mlogs, {
                    "time"      => $t,
                    "record"    => sprintf("[%s] %s: %s\n",
                        $ttxt, $id, $msg),
                };
        }
        push @logs, @mlogs;
    }
    
    # Variables used, for failure investigation
    $vardump = Data::Dumper->Dump([\@logs, $tz], [qw($logs $tz)]);
    
    # Split by months
    %months = split_months @logs;
    # Drop the time and keep the records
    @logs = map $$_{"record"}, @logs;
    # Insert 1-2 malformed lines
    insert_malformed @logs;
    
    # Compose the content
    $content = join "", @logs;
    # Output the file
    fwrite($file, $content);
    # Return the content
    return $content, $vardump, %months;
}

# monrng_one: Get the range of a specific month
sub monrng_one($) {
    local ($_, %_);
    my ($month, @range);
    $month = $_[0];
    # Sanity check
    return unless $month =~ /^(\d{4})(\d{2})$/;
    @range = qw();
    # The beginning of the month
    @_ = (0, 0, 0, 1, $2 - 1, $1 - 1900);
    return unless defined($_ = timelocal(@_[0...6]));
    push @range, $_;
    # The beginning of the next month
    $_[4]++;
    if ($_[4] > 11) {
        $_[4] = 0;
        $_[5]++;
    }
    return unless defined($_ = timelocal(@_[0...6]));
    push @range, $_;
    return @range;
}

# monrng_rand: Get the range of some previous months
sub monrng_rand() {
    local ($_, %_);
    my ($num, @range);
    # 1-3 previous months
    $num = 1 + int rand 3;
    @range = qw();
    unshift @range, time;
    @_ = (0, 0, 0, 1, (localtime)[4,5]);
    unshift @range, timelocal(@_);
    for (my $i = 0; $i < $num; $i++) {
        $_[4]--;
        if ($_[4] < 0) {
            $_[4] = 11;
            $_[5]--;
        }
        unshift @range, timelocal(@_);
    }
    return @range;
}

# split_months: Split the log records by months
sub split_months(\@) {
    local ($_, %_);
    my ($logs, %months);
    $logs = $_[0];
    
    %months = qw();
    foreach (@$logs) {
        my $month;
        @_ = localtime $$_{"time"};
        $month = sprintf "%04d%02d", $_[5] + 1900, $_[4] + 1;
        $months{$month} = "" if !exists $months{$month};
        $months{$month} .= $$_{"record"};
    }
    
    return %months;
}

# insert_malformed: Insert 1-2 malformed lines
sub insert_malformed(\@) {
    local ($_, %_);
    my ($logs, $malformed);
    $logs = $_[0];
    
    $malformed = 1 + int rand 2;
    while ($malformed > 0) {
        my $line;
        # Generate the random malformed line
        $_ = 3 + int rand 5;
        @_ = qw();
        push @_, randword while @_ < $_;
        $line = join(" ", @_) . ".\n";
        $line =~ s/^(.)/uc $1/e;
        # The position to insert the line
        # The position cannot be 0 - or we cannot judge the log format
        $_ = 1 + int rand(@$logs - 1); 
        $logs = [@$logs[0...$_], $line, @$logs[$_+1...$#$logs]];
        $malformed--;
    }
    
    return;
}

# randword: Supply a random English word
sub randword() {
    local ($_, %_);
    @_ = qw(
culminates spector thule tamil sages fasten bothers intricately librarian
mist criminate impressive scissor trance standardizing enabler athenians
planers decisions salvation wetness fibers cowardly winning call stockton
bifocal rapacious steak reinserts overhaul glaringly playwrights wagoner
garland hampered effie messy despaired orthodoxy bacterial bernardine driving
danization vapors uproar sects litmus sutton lacrosse);
    return $_[int rand @_];
}

# randip: Supply a random IP
sub randip() {
    return join ".", (int rand 255, int rand 255,
        int rand 255, 1 + int rand 254);
}

# randdomain: Supply a random domain
sub randdomain() {
    local ($_, %_);
    # Generate a random domain name
    # 3-5 levels, end with net or com
    $_ = 2 + int rand 3;
    @_ = qw();
    push @_, randword while @_ < $_;
    push @_, (qw(net com))[int rand 2];
    return join ".", @_;
}

1;

__END__