649 lines
17 KiB
Perl
Executable File
649 lines
17 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#===============================================================================
|
|
#
|
|
# FILE: edit_host
|
|
#
|
|
# USAGE: ./edit_host [-help] [-debug=N] [-[no]update] [-config=FILE]
|
|
# [-[no]espeak_name] [-hostid=id] [-[no]regex] host_name
|
|
#
|
|
# DESCRIPTION: A simple editor for the HPR hosts table
|
|
#
|
|
# OPTIONS: ---
|
|
# REQUIREMENTS: ---
|
|
# BUGS: ---
|
|
# NOTES: DBI::MariaDB was here for a while then reverted to DBI::mysql.
|
|
# Had to revert this script onn 2023-01-22.
|
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
|
# VERSION: 0.0.7
|
|
# CREATED: 2018-04-07 22:05:06
|
|
# REVISION: 2023-01-22 14:06:48
|
|
#
|
|
#===============================================================================
|
|
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
|
|
use Config::General;
|
|
use File::Temp;
|
|
use File::Slurper qw{ read_text };
|
|
use SQL::Abstract;
|
|
use DBI;
|
|
|
|
use Data::Dumper;
|
|
|
|
#
|
|
# Version number (manually incremented)
|
|
#
|
|
our $VERSION = '0.0.7';
|
|
|
|
#
|
|
# Script and directory names
|
|
#
|
|
( my $PROG = $0 ) =~ s|.*/||mx;
|
|
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
|
|
$DIR = '.' unless $DIR;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Declarations
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Constants and other declarations
|
|
#
|
|
my $basedir = "$ENV{HOME}/HPR/Database";
|
|
my $configfile = "$basedir/.hpr_db.cfg";
|
|
|
|
#
|
|
# Declarations
|
|
#
|
|
my ( $dbh, $sth1, $h1, $rc );
|
|
my ( $host_name, %changes );
|
|
|
|
#
|
|
# Enable Unicode mode
|
|
#
|
|
binmode STDOUT, ":encoding(UTF-8)";
|
|
binmode STDERR, ":encoding(UTF-8)";
|
|
|
|
#
|
|
# Options and arguments
|
|
#
|
|
my %options;
|
|
Options( \%options );
|
|
|
|
#
|
|
# Default help
|
|
#
|
|
pod2usage( -msg => "Version $VERSION\n", -exitval => 1 )
|
|
if ( $options{'help'} );
|
|
|
|
#
|
|
# Collect options
|
|
#
|
|
my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
|
|
|
|
my $cfgfile
|
|
= ( defined( $options{config} ) ? $options{config} : $configfile );
|
|
|
|
my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
|
|
my $regexp = ( defined( $options{'regexp'} ) ? $options{'regexp'} : 0 );
|
|
|
|
my $email = ( defined( $options{'email'} ) ? $options{'email'} : 0 );
|
|
my $profile = ( defined( $options{'profile'} ) ? $options{'profile'} : 0 );
|
|
my $espeak_name
|
|
= ( defined( $options{'espeak_name'} ) ? $options{'espeak_name'} : 0 );
|
|
|
|
#
|
|
# There must be at least one field to change
|
|
#
|
|
die "Select one of -email, -profile and -espeak_name\n"
|
|
unless ( $email || $profile || $espeak_name );
|
|
|
|
#
|
|
# Was a host id provided (through an option)?
|
|
#
|
|
my $hostid = $options{'hostid'};
|
|
|
|
#
|
|
# Deal with the two routes: one via the unique host id, and the other vai the
|
|
# less unique host name
|
|
#
|
|
unless ($hostid) {
|
|
#
|
|
# Get the arg
|
|
#
|
|
$host_name = shift;
|
|
pod2usage( -msg => "Specify the host name\n", -exitval => 1 )
|
|
unless $host_name;
|
|
}
|
|
|
|
#
|
|
# Sanity check
|
|
#
|
|
die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
|
|
|
|
#
|
|
# Load configuration data
|
|
#
|
|
my $conf = new Config::General(
|
|
-ConfigFile => $cfgfile,
|
|
-InterPolateVars => 1,
|
|
-ExtendedAccess => 1
|
|
);
|
|
my %config = $conf->getall();
|
|
|
|
#
|
|
# Connect to the database
|
|
#
|
|
my $dbhost = $config{database}->{host} // '127.0.0.1';
|
|
my $dbport = $config{database}->{port} // 3306;
|
|
my $dbname = $config{database}->{name};
|
|
my $dbuser = $config{database}->{user};
|
|
my $dbpwd = $config{database}->{password};
|
|
|
|
#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
|
|
# $dbuser, $dbpwd, { AutoCommit => 1 } )
|
|
# or die $DBI::errstr;
|
|
|
|
$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
|
|
$dbuser, $dbpwd, { AutoCommit => 1 } )
|
|
or die $DBI::errstr;
|
|
|
|
#
|
|
# Prepare to read the database either for the hostid or the exact or
|
|
# approximate name
|
|
#
|
|
if ($hostid) {
|
|
#
|
|
# Simple hostid query
|
|
#
|
|
$sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE hostid = ?});
|
|
$sth1->execute($hostid);
|
|
if ( $dbh->err ) {
|
|
die $dbh->errstr;
|
|
}
|
|
}
|
|
else {
|
|
#
|
|
# Host name query
|
|
#
|
|
if ($regexp) {
|
|
#
|
|
# Regexp match requested. Count how many matches there are
|
|
#
|
|
$sth1 = $dbh->prepare(
|
|
q{SELECT count(*) AS count FROM hosts WHERE host REGEXP ?});
|
|
$sth1->execute($host_name);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
if ( $h1 = $sth1->fetchrow_hashref ) {
|
|
die "Too many matches to regex $host_name\n"
|
|
unless $h1->{count} == 1;
|
|
}
|
|
else {
|
|
die "Unable to find host matching regex $host_name\n";
|
|
}
|
|
|
|
$sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE host REGEXP ?});
|
|
}
|
|
else {
|
|
$sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE host = ?});
|
|
}
|
|
|
|
#
|
|
# Execute the query
|
|
#
|
|
$sth1->execute($host_name);
|
|
if ( $dbh->err ) {
|
|
die $dbh->errstr;
|
|
}
|
|
}
|
|
|
|
#
|
|
# Did we find it?
|
|
#
|
|
if ( $h1 = $sth1->fetchrow_hashref ) {
|
|
#
|
|
# Found. Save the hostid to simplify the update if we don't already have
|
|
# it
|
|
#
|
|
$hostid //= $h1->{hostid};
|
|
|
|
#
|
|
# So what needs changing?
|
|
#
|
|
#<<< [perltidy messes up the following]
|
|
if ($email) {
|
|
$changes{email} = check_field( 'email',
|
|
scalar( run_editor( $h1->{email}, ['+set paste'] ) ), 256, qr{(\n)} );
|
|
}
|
|
if ($profile) {
|
|
$changes{profile} = run_editor( $h1->{profile}, ['+set paste'] );
|
|
}
|
|
if ($espeak_name) {
|
|
$changes{espeak_name} = check_field( 'espeak_name',
|
|
scalar( run_editor( $h1->{espeak_name} ) ), 256, qr{(\n)} );
|
|
}
|
|
#>>>
|
|
print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
|
|
|
|
#
|
|
# Are we updating the database then?
|
|
#
|
|
if ($updatedb) {
|
|
#
|
|
# Was anything edited?
|
|
#
|
|
if (%changes) {
|
|
#
|
|
# Did the edits do anything? If not delete the element from the
|
|
# hash since there's no point writing it to the database
|
|
#
|
|
for my $key ( keys(%changes) ) {
|
|
if ( $changes{$key} eq $h1->{$key} ) {
|
|
print "No change made to $key, ignored\n";
|
|
delete( $changes{$key} );
|
|
}
|
|
}
|
|
print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
|
|
}
|
|
|
|
#
|
|
# If there's anything left apply the changes
|
|
#
|
|
if (%changes) {
|
|
#
|
|
# Go into transaction mode here so we can fail safely
|
|
#
|
|
$rc = $dbh->begin_work or die $dbh->errstr;
|
|
|
|
my $sql = SQL::Abstract->new;
|
|
my %where = ( hostid => $hostid );
|
|
my ( $stmt, @bind ) = $sql->update( 'hosts', \%changes, \%where );
|
|
#print "$stmt\n";
|
|
#print join( ",", map {"'$_'"} @bind ), "\n";
|
|
|
|
my $sth = $dbh->prepare($stmt);
|
|
my $rv = $sth->execute(@bind);
|
|
|
|
#
|
|
# Respond to any error by rolling back
|
|
#
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
eval { $dbh->rollback };
|
|
$rv = 0;
|
|
}
|
|
else {
|
|
$dbh->commit;
|
|
}
|
|
$rv = 0 if ( $rv eq '0E0' );
|
|
|
|
#
|
|
# Update the log file
|
|
#
|
|
if ($rv) {
|
|
print "Updated database\n";
|
|
}
|
|
else {
|
|
print "Database not updated due to error\n";
|
|
}
|
|
|
|
}
|
|
else {
|
|
print "There was nothing to do\n";
|
|
}
|
|
}
|
|
else {
|
|
print "Database not updated\n";
|
|
}
|
|
}
|
|
else {
|
|
if ($hostid) {
|
|
print "Unable to find host number $hostid\n";
|
|
}
|
|
else {
|
|
print "Unable to find host name $host_name\n";
|
|
}
|
|
}
|
|
|
|
exit;
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: run_editor
|
|
# PURPOSE: Run an interactive vim editor on a string
|
|
# PARAMETERS: $string String to edit
|
|
# $options An arrayref containing options for vim
|
|
# (optional) Example '+set paste'. Each option
|
|
# (such as '-c startinsert') needs to be
|
|
# a separate array element.
|
|
# RETURNS: Edited string
|
|
# DESCRIPTION: Makes a temporary file with File::Temp ensuring that the file
|
|
# is in utf8 mode. Writes the edit string to the file and invokes
|
|
# the 'vim' editor on it. The resulting file is then read back
|
|
# into a string and returned to the caller, again taking care to
|
|
# retain utf8 mode.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: File::Slurp and UTF-8 don't go well together. Moved to
|
|
# File::Slurper instead
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub run_editor {
|
|
my ( $string, $options ) = @_;
|
|
|
|
#
|
|
# Build an arguments array for 'system'
|
|
#
|
|
my @args;
|
|
push( @args, @$options ) if $options;
|
|
|
|
#
|
|
# Make a temporary file
|
|
#
|
|
my $tfh = File::Temp->new;
|
|
binmode $tfh, ":encoding(UTF-8)";
|
|
my $tfn = $tfh->filename;
|
|
print $tfh $string if $string;
|
|
$tfh->close;
|
|
|
|
#
|
|
# Add the filename to the arguments
|
|
#
|
|
push( @args, $tfn );
|
|
|
|
die "Edit failed\n"
|
|
unless ( system( ( 'vim', @args ) ) == 0 );
|
|
|
|
return read_text($tfn);
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: check_field
|
|
# PURPOSE: Checks the a field is not too long and doesn't contain certain
|
|
# characters
|
|
# PARAMETERS: $name name of field
|
|
# $field string to be checked
|
|
# $maxlen maximum string length
|
|
# $regex regex containing illegal characters to be removed
|
|
# RETURNS: The input string truncated and with any illegal characters
|
|
# removed.
|
|
# DESCRIPTION: Runs a substitution on the string then truncates the result if
|
|
# it is too long.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub check_field {
|
|
my ( $name, $field, $maxlen, $regex ) = @_;
|
|
|
|
return unless $field;
|
|
|
|
$field =~ s/$regex//g;
|
|
if ( length($field) > $maxlen ) {
|
|
warn "Field '$name' too long ("
|
|
. length($field)
|
|
. "); truncated to "
|
|
. $maxlen . "\n";
|
|
$field = substr( $field, 0, $maxlen );
|
|
}
|
|
return $field;
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: Options
|
|
# PURPOSE: Processes command-line options
|
|
# PARAMETERS: $optref Hash reference to hold the options
|
|
# RETURNS: Undef
|
|
# DESCRIPTION:
|
|
# THROWS: no exceptions
|
|
# COMMENTS: none
|
|
# SEE ALSO: n/a
|
|
#===============================================================================
|
|
sub Options {
|
|
my ($optref) = @_;
|
|
|
|
my @options = (
|
|
"help", "debug=i", "updatedb!", "config=s",
|
|
"hostid=i", "regexp", "email!", "profile!",
|
|
"espeak_name!",
|
|
);
|
|
|
|
if ( !GetOptions( $optref, @options ) ) {
|
|
pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
__END__
|
|
|
|
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
# Application Documentation
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
#{{{
|
|
|
|
=head1 NAME
|
|
|
|
edit_host - edit one or more fields in the database for a given host
|
|
|
|
=head1 VERSION
|
|
|
|
This documentation refers to edit_host version 0.0.7
|
|
|
|
|
|
=head1 USAGE
|
|
|
|
edit_host [-h] [-debug=N] [-[no]updatedb] [-hostid=ID] [-regexp]
|
|
[-[no]email] [-[no]profile] [-[no]espeak_name] [-config=FILE] hostname
|
|
|
|
edit_host -updatedb -espeak_name operat0r
|
|
edit_host -updatedb -espeak_name -regexp oper
|
|
edit_host -updatedb -email -espeak -host=225
|
|
|
|
|
|
=head1 REQUIRED ARGUMENTS
|
|
|
|
=over 4
|
|
|
|
=item B<hostname>
|
|
|
|
Unless the B<-hostid=ID> option is given (see the OPTIONS section) it is
|
|
necessary to provide a host name.
|
|
|
|
Unless the B<-regexp> option is provided (see the OPTIONS section) the
|
|
hostname must match exactly, otherwise it is regarded as a MySQL regular
|
|
expression.
|
|
|
|
=back
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item B<-[no]updatedb>
|
|
|
|
This option is required to make the script apply any changes that are made to
|
|
the database. By default no updates are applied (B<-noupdatedb>).
|
|
|
|
=item B<-regexp>
|
|
|
|
This option causes the B<hostname> argument to be interpreted as a regular
|
|
expression for the MySQL database. By default the argument is treated as if it
|
|
is an exact match.
|
|
|
|
=item B<-hostid=ID>
|
|
|
|
The host can be specified by the host ID through this route. If this used then
|
|
the B<hostname> argument is not required (and is ignored if given).
|
|
|
|
=item B<-[no]email>
|
|
|
|
This option, if given (as B<-email>), indicates that the 'email' field is to
|
|
be edited. The Vim editor is invoked to make changes. The default is
|
|
B<-noemail> meaning that this field is not to be edited.
|
|
|
|
=item B<-[no]profile>
|
|
|
|
This option, if given (as B<-profile>), indicates that the 'profile' field is
|
|
to be edited. The Vim editor is invoked to make changes. The default is
|
|
B<-noprofile> meaning that this field is not to be edited.
|
|
|
|
=item B<-[no]espeak_name>
|
|
|
|
This option, if given (as B<-espeak_name>), indicates that the 'espeak_name'
|
|
field is to be edited. The Vim editor is invoked to make changes. The default
|
|
is B<-noespeak_name> meaning that this field is not to be edited.
|
|
|
|
=item B<-config=FILE>
|
|
|
|
This option allows an alternative configuration file to be used. This file
|
|
defines the location of the database, its port, its name and the username and
|
|
password to be used to access it. This feature was added to allow the script
|
|
to access alternative databases or the live database over an SSH tunnel.
|
|
|
|
See the CONFIGURATION AND ENVIRONMENT section below for the file format.
|
|
|
|
If the option is omitted the default file is used: B<.hpr_db.cfg>
|
|
|
|
=back
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The script B<edit_host> provides an editor interface to certain fields in
|
|
the B<hosts> table of the HPR database. The fields are:
|
|
|
|
=over 4
|
|
|
|
=item B<email>
|
|
|
|
A single line of up to 256 characters of text. The line is stored in a 'TEXT'
|
|
field but it makes no sense to make it too long even though an email address
|
|
can be arbitrarily long. The current maximum address length in the database is
|
|
44 characters.
|
|
|
|
=item B<profile>
|
|
|
|
A multi-line line of text of arbitrary length and content. The contents are
|
|
the host's profile in optional HTML format to be displayed on the page which
|
|
lists all of their contributions to HPR.
|
|
|
|
=item B<espeak_name>
|
|
|
|
A single line of up to 256 characters of text. The line is stored in a 'TEXT'
|
|
field but it makes no sense to make it too long. Its purpose is to provide the
|
|
'espeak' program with a form of the host name (or alias) which can be spoken
|
|
as the host requires. For example the host 'thelovebug' finds his name spoken
|
|
as "thel ove bug" and this can be corrected by storing 'TheLoveBug' in this
|
|
field.
|
|
|
|
=back
|
|
|
|
=head1 DIAGNOSTICS
|
|
|
|
=over 4
|
|
|
|
=item B<Select one of -email, -profile and -espeak_name>
|
|
|
|
At least one of these options is required. This a fatal error.
|
|
|
|
=item B<Specify the host name>
|
|
|
|
If no host name has been provided, and the B<-hostid=ID> option has not been
|
|
used the script is unable to determine the host to edit. This is a fatal
|
|
error.
|
|
|
|
=item B<Unable to find ...>
|
|
|
|
The configuration file containing details of the database cannot be found.
|
|
This is a fatal error.
|
|
|
|
=item B<DBI connect ... failed: Access denied for user ... >
|
|
|
|
The database connection has been denied. Check the configuration details (see
|
|
below). This a fatal error.
|
|
|
|
=item B<Too many matches to regex ...>
|
|
|
|
In B<-regex> mode a hostname has been provided that matches too many hosts in
|
|
the database. Try again with a less ambiguous name. This a fatal error.
|
|
|
|
=item B<Unable to find host matching regex ...>
|
|
|
|
In B<-regex> mode a hostname has been provided that matches no hosts in the
|
|
database. Try again. This a fatal error.
|
|
|
|
=item B<Edit failed>
|
|
|
|
If the Vim edit session fails in some way the script reports it this way. This
|
|
a fatal error.
|
|
|
|
=item B<Field '...' is too long (...); truncated to ...>
|
|
|
|
The string provided for the field is greater than the limit and has been
|
|
truncated. This is a warning.
|
|
|
|
=back
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT
|
|
|
|
The script obtains the credentials it requires to open the HPR database from
|
|
a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
|
|
directory holding the script. To change this will require changing the script.
|
|
|
|
The configuration file format is as follows:
|
|
|
|
<database>
|
|
host = 127.0.0.1
|
|
port = PORT
|
|
name = DATABASE
|
|
user = USERNAME
|
|
password = PASSWORD
|
|
</database>
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
Config::General
|
|
DBI
|
|
Data::Dumper
|
|
File::Slurper
|
|
File::Temp
|
|
Getopt::Long
|
|
Pod::Usage
|
|
SQL::Abstract
|
|
|
|
=head1 BUGS AND LIMITATIONS
|
|
|
|
There are no known bugs in this module.
|
|
Please report problems to Dave Morriss (Dave.Morriss@gmail.com)
|
|
Patches are welcome.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Dave Morriss (Dave.Morriss@gmail.com)
|
|
|
|
=head1 LICENCE AND COPYRIGHT
|
|
|
|
Copyright (c) 2018 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
|
|
|
|
This module is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself. See perldoc perlartistic.
|
|
|
|
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.
|
|
|
|
=cut
|
|
|
|
#}}}
|
|
|
|
# [zo to open fold, zc to close]
|
|
|
|
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
|
|
|