#!/usr/bin/perl -w
$ID = q$Id: volnuke,v 1.11 2004/03/11 01:30:04 eagle Exp $;
#
# volnuke -- Delete a volume, tracking down what servers it's on.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2002, 2003, 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.
#
# 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.

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

# The full path to the list of volumes awaiting ADSM deletion.
$NUKELIST       = '/afs/ir/service/afs/data/adsm-delete';

# 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($FS $ID $NUKELIST $VOS);

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

##############################################################################
# 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";
    }
    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) {
    my $version = join (' ', (split (' ', $ID))[1..3]);
    $version =~ s/,v\b//;
    $version =~ s/(\S+)$/($1)/;
    $version =~ tr%/%-%;
    print $version, "\n";
    exit 0;
}
$file = $NUKELIST unless $file;

# 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) {
    print "$FS rmmount $mountpoint\n";
    system ($FS, 'rmmount', $mountpoint) unless $justprint;
}
__END__

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

=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.  If no file is given, it
defaults to F</afs/ir/service/afs/data/adsm-delete>.

=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 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 FILES

=over 4

=item F</afs/ir/service/afs/data/adsm-delete>

Where the names of deleted volumes are saved so that they can also be purged
from ADSM.  This path can be overridden with the B<-f> option and changed at
the top of this script.

=back

=head1 SEE ALSO

fs_lsmount(1), vos(1), vos_examine(1), vos_remove(1)

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

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 2002, 2003, 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