ngircd/debian/ngircd-conf-convert

#!/usr/bin/perl

# Copyright (C) 2011, Christoph Biedl, <debian.axhn@manchmal.in-ulm.de>
#%# license-gplv2+

=head1 NAME

ngircd-conf-convert - convert ngircd.conf from pre18 version

=head1 VERSION

Version 2011.10.30

=cut

our $VERSION = '2011.10.30';

=head1 SYNOPSIS

convert ngircd.conf from pre18 version

Usage:

    ngircd-conf-convert [options] <old ngircd.conf> <new ngircd.conf>

=cut

use 5.010;
use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;

my $ignorecomments;

=head1 OPTIONS

=over

=cut

{
    my $help;
    my $man;
    my %GetOptions = (
	'help|?' =>	\$help,
	'man' =>	\$man
    );

=item B<--ignorecomments>

By default, this program will rewrite configuration variables even if
they are commented out, e.g.

    ;NoDNS = no

to

    ;DNS = yes

Use this option to disable that feature.

=cut

    $GetOptions{'ignorecomments'} = \$ignorecomments;

=item F<old-ngircd.conf> F<new-ngircd.conf>

The old configuration file, and where to write the converted one to.
The first one must exist, the content of the latter will be
overwritten. If C<-> is given, content is read from stdin or written
to stdout, respectively.

=back

=head1 DESCRIPTION

The C<ngircd-conf-convert> converts ngIRCd configuration files according
to the new section and variable names introduced in version 18.

The changes done are small: Just renamings and adding the appropriate
section name. No blocks are moved around, you might want to do that
manually.

Suggested workflow:

    ngircd-conf-convert ngircd.conf ngircd.conf.new
    # compare dumps created by --configtest
    </dev/null ngircd --configtest --config ngircd.conf |
	sed -n '/GLOBAL/,$p' >dump.old
    </dev/null ngircd --configtest --config ngircd.conf.new |
	sed -n '/GLOBAL/,$p' >dump.new
    cmp -s dump.old dump.new || echo "ALERT: configuration was changed!"

Remember: Your C<ngircd.conf> may contain sensitive data, so don't
do that in a world-readable directory.

=cut

    GetOptions (%GetOptions) or pod2usage (2);
    pod2usage (1) if ($help);
    pod2usage (-exitstatus => 0, -ignorecomments => 2) if ($man);

    (scalar (@ARGV) == 2) or
	die ("Need two file parameters.\n");
}

my %convert_logic = (
    # variable name => [ <new section>, <new name>, <invert> ]
    'allowremoteoper'    => [ 'Options' ],
    'chrootdir'          => [ 'Options' ],
    'connectipv4'        => [ 'Options' ],
    'connectipv6'        => [ 'Options' ],
    'connectretry'       => [ 'Limits' ],
    'maxconnections'     => [ 'Limits' ],
    'maxconnectionsip'   => [ 'Limits' ],
    'maxjoins'           => [ 'Limits' ],
    'maxnicklength'      => [ 'Limits' ],
    'nodns'              => [ 'Options', 'DNS', 1 ],
    'noident'            => [ 'Options', 'Ident', 1 ],
    'nopam'              => [ 'Options', 'PAM', 1 ],
    'opercanusemode'     => [ 'Options' ],
    'operservermode'     => [ 'Options' ],
    'pingtimeout'        => [ 'Limits' ],
    'pongtimeout'        => [ 'Limits' ],
    'predefchannelsonly' => [ 'Options' ],
    'sslcertfile'        => [ 'SSL', 'CertFile' ],
    'ssldhfile'          => [ 'SSL', 'DHFile' ],
    'sslkeyfile'         => [ 'SSL', 'KeyFile' ],
    'sslkeyfilepassword' => [ 'SSL', 'KeyFilePassword' ],
    'sslports'           => [ 'SSL', 'Ports' ],
    'syslogfacility'     => [ 'Options' ],
    'webircpassword'     => [ 'Options' ],
);

my $oldvars = join ('|', keys %convert_logic);

my ($old_file, $new_file) = @ARGV;
my ($old_fh, $new_fh);
if ($old_file eq '-') {
    $old_fh = *STDIN;
} else {
    (-f $old_file) or
	die ("Not a file: '$old_file'.\n");
    open ($old_fh, '<', $old_file) or
	die ("Canno read '$old_file': $!.\n");
}

my $section = '';
# last section read from input

my $set_section = '';
# section we're currently in

# slurp content
my @content = <$old_fh>;
($old_file eq '-') or close ($old_fh);

sub insert_line ($$) {
    # insert content before the given line. If this is a comment, seek
    # further backwards.
    my ($before, $content) = @_;
    while ($before > 0 && $content[--$before] =~ /^\s*#/) {
    }
    splice @content, $before+1, 0, $content;
}

for (my $i = 0; $i < scalar (@content); $i++) {
    my $line = $content[$i];
    if ($line =~ /^\s*\[([a-z]+)\]/i) {
	$set_section = $section = lc $1;
    } elsif ($line =~ /^\s*(,|#|$)/) {
	# nothing to do
    } elsif (
	$section eq 'global' &&
	$line =~ /^(\s*)(;\s*)?($oldvars)(\s*=\s*)(.*?)$/i
    ) {
	my ($left, $comment, $var, $middle, $value) =
	    ($1 // '', $2 // '', $3, $4, $5 // '');
	my ($new_section, $new_var, $invert) = @{$convert_logic{lc $var}};
	$new_var //= $var;
	($comment && $ignorecomments) and
	    next;
	if ($set_section ne $new_section) {
	    # switch section
	    insert_line ($i, "[$new_section]\n");	$i++;
	    $set_section = $new_section;
	}
	$invert and
	    ($value = ($value =~ /^(yes|true|[1-9]\d*)\s*$/) ? 'no' : 'yes');
	$content[$i] = "$left$comment$new_var$middle$value\n";
    } elsif ($set_section ne $section) {
	# other content, switch back to global if necessary
	die if ($section ne 'global');
	insert_line ($i, "[Global]\n");	$i++;
	$set_section = $section;
    }
}


if ($new_file eq '-') {
    $new_fh = *STDOUT;
} else {
    open ($new_fh, '>', $new_file) or
	die ("Canno write '$new_file': $!.\n");
    print $new_fh @content;
}
($new_file eq '-') or close ($new_fh);

exit 0;

__END__

=head1 AUTHOR

Christoph Biedl, C<E<lt>debian.axhn@manchmal.in-ulm.deE<gt>>

=head1 COPYRIGHT & LICENSE

    #%# license-gplv2+

=cut

# -- ETYKACLGPAK