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