#!/usr/bin/perl
our $VERSION = '2.0 (2013-01-15)';
#
# volnuke -- Delete a volume, tracking down what servers it's on.
#
# A smart and dangerous vos remove, but one that prompts you to be sure you're
# doing what you intend.  Deletes a volume without having to know the volume's
# location beforehand, including tracking down and removing all the
# replication points.  If the volume is replicated, it also checks to be sure
# that none of the replicas have been accessed.
#
# "These had really struck terror into the hearts of everyone who had
# encountered them -- in most cases, however, the terror was extremely
# short-lived, as was the person experiencing the terror."
#                       -- Douglas Adams, _Life, the Universe, and Everything_
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2002, 2003, 2004, 2010, 2011, 2013
#     The Board of Trustees of the Leland Stanford Junior University
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

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

use 5.006;
use strict;
use warnings;

use Date::Parse qw(str2time);
use Getopt::Long qw(GetOptions);
use POSIX qw(strftime);

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

# The full path to fs and vos.  vos may be in an sbin directory, which may
# not be on the user's path by default, so check there first.
our $FS = 'fs';
our $VOS = grep { -x $_ } qw(/usr/local/sbin/vos /usr/sbin/vos);
$VOS ||= 'vos';

# Load the configuration file if it exists.
if (-f '/etc/afs-admin-tools/config') {
    require '/etc/afs-admin-tools/config';
}

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

# Override system with something that checks return status.
use subs qw(system);
sub system {
    CORE::system (@_) == 0
        or die "$0: @_ failed (status " . ($? >> 8) . ")\n";
}

##############################################################################
# AFS information
##############################################################################

# Given a mount point, get the volume name of the volume mounted there.
sub mount_to_name {
    my ($path) = @_;
    if ($path =~ /[\\\']/) {
        die "$0: invalid character in $path\n";
    }
    if ($path !~ m%^/%) {
        $path = './' . $path;
    }
    my $volume = `$FS lsmount '$path'`;
    die "$0: cannot determine volume from mount point $path\n"
        unless ($volume =~ /^\S+ is a mount point for volume \'\#(\S+)\'$/);
    return $1;
}

# Given a volume name, determines various characteristics of the volume and
# returns them in a hash.  'size' gets the volume size in KB, 'rwserver' and
# 'rwpart' get the server and partition for the read-write volume, 'ro' gets a
# hash of server and partition values for the replicas, 'sites' gets a count
# of the number of sites the volume is replicated on, 'unreleased' gets a
# boolean value saying whether there are unreleased changes, and 'accesses'
# gets an array of access counts.
sub volinfo {
    my ($volume, $checkro) = @_;
    my (%results, $rotime, $rwtime);
    open (VEX, "$VOS examine $volume |")
        or die "$0: can't fork $VOS examine: $!\n";
    local $_;
    while (<VEX>) {
        if (/^\Q$volume\E\s+\d+ (RW|RO|BK)\s+(\d+) K\s+On-line\s*$/) {
            die "$0: $volume is $1, not RW\n" unless $1 eq 'RW';
            $results{size} = $2;
        } elsif (/^\s+server ([^.\s]+)\.\S+ partition (\S+) RW Site\s*/) {
            die "$0: saw two RW sites for $volume\n" if $results{rwserver};
            $results{rwserver} = $1;
            $results{rwpart} = $2;
        } elsif (/^\s+server ([^.\s]+)\.\S+ partition (\S+) RO Site\s*/) {
            $results{ro}{$1} = $2;
            $results{sites}++;
        } elsif (/^\s+Last Update (.*)/) {
            my $tmp = $1;
            $rwtime = str2time($tmp);
        }
    }
    close VEX;
    die "$0: unable to parse vos examine $volume\n"
        unless ($results{rwserver} && $results{size});
    if ($results{sites}) {
        open (VEX, "$VOS examine $volume.readonly |")
            or die "$0: can't fork $VOS examine for readonly: $!\n";
        while (<VEX>) {
            if (/^\s+Last Update (.*)/) {
                my $tmp = $1;
                $rotime = str2time($tmp);
            }
            if (/^\s+(\d+) accesses in the past day/) {
                $results{accesses} ||= [];
                push (@{ $results{accesses} }, $1);
            }
        }
        close VEX;
        if ($rwtime > $rotime) { $results{unreleased} = 1 }
    }
    return %results;
}

##############################################################################
# Implementation
##############################################################################

# Usage message, in case the command line syntax is wrong.
sub usage { die "Usage: $0 <volume>\n" }

# Make sure that all output is sent immediately, since vos remove reports some
# things to stderr.
$| = 1;

# Parse our options.
my $fullpath = $0;
$0 =~ s%.*/%%;
my ($date, $file, $force, $help, $justprint, $mountpoint, $version);
Getopt::Long::config ('bundling', 'no_ignore_case');
GetOptions ('date|d'               => \$date,
            'file|f=s'             => \$file,
            'force|F'              => \$force,
            'help|h'               => \$help,
            'mountpoint|m'         => \$mountpoint,
            'dry-run|just-print|n' => \$justprint,
            'version|v'            => \$version) or exit 1;
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $fullpath);
} elsif ($version) {
    print "volnuke $VERSION\n";
    exit 0;
}

# Volume name or mount point is always the first argument.  Pull it off and
# figure out where this volume is.
usage if (@ARGV != 1);
my $volume;
if ($mountpoint) {
    $mountpoint = shift;
    $mountpoint =~ s%/+$%%;
    $volume = mount_to_name ($mountpoint);
} else {
    $volume = shift;
}
my %volume = volinfo $volume;

# Report the details about the volume and get confirmation.
print "\n$volume on $volume{rwserver} $volume{rwpart} ($volume{size} KB)";
print " with unreleased changes" if $volume{unreleased};
print "\n";
for (keys %{ $volume{ro} }) {
    print "  replica on $_ $volume{ro}{$_}\n";
}
unless ($force) {
    print "\nContinue (y/N)? ";
    my $response = <STDIN>;
    exit if ($response !~ /^y/i);
    print "\n";
}
if ($volume{accesses} && grep { $_ != 0 } @{ $volume{accesses} }) {
    print "WARNING: Replica sites have accesses:\n\n";
    for (@{ $volume{accesses} }) {
        printf "  %6d accesses in the past day\n", $_;
    }
    if ($force) {
        print "\nCowardly refusing to delete with --force in effect\n";
        exit 1;
    } else {
        print "\nAre you SURE you want to continue (y/N)? ";
        my $response = <STDIN>;
        exit if ($response !~ /^y/i);
        print "\n";
    }
}

# Now build the list of commands to run to remove the volume.
my @commands;
if ($volume{sites}) {
    for (keys %{ $volume{ro} }) {
        push (@commands,
              [ $VOS, 'remove', $_, $volume{ro}{$_}, "$volume.readonly" ]);
    }
}
push (@commands,
      [ $VOS, 'remove', $volume{rwserver}, $volume{rwpart}, $volume ]);

# Okay, run our commands.
for (@commands) {
    print "@$_\n";
    unless ($justprint) { system (@$_) }
}
if ($file && !$justprint) {
    open (LIST, ">> $file") or die "$0: cannot open $file: $!\n";
    if ($date) {
        my $date = strftime ('%Y-%m-%d', localtime);
        print LIST "$date $volume\n";
    } else {
        print LIST $volume, "\n";
    }
    close LIST;
}
if ($mountpoint) {
    if ($mountpoint !~ m%^/%) {
        $mountpoint = './' . $mountpoint;
    }
    print "$FS rmmount $mountpoint\n";
    system ($FS, 'rmmount', $mountpoint) unless $justprint;
}
__END__

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

=for stopwords
AFS -Fn afs-admin-tools YYYY-MM-DD backend -dFhvn fs lsmount mvto volnuke vos

=head1 NAME

volnuke - Delete a volume, tracking down what servers it's on

=head1 SYNOPSIS

volnuke [B<-dFhvn>] [B<-f> I<list-file>] I<volume>

volnuke [B<-Fn>] [B<-f> I<list-file>] B<-m> I<mountpoint>

=head1 DESCRIPTION

B<volnuke> is a smart B<vos remove> that figures out what servers the
volume is on to delete it, including replication sites for replicated
volumes.  As a safety measure, it prompts the user whether they're sure
they want to delete the volume, and for replicated volumes it also checks
if any of the replicas have had accesses and prompts the user again to be
sure if they do.

Normally, B<volnuke> takes a volume as an argument, but with the B<-m>
option it takes a mount point instead and gets the volume name with B<fs
lsmount>, and then removes that mount point when it finishes.

=head1 OPTIONS

=over 4

=item B<-d>, B<--date>

When writing the name of the deleted volume to a file (see the B<-f>
option), prepend the current date as YYYY-MM-DD and then a space to each
line.

=item B<-F>, B<--force>

Don't prompt before deleting the volume.  This option is NOT RECOMMENDED
and is here solely for sysctl/remctl backend scripts.

=item B<-f> I<list-file>, B<--file>=I<list-file>

Append the name of the deleted volume to the given file.  This is used to
accumulate a list of volumes to purge from backups.

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

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

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

Rather than a volume name, take the argument to B<volnuke> as a mount
point and get the volume name from B<fs lsmount>.  Also removes the mount
point after B<volnuke> finishes.

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

Print out volume status information and the commands that B<mvto> would
run, but don't execute any of them.

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

Print out the version of B<mvto> and exit.

=back

=head1 CONFIGURATION

B<volnuke> loads configuration settings from
F</etc/afs-admin-tools/config> if that file exists.  If it exists, it must
be Perl code suitable for loading with C<require>.  This means that each
line of the configuration file should be of the form:

    our $VARIABLE = VALUE;

where C<$VARIABLE> is the configuration variable being set and C<VALUE> is
the value to set it to (which should be enclosed in quotes if it's not a
number).  The file should end with:

    1;

so that Perl knows the file was loaded correctly.

The supported configuration variables are:

=over 4

=item $FS

The full path to the AFS B<fs> utility.  If this variable is not set,
B<volnuke> defaults to looking for B<fs> on the user's PATH.

=item $VOS

The full path to the AFS B<vos> utility.  If this variable is not set,
B<volnuke> defaults to F</usr/local/sbin/vos> or F</usr/sbin/vos> if they
exist, and otherwise looks for B<vos> on the user's PATH.

=back

=head1 EXAMPLES

Delete the volume ls.trip.windlord:

    volnuke ls.trip.windlord

The user will be prompted to confirm the action, and possibly prompted
again if the volume is replicated and the read-only replicas have
accesses.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 2002, 2003, 2004, 2010, 2011 The Board of Trustees of the Leland
Stanford Junior University.

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

=head1 SEE ALSO

L<fs_lsmount(1)>, L<vos(1)>, L<vos_examine(1)>, L<vos_remove(1)>

This script is part of the afs-admin-tools package.  The most recent
version is available from the afs-admin-tools web page at
L<http://www.eyrie.org/~eagle/software/afs-admin-tools/>.

=cut
