| 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 | } | 
|---|