#!/usr/bin/perl -w
$ID = q$Id: volcreate-logs,v 1.15 2004/07/16 01:03:21 eagle Exp $;
#
# volcreate-logs -- Create and grant quota to log volumes in AFS.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2002, 2004 Board of Trustees, Leland Stanford Jr. University
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

##############################################################################
# Site configuration
##############################################################################

# The address to which to send mailed reports.
$ADDRESS        = 'afs-reports@lists.stanford.edu';

# The full path to aklog, used to obtain AFS tokens from a Kerberos ticket.
$AKLOG          = '/usr/local/bin/aklog';

# The path to the config file specifying what to do.
$CONFIG         = '/afs/ir/service/afs/data/log-volumes';

# The default root path for ticket files, used for the -k option if a relative
# path to a ticket file was given.
$TICKETS        = '/var/run';

# The path to volcreate, used to create volumes.
$VOLCREATE      = '/afs/ir/service/afs/scripts/volcreate';

# The full path to fs and vos.  Allow for Linux where the preferred location
# may be on local disk.
($FS)  = grep { -x $_ } qw(/usr/bin/fs /usr/afsws/bin/fs /usr/pubsw/bin/fs);
$FS ||= '/usr/afsws/bin/fs';
($VOS) = grep { -x $_ } qw(/usr/bin/vos /usr/pubsw/bin/vos);
$VOS ||= '/usr/pubsw/bin/vos';

##############################################################################
# Modules and declarations
##############################################################################

require 5.005;

use strict;
use vars qw($ADDRESS $AKLOG $CONFIG $FS $ID $JUSTPRINT $MAIL $MAILOPEN
            $TICKETS $VOLCREATE $VOS);
use subs qw(system);

use Getopt::Long qw(GetOptions);
use POSIX qw(strftime);

##############################################################################
# Overrides
##############################################################################

# We override system to honor the global $JUSTPRINT variable.  It otherwise
# works the same way as system normally does.
sub system {
    if ($JUSTPRINT) {
        print "@_\n";
        return 0;
    } else {
        return CORE::system (@_);
    }
}

##############################################################################
# Reporting
##############################################################################

# Start a mail message to $ADDRESS on the MAIL file descriptor.
sub start_mail {
    my ($sendmail) = grep { -x $_ } qw(/usr/sbin/sendmail /usr/lib/sendmail);
    $sendmail ||= '/usr/lib/sendmail';
    my $date = strftime ("%Y-%m-%d", localtime);
    open (MAIL, "| $sendmail -t -oi -oem")
        or die "Cannot fork $sendmail: $!\n";
    print MAIL "To: $ADDRESS\n";
    print MAIL "Subject: Log volume report ($date)\n";
    print MAIL "\n";
    $MAILOPEN = 1;
}

# Report an action.  Checks $MAIL to see if the report should be via e-mail,
# and if so, checks $MAILOPEN to see if we've already started the mail
# message.
sub report {
    if ($MAIL) {
        start_mail unless $MAILOPEN;
        print MAIL @_;
    } else {
        print @_;
    }
}

##############################################################################
# Volume quota checking
##############################################################################

# Takes the volume name, the full path to a mount point for a volume, and the
# minimum quota that that volume should have.  Increases the quota of the
# volume to at least the minimum and by 10% if the volume is within 90% of its
# quota.
sub check_quota {
    my ($volume, $mountpoint, $minimum) = @_;
    $minimum *= 1000;
    my @listquota = `$FS listquota $mountpoint 2>&1`;

    # The first line is always headers, so ignore it.  The second line is
    # either an error message or our quota information, in the form volume
    # name, quota, used amount, used percentage, and partition percentage.
    shift @listquota;
    if ($listquota[0] =~ /^fs: /) {
        warn $listquota[0];
        warn "Unable to get quota information for $volume\n";
        return;
    }
    my ($volname, $quota, $used, $percent) = split (' ', $listquota[0]);
    unless ($percent =~ s/%(<\<)?$//) {
        warn "Unable to parse: $listquota[0]";
        warn "Unable to get quota information for $volume\n";
        return;
    }

    # Figure out if we need to do anything.
    my $newquota = $quota;
    $newquota = int (($quota / 10000) * 1.1 + 0.9) * 10000 if ($percent > 90);
    $newquota = $minimum if ($newquota < $minimum);
    if ($newquota != $quota) {
        report "Setting quota to ", $newquota / 1000, "MB for $volume\n";
        if (system ($FS, 'setquota', $mountpoint, $newquota) != 0) {
            warn "$FS setquota $mountpoint $newquota exited with status ",
                ($? >> 8), "\n";
            warn "Unable to set quota for $volume\n";
        }
    }
}

##############################################################################
# Finding volumes
##############################################################################

# Given a path, run fs lsmount on it and return the volume name, or undef if
# this path isn't a mount point.
sub lsmount {
    my ($path) = @_;
    if ($path =~ /[\\\';]/) {
        die "$0: invalid character in $path\n";
    }
    my $volume = `$FS lsmount '$path' 2>&1`;
    if ($volume =~ /is a mount point for volume \'\#([^\']+)\'/) {
        return $1;
    } else {
        return undef;
    }
}

# Given the base path and the current month and year, find the full path to
# the volume associated with that month and year.  Returns the full path and
# the volume name in a list.
sub find_volume_month {
    my ($base, $month, $year) = @_;
    $month = sprintf ("%02d", $month);
    my ($volume, $path);
    if (-d "$base/$year/$month") {
        $volume = lsmount ("$base/$year/$month");
        $path = "$base/$year/$month" if defined $volume;
    }
    return ($volume, $path);
}

# Given the base path and the current year, find the full path to the volume
# associated with that year for logs where we only create one volume per year.
# Returns the full path and the volume name in a list.
sub find_volume_year {
    my ($base, $year) = @_;
    my ($volume, $path);
    if (-d "$base/$year") {
        $volume = lsmount ("$base/$year");
        $path = "$base/$year" if defined $volume;
    }
    return ($volume, $path);
}

##############################################################################
# Creating volumes
##############################################################################

# Given a volume name, mount point, quota, and flag saying whether to be
# quiet, create that volume.  Performs some basic consistency checks to make
# sure that the quota isn't too large and that the volume or mount point don't
# already exist.
sub create_volume {
    my ($volume, $mountpoint, $quota, $quiet) = @_;
    if ($quota > 5000) {
        warn "$volume not created: ${quota}MB exceeds maximum of 5GB\n";
        return;
    }
    $mountpoint =~ s%/afs/ir%/afs/.ir%;
    if (-d "$mountpoint") {
        warn "$volume not created: $mountpoint already exists\n";
        return;
    }
    if (!$JUSTPRINT && system ("$VOS examine $volume >/dev/null 2>&1") == 0) {
        warn "$volume not created: volume already exists\n";
        return;
    }

    # Create the volume.
    my @command = ('-t', 'logs', $volume, $quota, $mountpoint);
    unshift (@command, '-q') if $quiet;
    if (system ($VOLCREATE, @command) != 0) {
        warn "$VOLCREATE -t logs $volume $quota $mountpoint exited with",
            " status ", ($? >> 8), "\n";
        warn "$volume not fully created, please check\n";
    } else {
        report "Created $volume with quota ${quota}MB\n";
    }
}

# For a yearly log volume, create all of the month subdirectories.  Takes the
# base directory of the new log volume.
sub create_month_dirs {
    my ($base) = @_;
    for (1..12) {
        my $month = sprintf ("%02d", $_);
        if ($JUSTPRINT) {
            print "mkdir $base/$month\n";
        } else {
            mkdir ("$base/$month", 0755)
                or warn "Could not create $base/$month: $!\n";
        }
    }
}

# Given a year, month, configuration hash for a log volume, and flag saying
# whether to be quiet, make sure that a volume for that year and month already
# exists.  If it doesn't, create it.
sub create_log_volume {
    my ($year, $month, $config, $quiet) = @_;
    my ($path, $volume);
    if ($$config{type} eq 'monthly') {
        $path = sprintf ("$$config{path}/%04d/%02d", $year, $month);
        $volume = sprintf ("%s.%04d%02d", $$config{name}, $year, $month);
        if (!-d "$$config{path}/$year") {
            if ($JUSTPRINT) {
                print "mkdir $$config{path}/$year\n";
            } elsif (!mkdir ("$$config{path}/$year", 0755)) {
                warn "Could not create $$config{path}/$year: $!\n";
                warn "$volume not created\n";
                return;
            }
        }
    } elsif ($$config{type} eq 'yearly') {
        $path = sprintf ("$$config{path}/%04d", $year);
        $volume = sprintf ("%s.%04d", $$config{name}, $year);
    }
    if (!-d $path) {
        create_volume ($volume, $path, $$config{quota}, $quiet);
        create_month_dirs ($path) if $$config{type} eq 'yearly';
    }
}

##############################################################################
# Configuration parsing
##############################################################################

# Parse a log section, returning an anonymous hash representing the log
# configuration.
sub parse_log {
    my ($config) = @_;
    my %log;
    while (<$config>) {
        next if /^\s*\#/;
        next if /^\s*$/;
        if (/^\s*\}/) {
            my $okay = 1;
            for (qw/name path type quota/) {
                $okay = 0 unless exists $log{$_};
            }
            if ($okay) {
                return \%log;
            } else {
                warn "Missing attributes in log group ending on line $.\n";
                return undef;
            }
        }
        my ($key, $value) = split (/:\s+/, $_, 2);
        $key =~ s/^\s+//;
        $value =~ s/\s+$//;
        unless ($value) {
            warn "Parse error in log group on line $.\n";
            next;
        }
        unless ($key =~ /^(name|path|type|quota)$/) {
            warn "Unknown attribute $key on line $.\n";
            next;
        }
        $log{$key} = $value;
    }
    warn "Unterminated log group on line $.\n";
    return undef;
}

# Parse the configuration file.  Returns a list of anonymous hashes containing
# configuration information for each log.
sub parse_config {
    my @config;
    open (CONFIG, $CONFIG) or die "Cannot open $CONFIG: $!\n";
    while (<CONFIG>) {
        next if /^\s*\#/;
        next if /^\s*$/;
        if (/^\s*log\s+\{\s*$/) {
            my $config = parse_log (\*CONFIG);
            push (@config, $config) if $config;
        } else {
            warn "Parse error in configuration file on line $.\n";
            next;
        }
    }
    return @config;
}

##############################################################################
# Main routine
##############################################################################

# Parse command line options.
my ($help, $quiet, $ticket, $version);
Getopt::Long::config ('bundling', 'no_ignore_case');
GetOptions ('n|dry-run|just-print' => \$JUSTPRINT,
            'h|help'               => \$help,
            'k|ticket-cache=s'     => \$ticket,
            'm|mail'               => \$MAIL,
            'q|quiet'              => \$quiet,
            'v|version'            => \$version) or exit 1;
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $0) or die "Cannot fork: $!\n";
} elsif ($version) {
    my $version = join (' ', (split (' ', $ID))[1..3]);
    $version =~ s/,v\b//;
    $version =~ s/(\S+)$/($1)/;
    print $version, "\n";
    exit 0;
}

# If a ticket cache was specified on the command line, obtain Kerberos tickets
# from that cache and run aklog to get a token.
if ($ticket) {
    require AFS::Utils;
    $ticket = $TICKETS . '/' . $ticket unless $ticket =~ m%^/%;
    $ENV{KRBTKFILE} = $ticket;
    AFS::Utils::setpag () or die "$0: unable to setpag: $!\n";
    system ($AKLOG) == 0 or die "$0: unable to obtain tokens\n";
}

# Parse the configuration and get the current time.
my @config = parse_config;
my ($day, $month, $year) = (localtime)[3..5];
$month++;
$year += 1900;

# If a particular name or set of names were given on the command line, limit
# our actions to just those names.
if (@ARGV) {
    my %names = map { $_ => 1 } @ARGV;
    @config = grep { $names{$$_{name}} } @config;
    unless (@ARGV == @config) {
        my %found = map { $$_{name} => 1 } @config;
        for (sort keys %names) {
            warn "No configuration found for $_" unless $found{$_};
        }
        exit 1;
    }
}

# For each log configuration, update the quota of the current volume if
# necessary and then create the new volume if it's past the 20th of the month.
for my $config (@config) {
    my ($path, $volume);
    if ($$config{type} eq 'monthly') {
        ($volume, $path) = find_volume_month ($$config{path}, $month, $year);
    } elsif ($$config{type} eq 'yearly') {
        ($volume, $path) = find_volume_year ($$config{path}, $year);
    } else {
        warn "Unknown type $$config{type} for $$config{name}\n";
        next;
    }
    if ($path) {
        check_quota ($volume, $path, $$config{quota});
    } else {
        create_log_volume ($year, $month, $config, $quiet);
    }
    if ($day >= 20) {
        my $month = $month;
        my $year = $year;
        $month++;
        if ($month > 12) {
            $month = 1;
            $year++;
        }
        create_log_volume ($year, $month, $config, $quiet);
    }
}

__END__

##############################################################################
# Documentation
##############################################################################

=head1 NAME

volcreate-logs - Create and grant quota to log volumes in AFS

=head1 SYNOPSIS

B<volcreate-logs> [B<-hmnqv>] [B<-k> I<ticket-cache>]

=head1 DESCRIPTION

This program maintains the size and existence of log volumes in AFS,
creating new ones for upcoming months or years as necessary and increasing
their quota as necessary if they're getting too full.  It reports all of its
actions, by default to standard out but optionally through mail with the
B<-m> option.

The rules for each set of log volumes are defined in the program
configuration file, in F</afs/ir/service/afs/data/log-volumes> by default.
It uses B<volcreate> to create all new log volumes, and therefore initial
ACLs for new log volumes can be set using B<volcreate>'s ACL handling
capabilities.  See L<volcreate(1)> for more information.

In order to use B<volcreate-logs> to manage a set of volumes, the volumes
must use standard directory structure and naming conventions.  This means
that under some root log directory, volumes must be organized like:

    ROOT/<year>/<month>

where <year> is the four-digit year and <month> is the two-digit month (with
zero-padding where necessary).  If there is a separate volume for each
month, those volumes are mounted at locations that look like the above; if
there is only a single volume for each year's worth of logs, that volume is
mounted at ROOT/<year> and will have subdirectories for each month created
automatically.  The log volumes are named C<logs.service.YYYYMM> where
C<service> is some string representing the service being logged and
C<YYYYMM> is the four-digit year and two-digit month.  If the volume only
holds logs for one year, the volume will end with C<YYYY> instead.

New volumes will be created for the following month on any date after the
twentieth of the month (log volumes will only be created if the appropriate
directory does not already exist).  Existing log volumes will have their
quota and usage checked.  If the quota is under the configured size, it will
be increased to match.  If the usage is over 90%, the volume quota will be
increased by 10%, rounded up to the nearest 10MB.

=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print out this documentation (which is done simply by feeding the script to
C<perldoc -t>).

=item B<-k> I<path>, B<--ticket-cache>=I<path>

Indicates that the Kerberos v4 ticket cache found at I<path> should be used
to obtain an AFS token.  If this option is used, the AFS::Utils Perl module
must be available.  A new PAG will be created for the script, the K4 ticket
cache set to I<path>, and B<aklog> will be run to get a token.

If I<path> is relative, it is assumed to be relative to F</var/run>.

=item B<-m>, B<--mail>

Report via e-mail rather than to standard out.  Sends an e-mail report to
afs-reports@lists.stanford.edu (configured at the top of this program).

=item B<-n>, B<--dry-run>, B<--just-print>

Don't take any action other than inspection.  Instead, just print to
standard out each command that would be executed.

=item B<-q>, B<--quiet>

Suppress any additional output other than the one line per action taken
(done mostly by adding the B<-q> option to B<volcreate>).

=item B<-v>, B<--version>

Print out the version of B<volcreate-logs> and exit.

=back

=head1 EXAMPLES

Process all of the current rules, reporting actions to standard out.

    volcreate-logs

Do the same, but instead send the report via e-mail.

    volcreate-logs -m

Do the same, but obtain AFS credentials from /var/run/admin.k4.tgt:

    volcreate-logs -m -k admin.k4.tgt

Check to see what needs to be done, but don't actually do it.  Instead, just
print the commands that would be executed to standard out:

    volcreate-logs -n

Only check and reset quota or create new log volumes for the config file
entries with a name value of C<logs.cgi> or C<logs.www>:

    volcreate-logs logs.cgi logs.www

=head1 FILES

=over 4

=item F</afs/ir/service/afs/data/log-volumes>

This file specifies the collections of log volumes managed by this program,
which runs on lsdb nightly and increases quota or creates new log volumes
as needed.  The syntax must look like:

    log {
        name: <volume-name>
        path: <base-path>
        type: monthly | yearly
        quota: <quota>
    }

where <volume-name> is the base name of the volume (.YYYY or .YYYYMM will be
appended), <base-path> is the root of the log structure (its immediate
subdirectories must be the year directories), type is either montly to
create a new volume for each month or yearly to create one volume for each
year of logs, and <quota> is the starting quota for each volume in MB.

=item F</afs/ir/service/afs/scripts/volcreate>

Used to create volumes.  B<volcreate-logs> assumes that B<volcreate> has
been configured to set the appropriate initial ACLs for the volumes.

=item F</usr/local/bin/aklog>

If AFS token authentication is requested with the B<-k> flag, this program
will be run to obtain an AFS token from the specified ticket cache.

=back

=head1 SEE ALSO

L<newsyslog(1)>, L<volcreate(1)>

The current version of newsyslog is available from its web site at
L<http://www.eyrie.org/~eagle/software/newsyslog/>.

The current version of this program is available from its web page at
L<http://www.eyrie.org/~eagle/software/volcreate/>.  B<volcreate> is also
available from the same page.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 2002, 2004 Board of Trustees, Leland Stanford Jr. University.

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=cut