Fixed introduced syntax error.
[ssh-keysync.git] / files / server / SshKeySync / Merge.pm
1 #!/usr/bin/perl -w
2 #
3 # SshKeySync::Merge
4 #
5 #
6 #   Exit status:
7 #    1 => Configuration related problems
8 #    2 => Runtime problems
9 #    3 => Filesystemstructure related problems
10 #
11 #   Copyright (C) 2005-2008, Maximilian Wilhelm <max@rfc2324.org>
12
13 #   SshKeySync::Merge is free software; you can redistribute it and/or
14 #   modify it under the terms of the GNU General Public License as published
15 #   by the Free Software Foundation; either version 2, or (at your option) 
16 #   any later version.
17 #   
18 #   On Debian GNU/Linux systems you can find a copy of the GPL in
19 #   /usr/share/common-licenses/GPL
20 #
21
22 package SshKeySync::Merge;
23
24 use strict;
25 use Config::IniFiles;
26 use File::Basename;
27 use File::Copy;
28 use File::Path;
29 use Net::DNS;
30 use SshKeySync::Merge::Domain;
31
32 # Net::DNS::Resolver
33 my $resolver = Net::DNS::Resolver->new;
34
35
36 ##
37 # _options( @args ): Little big of magic #{{{
38 sub _options (@) {
39         my %args = @_;
40         
41         if ($args{debug}) {
42                 foreach my $arg (keys %args) {
43                         print STDERR __PACKAGE__ . "->_options: $arg => $args{$arg}\n";
44                 }
45         }
46         
47         return \%args;
48 }
49 #}}}
50
51 ##
52 # new(): Create new instance # {{{
53 sub new {
54         my $class = shift;
55
56         my $args = &_options;
57
58         # Default configfile if unset.
59         $args->{configfile} = "/etc/ssh-keysync/ssh-keysync-server.conf" unless ( $args->{configfile} );
60
61         if ( $args->{debug} && $args->{quiet} ) {
62                 $args->{quiet} = 0;
63                 print STDERR "Reenabling verbosity as you requested debug information...\n";
64         }
65         
66         # Parse the configfile
67         my ( $config, $domains ) = init( $args  );
68
69         # Default values if unset
70         $config->{debug} = 0 unless ( $config->{debug} );
71         $config->{verbose} = 1 unless ( $args->{quiet} );
72         $config->{base_dir} = "/var/cache/ssh-keysync" unless ( $config->{base_dir} );
73
74         bless {
75                 configfile => $args->{configfile},
76                 config => $config,
77                 domains => $domains,
78                 fh_common_of => undef
79         }, $class;
80 }
81 # }}}
82
83 ##
84 # init(): verify the configuration and initialize data strcuture # {{{
85 sub init() {
86         my $args = shift;
87         my $configfile = $args->{configfile};
88
89         my $config;
90         my $domains;
91         
92         # Check/load config file
93         if ( -f $configfile ) {
94                 ( $config, $domains ) = loadConfig( $configfile, $args );
95
96                 unless( $config ) {
97                         print STDERR "Failed to load config file \"$configfile\", exiting!\n";
98                         exit 1;
99                 }
100         } else {
101                 print STDERR "Unable to load config file \"$configfile\".\n";
102                 print STDERR "File does not exist or is not accessable, exiting\n";
103                 exit 1;
104         }
105
106         # Check working directories
107         unless ( -d $config->{base_dir} ) {
108                 print STDERR "The directory $config->{base_dir} does not exist, but is neccessary for this tool to work.\n";
109                 print STDERR "Please create $config->{base_dir} and allow user 'skeysync' to write there.\n";
110                 exit 3;
111         }
112
113         # Check domain config/dirs
114         if ( %{$domains} ) {
115                 foreach my $domain ( keys %{$domains} ) {
116                         my $keydir="$config->{base_dir}/$domain/keys";
117                         unless ( -d $keydir ) {
118                                 print STDERR "Key directory for domain $domain ($keydir) does not exist.\n";
119                                 exit 3;
120                         }
121                 }
122         } else {
123                 print STDERR "You have to specify at least one domain in $configfile.\n";
124                 exit 1
125         }
126
127         return ( $config, $domains );
128 }
129 # }}}
130
131 ##
132 # loadConfig( $configfile, \%args ): Parse $configfile (using Config::IniFiles) and return a reference %config and %domains. # {{{
133 sub loadConfig {
134         my $configfile = shift;
135         my $args = shift;
136
137         my %config;
138         my %domains;
139
140         print "Loading configuration from $configfile...\n" unless ( $args->{quiet} );
141         my $cfg = new Config::IniFiles( -file => "$configfile" );
142
143         unless( $cfg ) {
144                 return 0;
145         }
146
147         my @sections = $cfg->Sections();
148
149         foreach my $section ( @sections ) {
150
151                 unless ( $section eq "general" ) {
152                         # Initialize/clear values
153                         my $domain = "$section";
154                         my @alt_domains = ();
155                         my %domain_opt;
156                         $domain_opt{separate_outfile} = 1;
157                         $domain_opt{commin_outfile} = 0;
158
159                         my @params = $cfg->Parameters( $section );
160                         foreach my $param ( @params ) {
161                                 # Read the value for this parameter.
162                                 my $value = $cfg->val( $section, $param );
163
164                                 # Are the hosts known in more domains?
165                                 if ( $param eq "alt_domains" ) {
166                                         $value =~ s/"//g;
167                                         @alt_domains = split( /[, ]/, "$value" );
168                                         print "Found alternativ domains in domain $domain : $value\n" if ( $args->{debug} );
169                                 }
170
171                                 # Where to put the known_host information of this domain?
172                                 elsif ( $param eq "separate_outfile" or $param eq "common_outfile" ) {
173                                         if ( $value eq "yes" ) {
174                                                 $domain_opt{$param} = 1;
175                                         }
176                                         elsif ( $value eq "no" ) {
177                                                 $domain_opt{$param} = 0;
178                                         }
179                                         else {
180                                                 print STDERR "Value of $param has to be \"yes\" or \"no\", but $value was found, defauting\n" if ( $args->{debug} );
181                                         }
182                                 }
183                         }
184
185                         # Save domain data
186                         $domains{$domain} = SshKeySync::Merge::Domain->new( $domain, \@alt_domains, $domain_opt{separate_outfile}, $domain_opt{common_outfile} );
187                         print "Domain information for $domain successfully loaded...\n" unless ( $args->{quiet} );
188                 } 
189
190                 else {
191                         my @params = $cfg->Parameters( $section );
192
193                         foreach my $param ( @params ) {
194                                 # Read the value for this parameters
195                                 my $value = $cfg->val( $section, $param );
196
197                                 if ( $param eq "base_dir" ) {
198                                         $config{$param} = $value;
199                                         print "Setting $param = $value\n" if ( $config{debug} );
200                                 } else {
201                                         print STDERR "Unkown configuration paramter $param\n" if ( $config{debug} );
202                                 }
203                         }
204                 } # general
205         }
206
207         return (\%config, \%domains);
208 }
209 # }}}
210
211 ##
212 # merge_domain( $domain ): Merge all keys within $domain. # {{{
213 sub merge_domain {
214         my $self = shift;
215
216         my $config = $self->{config};
217         my $domains = $self->{domains};
218
219         my $domain = shift;
220
221         ##
222         # Check if this domain is valid.
223         unless ( $domains->{$domain} ) {
224                 print STDERR "merge_domain: Domain $domain does not exist.\n";
225                 return 0;
226         }
227
228         my @alt_domains = @{$domains->{$domain}->get_alt_domains()};
229
230         my $keydir = "$config->{base_dir}/$domain/keys";
231         my $sep_outfile = "$config->{base_dir}/$domain/ssh_known_hosts";
232
233         ##
234         # Get the file names
235         unless ( opendir(KEYDIR, $keydir) ) {
236                 print STDERR "Cannot open key directory for domain $domain, skipping this domain... \n";
237                 return 0;
238         }
239         my @files= grep {!/^\.{1,2}$/} readdir(KEYDIR);         # weed out "." and ".."
240         closedir(KEYDIR);
241
242         print "========\n Domain: $domain\n" if ( $config->{verbose} );
243         print "  * Found " . scalar(@files) . " key files...\n" if ( $config->{verbose} );
244
245         ##
246         # Check if there are keys
247         unless( scalar(@files) ) {
248                 print STDERR " Nothing to do for domain $domain...\n" if ( $config->{verbose} );
249                 return 1;
250         }
251
252         ##
253         # Check if the output should be put into a separate outfile for this domain,
254         # open the file is neccessary
255         if ( $domains->{$domain}->get_separate_outfile() ) {
256                 unless( open ( SEPARATE_OF, "> $sep_outfile") ) {
257                         print STDERR "Cannot open outfile for domain $domain, skipping this domain...\n";
258                         return 0;
259                 }
260         }
261
262         ##
263         # Check if the output should be put into the common outfile
264         # Open the file is neccessary and not allready done.
265         my $fh_common_of = undef;
266         if ( $domains->{$domain}->get_common_outfile() ) {
267                 unless( $self->{fh_common_of} ) {
268                         unless( open( $self->{fh_common_of}, "> $config->{base_dir}/ssh_known_hosts" ) ) {
269                                 print STDERR "Cannot open common outfile $config->{base_dir}/ssh_known_hosts for writing.";
270                                 exit 1;
271                         }
272                 }
273                 $fh_common_of = $self->{fh_common_of};
274         }
275
276
277         ##
278         # Check if neither a separate outfile or the common outfile should be used
279         unless ( $domains->{$domain}->get_separate_outfile() or
280                         $domains->{$domain}->get_common_outfile() ) {
281                 print STDERR "Error: The merged keys of domain $domain should neither be written to a\nseparate file, nor the common outfile. Please check the configuration!\n";
282                 return 1;
283         }
284
285         ##
286         # Ok, let's go
287         my $date=`date +"%d.%m.%Y at %H:%M"`;
288         if ( $domains->{$domain}->get_separate_outfile() ) {
289                 print SEPARATE_OF "# ssh_known_hosts generated by " . __PACKAGE__ . " on " . $date . "#\n";
290         }
291
292         ##
293         # Merge all found keys.
294         print "  * Merging keys for domain $domain...\n" if ( $config->{verbose} );
295         foreach my $file (sort @files) {
296                 if ( $file =~ m/([[:alnum:]-]+).(\w+).key/ ) {
297                         my $keyfile = "$keydir/$file";
298                         my $hostname = $1;
299                         my $keytype = $2;
300
301                         ##
302                         # Try to open the file
303                         unless ( open (KEYFILE, "< $keyfile" ) ) {
304                                 warn "Cannot read file $file, skipping...\n";
305                                 next;
306                         }
307
308                         ##
309                         # Read the first line, if there are more, something is wrong...
310                         my $linecounter = 0;
311                         my $keyline = "";
312                         while ( <KEYFILE> ) {
313                                 if ( $linecounter++ == 0 ) {
314                                         $keyline = $_;
315                                 } 
316                         } 
317                         close ( KEYFILE );
318
319                         if ( $linecounter gt 1 ) {
320                                 print STDERR "Error: File $domain / $file contains more that one line, skipping...\n";
321                                 next;
322                         }
323
324                         ##
325                         # Generate/get everything needed for a ssh_known_hosts entry and check if
326                         # this host exists in the DNS.
327                         # Print out the keyline if, move the key away, if not.
328                         my $hostpart = gen_hostpart( $domain, $hostname, \@alt_domains );
329                         my $ip_string = get_ip_string( "$hostname.$domain", $config );
330
331                         unless ( $ip_string ) {
332                                 print STDERR "Warning: No DNS entry found for host $hostname (type $keytype) in domain $domain.\n";
333                                 print STDERR "Moving this key into the ATTIC...\n";
334                                 $self->move_key_to_ATTIC( $domain, $keyfile );
335                                 next;
336                         }
337
338                         my $outline = $hostpart . $ip_string . " " . $keyline;
339
340                         if ( $domains->{$domain}->get_separate_outfile() ) {
341                                 print SEPARATE_OF $outline;
342                         }
343
344                         # Pre-arranged above.
345                         if ( $fh_common_of ) {
346                                 print $fh_common_of $outline;
347                         }
348                 } else {
349                         print STDERR "File $file does not have the format <hostname>.<type>.key, skipping...\n";
350                 }
351
352         }
353         print "  * finished.\n" if ( $config->{verbose} );
354         close ( SEPARATE_OF );
355 }
356 # }}}
357
358 ##
359 # merge_all_domains(): Loop through all domains an merge them. # {{{
360 sub merge_all_domains() {
361         my $self = shift;
362         my $config = $self->{config};
363         my $domains = $self->{domains};
364
365         
366         unless ( $self->{fh_common_of} ) {
367                 unless( open( $self->{fh_common_of}, "> $config->{base_dir}/ssh_known_hosts" ) ) {
368                         print STDERR "Cannot open common outfile $config->{base_dir}/ssh_known_hosts for writing.";
369                         exit 1;
370                 }
371         }
372
373         my $date=`date +"%d.%m.%Y at %H:%M"`;
374
375         my $fh_c_of = $self->{fh_common_of};
376         print $fh_c_of "# ssh_known_hosts generated by " . __PACKAGE__ . " on " . $date . "#\n";
377
378         foreach my $domain (keys %$domains) {
379                 $self->merge_domain( $domain );
380         }
381
382         close( $self->{fh_common_of} );
383 }
384 # }}}
385
386 ##
387 # gen_hostpart( $domain, $hostname, \@alt_domain ): Generate and return a well formated ssh_known_hosts line # {{{
388 #
389 # Usage: gen_entry( domain, hostname, reference to the alt_domains_array )
390 # Format: hostname,hostname.domain,hostname.alt_domain1...hostname.alt_domainN,IP1,IPn key
391 sub gen_hostpart {
392         my ( $domain, $hostname, $alt_domain_ref ) = @_;
393         my @alt_domains = @$alt_domain_ref;
394
395         my $hostpart = "$hostname,$hostname.$domain";
396         foreach my $alt_domain (@alt_domains) {
397                 $hostpart .= ",$hostname.$alt_domain";
398         }
399
400         return $hostpart;
401 }
402 # }}}
403
404 ##
405 # get_ip_string( $host, \%config ): Return a comma separeted list of ip adress(es) for this host. #{{{
406 # (formated to be added to the $hostpart string in gen_entry())
407 #
408 # Format: ",IP1,IP2"
409 sub get_ip_string {
410         my ( $host, $config ) = shift;
411
412         unless( $host ) {
413                 print STDERR "get_ip: No hostname given..." if ( $config->{debug} );
414                 return "";
415         }
416
417         my $ipstring = "";
418         my $query = $resolver->search( $host );
419
420         unless ( $query ) {
421                 print STDERR "No DNS entry found for host $host\n" if ( $config->{debug} );
422                 return "";
423         }
424
425         foreach my $entry ( $query->answer ) {
426                 if ( $entry->type eq "A" ) {
427                         $ipstring .= "," . $entry->address;
428                 }
429         }
430
431         return $ipstring;
432 }
433 #}}}
434
435 ##
436 # move_key_to_ATTIC( $self, $domain, $keyfile): Move $keyfile into the domains ATTIC dir #{{{
437 sub move_key_to_ATTIC {
438         my $self = shift;
439         my $domain = shift;
440         my $keyfile = shift;
441         
442         # Check if $domain exists
443         unless ( $self->{domains}->{$domain} ) {
444                 print STDERR "Error: " . __PACKAGE__ . "::move_key_to_ATTIC called with invalid domain $domain\n";
445                 return 1;
446         }
447
448         # Check $keyfile
449         unless ( $keyfile ) {
450                 print STDERR "Error: " . __PACKAGE__ . "::move_key_to_ATTIC called without a key to move...\n";
451                 return 1;
452         }
453
454         # Check if $keyfile exists
455         unless( -f $keyfile ) {
456                 print STDERR "Error: " . __PACKAGE__ . "::move_key_to_ATTIC: Given keyfile does not exist...\n";
457                 return 1;
458         }
459         
460         # Check if the ATTIC directory for this domain exists, create it if not.
461         unless ( -d "$self->{config}->{base_dir}/$domain/ATTIC" ) {
462                 print STDERR "ATTIC directory for domain $domain does not exist, creating it.\n" if ( $self->{config}->{verbose} );
463                 mkpath( [ "$self->{config}->{base_dir}/$domain/ATTIC" ], 0, 0755 ) 
464                         or die "Cannot create ATTIC dir for domain $domain";
465         }
466
467         rename $keyfile, "$self->{config}->{base_dir}/$domain/ATTIC/" . basename( $keyfile )
468                 or print STDERR "Cannot move " . basename( $keyfile ) . " from domain $domain into the ATTIC...\n";
469 }
470 #}}}
471
472 ##
473 # publish_known_hosts() : Copy generate known_hosts files to public webserver dir  #{{{
474 sub publish_known_hosts() {
475         my $self = shift;
476         my $config = $self->{config};
477         my $domains = $self->{domains};
478
479         print " * Publishing ssh_known_hosts files:\n" if ( $config->{verbose} );
480         print "    - global ssh_known_hosts files...\n" if ( $config->{verbose} );
481
482         if ( -f "$config->{base_dir}/ssh_known_hosts" ) {
483                 unless ( copy( "$config->{base_dir}/ssh_known_hosts", "$config->{base_dir}/pub/" ) ) {
484                         print STDERR "Error, while copying global ssh_known_hosts file to public dir.\n";
485                 }
486         } else {
487                 print STDERR "Global ssh_known_hosts file does not exist.\n";
488         }
489
490         foreach my $domain (keys %${domains}) {
491                 if ( $domains->{$domain}->get_common_outfile() ) {
492                         print "    - ssh_known_hosts file for domain ${domain}...\n" if ( $config->{verbose} );
493                         if ( -f "$config->{base_dir}/$domain/ssh_known_hosts" ) {
494                                 unless ( copy( "$config->{base_dir}/$domain/ssh_known_hosts", "$config->{base_dir}/pub/ssh_known_hosts.${domain}" ) ) {
495                                         print STDERR "Error while copying file...\n";
496                                 }
497                         } else {
498                                 print STDERR "Error: There is no ssh_known_hosts file for domain $domain\n";
499                         }
500                 }
501         }
502 }
503 #}}}
504
505 ##
506 # return true on startup
507 1;
508
509 ##
510 # vim:foldmethod=marker: