| [121] | 1 | #! /usr/bin/perl
|
|---|
| 2 |
|
|---|
| 3 | # Copyright (c) 2007 Riccardo Murri <riccardo.murri@gmail.com>
|
|---|
| 4 | #
|
|---|
| 5 | # License Information:
|
|---|
| 6 | # This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | # it under the terms of the GNU General Public License as published by
|
|---|
| 8 | # the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | # (at your option) any later version.
|
|---|
| 10 | #
|
|---|
| 11 | # This program is distributed in the hope that it will be useful,
|
|---|
| 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | # GNU General Public License for more details.
|
|---|
| 15 | #
|
|---|
| 16 | # You should have received a copy of the GNU General Public License
|
|---|
| 17 | # along with this program; if not, write to the Free Software
|
|---|
| 18 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|---|
| 19 | #
|
|---|
| 20 |
|
|---|
| 21 | use warnings;
|
|---|
| 22 | use strict;
|
|---|
| 23 | use Getopt::Long;
|
|---|
| 24 | use File::Basename;
|
|---|
| 25 | use File::Copy;
|
|---|
| 26 | use File::Temp qw/ tempfile /;
|
|---|
| 27 | use IO::File;
|
|---|
| 28 |
|
|---|
| 29 | # Do I/O to the data file in binary mode (so it
|
|---|
| 30 | # wouldn't complain about invalid UTF-8 characters).
|
|---|
| 31 | use bytes;
|
|---|
| 32 |
|
|---|
| 33 | File::Temp->safe_level( File::Temp::HIGH );
|
|---|
| 34 |
|
|---|
| 35 | my %opts = ();
|
|---|
| 36 | my $outfile;
|
|---|
| 37 | my $verbose;
|
|---|
| 38 | my $base = basename($0);
|
|---|
| 39 |
|
|---|
| 40 | my $cfgfile = "@myconffile@";
|
|---|
| 41 | my $yule = "@sbindir@/@install_name@";
|
|---|
| 42 |
|
|---|
| 43 | $cfgfile =~ s/^REQ_FROM_SERVER//;
|
|---|
| 44 |
|
|---|
| 45 | sub usage() {
|
|---|
| 46 | print <<__END_OF_TEXT__
|
|---|
| 47 | Usage:
|
|---|
| 48 | $base { -a | --add } [options] HOSTNAME [PASSWORD]
|
|---|
| 49 | Add client HOSTNAME to configuration file. If PASSWORD is
|
|---|
| 50 | omitted, it is read from stdin. If HOSTNAME already exists
|
|---|
| 51 | in the configuration file, an error is given.
|
|---|
| 52 |
|
|---|
| 53 | $base { -d | --delete } [options] HOSTNAME
|
|---|
| 54 | Remove client HOSTNAME from configuration file.
|
|---|
| 55 |
|
|---|
| 56 | $base { -l | --list } [options]
|
|---|
| 57 | List clients in the yule configuration file.
|
|---|
| 58 |
|
|---|
| 59 | $base { -r | --replace } [options] HOSTNAME [PASSWORD]
|
|---|
| 60 | Replace password of existing client HOSTNAME in configuration file.
|
|---|
| 61 | If PASSWORD is omitted, it is read from stdin. If HOSTNAME does not
|
|---|
| 62 | already exist in the configuration file, an error is given.
|
|---|
| 63 |
|
|---|
| 64 | $base { -u | --update } [options] HOSTNAME [PASSWORD]
|
|---|
| 65 | Add client HOSTNAME to config file or replace its password with a new one.
|
|---|
| 66 | If PASSWORD is omitted, it is read from stdin.
|
|---|
| 67 |
|
|---|
| 68 | Options:
|
|---|
| 69 | -c CFGFILE --cfgfile CFGFILE
|
|---|
| 70 | Select an alternate configuration file. (default: $cfgfile)
|
|---|
| 71 |
|
|---|
| 72 | -o OUTFILE --output OUTFILE
|
|---|
| 73 | Write modified configuration to OUTFILE. If this option is
|
|---|
| 74 | omitted, $base will rename the original configuration file
|
|---|
| 75 | to '$cfgfile.BAK' and overwrite it with the modified content.
|
|---|
| 76 |
|
|---|
| 77 | -Y YULECMD --yule YULECMD
|
|---|
| 78 | Use command YULECMD to generate the client key from the password.
|
|---|
| 79 | (default: $yule)
|
|---|
| 80 |
|
|---|
| 81 | -v --verbose
|
|---|
| 82 | Verbose output.
|
|---|
| 83 |
|
|---|
| 84 | __END_OF_TEXT__
|
|---|
| 85 | ;
|
|---|
| 86 | return;
|
|---|
| 87 | }
|
|---|
| 88 |
|
|---|
| 89 |
|
|---|
| 90 | ## subroutines
|
|---|
| 91 |
|
|---|
| 92 | sub read_clients ($) {
|
|---|
| 93 | my $cfgfile = shift || '-';
|
|---|
| 94 | my %clients;
|
|---|
| 95 |
|
|---|
| 96 | open INPUT, "<$cfgfile"
|
|---|
| 97 | or die ("Cannot read configuration file '$cfgfile'. Aborting");
|
|---|
| 98 |
|
|---|
| 99 | my $section;
|
|---|
| 100 | while (<INPUT>) {
|
|---|
| 101 | # skip comment and blank lines
|
|---|
| 102 | next if m{^\s*#};
|
|---|
| 103 | next if m{^\s*$};
|
|---|
| 104 |
|
|---|
| 105 | # match section headers
|
|---|
| 106 | $section = $1 if m{^\s*\[([a-z0-9 ]+)\]}i;
|
|---|
| 107 |
|
|---|
| 108 | # ok, list matching lines
|
|---|
| 109 | if ($section =~ m/Clients/) {
|
|---|
| 110 | if (m{^\s*Client=}i) {
|
|---|
| 111 | chomp;
|
|---|
| 112 | s{^\s*Client=}{}i;
|
|---|
| 113 | my ($client, $key) = split /@/,$_,2;
|
|---|
| 114 |
|
|---|
| 115 | $clients{lc($client)} = $key;
|
|---|
| 116 | }
|
|---|
| 117 | }
|
|---|
| 118 | }
|
|---|
| 119 |
|
|---|
| 120 | close INPUT;
|
|---|
| 121 | return \%clients;
|
|---|
| 122 | }
|
|---|
| 123 |
|
|---|
| 124 |
|
|---|
| 125 | sub write_clients ($$$) {
|
|---|
| 126 | my $cfgfile_in = shift || '-';
|
|---|
| 127 | my $cfgfile_out = shift || $cfgfile_in;
|
|---|
| 128 | my $clients = shift;
|
|---|
| 129 |
|
|---|
| 130 | my @lines;
|
|---|
| 131 | my $in_clients_section;
|
|---|
| 132 |
|
|---|
| 133 | # copy-pass input file
|
|---|
| 134 | my $section = '';
|
|---|
| 135 | open INPUT, "<$cfgfile_in"
|
|---|
| 136 | or die ("Cannot read configuration file '$cfgfile_in'. Aborting");
|
|---|
| 137 | while (<INPUT>) {
|
|---|
| 138 | # match section headers
|
|---|
| 139 | if (m{^\s*\[([a-z0-9 ]+)\]}i) {
|
|---|
| 140 | if ($in_clients_section and ($section ne $1)) {
|
|---|
| 141 | # exiting [Clients] section, output remaining ones
|
|---|
| 142 | foreach my $hostname (keys %{$clients}) {
|
|---|
| 143 | push @lines,
|
|---|
| 144 | 'Client=' . $hostname . '@'
|
|---|
| 145 | . $clients->{lc($hostname)} . "\n";
|
|---|
| 146 | delete $clients->{lc($hostname)};
|
|---|
| 147 | }
|
|---|
| 148 | }
|
|---|
| 149 | # update section title
|
|---|
| 150 | $section = $1;
|
|---|
| 151 | if ($section =~ m/Clients/i) {
|
|---|
| 152 | $in_clients_section = 1;
|
|---|
| 153 | } else {
|
|---|
| 154 | $in_clients_section = 0;
|
|---|
| 155 | }
|
|---|
| 156 | }
|
|---|
| 157 |
|
|---|
| 158 | # process entries in [Clients] section
|
|---|
| 159 | if ($in_clients_section) {
|
|---|
| 160 | if (m{^\s*Client=}i) {
|
|---|
| 161 | my ($hostname, undef) = split /@/,$_,2;
|
|---|
| 162 | $hostname =~ s{^\s*Client=}{}i;
|
|---|
| 163 | if (defined($clients->{lc($hostname)})) {
|
|---|
| 164 | # output (possibly) modified key
|
|---|
| 165 | $_ = 'Client=' . $hostname . '@' . $clients->{lc($hostname)} . "\n";
|
|---|
| 166 | delete $clients->{lc($hostname)};
|
|---|
| 167 | }
|
|---|
| 168 | else {
|
|---|
| 169 | # client deleted, skip this line from output
|
|---|
| 170 | $_ = '';
|
|---|
| 171 | }
|
|---|
| 172 | }
|
|---|
| 173 | }
|
|---|
| 174 |
|
|---|
| 175 | # copy input to output
|
|---|
| 176 | push @lines, $_;
|
|---|
| 177 | }
|
|---|
| 178 | close INPUT;
|
|---|
| 179 |
|
|---|
| 180 | # if end-of-file reached within [Clients] section, output remaining ones
|
|---|
| 181 | if ($in_clients_section) {
|
|---|
| 182 | foreach my $hostname (keys %{$clients}) {
|
|---|
| 183 | push @lines, 'Client=' . $hostname . '@'
|
|---|
| 184 | . $clients->{lc($hostname)} . "\n";
|
|---|
| 185 | }
|
|---|
| 186 | }
|
|---|
| 187 |
|
|---|
| 188 | # if necessary, replace input file with output file
|
|---|
| 189 | if ($cfgfile_in eq $cfgfile_out) {
|
|---|
| 190 | copy($cfgfile_in, $cfgfile_in . '.BAK')
|
|---|
| 191 | or die("Cannot backup config file '$cfgfile_in'. Aborting");
|
|---|
| 192 | }
|
|---|
| 193 | open OUTPUT, ">$cfgfile_out"
|
|---|
| 194 | or die ("Cannot write to file '$cfgfile_out'. Aborting");
|
|---|
| 195 | # overwrite config file line by line
|
|---|
| 196 | foreach my $line (@lines) { print OUTPUT $line; }
|
|---|
| 197 | close OUTPUT;
|
|---|
| 198 | }
|
|---|
| 199 |
|
|---|
| 200 |
|
|---|
| 201 | sub new_client_key ($) {
|
|---|
| 202 | my $password = shift;
|
|---|
| 203 | my $yulecmd = shift || $yule;
|
|---|
| 204 |
|
|---|
| 205 | my (undef, $key) = split /@/, `$yulecmd -P $password`, 2;
|
|---|
| 206 | chomp $key;
|
|---|
| 207 | return $key;
|
|---|
| 208 | }
|
|---|
| 209 |
|
|---|
| 210 |
|
|---|
| 211 | ## main
|
|---|
| 212 |
|
|---|
| 213 | Getopt::Long::Configure ("posix_default");
|
|---|
| 214 | Getopt::Long::Configure ("bundling");
|
|---|
| 215 | # Getopt::Long::Configure ("debug");
|
|---|
| 216 |
|
|---|
| 217 | GetOptions (\%opts,
|
|---|
| 218 | 'Y|yule=s',
|
|---|
| 219 | 'a|add',
|
|---|
| 220 | 'c|cfgfile=s',
|
|---|
| 221 | 'd|delete',
|
|---|
| 222 | 'h|help',
|
|---|
| 223 | 'l|list',
|
|---|
| 224 | 'o|output=s',
|
|---|
| 225 | 'r|replace',
|
|---|
| 226 | 'u|update',
|
|---|
| 227 | 'v|verbose',
|
|---|
| 228 | );
|
|---|
| 229 |
|
|---|
| 230 | if (defined ($opts{'h'})) {
|
|---|
| 231 | usage();
|
|---|
| 232 | exit;
|
|---|
| 233 | }
|
|---|
| 234 |
|
|---|
| 235 | if (defined($opts{'c'})) {
|
|---|
| 236 | $cfgfile = $opts{'c'};
|
|---|
| 237 | $outfile = $cfgfile unless defined($outfile);
|
|---|
| 238 | }
|
|---|
| 239 | if (defined($opts{'Y'})) {
|
|---|
| 240 | $yule = $opts{'Y'};
|
|---|
| 241 | }
|
|---|
| 242 | if (defined($opts{'v'})) {
|
|---|
| 243 | $verbose = 1;
|
|---|
| 244 | }
|
|---|
| 245 | if (defined($opts{'o'})) {
|
|---|
| 246 | $outfile = $opts{'o'};
|
|---|
| 247 | }
|
|---|
| 248 |
|
|---|
| 249 | if (defined($opts{'l'})) {
|
|---|
| 250 | # list contents
|
|---|
| 251 | my $clients = read_clients($cfgfile);
|
|---|
| 252 |
|
|---|
| 253 | foreach my $client (keys %{$clients}) {
|
|---|
| 254 | print "$client";
|
|---|
| 255 | print " ${$clients}{$client}" if $verbose;
|
|---|
| 256 | print "\n";
|
|---|
| 257 | }
|
|---|
| 258 | }
|
|---|
| 259 | elsif (defined($opts{'a'})
|
|---|
| 260 | or defined($opts{'u'})
|
|---|
| 261 | or defined($opts{'r'})) {
|
|---|
| 262 | # add HOSTNAME
|
|---|
| 263 | my $hostname = $ARGV[0]
|
|---|
| 264 | or die("Actions --add/--replace/--update require at least argument HOSTNAME. Aborting");
|
|---|
| 265 |
|
|---|
| 266 | my $password;
|
|---|
| 267 | if (defined($ARGV[1])) {
|
|---|
| 268 | $password = uc($ARGV[1]);
|
|---|
| 269 | } else {
|
|---|
| 270 | $password = uc(<STDIN>);
|
|---|
| 271 | # remove leading and trailing space
|
|---|
| 272 | $password =~ s{\s*}{}g;
|
|---|
| 273 | }
|
|---|
| 274 | # sanity check
|
|---|
| 275 | die ("Argument PASSWORD must be a 16-digit hexadecimal string. Aborting")
|
|---|
| 276 | unless ($password =~ m/[[:xdigit:]]{16}/);
|
|---|
| 277 |
|
|---|
| 278 | my $add = defined($opts{'a'});
|
|---|
| 279 | my $replace = defined($opts{'r'});
|
|---|
| 280 |
|
|---|
| 281 | my $clients = read_clients($cfgfile);
|
|---|
| 282 | die ("Client '$hostname' already present in config file - cannot add. Aborting")
|
|---|
| 283 | if ($add and defined(${$clients}{$hostname}));
|
|---|
| 284 | die ("Client '$hostname' not already present in config file - cannot replace. Aborting")
|
|---|
| 285 | if ($replace and not defined(${$clients}{$hostname}));
|
|---|
| 286 |
|
|---|
| 287 | $clients->{$hostname} = new_client_key($password)
|
|---|
| 288 | or die ("Cannot get key for the given password. Aborting");
|
|---|
| 289 | write_clients($cfgfile, $outfile, $clients);
|
|---|
| 290 | }
|
|---|
| 291 | elsif (defined($opts{'d'})) {
|
|---|
| 292 | # remove HOSTNAME
|
|---|
| 293 | my $hostname = $ARGV[0]
|
|---|
| 294 | or die("Action --delete requires one argument HOSTNAME. Aborting");
|
|---|
| 295 |
|
|---|
| 296 | my $clients = read_clients($cfgfile);
|
|---|
| 297 | delete ${$clients}{$hostname};
|
|---|
| 298 | write_clients($cfgfile, $outfile, $clients);
|
|---|
| 299 | }
|
|---|
| 300 | else {
|
|---|
| 301 | usage();
|
|---|
| 302 | die ("You must specify one of --list, --add or --remove options. Aborting");
|
|---|
| 303 | }
|
|---|
